$CONTROL USLINIT,CODE,MAP                                      <<01549>>00010000
<< OPCOMMAND - MODULE 85>>                                     <<01549>>00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
                                                               <<00635>>00028000
$CONTROL MAIN=OPCOMMAND                                                 00030000
<< 85 -- OPCOMMAND >>                                                   00032000
                                                                        00034000
COMMENT                                                                 00036000
   THE FOLLOWING 'SET' FLAGS MEAN:                                      00038000
      X1 -- TURNS ON A DEBUGGING MODE WHERE THIS MODULE RUNS            00040000
            AS A PROGRAM, SIMULATING THE C.I. READING COMMANDS          00042000
            FROM $STDIN AND PROCESSING THEM AS DIRECTED FROM DEBUG      00044000
;                                                                       00046000
                                                                        00048000
<< PLACE ANY SETS AT THIS POINT>>                                       00050000
                                                                        00052000
                                                                        00054000
                                                                        00056000
COMMENT                                                                 00058000
   THE THEORY BEHIND THE SEGMENTATION USED IN THIS MODULE IS TO         00060000
GROUP THE PROCEDURES ACCORDING TO THEIR FREQUENCY OF USE, I.E.,         00062000
                                                                        00064000
   OPLOW -- FOR LOW USE GENERAL & EXECUTOR PROCEDURES                   00066000
   OPMED -- FOR MODERATE USE GENERAL & EXECUTOR PROCEDURES              00068000
   OPHI  -- FOR HIGH USE GENERAL & EXECUTOR PROCEDURES                  00070000
                                                                        00072000
   ANYONE DISAGREEING WITH THIS GROUPING OR WHERE ITS FOUND THAT        00074000
A PARTICULAR INSTALLATION'S USE OF COMMANDS IS DIFFERENT FROM THE       00076000
GENERAL USE IS WELCOME TO CHANGE THIS GROUPING OF PROCEDURES.           00078000
;                                                                       00080000
$PAGE                                                                   00082000
BEGIN                                                                   00084000
                                                               <<01649>>00086000
<<    ASSOCIATE DST LAYOUT & DEFINITIONS    >>                 <<01649>>00088000
                                                               <<01649>>00090000
COMMENT                                                        <<01649>>00092000
                                                               <<01649>>00094000
*****************************************                      <<01649>>00096000
|                                       |  0                   <<01649>>00098000
|                                       |  1                   <<01649>>00100000
|                  NOT                  |  2                   <<01649>>00102000
|                                       |  3                   <<01649>>00104000
|                  USED                 |  4                   <<01649>>00106000
|                                       |  5                   <<01649>>00108000
|                                       |  6                   <<01649>>00110000
|***************************************|                      <<01649>>00112000
|    NOT USED       | JMAT INDEX(8 BITS)|  7 \                 <<01649>>00114000
|---------------------------------------|    |                 <<01649>>00116000
|    NOT USED  |  JIT INDEX (10 BITS)   |  8 |                 <<01649>>00118000
|---------------------------------------|    |                 <<01649>>00120000
|  DST REL. INDEX TO USER'S NEXT ENTRY  |  9 |                 <<01649>>00122000
|---------------------------------------|    > LDEV #1         <<01649>>00124000
|    CLASS NAME UNDER WHICH LDEV IS     | 10 |                 <<01649>>00126000
|    ASSOCIATED ( LEFT JUSTIFIED AND    | 11 |                 <<01649>>00128000
|    BLANK PADDED -- 8 BYTES )          | 12 |                 <<01649>>00130000
|                                       | 13 /                 <<01649>>00132000
|***************************************|                      <<01649>>00134000
|  JMAT INDEX TO ASSOCIATED USER OR 0   | 14 \                 <<01649>>00136000
|---------------------------------------|    |                 <<01649>>00138000
|   JIT INDEX TO ASSOCIATED USER OR 0   | 15 |                 <<01649>>00140000
|---------------------------------------|    |                 <<01649>>00142000
|   POINTER TO USER'S NEXT ENTRY OR 0   | 16 |                 <<01649>>00144000
|---------------------------------------|    > LDEV #2         <<01649>>00146000
|                                       | 17 |                 <<01649>>00148000
|    CLASS NAME UNDER WHICH LDEV IS     | 18 |                 <<01649>>00150000
|       ASSOCIATED OR UNDEFINED         | 19 |                 <<01649>>00152000
|                                       | 20 /                 <<01649>>00154000
|***************************************|                      <<01649>>00156000
|                                       | 21                   <<01649>>00158000
                                                               <<01649>>00160000
.                   .                   .                      <<01649>>00162000
.                   .                   .                      <<01649>>00164000
.                   .                   .                      <<01649>>00166000
                                                               <<01649>>00168000
|                                       | (7*N)-1              <<01649>>00170000
|***************************************|                      <<01649>>00172000
|    NOT USED       |   JMAT INDEX      | 7*N \                <<01649>>00174000
|---------------------------------------|     |                <<01649>>00176000
|    NOT USED  |      JIT INDEX         |     |                <<01649>>00178000
|---------------------------------------|     |                <<01649>>00180000
|  DST REL. INDEX TO USER'S NEXT ENTRY  |     |                <<01649>>00182000
|---------------------------------------|     > LDEV #N        <<01649>>00184000
|                                       |     |                <<01649>>00186000
|    CLASS NAME UNDER WHICH LDEV IS     |     |                <<01649>>00188000
|             ASSOCIATED                |     |                <<01649>>00190000
|                                       |     /                <<01649>>00192000
*****************************************                      <<01649>>00194000
                                                               <<01649>>00196000
"N" IS THE HIGHEST LOGICAL DEVICE NUMBER CONFIGURED ON THE     <<01649>>00198000
SYSTEM.  (SAME AS THE HIGHEST ENTRY # OF THE LPDT.)            <<01649>>00200000
                                                               <<01649>>00202000
;                                                              <<01649>>00204000
                                                               <<01649>>00206000
EQUATE ASS'SIR = 24,  << SIR # FOR ASSOCIATION TABLE >>        <<01649>>00208000
       ASS'DST = 34,  << DST # FOR ASSOCIATION TABLE >>        <<01649>>00210000
                                                               <<01649>>00212000
       ASS'ENTRYSIZE = 7,  << SIZE OF ONE ENTRY IN TABLE >>    <<01649>>00214000
       ASS'NEXT      = 2,  << INDEX OF POINTER WORD >>         <<01649>>00216000
       ASS'CLASS     = 3,  << WORD INDEX OF CLASS NAME >>      <<04801>>00218000
       B'ASS'CLASS   = ASS'CLASS * 2;                          <<04801>>00220000
                                                               <<01649>>00222000
DEFINE  ASS'JMAT  = 0).(8:8#,   << JMAT INDEX AS PER PCBX >>   <<01649>>00224000
        ASS'JIT   = 1).(6:10#;  << JIT DST #  >>               <<01649>>00226000
                                                               <<01649>>00228000
$PAGE                                                                   00230000
COMMENT                                                                 00232000
   THE JIT FOR EACH USER CONTAINS A ONE WORD ENTRY WHICH IS AN          00234000
   INDEX TO THE HEAD OF THE CHAIN OF ASSOCIATED DEVICE THAT THE         00236000
   USER HAS.  IT IS A WORD INDEX INTO THE ASSOCIATE DST.  IF ZERO,      00238000
   IT IMPLIES THAT THE USER HASN'T ASSOCIATED ANY DEVICES.              00240000
;                                                                       00242000
EQUATE JIT'ASSPTR=5,     <<OFFSET IN USER'S JIT TO ASSOCIATE CHAIN>>    00244000
       JIT'ALLOW=40,     <<OFFSET IN USER'S JIT TO ALLOW TABLE>>        00246000
       JIT'ALLOW'L=3,    <<LENGTH OF ALLOW TABLE IN USER'S JIT>>        00248000
       JIT'ACCTNAME=16,  <<LOGON ACCOUNT NAME>>                         00250000
       JIT'USERNAME=28,  <<LOGON USER NAME>>                            00252000
       JIT'CAP=38,       <<USER CAPABILITIES>>                          00254000
       JIT'LENGTH=73;    <<JIT LENGTH>>                                 00256000
COMMENT                                                                 00258000
   THE JIT FOR EACH USER CONTAINS A THREE WORD ENTRY WHICH IS A MASK    00260000
   WITH A BIT FOR EACH 'OPERATOR' TYPE COMMAND.  EACH BIT SET IMPLIES   00262000
   USER CAN USER THAT COMMAND.  USER'S ALSO GAIN ACCESS TO CERTAIN      00264000
   OPERATOR COMMANDS BY 'ASSOICATE'ING A DEVICE.  THIS GIVES THEM       00266000
   ACCESS TO THOSE 'OPERATOR' COMMANDS DEALING WITH DEVICE FOR THAT     00268000
   DEVICE ONLY.                                                         00270000
;                                                                       00272000
                                                                        00274000
                                                                        00276000
<< THE FOLLOWING EQUATES DEFINE THE MASK BIT FOR EACH OPERATOR COMMAND>>00278000
<< THE FIRST "M'DEVICE" COMMANDS DEFINE THE OPERATOR COMMANDS>>         00280000
<< DEALING WITH DEVICES                                      >>         00282000
                                                               <<01527>>00284000
<< WHEN ADDING A NEW COMMAND TO THIS SET OF EQUATES, >>        <<01527>>00286000
<< BE SURE TO ADD A CORRESPONDING MOVE STATEMENT IN  >>        <<01527>>00288000
<< LOGIMAGE EVEN IF THE COMMAND WILL NOT BE LOGGED.  >>        <<01527>>00290000
                                                                        00292000
EQUATE M'ABORTIO=0,              <<ABORTIO ALLOW MASK BIT>>             00294000
       M'ACCEPT=M'ABORTIO+1,     <<ACCEPT ALLOW MASK BIT>>              00296000
       M'DOWN=M'ACCEPT+1,        <<DOWN ALLOW MASK BIT>>                00298000
       M'GIVE=M'DOWN+1,          <<GIVE ALLOW MASK BIT>>                00300000
       M'HEADOFF=M'GIVE+1,       <<HEADOFF ALLOW MASK BIT>>             00302000
       M'HEADON=M'HEADOFF+1,     <<HEADON ALLOW MASK BIT>>              00304000
       M'REFUSE=M'HEADON+1,      <<REFUSE ALLOW MASK BIT>>              00306000
       M'REPLY=M'REFUSE+1,       <<REPLY ALLOW MASK BIT>>               00308000
       M'STARTSPOOL=M'REPLY+1,        <<STARTSPOOL ALLOW MASK>>         00310000
       M'TAKE=M'STARTSPOOL+1,         <<TAKE ALLOW MASK BIT>>           00312000
       M'UP=M'TAKE+1,            <<UP ALLOW MASK BIT>>                  00314000
       M'MPLINE=M'UP+1,          <<MPLINE ALLOW MASK BIT>>              00316000
       M'DSCONTROL=M'MPLINE+1,   <<DSCONTROL ALLOW MASK BIT>>           00318000
                                                                        00320000
       M'DEVICE=M'DSCONTROL,     <<UPPER LIMIT OF DEVICE COMMANDS>>     00322000
                                                                        00324000
       M'ABORTJOB=M'DEVICE+1,    <<ABORTJOB ALLOW MASK BIT>>            00326000
       M'ALLOW=M'ABORTJOB+1,     <<ALLOW ALLOW MASK BIT>>               00328000
       M'ALTSPOOLFILE=M'ALLOW+1,     <<ALTFILE ALLOW MASK BIT>>         00330000
       M'ALTJOB=M'ALTSPOOLFILE+1,    <<ALTJOB ALLOW MASK BIT>>          00332000
       M'BREAKJOB=M'ALTJOB+1,    <<BREAKJOB ALLOW MASK BIT>>            00334000
       M'DELETESPOOLFILE=M'BREAKJOB+1,<<DELETE ALLOW MASK BIT>>         00336000
       M'DISALLOW=M'DELETESPOOLFILE+1,<<DISALLOW ALLOW MASK>>           00338000
       M'JOBFENCE=M'DISALLOW+1,  <<JOBFENCE ALLOW MASK BIT>>            00340000
       M'LIMIT=M'JOBFENCE+1,     <<LIMIT ALLOW MASK BIT>>               00342000
       M'STOPSPOOL=M'LIMIT+1,         <<STOPSPOOL ALLOW MASK>>          00344000
       M'SUSPENDSPOOL=M'STOPSPOOL+1,  <<SUSPENDSPOOL ALLOW >>           00346000
       M'OUTFENCE=M'SUSPENDSPOOL+1,   <<OUTFENCE ALLOW MASK>>           00348000
       M'RECALL=M'OUTFENCE+1,    <<RECALL ALLOW MASK BIT>>              00350000
       M'RESUMEJOB=M'RECALL+1,   <<RESUMEJOB ALLOW MASK BIT>>           00352000
       M'RESUMESPOOL=M'RESUMEJOB+1,   <<RESUMESPOOL ALLOW MASK>>        00354000
       M'STREAMS=M'RESUMESPOOL+1,     <<STREAMS ALLOW MASK BIT>>        00356000
       M'CONSOLE=M'STREAMS+1,    <<CONSOLE ALLOW MASK BIT>>             00358000
       M'WARN=M'CONSOLE+1,       <<WARN ALLOW MASK BIT>>                00360000
       M'WELCOME=M'WARN+1,       <<WELCOME ALLOW MASK BIT>>             00362000
       M'MON=M'WELCOME+1,        <<MON ALLOW MASK BIT>>                 00364000
       M'MOFF=M'MON+1,           <<MOFF ALLOW MASK BIT>>                00366000
       M'VMOUNT=M'MOFF+1,        <<VMOUNT ALLOW MASK BIT>>              00368000
       M'LMOUNT=M'VMOUNT+1,      <<LMOUNT ALLOW MASK BIT>>              00370000
       M'LDISMOUNT=M'LMOUNT+1,   <<LDISMOUNT ALLOW MASK BIT>>           00372000
       M'MRJECONTROL=M'LDISMOUNT+1,<<MRJECONTROL ALLOW MASK BIT>>       00374000
       M'JOBSCRTY=M'MRJECONTROL+1,<<JOB SECURITY ALLOW MASK BIT>>       00376000
       M'DOWNLOAD=M'JOBSCRTY+1,<<DOWNLOAD ALLOW MASK BIT>>  <<00575>>   00378000
       M'MIOENABLE=M'DOWNLOAD+1,<<MIOENABLE ALLOW MASK BIT>>   <<00575>>00380000
       M'MIODISABLE=M'MIOENABLE+1, <<MIODISABLE ALLOW MASK>>   <<00601>>00382000
       M'LOG=M'MIODISABLE+1,       <<LOG ALLOW MASK>>          <<00792>>00384000
       M'FOREIGN=M'LOG+1,      <<FOREIGN ALLOW MASK>>          <<00792>>00386000
       M'IMLCONTROL=M'FOREIGN+1,                               <<00792>>00388000
       M'SHOWCOM=M'IMLCONTROL+1,  <<SHOWCOM ALLOW MASK BIT>>            00390000
       NO'OF'OPCOMMANDS=M'SHOWCOM+1;                           <<01527>>00392000
$PAGE                                                                   00394000
INTEGER S0=S-0,                                                         00396000
        S1=S-1,                                                         00398000
        S2=S-2,                                                         00400000
        S3=S-3,                                                         00402000
        X=X;                                                            00404000
                                                                        00406000
INTEGER DB0 = DB + 0,                                                   00408000
        DB1 = DB + 1,                                          <<04801>>00410000
        DB2 = DB + 2,                                          <<04801>>00412000
        DB3 = DB + 3;                                          <<04801>>00414000
                                                               <<04801>>00416000
LOGICAL LS0=S-0,                                                        00418000
        LS1=S-1,                                                        00420000
        LS2=S-2,                                                        00422000
        LS3=S-3,                                                        00424000
        STATUS=Q-1;                                                     00426000
                                                                        00428000
BYTE POINTER BPS0=S-0,                                                  00430000
             BPS1=S-1,                                                  00432000
             BPS2=S-2,                                                  00434000
             BPS3=S-3;                                                  00436000
                                                                        00438000
INTEGER POINTER PS0=S-0,                                                00440000
                PS1=S-1,                                                00442000
                PS2=S-2,                                                00444000
                PS3=S-3,                                       <<04801>>00446000
                PDB0 = DB + 0,                                 <<04801>>00448000
                PDB1 = DB + 1,                                 <<04801>>00450000
                PDB2 = DB + 2,                                 <<04801>>00452000
                PDB3 = DB + 3,                                 <<04801>>00454000
                PDB4 = DB + 4;                                 <<04801>>00456000
                                                               <<04801>>00458000
DOUBLE POINTER DPS0 = S-0;                                     <<04801>>00460000
                                                                        00462000
INTEGER ARRAY ARRDB0(*)=DB+0,                                           00464000
              ARRDB1(*)=DB+1,                                           00466000
              ARRDB2(*)=DB+2,                                           00468000
              ARRDB3(*)=DB+3,                                           00470000
              ARRDB4(*)=DB+4,                                           00472000
              ARRDB5(*)=DB+5,                                           00474000
              ARRDB6(*)=DB+6,                                           00476000
              ARRDB12(*)=DB+12,                                <<04801>>00478000
              ARRDB27(*)=DB+27;                                         00480000
                                                                        00482000
EQUATE CCG=0,                                                           00484000
       CCL=1,                                                           00486000
       CCE=2,                                                           00488000
       CCX=3;                                                           00490000
                                                                        00492000
                                                                        00494000
DEFINE CC=STATUS.(6:2)#;                                                00496000
$INCLUDE INCLCIS                                               <<04604>>00498000
INTEGER POINTER DBP = DB + 1;  <<POINTER TO DB FROM PCBX>>              00502000
                                                                        00504000
                                                                        00506000
$PAGE "MESSAGE SET EQUATES"                                             00508000
<< The following CI error message  equates  (<  3000)  were >> <<04801>>00510000
<< added as part of this fix.                               >> <<04801>>00512000
EQUATE                                                         <<04801>>00514000
   ACCTEXPECTALPHA  =  550,   <<LEADING CHAR MUST BE ALPHA>>   <<04801>>00516000
   ACCTNAMEMISSING  =  551,   <<EXPECTED ACCOUNT NAME>>        <<04801>>00518000
   ACCTNAMETOOLONG  =  552,   <<ACCT NAME > 8 CHAR>>           <<04801>>00520000
   ACCTEXPECTNAMENOTAT=553,   <<EXPECTED NAME, FOUND "@">>     <<04801>>00522000
   USEREXPECTALPHA  =  590,                                    <<04801>>00524000
   USERNAMEMISSING  =  591,                                    <<04801>>00526000
   USERNAMETOOLONG  =  592,                                    <<04801>>00528000
   USEREXPECTNAMENOTAT=593,                                    <<04801>>00530000
   SHOWNODST        = 1127,   <<OUT OF DST'S>>                 <<04801>>00532000
   SHOWNOVDS        = 1128,   <<OUT OF VIRTUAL MEM FOR DST>>   <<04801>>00534000
   SHOWNOSPACE      = 1129,   <<OUT OF SPACE IN DST>>          <<04801>>00536000
   SHOWSYSERR       = 1130,   <<UNKNOW ERROR USING DST>>       <<04801>>00538000
   SHOWJOBOPNERR    =  1495,   <<CAN'T OPEN LISTFILE>>         <<04801>>00540000
   SHJBEXPARMLST    =  1496,   <<IGNRD PARMS PAST LISTFILE>>   <<04801>>00542000
   SHOWJOBCLSERR    =  1497,   <<CAN'T CLOSE LISTFILE>>        <<04801>>00544000
   SHOWJSTATSIGNRD  = 1500,   <<STATUS REQUEST IGNORED>>       <<04801>>00546000
   SHOWJXTRANPARMS  = 1501,   <<EXTRA PARMS IGNORED>>          <<04801>>00548000
   SHOWJXPCTJOB     = 1502,   <<EXPECTED JOB ID>>              <<04801>>00550000
   SHOWJXPCTATS     = 1503,   <<EXPECTED "@S">>                <<04801>>00552000
   SHOWJXPCTATJ     = 1504,   <<EXPECTED "@J">>                <<04801>>00554000
   SHOWJUNKATX      = 1505,   <<EXPECTED EITHER "@S" OR "@J">> <<04801>>00556000
   SHOWJJNAME2LONG  = 1506,   <<JOB NAME > 8 CHARACTERS LONG>> <<04801>>00558000
   SHOWJJNXPCTALPH  = 1507,   <<EXPECTED ALPHA LEADING CHAR>>  <<04801>>00560000
   SHOWJXPCTJN      = 1508,   <<SPECIALS EMBEDDED IN JOB NAME>><<04801>>00562000
   SHOWJXPCTJSNUM   = 1509,   <<EXPECTED EITHER J OR S>>       <<04801>>00564000
   SHOWJXPLCTJ2MP   = 1510,   <<EXTRA PARMS IGNORED>>          <<04801>>00566000
   SHOWJUNKKEY      = 1511,   <<UNKNOWN KEYWORD>>              <<04801>>00568000
   SHOWJ2MERRORS    = 1512,   <<TOO MANY ERRORS, PARSING STOPPE<<04801>>00570000
   SHOWJFSERR       = 1513,   <<SCRATCH FILE ERROR>>           <<04801>>00572000
   SHOWJREDNDSTATE  = 1514,   <<INCONSISTENT SPEC OF JOB STATE><<04801>>00574000
   SHOWJNDINAP      = 1515,   <<ONLY WITH WAIT STATE>>         <<04801>>00576000
   SHOWJUNKDEFR     = 1516,   <<UNKNOWN DEFER STATE>>          <<04801>>00578000
   SHOWJXPCTUN      = 1517,   <<EMBEDDED SPECIALS NOT ALLOWED>><<04801>>00580000
   SHOWJXPCTPERIOD  = 1518,   <<USER.ACCT>>                    <<04801>>00582000
   SHOWJXPCTAN      = 1519,   <<EMBEDDED SPECIALS NOT ALLOWED>><<04801>>00584000
   SHOWJREDUNDJOB   = 1520,   <<JOB PARM REDUNDANTLY SPECIFIED><<04801>>00586000
   SHOWJXPCTJOBEQ   = 1521,   <<EXPECTED = SIGN AFTER "JOB">>  <<04801>>00588000
   SHOWFXPCTODEVFL  = 1530,   <<ONLY OUTFILES WITH SHOWOUT>>   <<04801>>00590000
   SHOWFXPCTIDEVFL  = 1531,   <<ONLY INFILES WITH SHOWIN>>     <<04801>>00592000
   SHOWFINVLDDFID   = 1532,   <<INVALID DEVICEFILE ID>>        <<04801>>00594000
   SHOWFXTRAIGNORD  = 1533,   <<EXTRA PARAMETERS INAPPROPRIATE><<04801>>00596000
   SHOWFUNKKEY      = 1534,   <<UNKNOWN KEYWORD>>              <<04801>>00598000
   SHOWFSTATSIGNRD  = 1535,   <<STATUS PARM IGNORED>>          <<04801>>00600000
   SHOWFXTRANPARMS  = 1536,   <<UNIDENTIFIABLE PARAMETERS>>    <<04801>>00602000
   SHOWFFSERR       = 1537,   <<SCRATCH FILE FILESYS ERROR>>   <<04801>>00604000
   SHOWF2MERRORS    = 1538,   <<TOO MANY ERRORS IN PARSE>>     <<04801>>00606000
   SHOWFREDNDSTATE  = 1539,   <<STATE INCONSISTENTLY SPECIFIED><<04801>>00608000
   SHOWFINNDINAP    = 1540,   <<INPUT FILES CANNOT BE DEFERRED><<04801>>00610000
   SHOWFOUTNDINAP   = 1541,   <<APPROPRIATE ONLY FOR "READY" FI<<04801>>00612000
   SHOWFUNKDEFR     = 1542,   <<EXPECTED "N" OR "D">>          <<04801>>00614000
   SHOWFXPCTJOBEQ   = 1543,   <<EXPECTED "JOB=">>              <<04801>>00616000
   SHOWFXPCTJOB     = 1544,   <<INVALID JOB NAME SYNTAX>>      <<04801>>00618000
   SHOWFXPCTATS     = 1545,   <<EXPECTED @S OR @S'>>           <<04801>>00620000
   SHOWFXPCTATJ     = 1546,   <<EXPECTED @J OR @J'>>           <<04801>>00622000
   SHOWFUNKATX      = 1547,   <<UNKNOWN JOB TYPE>>             <<04801>>00624000
   SHOWFXPCTSNUM    = 1548,   <<INVALID SESSION NUMBER>>       <<04801>>00626000
   SHOWFXPCTJNUM    = 1549,   <<INVALID JOB NUMBER>>           <<04801>>00628000
   SHOWFXPCTJSNUM   = 1550,   <<INVALID JOB ID>>               <<04801>>00630000
   SHOWFREDUNDJOB   = 1551,   <<REDUNDANTLY SPECIFIED>>        <<04801>>00632000
   SHOWFXPCTDEV     = 1552,   <<EXPECTED DEVICE>>              <<04801>>00634000
   SHOWFINVLDDEVSP  = 1553,   <<INVALID DEVICE SPECIFICATION>> <<04801>>00636000
   SHOWFINPTDEVCLS  = 1554,   <<DEV CLASS INAPPROPRIATE FOR INP<<04801>>00638000
   SHOWFDACCESSDEV  = 1555,   <<DIRECT ACCESS INAPPROPRIATE>>  <<04801>>00640000
   SHOWFRDNTDEV     = 1556,   <<REDUNDANT>>                    <<04801>>00642000
   SHOWDV2MP        = 1580,  <<TOO MANY PARAMETERS TO SHOWDEV>><<04801>>00644000
   SHOWDVNOSUCHLDN  = 1581,  <<LDN CAN'T BE FOUND ON SYSTEM>>  <<04801>>00646000
   SHOWDVINVLDCLAS  = 1582,  <<CLASS NAME > 8 CHARACTERS>>     <<04801>>00648000
   SHOWDVNOSUCHCLS  = 1583,  <<CAN'T FIND DEVICE CLASS ON SYS>><<04801>>00650000
   SHOWFDSDEVICE    = 1584,  <<DS DEVICE INAPPROPRIATE>>       <<04801>>00652000
   STRMNOTENABLED   =   82,  <<STREAM DISABLED>>               <<04801>>00654000
   STRMNOSYSDEF     = 1590,  <<SYS DEF FILE NOT ALLOWED>>      <<04801>>00656000
   STRMINVLDCOLON   = 1591,  <<BAD PSEUDOCOLON>>               <<04801>>00658000
   STRMSYNTAX       = 1592,  <<BAD SYNTAX TO COMMAND>>         <<04801>>00660000
   STRMFILEOPENERR  = 1596; <<CAN'T OPEN STREAM FILE>>         <<04801>>00662000
                                                                        00664000
EQUATE OPCOMMNOTALLOW=3000,    <<USER HASN'T ACCESS TO OP COMMAND>>     00666000
       EXPLDEVBAD=3001,        <<EXPECTED LOGICAL DEVICE # BAD>>        00668000
       LDEVNOTCONFIG=3002,     <<LOGICAL DEVICE NOT IN THIS CONFIG.>>   00670000
       HEADONREQ1P=3003,       <<HEADON HAS EXACTLY ON PARAMETER, LDEV>>00672000
       HEADOFFREQ1P=3004,      <<HEADOFF HAS EXACTLY ONE PARAMETER>>    00674000
       LDEVNOTCRPRPNCH=3005,   <<EXPECTED CARD READ, PRINTER, OR PUNCH>>00676000
       USERNOACC2DEV=3006,     <<USER HAS NO ACCESS TO DEVICE>>         00678000
       LDEVNOTREAL=3007,       <<LOGICAL DEVICE IS NOT REAL>>           00680000
       GIVEREQ1P=3008,         <<GIVE REQUIRES EXACTLY ONE PARAM.>>     00682000
       TAKEREQ1P=3009,         <<TAKE REQUIRES EXACTLY ONE PARAM.>>     00684000
       LDEVINBYF=3010,         <<DEVICE IN USE BY SYSTEM, MUST BE DOWN>>00686000
       LDEVALINBYDIAG=3011,    <<DEVICE ALREADY IN USE BY DIAGNOSTICS>> 00688000
       UPREQ1P=3012,           <<UP REQUIRES EXACTLY ONE PARAMETER>>    00690000
       DOWNREQ1P=3013,         <<DOWN REQUIRES EXACTLY ONE PARAMETER>>  00692000
       LDEVINBYDIAG=3014,      <<DEVICE IN USE BY DIAGNOSTICS>>         00694000
       LDEVALINBYF=3015,       <<DEVICE ALREADY IN USE BY SYSTEM>>      00696000
       LDEVALDOWN=3016,        <<DEVICE ALREADY DOWN>>                  00698000
       LDEVALDOWNP=3017,       <<DEVICE ALREADY HAS DOWN PENDING>>      00700000
       LDEVINUSEDOWNP=3018,    <<DEVICE IN USE, DOWN PENDING>>          00702000
       RECALLHEADER=3019,      <<THE FOLLOWING REPLIES PENDING:>>       00704000
       WELCREADERR= 901,    << CIERR-READ ERROR IN WELCOME>>   <<01523>>00706000
       NOREPLYPENDING=3020,    <<NO REPLIES PENDING>>                   00708000
       ASSBYOTHERS=3021,       <<DEVICE ALREADY ASSOCIATED BY OTHERS>>  00710000
       LDEVNOTINDIAG=3022,     <<DEVICE NOT IN DIAGNOSTICS>>            00712000
       OUTFENCEREQ1P=3023,     <<OUTFENCE REQUIRES ONE PARAMETER>>      00714000
       EXPPRIOR1TO14=3024,     <<OUTFENCE PRIORITY EXPECTED 1 TO 14>>   00716000
       EXPPRIORGT14=3025,      <<PRIORITY > 14, 14 USED>>               00718000
       EXPPRIORLT1=3026,       <<PRIORITY < 1 , 1  USED>>               00720000
       ABORTIOREQ1P=3027,      <<ABORTIO REQUIRES ONE PARAMETER>>       00722000
       NOIOQED4DEV=3028,       <<NO I/O TO ABORT FOR DEVICE>>           00724000
       ACCEPTREQ2PARM=3029,    <<ACCEPT HAS AT MOST TWO PARMS>>         00726000
       REFUSEREQ2PARM=3030,    <<REFUSE HAS AT MOST TWO PARMS>>         00728000
       ACCEPTREQ1P=3031,       <<ACCEPT MUST HAVE AT LEAST 1 PARM.>>    00730000
       REFUSEREQ1P=3032,       <<ACCPET MUST HAVE AT LEAST 1 PARAM.>>   00732000
       COMMAAFTERDJ=3033,      <<COMMA EXPECTED AFTER DATA OR JOBS>>    00734000
       FIRSTMUSTBEDJ=3034,     <<EXPECTED 'DATA' OR 'JOBS'>>            00736000
       LDEVNOTDJ=3035,         <<LDEV NOT DATA OR JOB ACCEPTING>>       00738000
       LDEVHASNODEFOUT=3036,   <<LDEV HAS NOT DEFAULT OUTPUT DEVICE>>   00740000
       WELMSGBUSY=3037,        <<WELCOME DST'S BUSY>>                   00742000
       BREAKJOBREQ1P=3038,     <<BREAKJOB HAS EXACTLY ONE PARAMETER>>   00744000
       RESUMEJOBREQ1P=3039,    <<RESUMEJOB HAS EXACTLY ONE PARAMETER>>  00746000
       PARMNOTJOBID=3040,      <<EXPECTED JOB ID (#JNNN)>>              00748000
       BADJOBNUM=3041,         <<MUST BE POSITIVE INTEGER> 1>>          00750000
       NOSUCHJOB=3042,         <<THE SPECIFIED JOB DOES NOT EXIST>>     00752000
       JOBNOTACTIVE=3043,      <<BREAKJOB REQUIRES JOB TO BE ACTIVE>>   00754000
       JOBNOTSUSPENDED=3044,   <<RESUMEJOB REQUIRES JOB TO BE SUSPEND>> 00756000
       SUSPENDJOBOWN=3045,     <<SUSPEND JOB NNN OWNS DEVICE NNN>>      00758000
       JOBINTERM=3046,         <<RESUMING OR SUSPENDING JOB IN TERM.>>  00760000
       ILLEGALVALUE =3045,     << SPECIFIED INPRI OF 0 OR 14  ><<04684>>00762000
       NOTUSERSJOB=3047,       <<USER RESUMING OR SUSPENDING NOT HIS J>>00764000
       REPLYREQ2P=3048,        <<REPLY HAS AT LEAST TWO PARAMETERS>>    00766000
       REPLYTOOMANYP=3049,     <<REPLY HAS TOO MANY PARAMETERS>>        00768000
       INVALIDPIN=3050,        <<INVALID PIN SUPPLIED ON REPLY>>        00770000
       NOREQ4PIN=3051,         <<NO REPLY OUTSTANDING FOR PIN>>         00772000
       REPLYEXPYN'NUM=3052,    <<REPLY EXPECTED YES/NO OR #>>           00774000
       REPLYEXPYN=3053,        <<REPLY EXPECTED Y/N>>                   00776000
       REPLYEXPNUMBER=3054,    <<REPLY EXPECTED NUMBER>>                00778000
       ASSREQ1P=3055,          <<ASSOCIATE HAS EXACTLY ONE PARAMETER>>  00780000
       DISASSREQ1P=3056,       <<DISASSOCIATE HAS EXACTLY 1 PARAMETER>> 00782000
       USERHASDEVASS=3057,     <<USER ALREADY HAS ASSOCIATED DEVICE>>   00784000
       USERNOTASS2DEV=3058,    <<USER CAN'T DISASS. DEVICE NOT ASS. BY>>00786000
       USERCANTASSDEV=3059,    <<USER HAS NO PERMISSION TO ASS. DEVICE>>00788000
       REPLYEXP2PARM=3060,     <<REPLY EXPECTED TWO PARAMETERS ONLY>>   00790000
       STRINGTOOLONG=3061,     <<REPLY STRING TOO LONG>>                00792000
       JOBFENCEREQ1P=3062,     <<JOBFENCE REQUIRES EXACTLY 1 PARAMETER>>00794000
       EXP0TO14=3063,          <<JOB PRIORITY MUST BE >0 AND <14>>      00796000
       EXPPRIORLT0=3064,       <<JOBFENCE <0, ZERO USED>>               00798000
       EXPCOMMABREPLYP=3065,   <<EXPECTED COMMA BETWEEN REPLY PARM.>>   00800000
       STREAMSREQ1P=3066,      <<STREAMS EXPECTS EXACTLY ONE PARAMETER>>00802000
       CANTBETERM=3067,        <<STREAMS DEVICE CAN'T BE TERMINAL>>     00804000
       DEVNOTDJ=3068,          <<STREAMS DEVICE MUST BE DATA & JOB ACC>>00806000
       CONSOLEREQ1P=3069,      <<CONSOLE EXPECTS EXACTLY ONE PARAMETER>>00808000
       DEVNOTJOB=3070,         <<CONSOLE DEVICE MUST BE JOB ACCEPTING>> 00810000
       EXP1OFSORJLIMIT=3071,   <<EXPECTED ONE OF JOB OR SESSION LIMIT>> 00812000
       LIMITHAS2PARM=3072,     <<LIMIT HAS AT MOST TWO PARAMETERS>>     00814000
       EXPCOMMASJ=3073,        <<LIMIT EXPECTS COMMA BETWEEN PARAMETER>>00816000
       SLIMITBAD=3074,         <<SESSION LIMIT BAD>>                    00818000
       JLIMITBAD=3075,         <<JOB LIMIT BAD>>                        00820000
       EXPJNUMORJNAME=3076,    <<EXPECTED ONE OF JOBNUM OR JOBNAME>>    00822000
       DEVNOTOUTPUT=3077,      <<OUTDEV ON ALTJOB MUST BE OUTPUT DEV>>  00824000
       JOBNUMNOOTHERP=3078,    <<JOBNUM HAS NO OTHER PARAMETERS>>       00826000
       EXPJORSNUM=3079,        <<EXPECTED EITHER #JNNN OR #SNNN>>       00828000
       EXPUANDANAME=3080,      <<EXPECTED BOTH USERNAME AND ACCTNAME>>  00830000
       UORANAMEMAX8=3081,      <<USER AND ACCT NAME LIMITED TO 8 CHARS>>00832000
       PERIODEXP=3082,         <<PERIOD BETWEEN USER AND ACCT NAME>>    00834000
       JOBBEINTRO=3083,        <<CAN'T ABORT JOB BEING INTRODUCED>>     00836000
       EXPACCTNAME=3084,       <<EXPECTED [JOBNAME,]USER.NAME>>         00838000
       UORANAMEZERO=3085,      <<USER OR ACCT CAN'T BE ZERO LENGTH>>    00840000
       EXP1OFINOUT=3086,       <<KEYS FOR ALTJOB MUST BE INPRI/OUTDEV>> 00842000
       EXPSEMICOLON=3087,      <<KEYS MUST BE PRECEDED WITH ";">>       00844000
       EXPEQUALS=3088,         <<PARAMETER FOLLOWING KEY MUST HAVE "=">>00846000
       EXPJAND1PARM=3089,      <<ALTJOB MUST HAVE JOB & AT LEAST 1 KEY>>00848000
       NOSUCHDEV=3090,         <<NO SUCH DEVICE OR DEVICECLASS>>        00850000
       MUSTWAITORINTRO=3091,   <<ALTJOB MUST BE ON WAIT OR INTRO. JOB>> 00852000
       CANTBESYSFILE=3092,     <<ALLOW/DISALLOW FILE=CANT BE SYSTEM FI>>00854000
       MUSTBEASNOCTL=3093,     <<FILE=MUST BE ASCII/NOCCTL FILE>>       00856000
       EXP1OFUSERFILE=3094,    <<EXPECTED FILE= OR USER.ACCT;COMMANDS=>>00858000
       EXPUSERNAME=3095,       <<EXPECTED USERNAME>>                    00860000
       COMMANDSEPBYCOMMA=3096, <<COMMANDS ARE SEPARATED BY COMMAS>>     00862000
       EXPCOMMANDS=3097,       <<EXPECTED COMMANDS=>>                   00864000
       NOSUCHCOMMAND=3098,     <<UNKNOWN OPERATOR COMMAND>>             00866000
       TOOMANYPARM=3099,       <<ALLOW/DISALLOW TOO MANY PARAMETERS>>   00868000
       ALLDISALLIOERR=3100,    <<I/O ON FILE= FILE>>                    00870000
       NOJOBINGOODSTATE=3101,  <<NO JOBS IN EXECUTION STATE>>           00872000
       EXP1OFONOFF=3102,       <<EXPECTED EITHER ON/OFF IN VMOUNT>>     00874000
       EXPALL=3103,            <<EXPECTED ;ALL>>                        00876000
       REQSETGRPACCT=3104,     <<EXPECTED SET.GROUP.ACCT>>              00878000
       LMHAS5PARMS=3105,       <<LMOUNT HAS AT MOST 5 PARMS>>           00880000
       LDMEXP3PARMS=3106,      <<LDISMOUNT HAS EXACTLY 3 PARMS>>        00882000
       BADSETNAME=3107,        <<BAD VOLUME SET/CLASS NAME>>            00884000
       SETNAMEPERIOD=3108,     <<EXPECTED PERIOD FOLLOWING SET NAME>>   00886000
       GROUPPERIOD=3109,       <<EXPECTED PERIOD FOLLOWING GROUP NAME>> 00888000
       EXPGENERATION=3110,     <<EXPECTED ;GEN=>>                       00890000
       BADGENERATION=3111,     <<INVALID GENERATION #>>                 00892000
       MONMAXPARM=3112,        <<TOO MANY PARMS FOR MON>>               00894000
       MONREQLDEV=3113,        <<EXPECTED LDEV FOR MON>>                00896000
       NOSYSBUF=3114,          <<NO SYSTEM BUFFERS FOR MONITORING>>     00898000
       MONMUSTBETAPE=3115,     <<LDEV MUST BE TAPE FOR MONITORING>>     00900000
       TAPEMUSTBEDOWN=3116,    <<LDEV MUST BE DOWN FOR MONITORING>>     00902000
       EXPSEMI'E'EQUALS=3117,  <<EXPECTED ;E=>>                         00904000
       MASKCOMMA=3120,         <<EXPECTED COMMA FOLLOWING MASK BIT #>>  00906000
       IGNOREDNULL=3121,       <<IGNORED NULL MASK BIT #>>              00908000
       BADMASK=3122,           <<INVALID MASK BIT SPECIFIED>>           00910000
       NODS=3123,              <<NO DS SUBSYSTEM>>                      00912000
       NOMP=3124,              <<NO MULTI-POINT SUBSYSTEM>>             00914000
       NOMRJE=3125,            <<NO MRJE SUBSYSTEM>>                    00916000
       EXPAUTO=3126,           <<EXPECTED AUTO FOLLOWING ON PARAMETER>> 00918000
       INVALIDNAME=3127,       <<NAME MUST BE 1-8 CHARS,ALPHANUMERIC>>  00920000
       JOBSECURITY1PARM=3128,  <<JOBSECURITY HAS EXACTLY ONE PARAMETER>>00922000
       EXP1OFHIGHLOW=3129,     <<EXPECTED EITHER HIGH OR LOW>>          00924000
       LDEVMUSTBETERM=3130,    <<CONSOLE DEVICE MUST BE TERMINAL>>      00926000
       LDEVCANTBEDSTERM=3131,  <<CONSOLE DEVICE CANT BE DS TERMINAL>>   00928000
       DEVNOTASS=3132,         <<MASTEROP TRIED TO DISASS. NON-ASS. DE>>00930000
       LDEVWASASS=3133,        <<NOTIFY MASTEROP ABOUT ASSOCIATION>>    00932000
       LDEVWASDISASS=3134,     <<NOTIFY MASTEROP ABOUT DISASSOCIATION>> 00934000
       OTHERUSERHASDEV=3135,   <<REQUIRE MASTEROP TO VERIFY DEV COMMAN>>00936000
       OPNOTDONE=3136,         <<OPERATOR NOT VERIFIED>>                00938000
       EXPFILESHOW=3137,       <<EXPECTED FILE=FORMAL[;SHOW]>>          00940000
       EXPSHOW=3138,           <<EXPECTED ;SHOW>>                       00942000
       LASTALLOW=3139,         <<LAST INPUT LINE COMPLETED WAS:>>       00944000
       MASTEROPDISASS=3140,    <<MASTER OP DISASS. SOMEBODY>>           00946000
       NOSUCHDEVCLASS=3141,     <<NO SUCH DEVICE CLASS>>                00948000
         ASSREQSESSION=3142,   <<ASSOCIATE/DISASS. AVAIL ONLY TOSESS>>  00950000
         OTHERUSERHASCLASS=3143, <<REQ MASTEROP VERIFY CLASS COMMAND>>  00952000
      CONSOLEBUSY = 3144,     <<CONSOLE IS BUSY>>              <<00671>>00954000
      CONSOLESWITCHED = 3145, <<CONSOLE SWITCHED FROM LDEV TO LDEV>>    00956000
      OUTFENCEXP3PARMS =  3146, <<OUTFENCE 3 PARMS>>           <<00874>>00958000
      EXPLDEVEQ    =   3147, <<EXPECTED "LDEV=">>              <<00874>>00960000
      LDEVNOTINODD =   3148, <<LDEV NOT IN DIRECTORY>>         <<00874>>00962000
      CONSOLEDOWN =   3149, <<LDEV DOWN OR PENDING>>           <<01027>>00964000
      DOWNCONSOLE =   3150, <<ATTEMPT TO DOWN CONSOLE>>        <<01027>>00966000
      CANT'DOWN'SYS'DISC = 3151, << Attempt to down sysdisc.>> <<04195>>00968000
       CANTABORTIODISK=3160,   << Can't do ABORTIO on disk >>  <<02677>>00970000
      CONSOLEIS=3190,     <<TELL WHERE CONSOLE IS CURRENTLY>>  <<00893>>00972000
        CONF'ERROR=3819, << CONFDATA.PUB.SYS ERROR >>          <<01108>>00974000
        ABSLIMITEXCEEDED=3818,<<ABSOLUTE JS LIMIT EXCEEDED>>   <<01108>>00976000
         YYY=1; <<END OF OPERATOR MESSAGES>>                   <<00635>>00978000
<<SPOOLING ERROR MESSAGES>>                                             00980000
                                                                        00982000
EQUATE                                                                  00984000
   EXPSPFNAME = 3200,     <<EXPECTED SPOOLFILE DFID>>                   00986000
   FILENUMNOOTHERP = 3201,<<EXPECTED ONE PARM DFID>>                    00988000
   EXPOORINUM = 3202,     <<EXPECTED #ONNN OR #INNN>>                   00990000
   BADFILENUM = 3203,     <<DFID MUST BE POSITIVE INTEGER>1>>           00992000
   NOSUCHFILE = 3204,     <<DFID DOES NOT EXIST>>                       00994000
   WRONGSTATE = 3205,     <<DFID NOT READY     >>                       00996000
   NOPOUNDSIGN = 3206,    <<DFID MUST START WITH # SIGN>>               00998000
   CANT'DELETE'STDIN = 3227,                                            01000000
   SPACTLDEV=3207,        <<SPOOLFILE IS ACTIVE ON LDEV \>>             01002000
   EXPONUM = 3208,         <<EXPECTED DFID OF #ONNN>>                   01004000
   EXP1OFKEY = 3209,       <<EXPECT 1 OF DEV,PRI,DEFER,COPIES>>         01006000
   EXP1TO127 = 3210,       <<EXPECT NUMBER 1<=COPIES<=127>>             01008000
   EXPOAND1PARM = 3211,    <<EXPECT DFID AND ONE PARM>>                 01010000
   EXPO0TO14 = 3212,        <<EXPECTS 0 <= PRI <= 14 >>                 01012000
   STARTSPREQ1P = 3213,     <<STARTSPOOL REQUIRES 1 PARM>>              01014000
   INVDEVCLASS  = 3214,     <<INVALID DEVICE CLASS >>                   01016000
   UNKNOWNDEVCL = 3215,     <<UNKNOWN DEVICE CLASS >>                   01018000
   EXPINOROUT   = 3216,     <<EXPECTED IN OR OUT IN REPLY>>             01020000
   DEVTYPENOTSPOOLEE=3217,  <<DEVICE NOT SPOOLEE TYPE>>                 01022000
   SPOOLEEOWNEDOUT=3218,    <<DEVICE ALREADY OUTPUT SPOOLEE>>           01024000
   SPOOLEEOWNEDIN =3219,    <<DEVICE ALREADY INPUT SPOOLEE>>            01026000
   DEVOWNEDOTHER = 3220,    <<DEVICE OWNED BY ANOTHER PROC>>   <<04801>>01028000
   DEVNOTJOBDATA = 3221,    <<DEVICE NOT JOB/DATA ACCEPTING>>           01030000
   DEVOWNEDDIAG = 3222,     <<DEVICE OWNED BY DIAGNOSTICS>>             01032000
   UNABLETOGETSTACK=3223,   <<UNABLE TO GET SPOOLER STACK>>             01034000
   UNABLETOPROCREATE=3224,  <<UNABLE TO CREATE SPOOLER PROC>>           01036000
   STOPSPREQ1P = 3225,      <<STOPSPOOL REQUIRES 1 PARM>>               01038000
   SPOOLERBUSY = 3226,      <<SPOOLER PROCESS BUSY>>                    01040000
   SPOOLINOROUT = 3227,     <<IS SPOOLER INPUT OR OUTPUT?>>             01042000
   DEVICENOTSPOOLED = 3228, <<DEVICE IS NOT SPOOLED>>                   01044000
   EXP1OFLDEVORFIN = 3229,  <<EXPECTED 1 OF LDEV OR FINISH>>            01046000
   SUSPENDSP2PARM  = 3230,  <<SUSPENDSPOOL EXP MAX 2 PARMS>>            01048000
   EXPFINISH = 3231,        <<EXPECTED "FINISH" PARAMETER>>             01050000
   RESUMESPREQ1P = 3232,    <<RESUMESP REQUIRES 1 PARM >>               01052000
   DEFEROVERPRI = 3233,      <<DEFER OVERRIDES PRI>>                    01054000
   PRIOVERDEFER = 3234,      <<PRI OVERRIDES DEFER>>                    01056000
   PRIOVERPRI = 3235,        <<PRI OVERRIDES PRI>>                      01058000
   SPACTLDEVNODEL = 3236,    <<SPFLE ACTIVE ON LDEV,NOT DELETE>>        01060000
   DEVICENOTOUTSPOOL = 3237, <<DEVICE NOT SPOOLED FOR OUTPUT>>          01062000
   EXPBACKORFORWARD = 3238,   <<EXPECTED "BACK" OR "FORWARD">> <<01549>>01064000
   EXPNUM1TO256 = 3239,       <<EXPECTED RANGE 1 TO 256>>      <<01549>>01066000
   EXPPAGESORFILES = 3240,    <<EXPECTED "PAGES" OR "FILES">>  <<01549>>01068000
   EXP4PARMS = 3241,          <<EXPECTED AT MOST 4 PARMS>>     <<01549>>01070000
   EXPDEVCLASSLONG = 3242,  <<DEVCLASS NAME > 8 CHARS>>        <<00635>>01072000
   BADCLASSNAME  = 3243,    <<CLASS NOT CONFIGURED>>           <<00635>>01074000
   CLASSALREADYSPOOLED = 3244, <<CLASS ALREADY SPOOLED>>       <<00635>>01076000
   CLASSNOTSPOOLED = 3245,  <<CLASS NOT SPOOLED>>              <<00635>>01078000
   CLTYPENOTSPOOLEE = 3246, <<DEVCLASSTYPE NOT SPOOLEE>>       <<00635>>01080000
   USERNOACC2CLASS = 3247, <<USER HAS NO ACCESS TO CLASS>>     <<00635>>01082000
   LDEVNOTACTIVE = 3248,      <<LDEV IS NOT ACTIVE >>          <<00903>>01084000
   RESUMESPBEGINX = 3249,   <<EXTRA PARMS AFTER "BEGINNING">>  <<01549>>01086000
   EXPBLANK       = 3250,    <<EXPECTED BLANK DELIMITER>>      <<01549>>01088000
   EXP1OFLDEVORSHUTQ = 3251, <<EXPECTED LDEV;[SHUTQ]>>         <<01088>>01090000
   EXP1OFLDEVOROPENQ = 3252, <<EXPECTED LDEV;[OPENQ]>>         <<01088>>01092000
   STARTSP2PARM      = 3253, <<STARTSPOOL EXP 2 PARMS>>        <<01088>>01094000
   STOPSP2PARM       = 3254, <<STOPSPOOL EXP 2 PARMS>>         <<01088>>01096000
   EXPSHUTQ          = 3255, <<STARTSPOOL EXP SHUTQ>>          <<01088>>01098000
   EXPOPENQ          = 3256, <<STOPSPOOL EXP OPENQ>>           <<01088>>01100000
   CLASSXPARMS       = 3257, <<EXTRA PARMS AFTER CLASS>>       <<01088>>01102000
   DEVICEACTIVE   = 3258,    <<DEVICE IS ACTIVE>>              <<01549>>01104000
   SHUTQINPUT     = 3259, <<SHUTQ INVALID INPUT SPOOLEE>>      <<01330>>01106000
   OPENQINPUT     = 3260, <<OPENQ INVALID INPUT SPOOLEE>>      <<01330>>01108000
   DEVISDOWN      = 3261, <<DEV DOWNED ON START SPOOLER>>      <<02609>>01110000
      XXX=1;                                                            01112000
<<DOWNLOAD ERROR MESSAGES >>                                            01114000
EQUATE                                                                  01116000
   ERR'WRONG'LDEV = 3301,   <<INVALID LDEV FOR DOWNLOAD>>               01118000
   ERR'NUMERIC'MARGIN = 3302, <<MARGIN NOT NUMBERIC  >>                 01120000
   ERR'MARGIN'RANGE = 3303,   <<NOT BETWEEN 1 AND 16>>                  01122000
   ERR'MARGIN'TOOMANY = 3304, << Too many MARGIN parms. >>     <<04197>>01124000
   ERR'MARGIN'FAILED = 3305,  <<DOWNLOAD OF MARGIN FAILED>>             01126000
   ERR'TOO'MANY = 3306,       <<TOO MANAY PARAMETERS>>                  01128000
   ERR'TOO'FEW = 3307,        <<TOO FEW PARAMETERS>>                    01130000
   ERR'NUMERIC'LDEV = 3308,   <<LDEV NOT NUMERIC>>                      01132000
   ERR'INVALID'LDEV = 3309,   <<LDEV INVALID FOR DOWNLOAD>>             01134000
   ERR'WRONG'LDEV'2 = 3310,   <<LDEV NOT 2608>>                         01136000
   ERR'FILENAME'ALPHA = 3311, <<FILENAME IS NOT ALPHABETIC>>            01138000
   ERR'FOPEN = 3312,          <<FILE SYS ERROR>>                        01140000
ERR'EXPECTED'COMMA = 3313, <<NO COMMA DELIMITING VFC COMMENT>> <<01878>>01142000
   ERR'TOO'FEW'2  = 3314,     <<TOO FEW PARAMETERS IN VFC>>             01144000
   ERR'LPI'NUMERIC = 3315,    <<LINES PER INCH NOT NUMERIC>>            01146000
   ERR'NUMLINES = 3316,       <<VFC NUMLINES NOT NUMERIC>>              01148000
   ERR'TOO'LONG = 3317,       <<VFC CANNOT EXCEED 127 LINES>>           01150000
   ERR'REALIGN = 3318,        <<WARN TO REALIGN AFTER RESET>>           01152000
   ERR'VFC'FAILED = 3319,     <<DOWNLOAD VFC FAILED>>                   01154000
   ERR'NO'SYSBUFS = 3320,     <<NO MORE SYSTEM BUFFERS>>       <<01330>>01156000
   ERR'NEGATIVE'VFC = 3321,   <<NEGATIVE LENGTH VFC>>          <<02069>>01158000
   EXP'VFC'MARGIN = 3322,     <<EXPECT MARGIN OR VFC>>         <<02069>>01160000
   VFC'TOO'FEW = 3323,        << TOO FEW PARMS FOR VFC >>      <<04197>>01162000
   ERR'MARGIN'NOTFIRST = 3324,<< MARGIN not 1st line in VFC >> <<04197>>01164000
   ERR'VFC'NOTFIRST = 3325,   << VFC not 1st or 2nd line >>    <<04197>>01166000
   ERR'VFC'DELIMS =3326,      << Expected "," delimiters. >>   <<04197>>01168000
   EXP'LDN'COMMA = 3327,      << Expected "," after LDN.  >>   <<04197>>01170000
   BAD'VFC'LINE = 3328,       << Unexpected char in VFC def. >><<04197>>01172000
   USING'6'LPI = 3329,        << Lines/in. <> 6 or 8 or " ". >><<04197>>01174000
   EXTRA'LINES'IGNORED = 3330,<< Extra lines in file ignored.>><<04390>>01176000
   ERR'CAN'T'DO'MODE = 3331,  << Device can't handle MODE.   >><<04390>>01178000
   ERR'MODE'TOOMANY = 3332,   << Too many parms for MODE.    >><<04390>>01180000
   ERR'MODE'NOTFIRST = 3333,  << MODE in wrong place in file.>><<04390>>01182000
   ERR'ONE'PER'VFC = 3334,    << One MODE, MARGIN, VFC/file. >><<04390>>01184000
   ERR'MODE'MARGIN'FIRST = 3335 << MODE, MARGIN before VFC.  >><<04390>>01186000
       ;                                                                01188000
                                                                        01190000
<< LOG COMMAND ERRORS>>                                                 01192000
                                                                        01194000
EQUATE LOGEXP2PARM=3810,           <<LOG HAS EXACTLY 2 PARAMETERS>>     01196000
       LOGMUSTBE1TO8=3811,         <<LOGID IS 1 TO 8 CHARACTERS>>       01198000
       LOG1STCHARALPHA=3812,       <<LOGID 1ST CHARACTER IS ALPHA>>     01200000
       LOGIDMUSTBEAN=3813,         <<LOGID MUST BE ALPHANUMERIC>>       01202000
       LOGNOTACTIVE=3814,          <<NOT ACTIVE LOG PROCESS FOR ID>>    01204000
       EXP1OFSSR=3815,             <<EXPECTED STOP,START,RESTART>>      01206000
       LOGIDACTIVE=3816,           <<LOG PROCESS ALREAY ACTIVE>>        01208000
       NOINITLOG=3817;             <<UNABLE TO INITIATE LOG PROCESS>>   01210000
                                                               <<00575>>01212000
<< FOREIGN COMMAND ERROR MESSAGES>>                            <<01115>>01214000
                                                               <<01115>>01216000
EQUATE MUSTBEDISC=3850,  <<LDEV MUST BE DEVICE TYPE DISC>>     <<01115>>01218000
       FOREIGNREQ1P=3851,<<FOREIGN EXPECTS EXACTLY 1 PARM>>    <<01115>>01220000
       ALREADYFOREIGN=3852,<<VOLUME IS ALREADY FOREIGN>>       <<01115>>01222000
       VOLMUSTBEMTD=3853,  <<VOLUME MUST BE SPINNING>>         <<01115>>01224000
       INUSEPV=3854,       <<VOLUME IS AN IN-USE PV>>          <<01115>>01226000
       INUSESERDISC=3855,  <<VOLUME IS AN IN-USE SER DISC>>    <<01115>>01228000
       LDEVINSYSDOMAIN=3856, <<LDEV IS IN SYS DOMAIN>>         <<03713>>01230000
       CANTMAKEFOREIGN=3857 <<CANT MAKE DISC FOREIGN >>        <<03713>>01232000
       ;                                                       <<01115>>01234000
EQUATE EXPMINCLOCKCYCLE=3460,   <<AT LEAST ONE PARAM, CLOCKCYCLE>>      01236000
       TUNEHAS16PARMS=3461,     <<:TUNE HAS AT MOST 16 PARMS>> <<01549>>01238000
       EXPNUMBERFORCLOCK=3463,  <<EXPECTED NUMBER FOR CLOCKCYCLE>>      01240000
       QUEUEHAS4PARMS=3464,     <<ONLY 4 QUEUE DESCRIPTOR PARMS>>       01242000
       RELATIONSHIPBAD=3465,    <<QUEUE PARMS RELATIONSHIP BAD>>        01244000
       EXPECTATLEAST1QPARM=3466,<<EXPECT AT LEAST 1 QUEUE PARAMETER>>   01246000
       EXPECT1OFCQDQEQ=3467,    <<EXPECT ONE OF CQ, DQ, EQ>>   <<01549>>01248000
       EXPECTBEFORE=3468,       <<EXPECTED ! BEFORE PARAMETER>><<01549>>01250000
       EXPECTAFTER=3469,        <<EXPECTED ! AFTER PARAMETER>> <<01549>>01252000
       DUPLICATEQUEUE=3470,     <<DUPLICATEDLY SPECIFIED QUEUE>>        01254000
       EXPECTNUMBER=3471,       <<QUEUE DESCRIPTOR MUST BE NUMBER>>     01256000
       QUEUEBASELIMIT=3472,     <<QUEUE BASE MUST BE BETWEEN 150 & 250>>01258000
       ZZZ=1;                                                  <<01549>>01260000
                                                               <<00575>>01262000
<< MEASIO / SYSMON MESSAGES  >>                                <<00575>>01264000
                                                               <<00575>>01266000
EQUATE SYSMONENABLED=3400,     <<SYSMON ALREADY ENABLED>>      <<00575>>01268000
       CANTENABLEMIO=3401,     <<COULD NOT ENABLE MEASIO>>     <<00575>>01270000
       CANTGETBUF=3402,        <<CANT GET DSEG BUFFER>>        <<00575>>01272000
       NOTSYSMON=3403,         <<SYSMON WAS NOT ENABLED>>      <<00575>>01274000
       TAPEERROR=3404,         <<TAPE ERROR DURING MEASIO>>    <<00575>>01276000
       ENDOFTAPE=3405,         <<END OF TAPE ENCOUNTERED>>     <<00575>>01278000
       MONENABLED=3406,        <<SUCCESSFUL CXMON>>            <<00575>>01280000
       CANTLOCKMIO=3407,       <<CANT LOCK MIO CODE SEG.>>     <<00575>>01282000
       CANTUNLOADMIO=3408,     <<CANT UNLOADPROC MEASIO>>      <<00575>>01284000
       CANTLOADMIOIN=3409,     <<CANT LOAD MIO'INIT>>          <<00575>>01286000
       MEASIOERROR=3410,       <<ERROR RETURNED FROM MEASIO>>  <<00575>>01288000
       CANTLOADMIORE=3411,     <<CANT LOAD MIO'RESET>>         <<00575>>01290000
       CONTROLLERUNAV=3412,    <<CONTROLLER UNAVAILABLE>>      <<00575>>01292000
       SYSERROR=3413,          <<INTERNAL TABLE ERROR>>        <<00575>>01294000
       BADSTATUS=3414,         <<BAD STATUS FROM MEASIO>>      <<00575>>01296000
       CANTLOADMIO=3415,       <<CANT LOADPROC MEASIO>>        <<00575>>01298000
       ENABLEMIO=3416,         <<MEASIO ENABLED>>              <<00575>>01300000
       DEVICESDISABLED=3417,   <<DEVICES DISABLED>>            <<00575>>01302000
       DISABLEMIO=3418,        <<MEASIO DISABLED>>             <<00575>>01304000
       DEVICESENABLED=3419,    <<DEVICES ENABLED>>             <<00575>>01306000
       LDEVREQRD=3420,         <<LDEV REQUIRED>>               <<00575>>01308000
       MAXPARAMS=3421,         <<MAX # PARAMS EXCEEDED>>       <<00575>>01310000
       LDEVUNAVAIL=3422,       <<LDEV UNAVAILABLE >>           <<00575>>01312000
       LABELEDTAPE=3423,        <<LABELED TAPE ON LDEV>>       <<00575>>01314000
       NOTAPE=3424,            <<NO TAPE MOUNTED>>             <<00575>>01316000
       ILLEGALLDEV=3425,       <<BAD LDEV SPECIFIED>>          <<00575>>01318000
       LDEVMUSTBETAPE=3426,    <<LDEV MUST BE TAPE>>           <<00575>>01320000
       LDEVMUSTBE7970X=3435,   <<LDEV MUST BE A 7970X>>        <<02513>>01322000
       DEVICEATEOT=3427,       <<LDEV @ EOT >>                 <<00575>>01324000
       DEVICENOWRING=3428,     <<LDEV HAS NO WRITE RING>>      <<00575>>01326000
       DEVICENOTONLINE=3429,   <<LDEV NOT ON LINE>>            <<00575>>01328000
       DEVICENOTATLP=3430,     <<LDEV NOT @ LOAD PT>>          <<00575>>01330000
       DEVICEINVALID=3431,     <<LDEV INVALID>>                <<00575>>01332000
       DEVICEERROR=3432,       <<LDEV ERROR>>                  <<00575>>01334000
       MONDISABLED=3433,       <<SUCCESSFUL CXMOFF>>           <<00575>>01336000
       SYSMONRUN=3434;         <<SYSTEM MONITOR RUNNING>>      <<00575>>01338000
                                                               <<0726>> 01340000
<< SHOWALLOW ERROR MESSAGES>>                                  <<0726>> 01342000
                                                               <<0726>> 01344000
EQUATE USERHEADER=3901,                                        <<0726>> 01346000
       USERHASALLOW=3902,                                      <<0726>> 01348000
       NOQUALIFYUSERS=3903,                                    <<0726>> 01350000
       USERNOALLOW=3904,                                       <<0726>> 01352000
       GLOBALALLOW=3905,                                       <<0726>> 01354000
       NOGLOBALALLOW=3906,                                     <<0726>> 01356000
       NEED'SM'OR'MASTEROP=971,                                <<01683>>01358000
       NEED'AM'OR'MASTEROP=969,                                <<01683>>01360000
       BADNAME=3909,                                           <<0726>> 01362000
       EXP0OR2PARMS=3900;                                      <<0726>> 01364000
                                                               <<02345>>01366000
<< Misc. Errors  >>                                            <<02345>>01368000
EQUATE EXPCOMMA   =  1254,   << Comma expected >>              <<02345>>01370000
       EXTRADELIM =  1397;   << Extra trailing delim. ignored ><<02345>>01372000
                                                               <<02345>>01374000
EQUATE CIGENERALMSGSET=7,      <<CI'S GENERAL MESSAGE SET>>    <<00575>>01376000
       CIERRMSGSET=2,          <<CI'S ERROR MESSAGE SET>>      <<00575>>01378000
       GENERALSET=1,           <<GENERAL MESSAGE SET>>         <<00575>>01380000
       FILESYSMSGSET=8,              <<FILE SYSTEM'S ERROR MESSAGE SET>>01382000
       MOUNTERRS=253,                <<VMOUNT ERRORS>>                  01384000
       PARMSIGNORED = 165,                                     <<04535>>01386000
       NOREPENDING = 166,                                      <<04535>>01388000
       ERRSTDINEOF=900,              << EOF ON $STDIN >>       <<01649>>01390000
       ERRSTDINIO=901,               << I/O ERROR ON $STDIN >> <<01649>>01392000
       NUM'QUEUED = 163,    << PRINTS NUM. OF QUEUED ENTRIES >><<04803>>01394000
       WARNXPARMSIGNORED=1670;       <<EXTRA PARAMETERS IGNORED>>       01396000
$PAGE "MISC. EQUATES"                                                   01398000
EQUATE SYSGLOB=%1000;    <<ABSOLUTE LOCATION OF SYSTEM GLOBAL AREA>>    01400000
EQUATE CONSLDEV=SYSGLOB+%74;     <<LOGICAL DEVICE OF MASTER OPERATOR>>  01402000
EQUATE JOBSYNC=SYSGLOB+%121;      <<JOB SYNC. WORD>>                    01404000
EQUATE VMOUNTCNTL=SYSGLOB+%365; <<MOUNT/DISMOUNT CONTROL>>              01406000
EQUATE DSCONTROL=SYSGLOB+%341; <<DS CONTROL PLABEL>>                    01408000
EQUATE MPLINE=SYSGLOB+%374;    <<MULTI-POINT PLABEL>>                   01410000
EQUATE MRJECONTROL=SYSGLOB+%375;<<MRJE PLABEL>>                         01412000
EQUATE ALLOWMASK=SYSGLOB+%215;                                          01414000
                                                                        01416000
EQUATE CR=13 <<CARRIAGE RETURN>>, LF=10 <<LINE FEED>>;                  01418000
EQUATE LDTSIR=10, LDTDST=14, LDTSIZE=5;                                 01420000
EQUATE LPDTSIZE=2, LPDTSIR=9;                                           01424000
EQUATE LPDTDST=13;                                             <<00575>>01426000
EQUATE LDT'DTYPE'LIST=2;    <<LISTING DEVICE TYPE MINIMUM #>>           01428000
EQUATE UCOP=2;              <<UCOP'S PCB #>>                            01430000
                                                                        01432000
EQUATE PCBB =3,                                                <<00575>>01434000
       CPCB = 4;                                               <<00575>>01436000
EQUATE ODDSIR=4, ODDDST=46, ODD'PRIOR'W=4; <<ODD OUTFENCE WORD>>        01438000
EQUATE IDDSIR = 3, IDDDST = 45;                                         01440000
                                                                        01442000
EQUATE JMATHEADERSIZE=12,     <<SIZE OF JMAT HEADER>>                   01444000
       JMATENTRYSIZE=26,      <<SIZE OF JMAT ENTRY>>                    01446000
       JMATDST=25,            <<JMAT DST #>>                            01448000
       JMATSIR=15,            <<JMAT SIR>>                              01450000
       JOBEXEC=2,             <<JOB STATE IS EXECUTING>>                01452000
       JOBSUSP=4,             <<JOB STATE IS SUSPENDED>>                01454000
       JOBWAIT=%40,           <<JOB STATE IS WAITING>>                  01456000
       JOBERR=%50,                                             <<04801>>01458000
       JOBCIINIT=%60,         <<JOB BEING INIT. BY CI>>                 01460000
       JOBINTRO=1;            <<JOB STATE IS BEING INTRODUCED>>         01462000
                                                                        01464000
EQUATE PCBSIZE=16;            <<SIZE OF PCB>>                           01466000
                                                                        01468000
EQUATE ACCTNAME'L=4;        <<LENGTH OF LOGON ACCOUNT NAME>>            01470000
EQUATE USERNAME'L=4;        <<LENGTH OF LOGON USER NAME>>               01472000
                                                                        01474000
EQUATE XDD'ENTRY'SIZE = 30;  <<LENGTH OF XDD SUBENTRY>>                 01478000
<<SPOOLER DIRECTIVES>>                                                  01480000
                                                                        01482000
   EQUATE  PRIORDIRECTIVE    = 0                 ,                      01484000
           QUITSPOOLING      = 1                 ,                      01486000
           WAITSPOOLING      = 2                 ,                      01488000
           RESUMESPOOLING    = 3                 ,                      01490000
           KEEPSPOOLING      = RESUMESPOOLING    ,                      01492000
           FINISHFILE        = 0                 ,                      01494000
           DELETEFILE        = 1                 ,                      01496000
           DEFERFILE         = 2                 ,                      01498000
           RELINKFILE        = 3                 ;                      01500000
$PAGE "DEFINES"                                                         01502000
DEFINE READYFLAG=(13:1)#;         <<READY FLAG IN JOB SYNC. WORD>>      01504000
                                                                        01506000
DEFINE SETJIT=                                                          01508000
   PUSH(DL);                                                            01510000
   TOS:=ARRDB6(TOS-PS0(-1)).(6:10)# ;                                   01512000
                                                                        01514000
DEFINE SETJMAT=                                                         01516000
   PUSH(DL);                                                            01518000
   TOS:=ARRDB3(TOS-PS0(-1)).(0:8)# ;                                    01520000
DEFINE SETXPXGLOB=PUSH(DL);  <<SET X TO DB REL. OF PXGLOB>>             01522000
                  X:=TOS-PS0(-1)#,                                      01524000
       PXGLOBJOBTYPE=ARRDB27(X).(0:2)#,<<PXFIXED JOB TYPE FIELD>>       01526000
       PXGLOBINTERACT = ARRDB6(X).(5:1)#, << INTERACTIVE? >>   <<01523>>01528000
       PXGLOBDUP      = ARRDB6(X).(4:1)#, << DUPLICATIVE? >>   <<01523>>01530000
       PXGLOBINDEV=ARRDB3(X).(8:8)#, <<LOGICAL INPUT DEVICE #>>         01532000
       PXGLOBOUTDEV=ARRDB4(X).(8:8)#;<<LOGICAL OUTPUT DEVICE #>>        01534000
                                                                        01536000
DEFINE ABS=ABSOLUTE#;  <<ABBREVIATION FOR ABSOLUTE FUNCTION>>           01538000
                                                                        01540000
DEFINE EXECUTORHEAD= (PARMSP,ERRNUM,PARMNUM);                           01542000
                     BYTE ARRAY PARMSP;                                 01544000
                     INTEGER ERRNUM, PARMNUM;                           01546000
                     OPTION PRIVILEGED,UNCALLABLE #;                    01548000
                                                                        01550000
DEFINE DISABLE=ASSEMBLE(SED 0)#,           <<DISABLE INTERRUPTS>>       01552000
       ENABLE=ASSEMBLE(SED 1)#,            <<ENABLE INTERRUPTS>>        01554000
       PSEUDODISABLE=ASSEMBLE(PSDB)#,      <<DISABLE PROCESS SWITCHING>>01556000
       PSEUDOENABLE=ASSEMBLE(PSEB)#;       <<ENABLE PROCESS SWITCHING>> 01558000
                                                                        01560000
DEFINE DEF'MOVEFROMDSEG=                                                01562000
MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                                 01564000
VALUE TARGET,DSTN,OFFSET,COUNT;                                         01566000
LOGICAL TARGET,DSTN,OFFSET,COUNT;                                       01568000
BEGIN                                                                   01570000
   X:=TOS;     <<SAVE RETURN ADDR>>                                     01572000
   ASSEMBLE(MFDS 0);                                                    01574000
   TOS:=X;     <<RESTORE RETURN ADDR>>                                  01576000
END#,                                                                   01578000
                                                                        01580000
       DEF'MOVETODSEG=                                                  01582000
MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                                   01584000
VALUE DSTN,OFFSET,SOURCE,COUNT;                                         01586000
LOGICAL DSTN,OFFSET,SOURCE,COUNT;                                       01588000
BEGIN                                                                   01590000
   X:=TOS;                                                              01592000
   ASSEMBLE(MTDS 0);                                                    01594000
   TOS:=X;     <<RESTORE RETURN ADDR>>                                  01596000
END#;                                                                   01598000
                                                                        01600000
<< LDT FIELD DESCRIPTIONS>>                                             01602000
                                                                        01604000
DEFINE LDT'DTYPE=2).(10:6#,        <<DEVICE TYPE & SUBTYPE>>            01606000
       LDT'STREAMS=4).(8:8#,       <<STREAMS DEVICE #>>                 01608000
       LDT'DTYPE'M=2).(10:3#,      <<MAJOR TYPE OF DTYPE>>              01610000
       LDT'HT=3).(6:1#,            <<HEAD/TRAILER FLAG>>                01612000
       LDT'F=3).(2:1#,             <<UP FLAG (IN USE BY SYSTEM)>>       01614000
       LDT'D=3).(3:1#,             <<IN USE BY DIAGNOSTICS FLAG>>       01616000
       LDT'PINNUM=1).(0:8#,        <<MAIN PIN # OF OWNER OF DEVICE>>    01618000
       LDT'R=3).(4:1#,             <<REQUEST PENDING FLAG (DOWN)>>      01620000
       LDT'DEFOUT=3).(8:8#,        <<DEFAULT OUTPUT DEVICE>>            01622000
       LDT'USECNT=0#;              <<USER COUNT>>                       01624000
                                                                        01626000
DEFINE                                                                  01628000
   << PREFIX >>                                                         01630000
           LDT'HIENTRY       = DB0.(0:8)         #,                     01632000
           LDT'ENTRYSIZE     = DB0.(8:8)         #,                     01634000
           LDT'DCTP          = PDB1              #,                     01636000
           LDT'NUMCLASS      = DB2               #,                     01638000
           LDT'DCTSIZE       = DB3               #,                     01640000
           LDT'STREAMDEV     = DB4.(8:8)         #,                     01642000
   << ENTRY >>                                                          01644000
           LD'USECOUNT       = 0                 #,                     01646000
           LD'MAINPIN        = 1).(0:8           #,                     01648000
           LD'VTABX          = 1).(0:8           #,                     01650000
           LD'CTLYPIN        = 1).(8:8           #,                     01652000
           LD'RWIDTH         = 2).(0:8           #,                     01654000
           LD'FO             = 2).(9:1           #,                     01656000
           LD'DEVTYPE        = 2).(10:6          #,                     01658000
              PRINTER        = 32                #,                     01660000
              CARDPUNCH      = 33                #,                     01662000
              READERPUNCH    = 20                #,                     01664000
              CARDREADER     = 8                 #,                     01666000
              MAGTAPE        = 24                #,                     01668000
              TERMINAL       = 16                #, <<SP.09>>           01670000
              DISC           = 0#,                             <<01115>>01672000
           LD'BASICTYPE      = 2).(10:3          #,                     01674000
              DEVDISC        = 0                 #,                     01676000
              DEVIN          = 1                 #,                     01678000
              DEVCONIO       = 2                 #,                     01680000
              DEVSERIO       = 3                 #,                     01682000
              DEVOUT         = 4                 #,                     01684000
           LD'SP             = 3).(0:2           #,                     01686000
             NOSPOOLER       = 0                 #,                     01688000
             INPUTSPOOLER    = 1                 #,                     01690000
             INPUTSPOOFLE    = 1                 #,                     01692000
             OUTPUTSPOOLER   = 2                 #,                     01694000
             OUTPUTSPOOFLE   = 2                 #,                     01696000
           LD'F              = 3).(2:1           #,                     01698000
           LD'M              = 3).(3:1           #,                     01700000
           LD'R              = 3).(4:1           #,                     01702000
           LD'C              = 3).(7:1           #,                     01704000
           LD'OUTDEV         = 3).(8:8           #,                     01706000
           LD'SQ             = 4).(7:1           #,                     01708000
           LD'XDDHEADX       = 4).(8:8           #;                     01710000
                                                               <<03519>>01712000
   << Volume table definitions >>                              <<03519>>01714000
                                                               <<03519>>01716000
   EQUATE                                                      <<03519>>01718000
      VTAB'DST = 29,                                           <<03519>>01720000
      VTAB'ENTRY'SIZE = 14;                                    <<03519>>01722000
                                                               <<03519>>01724000
   DEFINE                                                      <<03519>>01726000
      VTAB'UNREADABLE = 12).(13:1#,                            <<03519>>01728000
      VTAB'NON'SYS'DOMAIN = 12).(14:1#,                        <<03519>>01730000
      VTAB'SCRATCH = 12).(15:1#,                               <<03519>>01732000
      VTAB'LDEV = 12).(0:8#;                                   <<03519>>01734000
                                                               <<03519>>01736000
<< ODD LAYOUT DESCRIPTION>>                                             01738000
                                                                        01740000
   DEFINE  C'SQ               = GETCLASSBUF(2).(8:1)  #,       <<00635>>01742000
           C'DEVTYPE          = GETCLASSBUF(2).(10:6) #;       <<00635>>01744000
DEFINE ODD'PRIOR=(12:4)#,          <<OUTFENCE FIELD>>                   01746000
       NOT'ODD'PRIOR=(0:12)#;      <<PART OF WORD OTHER THAN OUTFENCE>> 01748000
DEFINE                                                                  01750000
<< DEVICE CLASS TABLE - DCT >>                                          01752000
   << ENTRY >>                                                          01754000
           DC'CLASSNAME      = 0                 #,                     01756000
           DC'CLASSNAME'B    = 0                 #,                     01758000
           DC'CYCLICALP      = 4).(1:7           #,                     01760000
               DC'SQ           = 4).(8:1               #,      <<00635>>01762000
           DC'CLASSTYPE      = 4).(10:6          #,                     01764000
           DC'BASICTYPE      = 4).(10:3          #,                     01766000
           DC'NUMDEVS        = 5).(0:8           #,                     01768000
           DC'FIRSTDEV       = 5).(8:8           #,                     01770000
           DC'FIRSTDEV'B     = 11                #;                     01772000
$PAGE "***   COMMON FIELDS OF JMAT, IDD, ODD   ***"                     01774000
DEFINE                                                                  01776000
   << PREFIX >>                                                         01778000
           TBL'MAXSIZE       = DB0.(0:8)         #,                     01780000
           TBL'CURSIZE       = DB0.(8:8)         #,                     01782000
              TBLQUANTUM     = 128               #,                     01784000
           TBL'ENTRYSIZE     = DB1.(8:8)         #,                     01786000
           TBL'ENTRYAREAP    = PDB2              #,                     01788000
COMMENT                                                                 01790000
           << CHAINS DEFINED BY "HEAD" POINTER,                         01792000
              IMMEDIATELY FOLLOWED BY "TAIL" POINTER.                   01794000
              EACH POINTS TO WD 0 OF ENTRY.                             01796000
              NULL CHAIN:  HEAD = 0,  TAIL = @HEAD.                     01798000
              CHAIN TERMINATED BY 0 LINK.                               01800000
           >>                                                           01802000
           ;                                                            01804000
           TTCHAINEND        = 0                 #,                     01806000
           TT'INUSEWORD      = 0                 #,                     01808000
              FREEENTRY      = 0                 #,                     01810000
           TT'JTYPE          = 1).(0:2           #,                     01812000
              SESSIONTYPE    = 1                 #,                     01814000
              BATCHTYPE      = 2                 #,                     01816000
           TT'JNUM           = 1).(2:14          #,                     01818000
           TT'JOBNUM         = 1                 #,                     01820000
           TT'UNAME          = 2                 #,                     01822000
           TT'ANAME          = 6                 #,                     01824000
           TT'JNAME          = 10                #,                     01826000
           TT'LINKP'W        = 25                #,                     01828000
           TT'LINKP          = TT'LINKP'W        #;                     01830000
$PAGE "***   DEVICE DIRECTORIES: GENERAL - XDD   ***"                   01832000
<< DEVICE DIRECTORIES: GENERAL - XDD >>                                 01834000
DEFINE                                                                  01836000
   << PREFIX >>                                                         01838000
           XDD'MAXSIZE       = TBL'MAXSIZE       #,                     01840000
           XDD'CURSIZE       = TBL'CURSIZE       #,                     01842000
           XDD'HEADSIZE      = DB1.(0:8)         #,                     01844000
           XDD'SUBSIZE       = TBL'ENTRYSIZE     #,                     01846000
           XDD'SUBAREAP      = TBL'ENTRYAREAP    #,                     01848000
           XDD'ODD           = LDB3.(0:1)        #,                     01850000
           XDD'NEXTDFID      = DB3               #,                     01852000
           XDD'OUTFENCE      = DB4.(12:4)        #,                     01854000
   << HEAD ENTRY >>                                                     01856000
           XD'HLDEV          = 0).(8:8           #,                     01858000
           XD'HHEADP         = 1                 #,                     01860000
              DEVCHAINEND    = TTCHAINEND        #,                     01862000
           XD'HTAILP         = 2                 #,                     01864000
           XD'HREALP         = 3                 #,                     01866000
   << SUBENTRY >>                                                       01868000
           XD'STATE          = 0).(1:2           #,                     01870000
              DFACTIVE       = 0                 #,                     01872000
              DFREADY        = 1                 #,                     01874000
              DFOPENED       = 2                 #,                     01876000
              DFRESERVED     = 3                 #,                     01878000
              DFLOCKED       = 3                 #,                     01880000
           XD'OUTPRI         = 0).(3:4           #,                     01882000
           XD'C              = 0).(7:1           #,                     01884000
           XD'DEVICE         = 0).(8:8           #,                     01886000
           XD'JTYPE          = TT'JTYPE          #,                     01888000
           XD'JNUM           = TT'JNUM           #,                     01890000
           XD'JOBNUM         = TT'JOBNUM         #,                     01892000
           XD'UNAME          = TT'UNAME          #,                     01894000
           XD'ANAME          = TT'ANAME          #,                     01896000
           XD'JNAME          = TT'JNAME          #,                     01898000
           XD'FNAME          = 14                #,                     01900000
           XD'DEVFILEID      = 18                #,                     01902000
           XD'TEF            = 19).(0:1          #,                     01904000
           XD'DATA           = 19).(1:1              #,        <<U.RAO>>01906000
           XD'XDDHEADX       = 19).(8:8          #,                     01908000
   << SPOOFLE EXTENSION >>                                              01910000
           XD'SPOOLFILE      = 20                #,                     01912000
           XD'LOGDEV         = 20).(0:8          #,                     01914000
           XD'HIGHADDR       = 20).(8:8          #,                     01916000
           XD'LOWADDR        = 21                #,                     01918000
           XD'NUMEXT         = 22).(0:8          #,                     01920000
           XD'VDEV           = 22).(8:8          #,                     01922000
           XD'LASTEXT        = 23                #,                     01924000
           XD'RECOVERY       = 24                #,                     01926000
           XD'RESTART        = 24).(2:1          #,                     01928000
           XD'FOD            = 24).(3:1          #,                     01930000
           XD'NOSPACE        = 24).(4:1          #,                     01932000
            XD'ABORT          = 24).(5:1          #,           <<B0.SZ>>01934000
           XD'NUMCOPIES      = 24).(8:8          #,                     01936000
           XD'LINKP'W        = TT'LINKP'W        #,                     01938000
           XD'LINKP          = TT'LINKP          #,                     01940000
           XD'NUMLINES0      = 26                #,                     01942000
           XD'NUMLINES1      = 27                #,                     01944000
           XD'TIMEREADY0     = 28                #,                     01946000
           XD'TIMEREADY1     = 29                #;                     01948000
$PAGE "***   INPUT DEVICE DIRECTORY - IDD   ***"                        01950000
<<INPUT DEVICE DIRECTORY - IDD >>                                       01952000
DEFINE                                                                  01954000
   << PREFIX >>                                                         01956000
           IDD'MAXSIZE       = XDD'MAXSIZE       #,                     01958000
           IDD'CURSIZE       = XDD'CURSIZE       #,                     01960000
           IDD'HEADSIZE      = XDD'HEADSIZE      #,                     01962000
           IDD'SUBSIZE       = XDD'SUBSIZE       #,                     01964000
           IDD'SUBAREAP      = XDD'SUBAREAP      #,                     01966000
           IDD'NEXTDFID      = XDD'NEXTDFID      #,                     01968000
   << HEAD ENTRY >>                                                     01970000
           ID'HLDEV          = XD'HLDEV          #,                     01972000
           ID'HHEADP         = XD'HHEADP         #,                     01974000
           ID'HTAILP         = XD'HTAILP         #,                     01976000
           ID'HREALP         = XD'HREALP         #,                     01978000
   << SUBENTRY >>                                                       01980000
           ID'STATE          = XD'STATE          #,                     01982000
           ID'DEVICE         = XD'DEVICE         #,                     01984000
           ID'JTYPE          = XD'JTYPE          #,                     01986000
           ID'JNUM           = XD'JNUM           #,                     01988000
           ID'JOBNUM         = XD'JOBNUM         #,                     01990000
           ID'UNAME          = XD'UNAME          #,                     01992000
           ID'ANAME          = XD'ANAME          #,                     01994000
           ID'JNAME          = XD'JNAME          #,                     01996000
           ID'FNAME          = XD'FNAME          #,                     01998000
           ID'DEVFILEID      = XD'DEVFILEID      #,                     02000000
           ID'XDDHEADX       = XD'XDDHEADX       #,                     02002000
   << SPOOFLE EXTENSION >>                                              02004000
           ID'SPOOLFILE      = XD'SPOOLFILE      #,                     02006000
           ID'LOGDEV         = XD'LOGDEV         #,                     02008000
           ID'HIGHADDR       = XD'HIGHADDR       #,                     02010000
           ID'LOWADDR        = XD'LOWADDR        #,                     02012000
           ID'NUMEXT         = XD'NUMEXT         #,                     02014000
           ID'VDEV           = XD'VDEV           #,                     02016000
           ID'LASTEXT        = XD'LASTEXT        #,                     02018000
           ID'RESTART        = XD'RESTART        #,                     02020000
           ID'LINKP          = XD'LINKP          #,                     02022000
           ID'NUMLINES0      = XD'NUMLINES0      #,                     02024000
           ID'NUMLINES1      = XD'NUMLINES1      #,                     02026000
           ID'TIMEREADY0     = XD'TIMEREADY0     #,                     02028000
           ID'TIMEREADY1     = XD'TIMEREADY1     #;                     02030000
$PAGE "***   OUTPUT DEVICE DIRECTORY - ODD   ***"                       02032000
<< OUTPUT DEVICE DIRECTORY - ODD >>                                     02034000
DEFINE                                                                  02036000
   << PREFIX >>                                                         02038000
           ODD'MAXSIZE       = XDD'MAXSIZE       #,                     02040000
           ODD'CURSIZE       = XDD'CURSIZE       #,                     02042000
           ODD'HEADSIZE      = XDD'HEADSIZE      #,                     02044000
           ODD'SUBSIZE       = XDD'SUBSIZE       #,                     02046000
           ODD'SUBAREAP      = XDD'SUBAREAP      #,                     02048000
           ODD'ODD           = XDD'ODD           #,                     02050000
           ODD'NEXTDFID      = XDD'NEXTDFID      #,                     02052000
           ODD'OUTFENCE      = XDD'OUTFENCE      #,                     02054000
   << HEAD ENTRY >>                                                     02056000
              ODDCLASSHEADX  = 2                 #,                     02058000
           OD'HLDEV          = XD'HLDEV          #,                     02060000
              DEVCLASSCHAIN  = 0                 #,                     02062000
           OD'HHEADP         = XD'HHEADP         #,                     02064000
           OD'HTAILP         = XD'HTAILP         #,                     02066000
           OD'HREALP         = XD'HREALP         #,                     02068000
   << SUBENTRY >>                                                       02070000
           OD'STATE          = XD'STATE          #,                     02072000
           OD'OUTPRI         = XD'OUTPRI         #,                     02074000
           OD'C              = XD'C              #,                     02076000
           OD'DEVICE         = XD'DEVICE         #,                     02078000
           OD'JTYPE          = XD'JTYPE          #,                     02080000
           OD'JNUM           = XD'JNUM           #,                     02082000
           OD'JOBNUM         = XD'JOBNUM         #,                     02084000
           OD'UNAME          = XD'UNAME          #,                     02086000
           OD'ANAME          = XD'ANAME          #,                     02088000
           OD'JNAME          = XD'JNAME          #,                     02090000
           OD'FNAME          = XD'FNAME          #,                     02092000
           OD'DEVFILEID      = XD'DEVFILEID      #,                     02094000
           OD'TEF            = XD'TEF            #,                     02096000
           OD'XDDHEADX       = XD'XDDHEADX       #,                     02098000
   << SPOOFLE EXTENSION >>                                              02100000
           OD'SPOOLFILE      = XD'SPOOLFILE      #,                     02102000
           OD'LOGDEV         = XD'LOGDEV         #,                     02104000
           OD'HIGHADDR       = XD'HIGHADDR       #,                     02106000
           OD'LOWADDR        = XD'LOWADDR        #,                     02108000
           OD'NUMEXT         = XD'NUMEXT         #,                     02110000
           OD'VDEV           = XD'VDEV           #,                     02112000
           OD'LASTEXT        = XD'LASTEXT        #,                     02114000
           OD'RECOVERY       = XD'RECOVERY       #,                     02116000
           OD'FOD            = XD'FOD            #,                     02118000
           OD'NOSPACE        = XD'NOSPACE        #,                     02120000
           OD'NUMCOPIES      = XD'NUMCOPIES      #,                     02122000
           OD'LINKP          = XD'LINKP          #,                     02124000
           OD'NUMLINES0      = XD'NUMLINES0      #,                     02126000
           OD'NUMLINES1      = XD'NUMLINES1      #,                     02128000
           OD'TIMEREADY0     = XD'TIMEREADY0     #,                     02130000
           OD'TIMEREADY1     = XD'TIMEREADY1     #;                     02132000
                                                                        02134000
<< LPDT LAYOUT DESCRIPTION>>                                            02136000
                                                                        02138000
INTEGER POINTER LPDT=8;                                                 02140000
INTEGER POINTER SYS'LPDTP = 8;                                 <<04801>>02142000
DEFINE LPDT'VIRTUAL=0).(0:1#,      <<0=>REAL DEVICE>>                   02144000
       LPDT'JOB=1).(2:1#,          <<JOB ACCEPTING>>                    02146000
       LPDT'DATA=1).(3:1#,         <<DATA ACCEPTING>>                   02148000
       LPDT'DRSTART=1).(0:2#,      <<DR START>>                         02150000
            DEVAVAIL    = 0#,                                  <<04801>>02152000
            DEVOWNED    = 1#,                                  <<04801>>02154000
            DEVSERVICE  = 2#,                                  <<04801>>02156000
            DEVRESERVED = 3#,                                  <<04801>>02158000
       LPDT'SUBTYPE=1).(12:4#,     <<DEVICE SUBTYPE>>          <<02513>>02160000
       LPDT'DITP=0).(1:15#,        <<DIT POINTER>>                      02162000
       LPDT'PV = 1).(4:1#,                                     <<03519>>02164000
       LPDT'SD = 1).(10:1#,                                    <<03519>>02166000
       LPDT'MAXDEV=0).(0:8#;        <<MAXIMUM LOGICAL DEVICE>>          02168000
                                                                        02170000
<< JMAT LAYOUT DESCRIPTION >>                                           02174000
                                                                        02176000
DEFINE JMAT'H'CURSIZE=0).(8:8#,    <<# OF SECTORS TO JMAT>>             02178000
       JMAT'CURSIZE = TBL'CURSIZE#,                            <<04801>>02180000
       JMAT'H'ENTRYP=2#,           <<POINTER TO FIRST ENTRY>>           02182000
       JMAT'ENTRYP = TBL'ENTRYAREAP#,                          <<04801>>02184000
       JMAT'H'ENTRYSIZ=1).(8:8#,   <<SIZE OF ENTRY IN WORDS>>           02186000
       JMAT'ENTRYSIZE = TBL'ENTRYSIZE#,                        <<04801>>02188000
       JMAT'H'JOBFENCE=7).(12:4#,  <<JOB FENCE>>                        02190000
       JMAT'H'JLIMIT=10#,          <<JOB LIMIT>>                        02192000
       JMAT'H'SLIMIT=8#,           <<SESSION LIMIT>>                    02194000
       JMAT'H'JOBSECURITY=7).(1:2#,<<JOB SECURITY>>            <<00724>>02196000
         JOBSECURITY'LOW=3#,       <<LET JOB OWNERS USE JOB COMMANDS>>  02198000
         JOBSECURITY'HIGH=0#,      <<DONT LET JOB OWNERS USER JOB COMM>>02200000
       JMAT'JOBTYPE=1).(0:2#,      <<JOB TYPE>>                         02202000
            JOBTYPE'JOB=2#,        <<JOB>>                              02204000
            JOBTYPE'SESSION=1#,    <<SESSION>>                          02206000
       JMAT'JOBNAME=10#,           <<JOB NAME>>                         02208000
       JMAT'PINNUM=22).(0:8#,      <<MAIN PIN #>>                       02210000
       JM'JOBNUM = 1#,             << For SHJB, ABRTJB, SHDV>> <<04801>>02212000
       JMAT'JOBNUM=1).(2:14#,      <<JOB #>>                            02214000
       JMAT'USERNAME=2#,           <<JOB USER NAME>>                    02216000
       JMAT'ACCTNAME=6#,           <<JOB ACCOUNT NAME>>                 02218000
       JMAT'C=0).(11:1#,           <<JOB CLASS FLAG>>                   02220000
       JMAT'JIN=18).(0:8#,        <<JOB INPUT DEVICE>>                  02222000
       JMAT'JLIST=18).(8:8#,       <<JOB OUTPUT DEVICE>>                02224000
       JMAT'INPRI=0).(12:4#,       <<JOB INPUT PRIORITY>>               02226000
            JOBHIPRI = 15#,                                    <<04801>>02228000
       JMAT'JSTATE=0).(0:6#,       <<JOB STATE>>               <<04801>>02230000
       JM'QUIET = 0).(8:1#,                                    <<04801>>02232000
       JM'STARTTIME = 19#,                                     <<04801>>02234000
       JM'SPOOLED = 24).(0:1#,                                 <<04801>>02236000
       JM'RESTART = 24).(1:1#,                                 <<04801>>02238000
       JM'SCHEDLINKP = 25#,                                    <<04801>>02240000
       JM'ORIGJIN = 25).(0:8#,                                 <<04801>>02242000
       JM'ORIGJLIST = 25).(8:8#,                               <<04801>>02244000
       JMAT'H'SCHEDHEADP=3#,     <<JMAT SCHEDULE QUEUE OFFSET>><<04801>>02246000
       JMAT'SCHEDHEADP = PDB3#,                                <<04801>>02248000
       JMAT'WORKAREA = ARRDB12#;                               <<04801>>02250000
                                                                        02252000
<< PCB LAYOUT DESCRIPTION >>                                            02254000
                                                                        02256000
POINTER PCB=3;                                                          02258000
DEFINE PCB'SONPTR=5).(8:8#,         <<SON POINTER>>                     02260000
       PCB'FTHRPTR=5).(0:8#,        <<FATHER POINTER>>         <<01258>>02262000
       PCB'LIVE=9).(0:1#,           <<PROCESS ALIVE BIT>>               02264000
PCB'ACTORG=8).(4:2#,                                           <<01549>>02266000
       PCB'REPLYDONE=3#,            <<REPLY DONE TO RIT WAIT>> <<00594>>02268000
       PCB'STK=3).(1:10#,           <<PROCESS STACK>>                   02270000
       PCB'PTYPE=9).(6:3#,             <<PROCESS TYPE>>        <<00874>>02272000
       PCB'HYBERNATE=9).(13:1#;     <<PROCESS IN HYBERNATION BIT>>      02274000
                                                               <<00575>>02276000
EQUATE CITYPE = 2;           <<PTYPE OF CI>>                   <<00874>>02278000
                                                                        02280000
<< USER CAPABILITIES >>                                                 02282000
                                                                        02284000
DEFINE SMCAP=(0:1)#,           <<SYSTEM MANAGER CAPABILITY>>            02286000
       AMCAP=(1:1)#,           <<ACCOUNT MANAGER CAPABILITY>>           02288000
       ALCAP=(2:1)#,           <<ACCOUNT LIBRARIAN CAPABILITY>>         02290000
       GLCAP=(3:1)#,           <<GROUP LIBRARIAN CAPABILITY>>           02292000
       DICAP=(4:1)#,           <<DIAGNOSTIC CAPABILITY>>                02294000
       OPCAP=(5:1)#;           <<SYSTEM SUPERVISOR CAPABILITY>>         02296000
                                                                        02298000
$INCLUDE INCLRIT                                               <<04803>>02300000
                                                                        02304000
<< PCBX GLOBAL AREA>>                                                   02306000
                                                                        02308000
DEFINE PCBX'JIT=6).(6:10#,          <<JIT DST #>>                       02310000
       PCBX'GLOBALSIZE=8#;          <<PCBX GLOBAL SIZE>>                02312000
                                                                        02314000
<< MYCOMMAND PARAMETER DESCRIPTION AREA LAYOUT>>                        02316000
                                                                        02318000
DEFINE DELIMITER=(11:5)#, SPECIAL'CHAR=(10:1)#,                         02320000
       ALPHA'CHAR=(8:1)#, NUMERICAL'CHAR=(9:1)#;                        02322000
                                                                        02324000
<< VMOUNT CONTROL LAYOUT>>                                              02326000
                                                                        02328000
DEFINE ONOFFFLG=(15:1)#,       <<ON/OFF FLAG>>                          02330000
       AUTOFLG=(13:1)#,        <<AUTO FLAG>>                            02332000
       ALLFLG=(14:1)#;         <<ALL FLAG>>                             02334000
                                                                        02336000
<< DIT LAYOUT>>                                                         02338000
                                                                        02340000
DEFINE DIT'ILTP=5#;            <<ILT POINTER>>                          02342000
DEFINE DIT'LPLEVEL = 8).(13:3#;  <<DMODEM CONTROL A>>          <<00671>>02344000
                                                                        02346000
<< ASSOCIATE FILE ENTRY LAYOUT >>                                       02348000
                                                                        02350000
DEFINE ASF'USERNAME=0#,                <<USERNAME>>                     02352000
       ASF'ACCTNAME=4#,                <<ACCTNAME>>                     02354000
       ASF'CLASS=8#,                  <<DEVICE CLASS NAME>>             02356000
       ASF'NEXTENTRY=12#,              <<RECORD # OF NEXT ENTRY>>       02358000
       ASF'ENTRYSIZE=13#;              <<SIZE OF ASSOCIATE FILE ENTRY>> 02360000
$INCLUDE INCLMIFT                                              <<04111>>02362000
$PAGE "EXTERNAL DECLARATIONS"                                           02364000
INTRINSIC FOPEN,FCHECK,FGETINFO,FCLOSE,FREAD,PRINT,SEARCH;              02366000
INTRINSIC FWRITE;                                              <<04801>>02368000
INTRINSIC WHO;                                                 <<04801>>02370000
INTRINSIC FREEDSEG, GETDSEG;                                   <<04801>>02372000
INTRINSIC FREADDIR;                                                     02374000
INTRINSIC TERMINATE,READX;                                              02376000
INTRINSIC LOADPROC,UNLOADPROC;                                 <<00575>>02378000
                                                                        02380000
INTEGER PROCEDURE ALLOCATEPROC(PROCNAME);                      <<00575>>02382000
BYTE ARRAY PROCNAME;                                           <<00575>>02384000
OPTION EXTERNAL;                                               <<00575>>02386000
                                                               <<00575>>02388000
INTEGER PROCEDURE DEALLOCATEPROC(PROCNAME);                    <<00575>>02390000
BYTE ARRAY PROCNAME;                                           <<00575>>02392000
OPTION EXTERNAL;                                               <<00575>>02394000
                                                               <<00575>>02396000
LOGICAL PROCEDURE GETSIR(N);                                            02398000
VALUE N; LOGICAL N;                                                     02400000
OPTION EXTERNAL;                                                        02402000
                                                                        02404000
PROCEDURE RELSIR(N,T);                                                  02406000
VALUE N,T; LOGICAL N,T;                                                 02408000
OPTION EXTERNAL;                                                        02410000
                                                                        02412000
INTEGER PROCEDURE GETDATASEG(A,B);                             <<00575>>02414000
VALUE A,B; INTEGER A,B;                                        <<00575>>02416000
OPTION EXTERNAL;                                               <<00575>>02418000
                                                               <<00575>>02420000
PROCEDURE RELDATASEG(A);                                       <<00575>>02422000
VALUE A; INTEGER A;                                            <<00575>>02424000
OPTION EXTERNAL;                                               <<00575>>02426000
                                                               <<00575>>02428000
INTEGER PROCEDURE IOTABLEINFO(A,B,C);                          <<00575>>02430000
VALUE A,B,C; INTEGER A,B,C;                                    <<00575>>02432000
OPTION EXTERNAL;                                               <<00575>>02434000
                                                               <<00575>>02436000
PROCEDURE CXMIOENABLE EXECUTORHEAD;                            <<00575>>02438000
OPTION FORWARD;                                                <<00575>>02440000
                                                               <<00575>>02442000
PROCEDURE CXMIODISABLE EXECUTORHEAD;                           <<00575>>02444000
OPTION FORWARD;                                                <<00575>>02446000
                                                               <<00575>>02448000
PROCEDURE CXMIOMONOFF EXECUTORHEAD;                            <<00575>>02450000
OPTION FORWARD;                                                <<00575>>02452000
                                                               <<00575>>02454000
PROCEDURE HELP;                                                <<00575>>02456000
OPTION EXTERNAL;                                               <<00575>>02458000
                                                               <<00575>>02460000
PROCEDURE TGETINFO(LDEV,FBUF,ITEMNUM);                         <<02677>>02462000
VALUE LDEV,ITEMNUM;                                            <<02677>>02464000
INTEGER LDEV,ITEMNUM;                                          <<02677>>02466000
ARRAY FBUF;                                                    <<02677>>02468000
OPTION EXTERNAL;                                               <<02677>>02470000
                                                               <<02677>>02472000
PROCEDURE CIERR(A,B,C,D);                                               02474000
VALUE A,C,D; INTEGER A,C,D;                                             02476000
BYTE ARRAY B;                                                           02478000
                                                               <<00575>>02480000
OPTION EXTERNAL,VARIABLE;                                               02482000
                                                                        02484000
INTEGER PROCEDURE GENMSG(A,B,C,D,E,F,G,H,I,J,K,L,M);                    02486000
VALUE A,B,C,D,E,F,G,H,I,J,K,L,M;                                        02488000
LOGICAL A,B,C,D,E,F,G,H,I,J,K,L,M;                                      02490000
OPTION VARIABLE,EXTERNAL;                                               02492000
                                                                        02494000
PROCEDURE AWAKE(A,B,C);                                                 02496000
VALUE A,B,C; INTEGER A,B,C;                                             02498000
OPTION EXTERNAL;                                                        02500000
                                                                        02502000
INTEGER PROCEDURE SYSPROC(A);                                           02504000
VALUE A; LOGICAL A;                                                     02506000
OPTION EXTERNAL;                                                        02508000
                                                                        02510000
INTRINSIC MYCOMMAND,BINARY,ASCII;                                       02512000
PROCEDURE SROOSTER(A);                                                  02514000
VALUE A; INTEGER A;                                                     02516000
OPTION EXTERNAL;                                                        02518000
                                                                        02520000
PROCEDURE ABORTIO(A);                                                   02522000
VALUE A; LOGICAL A;                                                     02524000
OPTION EXTERNAL;                                                        02526000
                                                                        02528000
INTEGER PROCEDURE ALTDSEGSIZE(A,B);                                     02530000
VALUE A,B; INTEGER A,B;                                                 02532000
OPTION EXTERNAL;                                                        02534000
                                                                        02536000
LOGICAL PROCEDURE EXCHANGEDB(A);                                        02538000
VALUE A; LOGICAL A;                                                     02540000
OPTION EXTERNAL;                                                        02542000
                                                               <<02319>>02544000
LOGICAL PROCEDURE SETCRITICAL;                                 <<02319>>02546000
OPTION EXTERNAL;                                               <<02319>>02548000
                                                               <<02319>>02550000
PROCEDURE RESETCRITICAL(CRIT);                                 <<02319>>02552000
VALUE CRIT; LOGICAL CRIT;                                      <<02319>>02554000
OPTION EXTERNAL;                                               <<02319>>02556000
                                                                        02558000
DOUBLE PROCEDURE ATTACHIO(A,B,C,D,E,F,G,H,I);                           02560000
VALUE A,B,C,D,E,F,G,H,I; INTEGER A,B,C,D,E,F,G,H,I;                     02562000
OPTION EXTERNAL;                                                        02564000
                                                                        02566000
INTEGER PROCEDURE FAMILY(A,B);                                          02568000
VALUE A,B; INTEGER A,B;                                                 02570000
OPTION EXTERNAL;                                                        02572000
                                                                        02574000
PROCEDURE QUEUEPROC(PROCSYSDBINX,QUEUENAME,LOCATION);          <<01549>>02576000
VALUE PROCSYSDBINX,QUEUENAME,LOCATION;                         <<01549>>02578000
INTEGER PROCSYSDBINX,QUEUENAME,LOCATION;                       <<01549>>02580000
OPTION EXTERNAL;                                               <<01549>>02582000
                                                                        02584000
PROCEDURE DELINKENTRY(A,B);                                             02586000
VALUE B; INTEGER POINTER A,B;                                           02588000
OPTION EXTERNAL;                                                        02590000
                                                                        02592000
PROCEDURE SCHEDULEJOB(A);                                               02594000
VALUE A; INTEGER POINTER A;                                             02596000
OPTION EXTERNAL;                                                        02598000
                                                                        02600000
INTEGER PROCEDURE GETDEVINFO(A,B);                                      02602000
BYTE ARRAY A;                                                           02604000
INTEGER ARRAY B;                                                        02606000
OPTION EXTERNAL;                                                        02608000
                                                                        02610000
LOGICAL PROCEDURE DELETEJOB(A);                                         02612000
VALUE A; INTEGER POINTER A;                                             02614000
OPTION PRIVILEGED, UNCALLABLE, FORWARD;                        <<04801>>02616000
                                                               <<04801>>02618000
PROCEDURE WRITEDSEG(EN);                                       <<00716>>02620000
VALUE EN;                                                      <<00716>>02622000
INTEGER EN;                                                    <<00716>>02624000
OPTION EXTERNAL;                                               <<00716>>02626000
                                                               <<00716>>02628000
                                                                        02630000
INTEGER PROCEDURE CHECKFILENAME'(A,B,C,D);                              02632000
VALUE A;                                                                02634000
LOGICAL B,C,D;                                                          02636000
DOUBLE A;                                                               02638000
OPTION EXTERNAL;                                                        02640000
                                                                        02642000
PROCEDURE MOUNT(A,B,C,D,E,F,G);                                <<00775>>02644000
VALUE E,G;                                                     <<00775>>02646000
INTEGER D,E,F,G;                                               <<00775>>02648000
BYTE ARRAY A,B,C;                                                       02650000
OPTION VARIABLE,EXTERNAL;                                               02652000
                                                                        02654000
PROCEDURE DISMOUNT(A,B,C,D,E,F);                               <<00775>>02656000
VALUE E,F;                                                     <<00775>>02658000
INTEGER D,E,F;                                                 <<00775>>02660000
BYTE ARRAY A,B,C;                                                       02662000
OPTION VARIABLE,EXTERNAL;                                               02664000
                                                                        02666000
INTEGER PROCEDURE SETSYSDB;                                             02668000
OPTION EXTERNAL;                                                        02670000
                                                                        02672000
LOGICAL PROCEDURE INITLOG(A,B);                                <<00601>>02674000
VALUE B; INTEGER B; BYTE ARRAY A;                              <<00601>>02676000
OPTION EXTERNAL;                                               <<00601>>02678000
                                                               <<00601>>02680000
LOGICAL PROCEDURE FINDLOG(A,B);                                <<00601>>02682000
INTEGER B; BYTE ARRAY A;                                       <<00735>>02684000
OPTION EXTERNAL;                                               <<00601>>02686000
                                                               <<00601>>02688000
LOGICAL PROCEDURE STOPLOG(A);                                  <<00601>>02690000
BYTE ARRAY A;                                                  <<00601>>02692000
OPTION EXTERNAL;                                               <<00601>>02694000
                                                               <<04803>>02696000
LOGICAL PROCEDURE REM'QUEUED'ENTRY(PIN);                       <<04803>>02698000
VALUE PIN; INTEGER PIN;                                        <<04803>>02700000
OPTION EXTERNAL,PRIVILEGED,UNCALLABLE,VARIABLE;                <<04803>>02702000
                                                               <<04803>>02704000
                                                               <<04803>>02706000
PROCEDURE RESETDB(A);                                                   02708000
VALUE A; INTEGER A;                                                     02710000
OPTION EXTERNAL;                                                        02712000
                                                                        02714000
PROCEDURE RETURNSYSBUF(A);                                              02716000
VALUE A; INTEGER A;                                                     02718000
OPTION EXTERNAL;                                                        02720000
                                                                        02722000
                                                                        02724000
INTEGER PROCEDURE FGETSYSBUF(A,B);                                      02726000
VALUE A,B;                                                              02728000
INTEGER A;                                                              02730000
LOGICAL B;                                                              02732000
OPTION EXTERNAL;                                                        02734000
                                                                        02736000
PROCEDURE SET'PSIF(PCBPT,FLAG);                                <<01986>>02738000
VALUE PCBPT,FLAG;                                              <<01986>>02740000
INTEGER PCBPT;                                                 <<01986>>02742000
LOGICAL FLAG;                                                  <<01986>>02744000
OPTION EXTERNAL;                                               <<01986>>02746000
                                                               <<01986>>02748000
PROCEDURE CLEAR'PSIF(PCBPT,FLAG);                              <<01986>>02750000
VALUE PCBPT,FLAG;                                              <<01986>>02752000
INTEGER PCBPT;                                                 <<01986>>02754000
LOGICAL FLAG;                                                  <<01986>>02756000
OPTION EXTERNAL;                                               <<01986>>02758000
                                                               <<01986>>02760000
LOGICAL PROCEDURE VALIDDEVTYPE(LDEV,FUNCTION,FLAG);                     02762000
   VALUE LDEV,FUNCTION;                                                 02764000
   INTEGER LDEV,FUNCTION,FLAG;                                          02766000
   OPTION EXTERNAL;                                                     02768000
                                                                        02770000
INTEGER PROCEDURE GETSYSBUF(NUM,IFLG);                                  02772000
   VALUE NUM,IFLG;                                                      02774000
   INTEGER NUM ;                                                        02776000
   LOGICAL IFLG;                                                        02778000
   OPTION EXTERNAL;                                                     02780000
                                                                        02782000
INTEGER PROCEDURE DELETEDEVFILE(PARM,FLAGS);                            02784000
   VALUE PARM,FLAGS;                                                    02786000
   INTEGER PARM;                                                        02788000
   LOGICAL FLAGS;                                                       02790000
   OPTION EXTERNAL;                                                     02792000
                                                               <<04801>>02794000
INTEGER PROCEDURE PVOLID (LDEV, BUF);                          <<04801>>02796000
   VALUE LDEV;                                                 <<04801>>02798000
   INTEGER LDEV;                                               <<04801>>02800000
   BYTE ARRAY BUF;                                             <<04801>>02802000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04801>>02804000
                                                                        02806000
PROCEDURE MMSTAT(A,B,C,D);                                              02808000
VALUE A,B,C,D; INTEGER A,B,C,D;                                         02810000
OPTION EXTERNAL;                                                        02812000
                                                                        02814000
LOGICAL PROCEDURE CALENDAR;                                             02816000
OPTION EXTERNAL;                                                        02818000
                                                                        02820000
DOUBLE PROCEDURE CLOCK;                                                 02822000
OPTION EXTERNAL;                                                        02824000
                                                                        02826000
PROCEDURE FERROR'(A,B);                                                 02828000
VALUE A;                                                                02830000
INTEGER A,B;                                                            02832000
OPTION EXTERNAL;                                                        02834000
                                                                        02836000
LOGICAL PROCEDURE REQUESTSERVICE;                                       02838000
OPTION EXTERNAL;                                                        02840000
                                                                        02842000
INTEGER PROCEDURE LDEVTOTYPE(LDEV);                            <<01115>>02844000
   VALUE LDEV;                                                 <<01115>>02846000
   INTEGER LDEV;                                               <<01115>>02848000
   OPTION EXTERNAL;                                            <<02319>>02850000
                                                               <<01115>>02852000
INTEGER PROCEDURE LDEVTOSUBTYPE(LDEV);                         <<03713>>02854000
   VALUE LDEV;                                                 <<03713>>02856000
   INTEGER LDEV;                                               <<03713>>02858000
   OPTION EXTERNAL;                                            <<03713>>02860000
                                                               <<03713>>02862000
DOUBLE PROCEDURE REQSTATUS(LDEV);                              <<01115>>02864000
   VALUE LDEV; INTEGER LDEV;                                   <<01115>>02866000
   OPTION EXTERNAL;                                            <<02319>>02868000
                                                               <<01115>>02870000
INTEGER PROCEDURE FOREIGN(LDEV);                               <<01115>>02872000
   VALUE LDEV; INTEGER LDEV;                                   <<01115>>02874000
   OPTION FORWARD;                                             <<01115>>02876000
                                                               <<01115>>02878000
LOGICAL PROCEDURE GETCLASS(A,B,C,D,E);                                  02880000
VALUE B,C,D;                                                            02882000
INTEGER ARRAY A,E;                                                      02884000
LOGICAL B;                                                              02886000
INTEGER C,D;                                                            02888000
OPTION EXTERNAL,VARIABLE;                                               02890000
                                                                        02892000
PROCEDURE LOG15(A,B,C,D);                                               02894000
VALUE A,B,C,D; LOGICAL A,B,C,D;                                         02896000
OPTION EXTERNAL;                                                        02898000
                                                                        02900000
LOGICAL PROCEDURE MASTEROP;                                             02902000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                                   02904000
                                                                        02906000
PROCEDURE ABORTJOB (MAIN);                                     <<04801>>02910000
   VALUE MAIN;                                                 <<04801>>02912000
   INTEGER MAIN;                                               <<04801>>02914000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04801>>02916000
                                                               <<04801>>02918000
PROCEDURE SUDDENDEATH (ERRNUM);                                <<04801>>02920000
   VALUE ERRNUM;                                               <<04801>>02922000
   INTEGER ERRNUM;                                             <<04801>>02924000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04801>>02926000
                                                               <<04801>>02928000
PROCEDURE DEALLOCENTRY (ENTRYP);                               <<04801>>02930000
   VALUE ENTRYP;                                               <<04801>>02932000
   INTEGER POINTER ENTRYP;                                     <<04801>>02934000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04801>>02936000
                                                               <<04801>>02938000
LOGICAL PROCEDURE IT'S'A'DISC (TYPE);                          <<04801>>02940000
   VALUE TYPE;                                                 <<04801>>02942000
   INTEGER TYPE;                                               <<04801>>02944000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04801>>02946000
COMMENT -- Determines whether TYPE is a valid disc device.     <<04801>>02948000
;                                                              <<04801>>02950000
                                                               <<04801>>02952000
INTEGER PROCEDURE DEVSPEC (DEVICE, BUFB);                      <<04801>>02954000
   VALUE DEVICE;                                               <<04801>>02956000
   INTEGER DEVICE;                                             <<04801>>02958000
   BYTE ARRAY BUFB;                                            <<04801>>02960000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04801>>02962000
COMMENT -- Called with DEVICE > 0 (LDEV) or < 0 (Device  Class <<04801>>02964000
Table index).  On exit, BUFB contains the ASCII numeric string <<04801>>02966000
corresponding to LDEV, or the ASCII alphanumeric string of the <<04801>>02968000
specified DCT entry. The result is the length of either string <<04801>>02970000
with trailing blanks suppressed.  BUFB must be at least  eight <<04801>>02972000
bytes long.  DB must be at the stack.                          <<04801>>02974000
;                                                              <<04801>>02976000
                                                               <<04801>>02978000
INTEGER PROCEDURE FORMNAME (TYPE, TARGET, BA1, BA2,            <<04801>>02980000
                            BA3, BA4);                         <<04801>>02982000
   VALUE TYPE;                                                 <<04801>>02984000
   INTEGER TYPE;                                               <<04801>>02986000
   BYTE ARRAY TARGET, BA1, BA2, BA3, BA4;                      <<04801>>02988000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04801>>02990000
                                                               <<04801>>02992000
PROCEDURE DATE'LINE (STRING);                                  <<04801>>02994000
   BYTE ARRAY STRING;                                          <<04801>>02996000
   OPTION EXTERNAL;                                            <<04801>>02998000
                                                               <<04801>>03000000
                                                                        03002000
INTEGER PROCEDURE GET'DSDEVICE(LDEV);                          <<04167>>03004000
VALUE LDEV;                                                    <<04167>>03006000
INTEGER LDEV;                                                  <<04167>>03008000
OPTION EXTERNAL;                                               <<04167>>03010000
PROCEDURE LOCKSEG(EN,TEST,PINX);                               <<00575>>03012000
   VALUE EN,TEST,PINX;                                         <<00575>>03014000
   INTEGER EN,PINX;                                            <<00575>>03016000
   LOGICAL TEST;                                               <<00575>>03018000
   OPTION EXTERNAL;                                            <<00575>>03020000
                                                               <<00575>>03022000
PROCEDURE UNLOCKSEG(EN,TEST,PINX);                             <<00575>>03024000
   VALUE EN,TEST,PINX;                                         <<00575>>03026000
   INTEGER EN,PINX;                                            <<00575>>03028000
   LOGICAL TEST;                                               <<00575>>03030000
   OPTION EXTERNAL;                                            <<00575>>03032000
                                                               <<00707>>03034000
PROCEDURE FREEZE(EN,TEST,PINX);                                <<00707>>03036000
   VALUE EN,TEST,PINX;                                         <<00707>>03038000
   INTEGER EN,PINX;                                            <<00707>>03040000
   LOGICAL TEST;                                               <<00707>>03042000
   OPTION EXTERNAL;                                            <<00707>>03044000
                                                               <<00707>>03046000
PROCEDURE UNFREEZE(EN,TEST,PINX);                              <<00707>>03048000
   VALUE EN,TEST,PINX;                                         <<00707>>03050000
   INTEGER EN,PINX;                                            <<00707>>03052000
   LOGICAL TEST;                                               <<00707>>03054000
   OPTION EXTERNAL;                                            <<00707>>03056000
                                                               <<00707>>03058000
PROCEDURE UPDATEDISCCOPY(DSTENTRY);                            <<01549>>03060000
VALUE DSTENTRY;                                                <<01549>>03062000
INTEGER DSTENTRY;                                              <<01549>>03064000
OPTION EXTERNAL;                                               <<01549>>03066000
                                                               <<01549>>03068000
INTEGER PROCEDURE CONVEXTLABELTODELTAP(EXTLABEL);              <<01549>>03070000
VALUE EXTLABEL;                                                <<01549>>03072000
INTEGER EXTLABEL;                                              <<01549>>03074000
OPTION EXTERNAL;                                               <<01549>>03076000
                                                               <<01847>>03078000
PROCEDURE RESETDISPQ;                                          <<01847>>03080000
OPTION EXTERNAL;                                               <<01847>>03082000
                                                               <<01847>>03084000
PROCEDURE FPROCTERM;                                           <<01258>>03086000
   OPTION EXTERNAL;                                            <<01258>>03088000
                                                               <<03519>>03090000
LOGICAL PROCEDURE CREATE'DFS'DATA'SEG (LDEV, DISC'LABEL,       <<03519>>03092000
                        ASSUME'DT'IS'DIRTY, FLAG'DT'AS'DIRTY); <<03519>>03094000
   VALUE LDEV, ASSUME'DT'IS'DIRTY, FLAG'DT'AS'DIRTY;           <<03519>>03096000
   INTEGER LDEV;                                               <<03519>>03098000
   ARRAY DISC'LABEL;                                           <<03519>>03100000
   LOGICAL ASSUME'DT'IS'DIRTY, FLAG'DT'AS'DIRTY;               <<03519>>03102000
   OPTION EXTERNAL, VARIABLE;                                  <<03519>>03104000
                                                               <<03519>>03106000
PROCEDURE SEND'PROCESS'DFS'ERROR (LDEV, ERROR'STATUS,          <<03528>>03108000
                                  TYPE'OF'ERROR);              <<03528>>03110000
   VALUE LDEV, ERROR'STATUS, TYPE'OF'ERROR;                    <<03519>>03112000
   INTEGER LDEV;                                               <<03519>>03114000
   LOGICAL ERROR'STATUS;                                       <<03519>>03116000
   INTEGER TYPE'OF'ERROR;                                      <<03519>>03118000
   OPTION EXTERNAL;                                            <<03519>>03120000
                                                               <<03519>>03122000
PROCEDURE DELETE'DFS'DATA'SEG (LDEV);                          <<03519>>03124000
   VALUE LDEV;                                                 <<03519>>03126000
   INTEGER LDEV;                                               <<03519>>03128000
   OPTION EXTERNAL;                                            <<03519>>03130000
                                                               <<03519>>03132000
LOGICAL PROCEDURE DEALLOCATE'DFS'DATA'SEG (LDEV);              <<03519>>03134000
   VALUE LDEV;                                                 <<03519>>03136000
   INTEGER LDEV;                                               <<03519>>03138000
   OPTION EXTERNAL;                                            <<03519>>03140000
                                                               <<03519>>03142000
$PAGE "ASSOCIATE TABLE MANIPULATION ROUTINES"                  <<01649>>03144000
$CONTROL SEGMENT=OPHI                                                   03146000
INTEGER PROCEDURE ASSOC'CLASS(CLASSNAME);                               03148000
INTEGER ARRAY CLASSNAME;                                                03150000
OPTION UNCALLABLE,PRIVILEGED;                                           03152000
BEGIN                                                                   03154000
   INTEGER ARRAY LOCAL'CLASSNAME(0:7), ASSOC(0:ASS'ENTRYSIZE-1);        03156000
   INTEGER ARRAY GETCLASSBUF(0:130);                                    03158000
   BYTE ARRAY LDEVS(*)=GETCLASSBUF(3);                                  03160000
   BYTE ARRAY BLOCAL'CLASSNAME(*)=LOCAL'CLASSNAME;                      03162000
   BYTE ARRAY ASSOC'(*)=ASSOC;                                          03164000
   BYTE MATCH:=0;                                                       03166000
   INTEGER I:=0;                                                        03168000
   LOGICAL SAVESIR;                                            <<01649>>03170000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         03172000
                                                                        03174000
   COMMENT                                                              03176000
      THIS ROUTINE RETURNS -1, IF NO SUCH CLASS                         03178000
                            0, IF SYSTEM CONSOLE (NO ASSOCIATION)       03180000
                        LDEV#, THE OUTPUT DEVICE OF USER ASSOCIATED TO  03182000
                               DEVICE;                                  03184000
                                                                        03186000
   ASSOC'CLASS:=-1;                                                     03188000
   MOVE LOCAL'CLASSNAME:=CLASSNAME,(4);                                 03190000
   MOVE BLOCAL'CLASSNAME:=BLOCAL'CLASSNAME WHILE AN,1;                  03192000
   MOVE *:="       ";                                                   03194000
   IF GETCLASS(GETCLASSBUF,TRUE,,,LOCAL'CLASSNAME) THEN <<CLASS EXISTS>>03196000
   BEGIN                                                                03198000
      ASSOC'CLASS:=0;  <<ASSUME NO ASSOCIATION>>                        03200000
      SAVESIR := GETSIR(ASS'SIR);  << LOCK ASSOC. TABLE >>     <<01649>>03202000
      WHILE (I:=I+1)<=INTEGER(LDEVS) DO <<SCAN THRU LIST OF DEVICES>>   03204000
      BEGIN                                                             03206000
         MOVEFROMDSEG(@ASSOC,ASS'DST,LDEVS(I)*ASS'ENTRYSIZE,            03208000
            ASS'ENTRYSIZE);                                             03210000
         IF ASSOC(ASS'JIT)<>0  AND <<DEVICE IS ASSOCIATED>>             03212000
            BLOCAL'CLASSNAME=ASSOC'(ASS'CLASS*2),(8)  <<SAME CLASS>>    03214000
         THEN MATCH:=MATCH+1;                                           03216000
      END;                                                              03218000
      IF MATCH=LDEVS THEN <<CLASS IS ASSOCIATED>>                       03220000
      BEGIN                                                             03222000
         MOVEFROMDSEG(@GETCLASSBUF,JMATDST,                             03224000
            ASSOC(ASS'JMAT)*JMATENTRYSIZE,JMATENTRYSIZE);<<GET JMAT EN>>03226000
         ASSOC'CLASS:=GETCLASSBUF(JMAT'JLIST);<<GET USER'S OUTPUT DEV>> 03228000
      END;                                                              03230000
   << DON'T RELEASE ASOC. TABLE UNTIL AFTER GETTING >>         <<01649>>03232000
   << JMAT ENTRY TO ENSURE ITS VALIDITY.            >>         <<01649>>03234000
      RELSIR(ASS'SIR,SAVESIR);                                 <<01649>>03236000
   END;                                                                 03238000
END;                                                                    03240000
$PAGE                                                          <<01115>>03242000
$CONTROL SEGMENT=OPLOW                                         <<01115>>03244000
                                                               <<01115>>03246000
INTEGER PROCEDURE FOREIGN(LDEV);                               <<01115>>03248000
   VALUE LDEV;                                                 <<01115>>03250000
   INTEGER LDEV;                                               <<01115>>03252000
OPTION UNCALLABLE;                                             <<04685>>03254000
   BEGIN                                                       <<01115>>03256000
                                                               <<01115>>03258000
      COMMENT THIS PROCEDURE IS CALLED TO FORCE THE            <<01115>>03260000
              DISC VOLUME MOUNTED ON DEVICE LDEV TO            <<01115>>03262000
              BE RECOGNIZED AS A FOREIGN VOLUME.               <<01115>>03264000
              THE VALUE RETURNED IS AN ERROR CODE AS           <<01115>>03266000
              FOLLOWS:                                         <<01115>>03268000
                                                               <<01115>>03270000
              ERROR      MEANING                               <<01115>>03272000
                                                               <<01115>>03274000
                0        NO ERROR                              <<01115>>03276000
                1        VOLUME IS ALREADY FOREIGN             <<01115>>03278000
                2        DEVICE IS NOT A DISC (TYPE 0 OR 2)    <<01115>>03280000
                3        NO VOLUME IS MOUNTED                  <<01115>>03282000
                4        VOLUME IS AN IN-USE PV                <<01115>>03284000
                5        VOLUME IS AN IN-USE SERIAL DISC       <<01115>>03286000
                6        LDEV IS IN SYSTEM DOMAIN              <<01115>>03288000
                7        DISC CAN'T BE MADE FOREIGN            <<03713>>03290000
                                                               <<01115>>03292000
      ;                                                        <<01115>>03294000
                                                               <<01115>>03296000
      DOUBLE STATUS;                                           <<01115>>03298000
      LOGICAL STATUS1=STATUS,                                  <<01115>>03300000
              STATUS2=STATUS+1;                                <<01115>>03302000
      DEFINE NREADYF=(14:1)#;                                  <<01115>>03304000
                                                               <<01115>>03306000
      INTEGER ARRAY LDTX(0:4);                                 <<01115>>03308000
      DEFINE LDTX0=LDTX#,                                      <<01115>>03310000
             LDTX1=LDTX(1)#,                                   <<01115>>03312000
             LDTX2=LDTX(2)#,                                   <<01115>>03314000
             LDTX3=LDTX(3)#,                                   <<01115>>03316000
             LDTX4=LDTX(4)#;                                   <<01115>>03318000
                                                               <<01115>>03320000
      EQUATE LDTDST=14,                                        <<01115>>03322000
             LDTENT=5,                                         <<01115>>03324000
             LDTXENT=5;                                        <<01115>>03326000
      EQUATE LINUS = 0,       <<TYPE 3,SUBTYPE 0 >>            <<03713>>03328000
             HP7911= 1,       <<TYPE 3,SUBTYPE 1 >>            <<03713>>03330000
             HP7912= 2;       <<TYPE 3,SUBTYPE 2 >>            <<03713>>03332000
                                                               <<03713>>03334000
                                                               <<01115>>03336000
      LOGICAL POINTER LPDT=8;                                  <<01115>>03338000
      DEFINE LPDT1=LPDT(LDEV&LSL(1)+1)#,                       <<01115>>03340000
             NSDF=(4:1)#,                                      <<01115>>03342000
             MNTF=(5:1)#,                                      <<01115>>03344000
             SDLF=(10:1)#,                                     <<01115>>03346000
             FORS=(11:1)#;                                     <<01115>>03348000
                                                               <<01115>>03350000
      EQUATE NSD=1;   << NSDF VALUE FOR NON-SYS DOMAIN >>      <<01115>>03352000
                                                               <<01115>>03354000
      INTEGER TYPE,           << DEVICE TYPE >>                <<03713>>03356000
              SUBTYPE;        << DEVICE SUBTYPE >>             <<03713>>03358000
                                                               <<03713>>03360000
                                                               <<01115>>03362000
      SUBROUTINE GETLDTXENT;                                   <<01115>>03364000
         BEGIN << FETCH LDTX ENTRY FOR LDEV >>                 <<01115>>03366000
         TOS:=@LDTX0;                                          <<01115>>03368000
         TOS:=LDTDST;                                          <<01115>>03370000
         TOS:=0;                                               <<01115>>03372000
         TOS:=LDTENT;                                          <<01115>>03374000
         ASSEMBLE(MFDS 4);                                     <<01115>>03376000
         TOS:=@LDTX0;                                          <<01115>>03378000
         TOS:=LDTDST;                                          <<01115>>03380000
         TOS:=LDTX1+LDTX3+LDEV*LDTXENT;                        <<01115>>03382000
         TOS:=LDTXENT;                                         <<01115>>03384000
         ASSEMBLE(MFDS 4);                                     <<01115>>03386000
         END;                                                  <<01115>>03388000
                                                               <<01115>>03390000
                                                               <<01115>>03392000
      TYPE:=LDEVTOTYPE(LDEV);                                  <<01115>>03394000
      SUBTYPE := LDEVTOSUBTYPE(LDEV);                          <<03713>>03396000
                                                               <<03713>>03398000
      IF TYPE <> 0 AND TYPE <> 2 AND TYPE <> 3 THEN            <<03713>>03400000
         BEGIN                                                 <<01115>>03402000
         FOREIGN:=2;  << NOT A DISC DEVICE >>                  <<01115>>03404000
         RETURN;                                               <<01115>>03406000
         END;                                                  <<01115>>03408000
                                                               <<01115>>03410000
      IF TYPE = 3 AND (SUBTYPE = LINUS LOR                     <<03713>>03412000
                       SUBTYPE = HP7911 LOR                    <<03713>>03414000
                       SUBTYPE = HP7912) THEN                  <<03713>>03416000
         BEGIN                                                 <<03713>>03418000
         FOREIGN := 7;  <<CANT MAKE DISC FOREIGN >>            <<03713>>03420000
         RETURN;                                               <<03713>>03422000
         END;                                                  <<03713>>03424000
                                                               <<03713>>03426000
      IF LPDT1.NSDF<>NSD THEN                                  <<01115>>03428000
         BEGIN                                                 <<01115>>03430000
         FOREIGN:=6;                                           <<01115>>03432000
         RETURN;                                               <<01115>>03434000
         END;                                                  <<01115>>03436000
                                                               <<01115>>03438000
      STATUS:=REQSTATUS(LDEV);                                 <<01115>>03440000
      IF STATUS2.NREADYF THEN                                  <<01115>>03442000
         BEGIN                                                 <<01115>>03444000
         FOREIGN:=3;  << NO VOLUME MOUNTED >>                  <<01115>>03446000
         RETURN;                                               <<01115>>03448000
         END;                                                  <<01115>>03450000
                                                               <<01115>>03452000
      IF LPDT1.MNTF THEN                                       <<01115>>03454000
         BEGIN                                                 <<01115>>03456000
         FOREIGN:=4;  << IN USE PV >>                          <<01115>>03458000
         RETURN;                                               <<01115>>03460000
         END;                                                  <<01115>>03462000
                                                               <<01115>>03464000
      GETLDTXENT;                                              <<01115>>03466000
      IF LDTX1<>0 AND                                          <<01115>>03468000
         LPDT1.SDLF=1 AND                                      <<01115>>03470000
         LPDT1.FORS=0 THEN                                     <<01115>>03472000
         BEGIN                                                 <<01115>>03474000
           FOREIGN:=5;   << IN USE SERIAL DISC >>              <<01115>>03476000
           RETURN;                                             <<01115>>03478000
         END;                                                  <<01115>>03480000
                                                               <<01115>>03482000
      IF LPDT1.SDLF=1 AND                                      <<01115>>03484000
         LPDT1.FORS=1 THEN                                     <<01115>>03486000
         BEGIN                                                 <<01115>>03488000
           FOREIGN:=1;   << ALREADY FOREIGN >>                 <<01115>>03490000
           RETURN;                                             <<01115>>03492000
         END;                                                  <<01115>>03494000
                                                               <<01115>>03496000
      FOREIGN:=0;    << NO ERROR >>                            <<01115>>03498000
      LPDT1.SDLF:=1;                                           <<01115>>03500000
      LPDT1.FORS:=1;                                           <<01115>>03502000
                                                               <<01115>>03504000
   END; <<FOREIGN>>                                            <<01115>>03506000
$PAGE                                                                   03508000
$CONTROL SEGMENT=OPHI                                                   03510000
LOGICAL PROCEDURE CHECKASS(LDEV,ASSENT);                                03512000
VALUE LDEV; LOGICAL LDEV;                                               03514000
INTEGER ARRAY ASSENT;                                                   03516000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                                  03518000
BEGIN                                                                   03520000
   COMMENT                                                              03522000
      THIS ROUTINE CHECKS TO SEE WHETHER THE USER HAS "ASSOCIATE"D      03524000
      THE DEVICE "LDEV".  IT RETURNS TRUE IF YES, OTHERWISE FALSE.      03526000
      THE ROUTINE RETURNS THE ASSOCIATE TABLE ASSENT IF 'ASSENT' IS     03528000
      SPECIFIED, REGARDLESS OF WHETHER CHECKASS IS TRUE OR FALSE.       03530000
   ;                                                                    03532000
   INTEGER ARRAY ASS'ENTRY(0:ASS'ENTRYSIZE-1);                          03534000
   LOGICAL PMASK=Q-4;      <<PARAMETER MASK>>                           03536000
   DEFINE ASSENT'MASK=PMASK.(15:1)#; <<ASSENT PARAMETER MASK>>          03538000
   LOGICAL SAVESIR;                                            <<01649>>03540000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         03542000
                                                                        03544000
   CHECKASS:=FALSE;                                                     03546000
   IF LDEV>LOGICAL(LPDT(LPDT'MAXDEV)) THEN RETURN;<<BAD LDEV #>>        03548000
   IF LDEV < 1 THEN RETURN;   << BAD LDEV # >>                 <<01649>>03550000
   SAVESIR := GETSIR(ASS'SIR);   << LOCK ASSOC. TABLE >>       <<01649>>03552000
   SETJIT;              <<PLACE USER'S JIT INDEX ONTO STACK>>           03554000
   MOVEFROMDSEG(@ASS'ENTRY,ASS'DST,LDEV*ASS'ENTRYSIZE,ASS'ENTRYSIZE);   03556000
   IF TOS=ASS'ENTRY(ASS'JIT) THEN CHECKASS:=TRUE;                       03558000
   IF ASSENT'MASK THEN MOVE ASSENT:=ASS'ENTRY,(ASS'ENTRYSIZE);          03560000
   RELSIR(ASS'SIR,SAVESIR);      << RELEASE TABLE >>           <<01649>>03562000
END;                                                                    03564000
$PAGE                                                                   03566000
$CONTROL SEGMENT=OPHI                                                   03568000
LOGICAL PROCEDURE ADDASS(JITDSTNO,JMATINX,LDEV,CLASSNAME);              03570000
VALUE JITDSTNO,LDEV,JMATINX;                                            03572000
LOGICAL JITDSTNO,LDEV,JMATINX;                                          03574000
BYTE ARRAY CLASSNAME;                                                   03576000
OPTION PRIVILEGED,UNCALLABLE;                                           03578000
BEGIN                                                                   03580000
   COMMENT                                                              03582000
      THIS ROUTINES ADDS AN ENTRY TO THE ASSOCIATE TABLE.               03584000
      'JITDSTNO' IS THE USER'S JIT'S DST #.                             03586000
      'JMATINX' IS THE JOB'S JMAT INDEX AS PER PCBX GLOBAL.             03588000
      'LDEV" IS THE LOGICAL DEVICE TO BE 'ASSOCIATE'D.                  03590000
      ADDASS RETURNS A VALUE OF TRUE, IF ENTRY SUCCESSFULLY BUILT.      03592000
      IF IT RETURNS FALSE, THEN THE ENTRY WAS ALREADY IN USE.           03594000
   ;                                                                    03596000
   LOGICAL SAVESIR,ASSINX;                                              03598000
   LOGICAL ARRAY ASS'ENTRY(0:ASS'ENTRYSIZE-1)=Q;                        03600000
   BYTE ARRAY ASS'ENTRY'(*)=ASS'ENTRY;                                  03602000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         03604000
   SUBROUTINE DEF'MOVETODSEG;                                           03606000
                                                                        03608000
   ADDASS:=FALSE;       <<INITIALIZE ROUTINE RETURN VALUE>>             03610000
   IF LDEV>LOGICAL(LPDT(LPDT'MAXDEV)) THEN RETURN;<<BAD LDEV #>>        03612000
   IF LDEV < 1 THEN RETURN;   << BAD LDEV # >>                 <<01649>>03614000
   SAVESIR:=GETSIR(ASS'SIR); <<OBTAIN ASSOCIATE TABLE'S SIR>>           03616000
   ASSINX:=LDEV*ASS'ENTRYSIZE;  <<INDEX INTO ASSOCIATE TABLE NEW ENTRY>>03618000
   MOVEFROMDSEG(@ASS'ENTRY,ASS'DST,ASSINX,ASS'ENTRYSIZE);               03620000
   IF ASS'ENTRY=0 THEN   <<ENTRY IS AVAILABLE>>                         03622000
   BEGIN                                                                03624000
      ADDASS:=TRUE;                                                     03626000
      ASS'ENTRY(ASS'JIT):=JITDSTNO; <<BUILD ENTRY>>                     03628000
      ASS'ENTRY(ASS'JMAT):=JMATINX;                                     03630000
      MOVE ASS'ENTRY'(ASS'CLASS*2):="        ";                         03632000
      MOVE ASS'ENTRY'(ASS'CLASS*2):=CLASSNAME WHILE AN;                 03634000
      MOVEFROMDSEG(@ASS'ENTRY(ASS'NEXT),JITDSTNO,JIT'ASSPTR,1);         03636000
                                                                        03638000
         <<UPDATE USER'S ASSOCIATE CHAIN,STARTING AT JIT+5>>            03640000
                                                                        03642000
      MOVETODSEG(JITDSTNO,JIT'ASSPTR,@ASSINX,1);                        03644000
      MOVETODSEG(ASS'DST,ASSINX,@ASS'ENTRY,ASS'ENTRYSIZE);              03646000
   END;                                                                 03648000
   RELSIR(ASS'SIR,SAVESIR);                                             03650000
END;                                                                    03652000
$PAGE                                                                   03654000
$CONTROL SEGMENT=OPHI                                                   03656000
INTEGER PROCEDURE DELASS(ASSINX,JITINX);                                03658000
VALUE ASSINX,JITINX;                                                    03660000
LOGICAL ASSINX,JITINX;                                                  03662000
OPTION PRIVILEGED,UNCALLABLE;                                           03664000
BEGIN                                                                   03666000
   COMMENT                                                              03668000
      THIS ROUTINE DELETE THE SPECIFIC ASSOCIATE ENTRY FOR THE SPECIFIED03670000
      ENTRY.  THE CRITERIA FOR THE DELETION ARE AS FOLLOWS:             03672000
         1) THE SPECIFIED USER MUST OWN THE ENTRY,                      03674000
         2) THE SPECIFIED ENTRY MUST BE ON THE SPECIFIED USER'S         03676000
            ASSOCIATE CHAIN THAT STARTS IN HIS JIT                      03678000
      'ASSINX' IS THE INDEX INTO THE ASSOCIATE TABLE                    03680000
      'JITINX' IS THE USER'S JIT'S DST #                                03682000
      THE RETURN VALUE IMPLIES THE FOLLOWING:                           03684000
         -1 => USER DOES NOT OWN ENTRY                                  03686000
         0  => ENTRY DELETED IS LAST IN USER'S ASSOCIATE CHAIN          03688000
         >1 => IS THE ASSOCIATE INDEX TO THE ENTRY FOLLOWING THE        03690000
            DELETED ENTRY.                                              03692000
      THIS ROUTINE ASSUMES RUNNING ON USER'S STACK!                     03694000
   ;                                                                    03696000
   LOGICAL SAVESIR,I,J;                                                 03698000
   LOGICAL ARRAY ASS'ENTRY(0:ASS'ENTRYSIZE-1)=Q;                        03700000
   INTEGER LOCAL'DELASS=DELASS;                                         03702000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         03704000
   SUBROUTINE DEF'MOVETODSEG;                                           03706000
                                                                        03708000
   DELASS:=-1;       <<INITIALIZE ROUTINE'S RETURN VALUE>>              03710000
   SAVESIR:=GETSIR(ASS'SIR);  <<GET ASSOCIATE TABLE'S SIR>>             03712000
   MOVEFROMDSEG(@ASS'ENTRY,ASS'DST,ASSINX,ASS'ENTRYSIZE);               03714000
   IF ASS'ENTRY(ASS'JIT)=JITINX THEN   <<DELETE IS USER OWNS IT>>       03716000
   BEGIN                                                                03718000
      DELASS:=ASS'ENTRY(ASS'NEXT);                                      03720000
      MOVEFROMDSEG(@I,JITINX,JIT'ASSPTR,1);<<GET HEAD OF ASSOCIATE CHA>>03722000
      IF I=ASSINX THEN  <<ENTRY BEING DELETED IS HEAD ENTRY>>           03724000
         MOVETODSEG(JITINX,JIT'ASSPTR,@ASS'ENTRY(ASS'NEXT),1)<<HEAD PT>>03726000
      ELSE                                                              03728000
                                                                        03730000
 <<CHASE DOWN ASSOC. CHAIN UNTIL FIND ENTRY POINTING AT DELETED ENTRY>> 03732000
                                                                        03734000
      BEGIN                                                             03736000
         DO                                                             03738000
         BEGIN                                                          03740000
            J:=I;                                                       03742000
            MOVEFROMDSEG(@I,ASS'DST,J+ASS'NEXT,1);             <<01649>>03744000
         END UNTIL I=0 OR I=ASSINX;                                     03746000
         IF I<>0 THEN  MOVETODSEG(ASS'DST,J+ASS'NEXT,          <<01649>>03748000
                                  @ASS'ENTRY(ASS'NEXT),1)      <<01649>>03750000
         ELSE DELASS:=-1;  <<ENTRY NOT ON USER'S ASSOCIATE CHAIN>>      03752000
      END;                                                              03754000
   END;                                                                 03756000
   IF LOCAL'DELASS>=0 THEN <<HAS BEEN SUCCESSFULLY UNLINKED, SO DELETE>>03758000
   BEGIN                                                                03760000
   << ZERO ENTRY UP TO BUT NOT INCLUDING CLASSNAME. >>         <<01649>>03762000
      MOVE ASS'ENTRY := ASS'CLASS(0);                          <<01649>>03764000
      MOVETODSEG(ASS'DST,ASSINX,@ASS'ENTRY,ASS'ENTRYSIZE);              03766000
   END;                                                                 03768000
   RELSIR(ASS'SIR,SAVESIR); <<RELEASE ASSOCIATE TABLE'S SIR>>           03770000
END;                                                                    03772000
$PAGE                                                                   03774000
$CONTROL SEGMENT=OPHI                                                   03776000
LOGICAL PROCEDURE CHK'ASS'SECURITY(JITINX,LDEV,CLASSNAME);              03778000
VALUE JITINX,LDEV;                                                      03780000
INTEGER JITINX,LDEV;                                                    03782000
BYTE ARRAY CLASSNAME;                                                   03784000
OPTION PRIVILEGED,UNCALLABLE;                                           03786000
BEGIN                                                                   03788000
   COMMENT                                                              03790000
      THIS ROUTINE VERIFYS THE USER'S PRIVILEGE TO ASSOCIATE            03792000
   A PARTICULAR DEVICE.                                                 03794000
      IT RETURNS TRUE IF HE(SHE) HAS ACCESS OTHERWISE FALSE.            03796000
      'JITINX' IS THE DST # OF HIS(HER) JIT.                            03798000
      'LDEV' IS THE LOGICAL DEVICE # HE(SHE) WISHES TO ASSOCIATE.       03800000
      AS USUAL MUST NOT BE CALLED IN SPLIT STACK MODE.                  03802000
   ;                                                                    03804000
   ARRAY ASSOC'ENTRY(0:ASF'ENTRYSIZE-1)=Q;                              03806000
   BYTE ARRAY ASSOC'USERNAME(*)=ASSOC'ENTRY(ASF'USERNAME);              03808000
   BYTE ARRAY ASSOC'ACCTNAME(*)=ASSOC'ENTRY(ASF'ACCTNAME);              03810000
   BYTE ARRAY ASSOC'CLASS(*)=ASSOC'ENTRY(ASF'CLASS);                    03812000
   ARRAY USERNAME(0:3)=Q,ACCTNAME(0:3)=Q;                               03814000
   BYTE ARRAY USERNAME'(*)=USERNAME, ACCTNAME'(*)=ACCTNAME;             03816000
   ARRAY ASSFILENAME(0:8);                                              03818000
   INTEGER ASSFILE,I;                                                   03820000
                                                                        03822000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         03824000
   LOGICAL SUBROUTINE MATCHED;                                          03826000
   BEGIN                                                                03828000
      MATCHED:=FALSE;                                                   03830000
      IF (ASSOC'USERNAME="@       " OR                                  03832000
          ASSOC'USERNAME=USERNAME',(8)) AND                             03834000
         (ASSOC'ACCTNAME="@       " OR                                  03836000
          ASSOC'ACCTNAME=ACCTNAME',(8)) AND                             03838000
          ASSOC'CLASS=CLASSNAME,(8) THEN MATCHED:=TRUE;                 03840000
   END;                                                                 03842000
                                                                        03844000
   LOGICAL SUBROUTINE READREC(RECNO);                                   03846000
   VALUE RECNO; INTEGER RECNO;                                          03848000
   BEGIN                                                                03850000
      FREADDIR(ASSFILE,ASSOC'ENTRY,ASF'ENTRYSIZE,DOUBLE(RECNO));        03852000
      IF <> THEN                                                        03854000
      BEGIN                                                             03856000
         FERROR'(ASSFILE,I);                                            03858000
         READREC:=FALSE;                                                03860000
      END                                                               03862000
      ELSE READREC:=TRUE;                                               03864000
   END;                                                                 03866000
$PAGE                                                                   03868000
   CHK'ASS'SECURITY:=FALSE;                                             03870000
   MOVE ASSFILENAME:="ASOCIATE.PUB.SYS ";                               03872000
   ASSFILE:=FOPEN(ASSFILENAME,%2001,%306);<<SHARE,EXECUTE,NO FILEQ>>    03874000
   IF <> THEN FERROR'(ASSFILE,I) <<REPORT OPEN ERROR>>                  03876000
   ELSE                                                                 03878000
   IF 1<=LDEV<=255 THEN <<IF VALID ASSOCIATE FILE LDEV, DO SERACH>>     03880000
   BEGIN                                                                03882000
      MOVEFROMDSEG(@USERNAME,JITINX,JIT'USERNAME,4); <<GET USER'S NAME>>03884000
      MOVEFROMDSEG(@ACCTNAME,JITINX,JIT'ACCTNAME,4); <<GET USER'S ACCT>>03886000
      IF READREC(LDEV) THEN <<SUCCESSFULLY READ 1ST ENTRY>>             03888000
         IF ASSOC'ENTRY<>0 THEN <<1ST ENTRY HAS VALID ASSOCIATION>>     03890000
SEARCH:                                                                 03892000
            IF NOT (CHK'ASS'SECURITY:=MATCHED) THEN <<NO MATCH>>        03894000
               IF ASSOC'ENTRY(ASF'NEXTENTRY)<>0 THEN <<OTHER ENTRIES>>  03896000
               IF READREC(ASSOC'ENTRY(ASF'NEXTENTRY)) THEN GO TO SEARCH;03898000
   END;                                                                 03900000
   FCLOSE(ASSFILE,0,0);                                                 03902000
END;                                                                    03904000
$PAGE "VERIFY MASTER OPERATOR STATUS"                                   03906000
$CONTROL SEGMENT=OPHI                                                   03908000
LOGICAL PROCEDURE MASTEROP;                                             03910000
OPTION PRIVILEGED,UNCALLABLE;                                           03912000
BEGIN                                                                   03914000
   COMMENT                                                              03916000
      THIS ROUTINE RETURNS TRUE IF THE USER IS THE MASTER OPERATOR      03918000
      OTHERWISE IT RETURNS FALSE                                        03920000
   ;                                                                    03922000
                                                                        03924000
   SETXPXGLOB;    <<POINT X AT PCBX GLOBAL>>                            03926000
   TOS:=PXGLOBINDEV;    <<GET $STDIN DEVICE #>>                         03928000
   MASTEROP:= (TOS=ABS(CONSLDEV));                                      03930000
END;                                                                    03932000
$PAGE "MISCELLANEOUS GENERAL ROUTINES"                                  03934000
$CONTROL SEGMENT=OPHI                                                   03936000
LOGICAL PROCEDURE CHECKALLOW(MASK);                                     03938000
VALUE MASK; LOGICAL MASK;                                               03940000
OPTION UNCALLABLE,PRIVILEGED;                                           03942000
BEGIN                                                                   03944000
   COMMENT                                                              03946000
      THIS ROUTINE TELLS WHETHER OR NOT THIS USER HAS BEEN 'ALLOWED'    03948000
   TO DO THIS COMMAND OR IS THE MASTEROP.  IT RETURNS TRUE IF YES,      03950000
   ELSE FALSE.  'MASK' IS THE OPERATOR COMMAND MASK.                    03952000
   AS USUAL NO SPLIT STACK MODE CALLS, PLEASE!                          03954000
   ;                                                                    03956000
   INTEGER ARRAY ALLOWMASK(0:JIT'ALLOW'L-1)=Q;                          03958000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         03960000
                                                                        03962000
   TOS:=@ALLOWMASK;                                                     03964000
   SETJIT;                                                              03966000
   MOVEFROMDSEG(*,*,JIT'ALLOW,JIT'ALLOW'L); <<GET USER'S ALLOW MASK>>   03968000
   IF MASTEROP OR ((ALLOWMASK(MASK.(10:2))&LSL(MASK.(12:4)))<0) THEN    03970000
      CHECKALLOW:=TRUE;                                                 03972000
END;                                                                    03974000
$PAGE                                                          <<00635>>03976000
$CONTROL SEGMENT=OPHI                                          <<00635>>03978000
LOGICAL PROCEDURE VERIFY'MASTOP'C(CLASSNAME);                <<SP.14>>  03980000
INTEGER ARRAY CLASSNAME;                                       <<00635>>03982000
OPTION UNCALLABLE,PRIVILEGED;                                  <<00635>>03984000
BEGIN                                                          <<00635>>03986000
   COMMENT                                                     <<00635>>03988000
      THIS ROUTINE VERIFY THAT WHEN THE MASTEROP USES A COMMAND<<00635>>03990000
      DEALING WITH CLASSES AND THAT CLASS IS CURRENTLY ASSOCIATED       03992000
      THAT THE MASTEROP REALLY INTENDS HIS ACTION BY PROMPTING <<00635>>03994000
      THE MASTEROP FOR VERIFICATION IF ANY LDEV IN THAT CLASS IS        03996000
      ASSOCIATED.                                              <<00635>>03998000
                                                               <<00635>>04000000
      THE ROUTINE RETURNS TRUE IF MASTEROP AND HE FAILS TO VERIFY HIS   04002000
      ACTION.                                                  <<00635>>04004000
**** WARNING: LDT SIR MUST BE LOCKED EXTERNALLY ****           <<04174>>04006000
   ;                                                           <<00635>>04008000
   ARRAY ASS'ENTRY(0:ASS'ENTRYSIZE-1)=Q,USERNAME(0:4)=Q,ACCTNAME(0:4)=Q;04010000
   LOGICAL                                                     <<01649>>04012000
      SAVESIR;                                                 <<01649>>04014000
   INTEGER                                                     <<01649>>04016000
      ERRNUM;   << ERROR NUMBER FOR STDIN ERROR >>             <<01649>>04018000
   LOGICAL YESNO; BYTE YESNO'=YESNO;                           <<00635>>04020000
   BYTE ARRAY USERNAME'(*)=USERNAME,ACCTNAME'(*)=ACCTNAME;     <<00635>>04022000
    INTEGER LDEV;                                              <<00635>>04024000
    INTEGER ARRAY GETCLASSBUF(0:130);                          <<00635>>04026000
    BYTE ARRAY B'CLASSNAME(*) = CLASSNAME;                     <<00635>>04028000
                                                               <<00635>>04030000
   SUBROUTINE DEF'MOVEFROMDSEG;                                <<00635>>04032000
                                                               <<00635>>04034000
   VERIFY'MASTOP'C :=FALSE;                                    <<00635>>04036000
   IF MASTEROP THEN                                            <<00635>>04038000
   BEGIN                                                       <<00635>>04040000
      SETJIT;  <<GET JIT DST #>>                               <<00635>>04042000
      GETCLASS(GETCLASSBUF,TRUE,,,CLASSNAME);                  <<00635>>04044000
      LDEV := GETCLASSBUF(3).(8:8); <<FIRST LDEV IN CLASS>>    <<00635>>04046000
      SAVESIR := GETSIR(ASS'SIR);                              <<01649>>04048000
      MOVEFROMDSEG(@ASS'ENTRY,ASS'DST,LDEV*ASS'ENTRYSIZE,ASS'ENTRYSIZE);04050000
      RELSIR(ASS'SIR,SAVESIR);                                 <<01649>>04052000
      IF TOS<>ASS'ENTRY(ASS'JIT) AND ASS'ENTRY(ASS'JIT)<>0 THEN<<00635>>04054000
      BEGIN                                                    <<00635>>04056000
         MOVEFROMDSEG(@USERNAME,ASS'ENTRY(ASS'JIT),JIT'USERNAME,4);     04058000
         MOVEFROMDSEG(@ACCTNAME,ASS'ENTRY(ASS'JIT),JIT'ACCTNAME,4);     04060000
         USERNAME(4):=ACCTNAME(4):=0;                          <<00635>>04062000
         MOVE USERNAME':=USERNAME' WHILE AN,1;                 <<00635>>04064000
         BPS0:=0; <<TERMINATE WITH ZERO AFTER NON-ALPHANUMERIC>>        04066000
         MOVE ACCTNAME':=ACCTNAME' WHILE AN,1;                 <<00635>>04068000
         BPS0:=0; <<TERMINATE WITH ZERO AFTER NON-ALPHANUMERIC>>        04070000
         DDEL;                                                 <<00635>>04072000
                                                               <<00635>>04074000
<< TELL MASTEROP ABOUT ASSOCIATED USER AND REQUIRE Y/N RESPONSE>>       04076000
                                                               <<00635>>04078000
PROMTOP:                                                       <<00635>>04080000
         GENMSG(CIGENERALMSGSET,OTHERUSERHASCLASS,0,           <<00635>>04082000
               @USERNAME',@ACCTNAME',@B'CLASSNAME,,,0,,,,[1/1,15/0]);   04084000
         READX(YESNO,-1); <<GET Y/N>>                          <<00635>>04086000
         IF <> THEN     << ERROR ON $STDIN >>                  <<01649>>04088000
            BEGIN                                              <<01649>>04090000
            IF > THEN                                          <<01649>>04092000
               ERRNUM := ERRSTDINEOF                           <<01649>>04094000
            ELSE                                               <<01649>>04096000
               ERRNUM := ERRSTDINIO;                           <<01649>>04098000
            PRINT(YESNO,0,0);   << GENERATE CR/LF >>           <<01649>>04100000
            GENMSG(CIERRMSGSET,ERRNUM);  << REPORT ERROR  >>   <<01649>>04102000
            VERIFY'MASTOP'C := TRUE;  << OP NOT CONFIRMED >>   <<01649>>04104000
            GENMSG(CIGENERALMSGSET,OPNOTDONE);                 <<01649>>04106000
            RETURN;                                            <<01649>>04108000
            END;                                               <<01649>>04110000
         IF YESNO'="Y" OR YESNO'="y" THEN RETURN               <<00635>>04112000
         ELSE                                                  <<00635>>04114000
         IF YESNO'<>"N" AND YESNO'<>"n" THEN GO TO PROMTOP     <<00635>>04116000
         ELSE                                                  <<00635>>04118000
         BEGIN                                                 <<00635>>04120000
            VERIFY'MASTOP'C:=TRUE;                             <<00635>>04122000
            GENMSG(CIGENERALMSGSET,OPNOTDONE);                 <<00635>>04124000
         END;                                                  <<00635>>04126000
      END;                                                     <<00635>>04128000
   END;                                                        <<00635>>04130000
END;                                                           <<00635>>04132000
$PAGE                                                                   04134000
$CONTROL SEGMENT=OPHI                                                   04136000
LOGICAL PROCEDURE VERIFY'MASTEROP(LDEV);                                04138000
VALUE LDEV; INTEGER LDEV;                                               04140000
OPTION UNCALLABLE,PRIVILEGED;                                           04142000
BEGIN                                                                   04144000
   COMMENT                                                              04146000
      THIS ROUTINE VERIFY THAT WHEN THE MASTEROP USES A COMMAND         04148000
      DEALING WITH DEVICES AND THAT DEVICE IS CURRENTLY ASSOCIATED      04150000
      THAT THE MASTEROP REALLY INTENDS HIS ACTION BY PROMPTING          04152000
      THE MASTEROP FOR VERIFICATION.                                    04154000
                                                                        04156000
      THE ROUTINE RETURNS TRUE IF MASTEROP AND HE FAILS TO VERIFY HIS   04158000
      ACTION.                                                           04160000
   ;                                                                    04162000
   ARRAY ASS'ENTRY(0:ASS'ENTRYSIZE-1)=Q,USERNAME(0:4)=Q,ACCTNAME(0:4)=Q;04164000
   LOGICAL                                                     <<01649>>04166000
      SAVESIR;                                                 <<01649>>04168000
   INTEGER                                                     <<01649>>04170000
      ERRNUM;   << ERROR NUMBER FOR STDIN ERROR >>             <<01649>>04172000
   LOGICAL YESNO; BYTE YESNO'=YESNO;                                    04174000
   BYTE ARRAY USERNAME'(*)=USERNAME,ACCTNAME'(*)=ACCTNAME;              04176000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         04178000
                                                                        04180000
   VERIFY'MASTEROP:=FALSE;                                              04182000
<< IF LDEV IS NOT VALID, THEN NO NEED TO PROMPT OPERATOR. >>   <<01649>>04184000
   IF LDEV > LPDT(LPDT'MAXDEV)  THEN RETURN;                   <<01649>>04186000
   IF LDEV < 1  THEN RETURN;                                   <<01649>>04188000
                                                               <<01649>>04190000
   IF MASTEROP THEN                                                     04192000
   BEGIN                                                                04194000
      SETJIT;  <<GET JIT DST #>>                                        04196000
      SAVESIR := GETSIR(ASS'SIR);                              <<01649>>04198000
      MOVEFROMDSEG(@ASS'ENTRY,ASS'DST,LDEV*ASS'ENTRYSIZE,ASS'ENTRYSIZE);04200000
      RELSIR(ASS'SIR,SAVESIR);                                 <<01649>>04202000
      IF TOS<>ASS'ENTRY(ASS'JIT) AND ASS'ENTRY(ASS'JIT)<>0 THEN         04204000
      BEGIN                                                             04206000
         MOVEFROMDSEG(@USERNAME,ASS'ENTRY(ASS'JIT),JIT'USERNAME,4);     04208000
         MOVEFROMDSEG(@ACCTNAME,ASS'ENTRY(ASS'JIT),JIT'ACCTNAME,4);     04210000
         USERNAME(4):=ACCTNAME(4):=0;                                   04212000
         MOVE USERNAME':=USERNAME' WHILE AN,1;                          04214000
         BPS0:=0; <<TERMINATE WITH ZERO AFTER NON-ALPHANUMERIC>>        04216000
         MOVE ACCTNAME':=ACCTNAME' WHILE AN,1;                          04218000
         BPS0:=0; <<TERMINATE WITH ZERO AFTER NON-ALPHANUMERIC>>        04220000
         DDEL;                                                          04222000
                                                                        04224000
<< TELL MASTEROP ABOUT ASSOCIATED USER AND REQUIRE Y/N RESPONSE>>       04226000
                                                                        04228000
PROMTOP:                                                                04230000
         GENMSG(CIGENERALMSGSET,OTHERUSERHASDEV,[1/0,3/0,3/0,3/1,6/0],  04232000
               @USERNAME',@ACCTNAME',LDEV,,,0,,,,[1/1,15/0]);           04234000
         READX(YESNO,-1); <<GET Y/N>>                                   04236000
         IF <> THEN     << ERROR ON $STDIN >>                  <<01649>>04238000
            BEGIN                                              <<01649>>04240000
            IF > THEN                                          <<01649>>04242000
               ERRNUM := ERRSTDINEOF                           <<01649>>04244000
            ELSE                                               <<01649>>04246000
               ERRNUM := ERRSTDINIO;                           <<01649>>04248000
            PRINT(YESNO,0,0);   << GENERATE CR/LF >>           <<01649>>04250000
            GENMSG(CIERRMSGSET,ERRNUM);   << REPORT ERROR >>   <<01649>>04252000
            VERIFY'MASTEROP := TRUE;  << OP NOT CONFIRMED >>   <<01649>>04254000
            GENMSG(CIGENERALMSGSET,OPNOTDONE);                 <<01649>>04256000
            RETURN;                                            <<01649>>04258000
            END;                                               <<01649>>04260000
         IF YESNO'="Y" OR YESNO'="y" THEN RETURN                        04262000
         ELSE                                                           04264000
         IF YESNO'<>"N" AND YESNO'<>"n" THEN GO TO PROMTOP              04266000
         ELSE                                                           04268000
         BEGIN                                                          04270000
            VERIFY'MASTEROP:=TRUE;                                      04272000
            GENMSG(CIGENERALMSGSET,OPNOTDONE);                          04274000
         END;                                                           04276000
      END;                                                              04278000
   END;                                                                 04280000
END;                                                                    04282000
$PAGE                                                                   04284000
$CONTROL SEGMENT=OPHI                                                   04286000
INTEGER PROCEDURE CHECKJOB(JMATENTRY,PRI);                     <<04684>>04288000
ARRAY JMATENTRY;                                                        04290000
INTEGER PRI;               << USED WITH CALL FROM CXALTJOB  >> <<04684>>04292000
OPTION UNCALLABLE,PRIVILEGED,VARIABLE;                         <<04684>>04294000
BEGIN                                                                   04296000
   ARRAY JIT(0:JIT'LENGTH-1);                                           04298000
   INTEGER TEMPPRI;                                            <<04684>>04300000
   LOGICAL PMAP= Q-4;      << PARAMETER BIT MAP >>             <<04684>>04302000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);                        04304000
   LOGICAL NOTEQUAL,CAP0=JIT+JIT'CAP;                                   04306000
   INTEGER I;                                                           04308000
   COMMENT                                                              04310000
      THIS PROCEDURE CHECK TO SEE IF THE USER IS THE 'OWNER' OF THE     04312000
   JOB SPECIFIED BY THE JMATENTRY.  'OWNER' MEANS THE SAME ACCOUNT IF   04314000
   THE USER HAS 'AM' CAPABILITY AND SAME ACCOUNT & USER IF OTHERWISE.   04316000
    THE ROUTINE RETURNS 0 IF IF HE IS THE OWNER AND THE        <<04684>>04318000
    JOBSECURITY IS LOW, IT RETURNS 2 IF IT IS THE SAME         <<04684>>04320000
    ACCOUNT AND USER BUT HAS AN INPRI OF 0 OR 14 WITHOUT HIM   <<04684>>04322000
    HAVING AM CAPABILITY AND RETURNS A 1 OTHERWISE.            <<04684>>04324000
   ;                                                                    04326000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         04328000
   CHECKJOB := 1;                                              <<04684>>04330000
   IF NOT PMAP.(15:1)<<TRUE IF PARAMETER PRI WASNT PASSED IN >><<04684>>04332000
      THEN TEMPPRI := 8<<DUMMY VALUE THAT WILL HAVE NO EFFECT>><<04684>>04334000
      ELSE TEMPPRI := PRI;                                     <<04684>>04336000
   MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);                  04338000
   IF JMATHEADER(JMAT'H'JOBSECURITY)<>JOBSECURITY'LOW THEN RETURN;      04340000
   TOS:=@JIT;                                                           04342000
   SETJIT;                                                              04344000
   MOVEFROMDSEG(*,*,0,JIT'LENGTH); <<GET USER'S JIT>>                   04346000
   NOTEQUAL:=FALSE;                                                     04348000
   I:=0;                                                                04350000
   DO IF JIT(JIT'ACCTNAME+I)<>JMATENTRY(JMAT'ACCTNAME+I)                04352000
      THEN NOTEQUAL:=TRUE                                               04354000
   UNTIL NOTEQUAL OR (I:=I+1)>=ACCTNAME'L;                              04356000
   IF NOT NOTEQUAL THEN <<IT IS THE SAME ACCOUNT>>                      04358000
   IF JIT(JIT'CAP).AMCAP THEN<< HAS AM CAP. >> CHECKJOB := 0   <<04684>>04360000
   ELSE                                                                 04362000
   BEGIN                                                                04364000
      NOTEQUAL:=FALSE;                                                  04366000
      I:=0;                                                             04368000
      DO IF JIT(JIT'USERNAME+I)<>JMATENTRY(JMAT'USERNAME+I)             04370000
         THEN NOTEQUAL:=TRUE                                            04372000
      UNTIL NOTEQUAL OR (I:=I+1)>=USERNAME'L;                           04374000
      IF NOT NOTEQUAL  << SAME USER NAME >>                    <<04684>>04376000
         THEN IF 1<= TEMPPRI <= 13                             <<04684>>04378000
                 THEN CHECKJOB := 0                            <<04684>>04380000
                 ELSE CHECKJOB := 2                            <<04684>>04382000
         ELSE CHECKJOB := 1;                                   <<04684>>04384000
   END;                                                                 04386000
END;                                                                    04388000
$PAGE                                                                   04390000
$CONTROL SEGMENT=OPHI                                                   04392000
INTEGER PROCEDURE VERIFY'RLDEV(PARM,LEN,ERRNUM,PARMNUM,PARAMETERNUM);   04394000
VALUE PARAMETERNUM,LEN;                                                 04396000
INTEGER ERRNUM,PARMNUM,PARAMETERNUM,LEN;                                04398000
BYTE ARRAY PARM;                                                        04400000
OPTION UNCALLABLE,PRIVILEGED;                                           04402000
BEGIN                                                                   04404000
   COMMENT                                                              04406000
      THIS ROUTINE VERIFYS THAT THE ASCII STRING CONTAINED IN 'PARM'    04408000
   IS A 'REAL' DEVICE IN THIS CONFIGURATION OF THE OPERATING SYSTEM.    04410000
   'PARM' IS A BYTE ARRAY CONTAINING AN ASCII STRING OF LENGTH 'LEN'.   04412000
   'ERRNUM' IS SET TO THE ERROR NUM, IF AN ERROR IS FOUND.              04414000
   'PARMNUM' IS SET TO 'PARAMETERNUM' IF AN ERROR IS FOUND.             04416000
   THE CONDITION CODE IS SET EQUAL IF OK, OTHERWISE LESS THAN.          04418000
   AS USUAL SPLIT STACK MODE IS NOT ALLOWED!                            04420000
   ;                                                                    04422000
   INTEGER LDEV=VERIFY'RLDEV;                                           04424000
                                                                        04426000
   CC:=CCL;                                                             04428000
   VERIFY'RLDEV:=BINARY(PARM,LEN);  <<CONVERT STRING TO BINARY>>        04430000
   IF <> OR LDEV< 1 THEN <<NOT VALID LOGICAL DEVICE #>>                 04432000
   BEGIN                                                                04434000
      PARMNUM:=PARAMETERNUM;                                            04436000
      CIERR(ERRNUM:=EXPLDEVBAD,PARM); <<REPORT BAD LOGICAL DEV #>>      04438000
   END                                                                  04440000
   ELSE                                                                 04442000
   IF LDEV>LPDT(LPDT'MAXDEV) THEN <<DEV. NOT IN CONFIG.>>               04444000
   BEGIN                                                                04446000
      PARMNUM:=PARAMETERNUM;                                            04448000
      CIERR(ERRNUM:=LDEVNOTCONFIG,PARM,%10000,                          04450000
            LPDT(LPDT'MAXDEV));                                         04452000
   END                                                                  04454000
   ELSE                                                                 04456000
   IF LPDT(LDEV*LPDTSIZE+LPDT'VIRTUAL)=1 THEN <<NOT REAL>>              04458000
   BEGIN                                                                04460000
      PARMNUM:=PARAMETERNUM;                                            04462000
      CIERR(ERRNUM:=LDEVNOTREAL,PARM,%10000,LDEV);                      04464000
   END                                                                  04466000
   ELSE CC:=CCE;                                                        04468000
END;                                                                    04470000
$PAGE "CHECK'IF'SYS'DISC'OR'PV"                                <<03519>>04472000
$CONTROL SEGMENT=OPLOW                                         <<03519>>04474000
INTEGER PROCEDURE CHECK'IF'SYS'DISC'OR'PV (LDEV,               <<03519>>04476000
                                           LDT'ENTRY);                  04478000
   VALUE LDEV;                                                          04480000
   INTEGER LDEV;                                                        04482000
   ARRAY LDT'ENTRY;                                                     04484000
                                                                        04486000
<<=============================================================         04488000
                                                                        04490000
      This procedure determines if a device is a system disc            04492000
   or a private volume.                                                 04494000
                                                                        04496000
   Parameters:                                                          04498000
      ldev - logical device number of the device.                       04500000
      ldt'entry - Logical Device Table entry for the device.            04502000
                                                                        04504000
   Returns:                                                             04506000
      0 - Not a System disc of Private Volume.                          04508000
      1 - System disc.                                                  04510000
      2 - Private Volume.                                               04512000
                                                                        04514000
                                                                        04516000
   Assumptions on entry:                                                04518000
      DB is at the stack.                                               04520000
                                                                        04522000
   Exit conditions:                                                     04524000
      DB is unchanged.                                                  04526000
                                                                        04528000
   Globals:                                                             04530000
                                                                        04532000
      Input:                                                            04534000
         lpdt                                                           04536000
                                                                        04538000
      Equates:                                                          04540000
         vtab'dst                                                       04542000
         vtab'entry'size                                                04544000
                                                                        04546000
      Defines:                                                          04548000
         Def'Movefromdseg                                               04550000
         ldt'dtype                                                      04552000
         ld'vtabx                                                       04554000
         vtab'non'sys'domain                                            04556000
         lpdt'pv                                                        04558000
         lpdt'sd                                                        04560000
         vtab'scratch                                                   04562000
         vtab'unreadable                                                04564000
         vtab'ldev                                                      04566000
                                                                        04568000
   Externals:                                                           04570000
      None.                                                             04572000
                                                                        04574000
   Intrinsics:                                                          04576000
      None.                                                             04578000
                                                                        04580000
   Callers:                                                             04582000
      Cxup (Cxdown)                                                     04584000
                                                                        04586000
   Fix ID:                                                              04588000
         This procedure was added as part of the new disc               04590000
      free space map changes.  The fix number on the                    04592000
      procedure header applies to the whole procedure.                  04594000
                                                                        04596000
   Changes:                                                             04598000
                                                                        04600000
                                                                        04602000
==============================================================>>        04604000
                                                                        04606000
BEGIN                                                                   04608000
                                                                        04610000
   INTEGER VTAB'INDEX;  << Index into volume table >>                   04612000
   ARRAY VTAB'ENTRY (0:VTAB'ENTRY'SIZE-1);  << Entry in vtab >>         04614000
                                                                        04616000
   INTEGER RETURN'VALUE = CHECK'IF'SYS'DISC'OR'PV;                      04618000
                                                                        04620000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         04622000
                                                                        04624000
   << - - - - - - - - - - >>                                            04626000
                                                                        04628000
   << First check if it is a disc >>                                    04630000
                                                                        04632000
   IF LDT'ENTRY (LDT'DTYPE) >= 8 THEN                                   04634000
      RETURN'VALUE := 0  << Not a disc >>                               04636000
                                                                        04638000
   ELSE                                                                 04640000
      BEGIN  << A disc >>                                               04642000
                                                                        04644000
         << Get volume table entry >>                                   04646000
                                                                        04648000
         VTAB'INDEX := LDT'ENTRY (LD'VTABX);                            04650000
                                                                        04652000
         MOVEFROMDSEG (@VTAB'ENTRY, VTAB'DST,                           04654000
               VTAB'INDEX * VTAB'ENTRY'SIZE, VTAB'ENTRY'SIZE);          04656000
                                                                        04658000
         IF VTAB'ENTRY (VTAB'LDEV) = 0 THEN                             04660000
            RETURN'VALUE := 0   << Drive off-line >>                    04662000
                                                                        04664000
         ELSE                                                           04666000
            IF VTAB'ENTRY (VTAB'NON'SYS'DOMAIN) = 0 THEN                04668000
               RETURN'VALUE := 1  << A system disc >>                   04670000
                                                                        04672000
            ELSE                                                        04674000
               IF LPDT ((LDEV*LPDTSIZE) + LPDT'PV) = 1 AND              04676000
               LPDT ((LDEV*LPDTSIZE) + LPDT'SD) = 0 AND                 04678000
               VTAB'ENTRY (VTAB'SCRATCH) = 0 AND                        04680000
               VTAB'ENTRY (VTAB'UNREADABLE) = 0 THEN                    04682000
                  RETURN'VALUE := 2  << Private volume >>               04684000
                                                                        04686000
               ELSE                                                     04688000
                  RETURN'VALUE := 0;  << who knows >>                   04690000
                                                                        04692000
      END;   << A disc >>                                               04694000
                                                                        04696000
END;  << Check'If'Sys'Disc'Or'PV >>                                     04698000
$PAGE                                                          <<01258>>04700000
$CONTROL SEGMENT=OPHI                                          <<01258>>04702000
PROCEDURE CLOSE'FILES;                                         <<01258>>04704000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01258>>04706000
BEGIN                                                          <<01258>>04708000
   << PROCEDURE TO CLOSE ANY OPEN FILES A PROCESS MIGHT HAVE >><<01258>>04710000
   << BEFORE BEING ADOPTED BY PROGEN.  PROCEDURE ADOPT       >><<01258>>04712000
   << BUILDS A STACK MARKER ON THE ADOPTEE'S STACK WHICH     >><<01258>>04714000
   << FORCES THE ADOPTEE TO EXECUTE THIS PROCEDURE BEFORE    >><<01258>>04716000
   << ADOPTION IS COMPLETE AND ADOPT RETURNS TO ITS CALLER.  >><<01258>>04718000
                                                               <<01258>>04720000
   EQUATE FATHERWAIT = 1,   SONWAIT = 2;                       <<01258>>04722000
   FPROCTERM;     << FCLOSE ANY OPEN STANDARD FILES >>         <<01258>>04724000
                                                               <<01258>>04726000
   TOS := ABSOLUTE(CPCB) - ABSOLUTE (PCBB);   << MY PCB PTR >> <<01258>>04728000
   TOS := PCB(TOS+PCB'FTHRPTR) * PCBSIZE;   << FATHER'S PTR >> <<01258>>04730000
                                                               <<01258>>04732000
   AWAKE (*, SONWAIT, FATHERWAIT);                             <<01258>>04734000
END << CLOSE'FILES >>;                                         <<01258>>04736000
$CONTROL SEGMENT=OPHI                                                   04738000
$PAGE "ADOPT -- ADOPT CREATED PROCESS TO ANOTHER PROCESS"               04740000
INTEGER PROCEDURE ADOPT(ADOPTEE,ADOPTER);                               04742000
VALUE ADOPTEE,ADOPTER;                                                  04744000
INTEGER ADOPTEE,ADOPTER;                                                04746000
OPTION PRIVILEGED,UNCALLABLE;                                           04748000
BEGIN                                                                   04750000
   EQUATE SYSPROGENPCBPT=%1141,                                <<01549>>04752000
          PCB'ENTRYSIZE=16,                                    <<01549>>04754000
          PCBXGLOBSIZE=8,                                      <<01549>>04756000
          PCBXFIXEDSIZE=64,                                    <<01549>>04758000
          PROGEN=3;                                            <<01549>>04760000
   DEFINE                                                      <<01673>>04762000
      PROGENINX = ABSOLUTE(SYSPROGENPCBPT)#,                   <<01673>>04764000
      PROGENPIN = PROGENINX/PCB'ENTRYSIZE#;                    <<01673>>04766000
                                                                        04768000
   DEFINE PCB'FATHER=5).(0:8#,      <<FATHER PIN #>>                    04770000
          PCB'SON=5).(8:8#,         <<1 ST SON PIN #>>                  04772000
          PCB'BROTHER=6).(0:8#,     <<BROTHER PIN #>>                   04774000
          PCB'SYSPROC=9).(6:1#,     <<SYSTEM PROCESS BIT>>              04776000
         DUMMY = 0#;                                                    04778000
                                                                        04780000
<<  ADOPTEE'S PCBX GLOBAL & FIXED AREA>>                                04782000
                                                                        04784000
   INTEGER ARRAY A'PCBX(0:PCBXGLOBSIZE+PCBXFIXEDSIZE-1);                04786000
   INTEGER ARRAY A'PCBXGLOB(*)=A'PCBX;                                  04788000
   INTEGER ARRAY A'PCBXFIXED(*)=A'PCBX(PCBXGLOBSIZE);                   04790000
                                                                        04792000
<<  PROGEN'S PCBX GLOBAL & FIXED AREA>>                                 04794000
                                                                        04796000
   INTEGER ARRAY P'PCBX(0:PCBXGLOBSIZE+PCBXFIXEDSIZE-1);                04798000
   INTEGER ARRAY P'PCBXGLOB(*)=P'PCBX;                                  04800000
   INTEGER ARRAY P'PCBXFIXED(*)=P'PCBX(PCBXGLOBSIZE);                   04802000
                                                                        04804000
   INTEGER POINTER PCB=3;  <<SYSTEM GLOBAL RELATIVE PTR TO PCB AREA>>   04806000
                                                                        04808000
   INTEGER STK,I,NEW'FATHER,ADTINX,OLD'FATHER,INDEX,OLDINDEX;           04810000
                                                               <<01258>>04812000
   DOUBLE STACK'DB;  <<DB BANK & DB ADDRESS IN STACK>>         <<01258>>04814000
   INTEGER DB'BANK = STACK'DB,                                 <<01258>>04816000
           DB'ADDR = STACK'DB + 1,                             <<01258>>04818000
           DBPTR,                                              <<01258>>04820000
           SREL'VALUE;                                         <<01258>>04822000
                                                               <<01258>>04824000
   LOGICAL CSTNUM;                                             <<01258>>04826000
                                                               <<01258>>04828000
   LOGICAL ARRAY STK'MARKER(0:5);                              <<01258>>04830000
   EQUATE FATHERWAIT = 1,   SONWAIT = 2;                       <<01258>>04832000
                                                                        04834000
   DEFINE PDISABLE=ASSEMBLE(PSDB)#,  <<PSEUDO DISABLE>>                 04836000
          PENABLE=ASSEMBLE(PSEB)#;   <<PSEUDO ENABLE>>                  04838000
                                                                        04840000
   INTEGER X=X;                                                         04842000
                                                                        04844000
   EQUATE PCBX'DBPTR      = 1,       <<PXGLOB PTR TO DB>>      <<01258>>04846000
          PCBX'SREL       = 9;       <<PCBX RELATIVE S PTR>>   <<01258>>04848000
                                                               <<01258>>04850000
   DEFINE PCBXGLOB'JIT=6).(6:10#,   <<JIT DST # IN PCBXGLOB>>           04852000
          PCBXFIXED'JOB=19#,        <<JOB DESC. IN PCBXFIXED>>          04854000
          PCBXFIXED'SREL=1#,        <<RELATIVE S FOR PROCESS>>          04856000
          JIT'PRCNT=49#;            <<PROCESS CREATION CNT IN JIT>>     04858000
                                                                        04860000
   EQUATE JXREFDST=50;              <<JOB XREF TABLE DST #>>            04862000
                                                                        04864000
   SUBROUTINE MOVEFROMDSEG(TARGET,DSTN,OFFSET,COUNT);                   04866000
   VALUE TARGET,DSTN,OFFSET,COUNT;                                      04868000
   LOGICAL TARGET,DSTN,OFFSET,COUNT;                                    04870000
   BEGIN                                                                04872000
      X:=TOS;                                                           04874000
      ASSEMBLE(MFDS 0);                                                 04876000
      TOS:=X;                                                           04878000
   END;                                                                 04880000
                                                                        04882000
   SUBROUTINE MOVETODSEG(DSTN,OFFSET,SOURCE,COUNT);                     04884000
   VALUE DSTN,OFFSET,SOURCE,COUNT;                                      04886000
   LOGICAL DSTN,OFFSET,SOURCE,COUNT;                                    04888000
   BEGIN                                                                04890000
      X:=TOS;                                                           04892000
      ASSEMBLE(MTDS 0);                                                 04894000
      TOS:=X;                                                           04896000
   END;                                                                 04898000
                                                                        04900000
$PAGE                                                                   04902000
   ADOPT:=0;        <<INITIALIZE RETURN VALUE>>                         04904000
   <<PROGEN'S PIN IS NO LONGER 3. CALLING PROCEDURES SHOULD>>  <<01549>>04906000
   <<BE CHANGED TO LOOK UP PROGEN'S PIN AS IS DONE HERE. FOR>> <<01549>>04908000
   <<NOW, A KLUDGE.>>                                          <<01549>>04910000
   IF ADOPTER = PROGEN THEN                                    <<01673>>04912000
      ADOPTER := PROGENPIN     << THIS IS THE KLUDGE. >>       <<01673>>04914000
   ELSE                                                        <<01673>>04916000
      IF ADOPTER <> PROGENPIN THEN                             <<01673>>04918000
      BEGIN  << FOR NOW, ONLY LEGAL ADOPTER IS PROGEN >>       <<01673>>04920000
         ADOPT := 1;                                           <<01673>>04922000
         RETURN;                                               <<01673>>04924000
      END;                                                     <<01673>>04926000
                                                               <<01673>>04928000
   NEW'FATHER:=ADOPTER*PCB'ENTRYSIZE; <<PCB AREA INDEX TO NEW FATHER>>  04930000
   ADTINX:=ADOPTEE*PCB'ENTRYSIZE;     <<PCB AREA INDEX OF ADOPTEE>>     04932000
   PDISABLE;                                                            04934000
   OLD'FATHER:=PCB(ADTINX+PCB'FATHER)*PCB'ENTRYSIZE;<<INDEX OF OLD FAT>>04936000
   STK := PCB(ADTINX+PCB'STK);                                 <<01258>>04938000
   IF PCB(OLD'FATHER+PCB'SYSPROC)<>0 THEN <<OLD FAT SYS PROCESS>>       04940000
   BEGIN                                                                04942000
      ADOPT := 2; PENABLE; RETURN;                                      04944000
   END;                                                                 04946000
   PENABLE;                                                    <<01258>>04948000
                                                               <<01258>>04950000
                                                               <<01258>>04952000
<< IF ADOPTER PROCESS IS SYSTEM PROCESS, NEED TO HAVE >>       <<01258>>04954000
<< ADOPTEE PROCESS CLOSE OPEN STANDARD FILES, IF THEY >>       <<01258>>04956000
<< ARE OPEN                                           >>       <<01258>>04958000
   IF PCB(NEW'FATHER+PCB'SYSPROC)<>0 THEN <<SYSTEM PROCESS>>   <<01258>>04960000
   BEGIN                                                       <<01258>>04962000
      <<GET DB BANK, DB ADDRESS, & S REL PTR FROM ADOPTEE STK>><<01258>>04964000
      MOVEFROMDSEG(@DBPTR,STK,PCBX'DBPTR,1);                   <<01258>>04966000
      MOVEFROMDSEG(@SREL'VALUE,STK,PCBX'SREL,1);               <<01258>>04968000
      MOVEFROMDSEG(@STACK'DB,STK,DBPTR+SREL'VALUE,2);          <<01258>>04970000
                                                               <<01258>>04972000
      <<BUILD STACK MARKER TO CLOSE'FILES>>                    <<01258>>04974000
      CSTNUM := @CLOSE'FILES.(8:8);                            <<01258>>04976000
      STK'MARKER(0) := 0;                  <<X REG>>           <<01258>>04978000
      STK'MARKER(1) := CONVEXTLABELTODELTAP(@CLOSE'FILES);     <<01549>>04980000
      STK'MARKER(2) := %160000 LOR CSTNUM; <<STATUS REG>>      <<01258>>04982000
      STK'MARKER(3) := 4;                  <<DELTA Q>>         <<01258>>04984000
      STK'MARKER(4) := DB'BANK;            <<DB BANK FOR IXIT>><<01258>>04986000
      STK'MARKER(5) := DB'ADDR;            <<DB ADDR FOR IXIT>><<01258>>04988000
                                                               <<01258>>04990000
      <<PUT STACK MARKER ON ADOPTEE'S STACK & ADJUST SREL>>    <<01258>>04992000
      MOVETODSEG(STK, DBPTR+SREL'VALUE-1, @STK'MARKER, 6);     <<01258>>04994000
      SREL'VALUE := SREL'VALUE + 4;                            <<01258>>04996000
      MOVETODSEG(STK, PCBX'SREL, @SREL'VALUE, 1);              <<01258>>04998000
                                                               <<01258>>05000000
      <<ALLOW ADOPTEE TO CLOSE OPEN STANDARD FILES BEFORE    >><<01258>>05002000
      <<CONTINUING ADOPTION.                                 >><<01258>>05004000
      AWAKE(ADOPTEE*PCBSIZE, FATHERWAIT, SONWAIT);             <<01258>>05006000
   END;                                                        <<01258>>05008000
                                                               <<01258>>05010000
   PDISABLE;                                                   <<01258>>05012000
   INDEX:=PCB(OLD'FATHER+PCB'SON)*PCB'ENTRYSIZE;<<INDEX OF 1ST SON OF >>05014000
<<  REMOTE ADOPTEE FROM HIS OLD FATHER'S PROCESS TREE>>                 05016000
   IF INDEX=ADTINX THEN <<ADOPTEE IS FATHER'S 1ST SON>>                 05018000
      PCB(OLD'FATHER+PCB'SON):=PCB(ADTINX+PCB'BROTHER)                  05020000
   ELSE                                                                 05022000
   BEGIN   <<ADOPTEE IS A BROTHER OF FATHER'S 1ST SON>>                 05024000
      DO INDEX:=PCB((OLDINDEX:=INDEX)+PCB'BROTHER)*PCB'ENTRYSIZE        05026000
      UNTIL INDEX=ADTINX;  <<SCAN BROTHER CHAIN UNTIL ADOPTEE FOUND>>   05028000
      PCB(OLDINDEX+PCB'BROTHER):=PCB(ADTINX+PCB'BROTHER);               05030000
   END;                                                                 05032000
   PENABLE;                                                             05034000
                                                                        05036000
   MOVEFROMDSEG(@A'PCBX, STK, 0, PCBXGLOBSIZE+                 <<01258>>05038000
                PCBXFIXEDSIZE); <<GET ADOPTEE'S PCBX GLOB & FIXED>>     05040000
                                                                        05042000
   MOVEFROMDSEG(@P'PCBX,PCB(NEW'FATHER+PCB'STK),0,PCBXGLOBSIZE+         05044000
                PCBXFIXEDSIZE); <<GET PROGEN'S PCBX GLOB & FIXED>>      05046000
                                                                        05048000
   << UPDATE PROCESS CREATION COUNT IN JIT>>                            05050000
                                                                        05052000
   MOVEFROMDSEG(@I,A'PCBXGLOB(PCBXGLOB'JIT),JIT'PRCNT,1);               05054000
   IF I<>0 THEN                                                         05056000
   BEGIN                                                                05058000
      I:=I-1;                                                           05060000
      MOVETODSEG(A'PCBXGLOB(PCBXGLOB'JIT),JIT'PRCNT,@I,1);              05062000
   END;                                                                 05064000
   MOVEFROMDSEG(@I,P'PCBXGLOB(PCBXGLOB'JIT),JIT'PRCNT,1);               05066000
   I:=I+1;                                                              05068000
   MOVETODSEG(P'PCBXGLOB(PCBXGLOB'JIT),JIT'PRCNT,@I,1);                 05070000
                                                                        05072000
<< UPDATE JOB CROSS REFERENCE TABLE>>                                   05074000
                                                                        05076000
   MOVETODSEG(JXREFDST,ADOPTEE,@P'PCBXFIXED(PCBXFIXED'JOB),1);          05078000
                                                                        05080000
<< UPDATE JOB PROCESS COUNT TABLE >>                                    05082000
                                                                        05084000
   <<NO CODE IS HERE AS THE TABLE ISN'T CURRENTLY BEING MAINTAINED>>    05086000
   <<BY MPE.>>                                                          05088000
                                                                        05090000
<< UPDATE JOB#/JOB TYPE IN ADOPTEE'S PCBXFIXED AREA>>                   05092000
                                                                        05094000
   A'PCBXFIXED(PCBXFIXED'JOB):=P'PCBXFIXED(PCBXFIXED'JOB);              05096000
                                                                        05098000
<< UPDATE ADOPTEE'S PCBXGLOB AREA TO REFLECT ADOPTER'S JOB>>            05100000
                                                                        05102000
   MOVE A'PCBXGLOB(2):=P'PCBXGLOB(2),(6);                               05104000
                                                                        05106000
<< IF ADOPTER PROCESS IS SYSTEM PROCESS, NEED TO MAKE THIS NEW>>        05108000
<< SON A SYSTEM PROCESS>>                                      <<01200>>05110000
                                                                        05112000
   IF PCB(NEW'FATHER+PCB'SYSPROC)<>0 THEN <<SYSTEM PROCESS>>            05114000
   BEGIN                                                                05116000
      PCB(ADTINX+PCB'SYSPROC):=1;                                       05118000
   END;                                                                 05120000
                                                                        05122000
<< NOW READY TO LINK THE ADOPTEE INTO ADOPTER PROCESS STRUCTURE>>       05124000
                                                                        05126000
   MOVETODSEG(STK,0,@A'PCBX,PCBXGLOBSIZE+PCBXFIXEDSIZE);                05128000
   PDISABLE;                                                            05130000
   PCB(ADTINX+PCB'BROTHER):=PCB(NEW'FATHER+PCB'SON);                    05132000
   PCB(NEW'FATHER+PCB'SON):=ADOPTEE;                                    05134000
   PCB(ADTINX+PCB'FATHER):=ADOPTER;                                     05136000
   PENABLE;                                                             05138000
                                                                        05140000
<< AT THIS POINT EVERYTHING IS DONE.>>                                  05142000
<< THIS PROCESS CANNOT BE ACTIVATED BY THE CREATING PROCESS,>>          05144000
<< BUT RATHER MUST BE AWAKEN VIA AWAKE(ADOPTEE,1)>>                     05146000
                                                                        05148000
   END;                                                                 05150000
                                                                        05154000
$PAGE "MISCELLANEOUS GENERAL ROUTINES"                                  05156000
$CONTROL SEGMENT=OPHI                                                   05158000
PROCEDURE SUSPENDJOB(MAINPIN,ERRNUM);                                   05160000
VALUE MAINPIN;                                                          05162000
INTEGER MAINPIN,ERRNUM;                                                 05164000
OPTION UNCALLABLE,PRIVILEGED;                                           05166000
BEGIN                                                                   05168000
   COMMENT                                                              05170000
      THIS PROCEDURE TAKES ALL THE PROCESSES RELATED TO A JOB IN OR     05172000
   OUT OF HYBERNATION DEPENDING ON WHETHER WE'RE SUSPENDING OR          05174000
   RESUMING THE JOB                                                     05176000
   ;                                                                    05178000
   ENTRY RESUMEJOB;                                                     05180000
   LOGICAL SUSPEND:=TRUE;                                               05182000
EQUATE PCBIX=3;                                                <<01549>>05184000
EQUATE DISPQ=1,                                                <<01549>>05186000
       ENDOFCLASS=0;                                           <<01549>>05188000
INTEGER PCBSYSBASEINX=DB+PCBIX;                                <<01549>>05190000
DOUBLE SAVEDB;                                                 <<01549>>05192000
   INTEGER NEXTPIN;                                                     05194000
                                                                        05196000
<<SUSPENDJOB ENTRY POINT>>                                              05198000
   GO TO MAINCODE;                                                      05200000
                                                                        05202000
<<RESUMEJOB ENTRY POINT>>                                               05204000
RESUMEJOB:                                                              05206000
   SUSPEND:=FALSE;                                                      05208000
                                                                        05210000
MAINCODE:                                                               05212000
   NEXTPIN:=MAINPIN;                                                    05214000
   PSEUDODISABLE;     <<DISALLOW PROCESS SWITCHING>>                    05216000
TOS:=%1000D;                                                   <<01549>>05218000
ASSEMBLE(XCHD);                                                <<01549>>05220000
SAVEDB:=TOS;                                                   <<01549>>05222000
   IF PCB(MAINPIN*PCBSIZE+PCB'LIVE)=FALSE THEN ERRNUM:=JOBINTERM        05224000
   ELSE                                                                 05226000
   BEGIN                                                                05228000
      IF PCB(MAINPIN*PCBSIZE+PCB'SONPTR)<>0 THEN <<MUST DO PROGENY>>    05230000
      WHILE (NEXTPIN:=FAMILY(NEXTPIN,MAINPIN))<>MAINPIN                 05232000
      DO IF PCB(NEXTPIN*PCBSIZE+PCB'LIVE) OR NOT SUSPEND THEN           05234000
      BEGIN                                                             05236000
                                                                        05238000
<< CHANGE ITS PROGENY'S STATE AND PUT HIM ON READY LIST IF RESUMING>>   05240000
                                                                        05242000
         IF SUSPEND THEN SET'PSIF(NEXTPIN*PCBSIZE,4)<<HYBERNATE PROC>>  05244000
         ELSE CLEAR'PSIF(NEXTPIN*PCBSIZE,4); <<WAKE UP PROC>>  <<01986>>05246000
      END;                                                              05250000
                                                                        05252000
<< CHANGE MAIN PIN'S STATE AND PUT HIM ON READY LIST IF RESUMING>>      05254000
                                                                        05256000
      IF SUSPEND THEN SET'PSIF(MAINPIN*PCBSIZE,4) <<HYBERNATE CI>>      05258000
      ELSE CLEAR'PSIF(MAINPIN*PCBSIZE,4); <<AWAKEN CI>>        <<01986>>05260000
   END;                                                                 05264000
   TOS:=SAVEDB;                                                <<01549>>05266000
   ASSEMBLE(XCHD;DDEL);                                        <<01549>>05268000
   PSEUDOENABLE;                                                        05270000
END;                                                                    05272000
$PAGE                                                                   05274000
$CONTROL SEGMENT=OPHI                                                   05276000
LOGICAL PROCEDURE FINDJOB(JMATENTRY,ENTRYP,JOBNUM,JOB,JNAME,UNAME,ANAME 05278000
                          ,SIR);                                        05280000
VALUE JOBNUM,JOB;                                                       05282000
INTEGER ARRAY JMATENTRY,JNAME,UNAME,ANAME;                              05284000
INTEGER JOBNUM,SIR,ENTRYP;                                              05286000
LOGICAL JOB;                                                            05288000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                                  05290000
BEGIN                                                                   05292000
   COMMENT                                                              05294000
      THIS ROUTINE SEARCHES THE JMAT FOR THE SPECIFIED JOB.             05296000
      THE JOB MAY BE SPECIFIED IN SEVERAL WAYS:                         05298000
         1) THE JOB # OR SESSION # MAY BE SPECIFIED                     05300000
         2) THE JOBNAME, USERNAME, AND ACCOUNT NAME MAY BE SPECIFIED.   05302000
      THE ROUTINE LEAVES THE SIR LOCKED ON THE JMAT IF THE SPECIFIED    05304000
      JOB IS FOUND AND RETURNS A VALUE OF TRUE.  IF NOT FOUND THE       05306000
      JMAT SIR IS RELEASED AND A VALUE OF FALSE IS RETURNED.            05308000
      ADDITIONALLY THE JMAT ENTRY IS RETURNED IN THE CALLING PARAMETER  05310000
      'JMATENTRY'                                                       05312000
                                                                        05314000
      ***WARNING***                                                     05316000
      WHILE THIS ROUTINE IS OPTION VARIABLE, IT MAKES NO VALIDITY       05318000
      CHECK ON THE CONSISTENCY OF WHICH PARAMETERS ARE SPECIFIED.       05320000
      IF THE SEARCH IS A TYPE 1) SEARCH THEN THE FOLLOWING SHOULD BE    05322000
      SPECIFIED:                                                        05324000
         JMATENTRY,ENTRYRP,JOBNUM,JOB                                   05326000
      IF THE SEARCH IS A TYPE 2) SEARCH, THEN THE FOLLOWING SHOULD BE   05328000
      SPECIFIED:                                                        05330000
         JMATENTRY,ENTRYP,JNAME,UNAME,ANAME                             05332000
      THE SEARCH TYPE IS DIFFERENTIATED BY WHETHER 'JOBNUM' IS SPECIFIED05334000
   ;                                                                    05336000
   LOGICAL PARMMASK=Q-4;   <<PARAMETER MASK>>                           05338000
   DEFINE JOBNUMMASK=(11:1)#;                                           05340000
   LOGICAL LOCAL'FINDJOB=FINDJOB;                                       05342000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);                        05344000
   INTEGER LASTP;                                                       05346000
   INTEGER I;                                                  <<00654>>05348000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         05350000
   FINDJOB:=FALSE;                                                      05352000
   SIR:=GETSIR(JMATSIR);                                                05354000
   MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);                  05356000
   ENTRYP:=JMATHEADER(JMAT'H'ENTRYP); <<POINTER TO 1ST ENTRY>>          05358000
   LASTP:=JMATHEADER(JMAT'H'CURSIZE)*128                                05360000
         -JMATHEADER(JMAT'H'ENTRYSIZE); <<POINTER TO LAST ENTRY+>>      05362000
   DO                                                                   05364000
   BEGIN     <<BEGIN SCAN OF JMAT ENTRIES>>                             05366000
      MOVEFROMDSEG(@JMATENTRY,JMATDST,ENTRYP,                           05368000
                   JMATHEADER(JMAT'H'ENTRYSIZE));                       05370000
      IF JMATENTRY<>0 THEN <<VALID ENTRY>>                              05372000
      IF PARMMASK.JOBNUMMASK THEN <<SEARCH BY JOBNUM>>                  05374000
         IF JOBNUM=INTEGER(JMATENTRY(JMAT'JOBNUM)) THEN <<CORRECT #>>   05376000
            IF JOB THEN <<SEARCHING FOR JOB>>                           05378000
               IF JMATENTRY(JMAT'JOBTYPE)=JOBTYPE'JOB THEN FINDJOB:=TRUE05380000
               ELSE                                                     05382000
            ELSE        <<SEARCHING FOR SESSION>>                       05384000
               IF JMATENTRY(JMAT'JOBTYPE)=JOBTYPE'SESSION THEN          05386000
                  FINDJOB:=TRUE                                         05388000
               ELSE                                                     05390000
         ELSE                                                           05392000
      ELSE <<SEARCHING BY JOBNAME,ACCOUNTNAME, USERNAME>>               05394000
      BEGIN                                                    <<00664>>05396000
      FINDJOB:=TRUE;                                           <<00654>>05398000
      I:=-1;                                                   <<00654>>05400000
      WHILE (I:=I+1)<4 AND LOCAL'FINDJOB DO                    <<00664>>05402000
      IF JMATENTRY(JMAT'USERNAME+I)<>UNAME(I) OR               <<00654>>05404000
         JMATENTRY(JMAT'ACCTNAME+I)<>ANAME(I) OR               <<00654>>05406000
         NOT (JNAME(0)="  ") AND                               <<00654>>05408000
         JMATENTRY(JMAT'JOBNAME+I)<>JNAME(I)                   <<00654>>05410000
      THEN FINDJOB:=FALSE;                                     <<00654>>05412000
      END;                                                     <<00664>>05414000
   END                                                                  05416000
   UNTIL LOCAL'FINDJOB OR                                               05418000
      (ENTRYP:=ENTRYP+JMATHEADER(JMAT'H'ENTRYSIZE))>LASTP;              05420000
   IF NOT LOCAL'FINDJOB THEN RELSIR(JMATSIR,SIR);                       05422000
END;                                                                    05424000
$PAGE "LOGIMAGE -- LOG OPERATOR COMMANDS TO SYSTEM LOG"                 05426000
$CONTROL SEGMENT=OPHI                                                   05428000
PROCEDURE LOGIMAGE(TYPE,PARMSP);                               <<01527>>05430000
VALUE TYPE;  INTEGER TYPE;                                     <<01527>>05432000
BYTE ARRAY PARMSP;                                             <<01527>>05434000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01527>>05436000
BEGIN                                                          <<01527>>05438000
   INTEGER LENGTH,            << TOTAL LENGTH OF IMAGE >>      <<01527>>05440000
           DATA'LENGTH,       << LENGTH OF DATA IN BUFFER >>   <<01527>>05442000
           PARM'LENGTH,       << LENGTH OF PARAMETERS >>       <<01527>>05444000
           COMMAND'LENGTH;    << LENGTH OF COMMAND NAME >>     <<01527>>05446000
   BYTE ARRAY BUFF(0:CIS'BCOMBUFLEN-1);                        <<04604>>05448000
      << ALTHOUGH PROGRAMMATIC COMMANDS ARE NOT LIMITED   >>   <<01527>>05450000
      << IN SIZE, AT THE TIME THIS CODE WAS PUT IN, THE   >>   <<01527>>05452000
      << MAXIMUM SIZE OF A LOG RECORD WAS ONLY 200 BYTES. >>   <<01527>>05454000
                                                               <<01527>>05456000
   << TEST FOR ILLEGAL TYPE >>                                 <<01527>>05458000
   IF TYPE >= NO'OF'OPCOMMANDS THEN TYPE := -1;                <<01527>>05460000
                                                               <<01527>>05462000
   CASE TYPE+1 OF                                              <<01527>>05464000
      BEGIN                                                    <<01527>>05466000
                                                               <<01527>>05468000
      MOVE BUFF := "UNKNOWN COMMAND TYPE;PARMS=",2;            <<01527>>05470000
      MOVE BUFF := "ABORTIO",2;                                <<01527>>05472000
      MOVE BUFF := "ACCEPT",2;                                 <<01527>>05474000
      MOVE BUFF := "DOWN",2;                                   <<01527>>05476000
      MOVE BUFF := "GIVE",2;                                   <<01527>>05478000
      MOVE BUFF := "HEADOFF",2;                                <<01527>>05480000
      MOVE BUFF := "HEADON",2;                                 <<01527>>05482000
      MOVE BUFF := "REFUSE",2;                                 <<01527>>05484000
      MOVE BUFF := "REPLY",2;                                  <<01527>>05486000
      MOVE BUFF := "STARTSPOOL",2;                             <<01527>>05488000
      MOVE BUFF := "TAKE",2;                                   <<01527>>05490000
      MOVE BUFF := "UP",2;                                     <<01527>>05492000
      MOVE BUFF := "MPLINE",2;                                 <<01527>>05494000
      MOVE BUFF := "DSCONTROL",2;                              <<01527>>05496000
      MOVE BUFF := "ABORTJOB",2;                               <<01527>>05498000
      MOVE BUFF := "ALLOW",2;                                  <<01527>>05500000
      MOVE BUFF := "ALTSPOOLFILE",2;                           <<01527>>05502000
      MOVE BUFF := "ALTJOB",2;                                 <<01527>>05504000
      MOVE BUFF := "BREAKJOB",2;                               <<01527>>05506000
      MOVE BUFF := "DELETESPOOLFILE",2;                        <<01527>>05508000
      MOVE BUFF := "DISALLOW",2;                               <<01527>>05510000
      MOVE BUFF := "JOBFENCE",2;                               <<01527>>05512000
      MOVE BUFF := "LIMIT",2;                                  <<01527>>05514000
      MOVE BUFF := "STOPSPOOL",2;                              <<01527>>05516000
      MOVE BUFF := "SUSPENDSPOOL",2;                           <<01527>>05518000
      MOVE BUFF := "OUTFENCE",2;                               <<01527>>05520000
      MOVE BUFF := "RECALL",2;                                 <<01527>>05522000
      MOVE BUFF := "RESUMEJOB",2;                              <<01527>>05524000
      MOVE BUFF := "RESUMESPOOL",2;                            <<01527>>05526000
      MOVE BUFF := "STREAMS",2;                                <<01527>>05528000
      MOVE BUFF := "CONSOLE",2;                                <<01527>>05530000
      MOVE BUFF := "WARN",2;                                   <<01527>>05532000
      MOVE BUFF := "WELCOME",2;                                <<01527>>05534000
      MOVE BUFF := "MON",2;                                    <<01527>>05536000
      MOVE BUFF := "MOFF",2;                                   <<01527>>05538000
      MOVE BUFF := "VMOUNT",2;                                 <<01527>>05540000
      MOVE BUFF := "LMOUNT",2;                                 <<01527>>05542000
      MOVE BUFF := "LDISMOUNT",2;                              <<01527>>05544000
      MOVE BUFF := "MRJECONTROL",2;                            <<01527>>05546000
      MOVE BUFF := "JOBSECURITY",2;                            <<01527>>05548000
      MOVE BUFF := "DOWNLOAD",2;                               <<01527>>05550000
      MOVE BUFF := "MIOENABLE",2;                              <<01527>>05552000
      MOVE BUFF := "MIODISABLE",2;                             <<01527>>05554000
      MOVE BUFF := "LOG",2;                                    <<01527>>05556000
      MOVE BUFF := "FOREIGN",2;                                <<01527>>05558000
      MOVE BUFF := "IMLCONTROL",2;                             <<01527>>05560000
      MOVE BUFF := "SHOWCOM",2;                                <<01527>>05562000
                                                               <<01527>>05564000
      END;  << OF COMMAND NAME INTO BUFFER >>                  <<01527>>05566000
                                                               <<01527>>05568000
   << SET LENGTHS >>                                           <<01527>>05570000
   COMMAND'LENGTH := TOS - @BUFF;                              <<01527>>05572000
   SCAN PARMSP UNTIL CR,1;                                     <<01527>>05574000
   PARM'LENGTH := TOS - @PARMSP;                               <<01527>>05576000
   DATA'LENGTH := LENGTH := PARM'LENGTH + COMMAND'LENGTH;      <<01527>>05578000
                                                               <<01527>>05580000
   << ENSURE THAT DON'T OVERFLOW BUFFER >>                     <<01527>>05582000
   IF LENGTH > CIS'BCOMBUFLEN THEN                             <<04604>>05584000
      BEGIN                                                    <<01527>>05586000
      DATA'LENGTH := CIS'BCOMBUFLEN;                           <<04604>>05588000
      PARM'LENGTH := CIS'BCOMBUFLEN - COMMAND'LENGTH;          <<04604>>05590000
      END;                                                     <<01527>>05592000
                                                               <<01527>>05594000
   << MOVE IN PARAMETER STRING >>                              <<01527>>05596000
   MOVE BUFF(COMMAND'LENGTH) := PARMSP,(PARM'LENGTH);          <<01527>>05598000
                                                               <<01527>>05600000
   LOG15(-LENGTH,@BUFF,DATA'LENGTH,15);                        <<01527>>05602000
                                                               <<01527>>05604000
END; << OF LOGIMAGE >>                                         <<01527>>05606000
$PAGE "PRINTALLOW -- PRINT SPECIFIED ALLOW MASK"               <<0726>> 05608000
PROCEDURE PRINTALLOW(MASK,FOUND,NOTFOUND);                     <<0726>> 05610000
VALUE FOUND,NOTFOUND;                                          <<0726>> 05612000
ARRAY MASK;                                                    <<0726>> 05614000
INTEGER FOUND,NOTFOUND;                                        <<0726>> 05616000
OPTION UNCALLABLE;                                             <<01549>>05618000
BEGIN                                                          <<0726>> 05620000
   LOGICAL PRINTFLG:=FALSE;                                    <<0726>> 05622000
   INTEGER I,LENGTH,PERLINE:=0;                                <<0726>> 05624000
   ARRAY PRINTBUF'(0:10);                                      <<0726>> 05626000
   BYTE ARRAY PRINTBUF(*)=PRINTBUF';                           <<0726>> 05628000
   FOR I:=0 UNTIL NO'OF'OPCOMMANDS-1 DO                        <<0726>> 05630000
   BEGIN                                                       <<0726>> 05632000
   IF REQUESTSERVICE THEN RETURN;                              <<01683>>05634000
      IF MASK(I.(10:2))&CSL(I.(12:4)+1) THEN <<BIT SET>>       <<0726>> 05636000
      BEGIN                                                    <<0726>> 05638000
         IF NOT PRINTFLG THEN <<NEED TO PRINT THE HEADER>>     <<0726>> 05640000
         BEGIN                                                 <<0726>> 05642000
            PRINTFLG:=TRUE;                                    <<0726>> 05644000
            GENMSG(CIGENERALMSGSET,FOUND);                     <<0726>> 05646000
         END;                                                  <<0726>> 05648000
         PRINTBUF':="  ";                                      <<0726>> 05650000
         MOVE PRINTBUF'(1):=PRINTBUF',(9); <<INITIALIZE BUFFER><<0726>> 05652000
         TOS:=@PRINTBUF;                                       <<0726>> 05654000
         ASSEMBLE(LDX I; INCX; LOAD PTR'TABLE,X; LRA PTR'TABLE,X;       05656000
                  ADD,DECX; LOAD PTR'TABLE,X; LRA PTR'TABLE,X; <<0726>> 05658000
                  ADD,DUP; CAB,SUB;);                          <<0726>> 05660000
         LENGTH:=-TOS&ASL(1);                                  <<0726>> 05662000
         TOS:=TOS&ASL(1);                                      <<0726>> 05664000
         MOVE *:=*PB,(LENGTH);                                 <<0726>> 05666000
         IF PERLINE<3 THEN <<PRINT WITH NO CR,LF>>             <<0726>> 05668000
         BEGIN                                                 <<0726>> 05670000
            PERLINE:=PERLINE+1;                                <<0726>> 05672000
            PRINT(PRINTBUF',-18,%320);                         <<0726>> 05674000
         END                                                   <<0726>> 05676000
         ELSE                                                  <<0726>> 05678000
         BEGIN                                                 <<0726>> 05680000
            PERLINE:=0;                                        <<0726>> 05682000
            PRINT(PRINTBUF',-18,0);                            <<0726>> 05684000
         END;                                                  <<0726>> 05686000
      END;                                                     <<0726>> 05688000
   END;                                                        <<0726>> 05690000
   PRINT(PRINTBUF',0,0);                                       <<0726>> 05692000
   IF NOT PRINTFLG THEN                                        <<0726>> 05694000
   BEGIN <<USER HAS NO ALLOW MASK>>                            <<0726>> 05696000
      GENMSG(CIGENERALMSGSET,NOTFOUND);                        <<0726>> 05698000
      PRINT(PERLINE,0,%60); <<DOUBLE SPACE>>                   <<0726>> 05700000
   END                                                         <<0726>> 05702000
   ELSE PRINT(PRINTBUF',0,IF PERLINE=0 THEN 0 ELSE %60);       <<0726>> 05704000
   RETURN;                                                     <<0726>> 05706000
                                                               <<0726>> 05708000
   ASSEMBLE(                                                   <<0726>> 05710000
ABORTIO:          CON "ABORTIO";                               <<0726>> 05712000
ACCEPT:           CON "ACCEPT";                                <<0726>> 05714000
DOWN:             CON "DOWN";                                  <<0726>> 05716000
GIVE:             CON "GIVE";                                  <<0726>> 05718000
HEADOFF:          CON "HEADOFF";                               <<0726>> 05720000
HEADON:           CON "HEADON";                                <<0726>> 05722000
REFUSE:           CON "REFUSE";                                <<0726>> 05724000
REPLY:            CON "REPLY";                                 <<0726>> 05726000
STARTSPOOL:       CON "STARTSPOOL";                            <<0726>> 05728000
TAKE:             CON "TAKE";                                  <<0726>> 05730000
UP:               CON "UP";                                    <<0726>> 05732000
MPLIN:            CON "MPLINE";                                <<0726>> 05734000
DSCONTRL:         CON "DSCONTROL";                             <<0726>> 05736000
ABORTJOB:         CON "ABORTJOB";                              <<0726>> 05738000
ALLOW:            CON "ALLOW";                                 <<0726>> 05740000
ALTSPOOLFILE:     CON "ALTSPOOLFILE";                          <<0726>> 05742000
ALTJOB:           CON "ALTJOB";                                <<0726>> 05744000
BREAKJOB:         CON "BREAKJOB";                              <<0726>> 05746000
DELETESPOOLFILE:  CON "DELETESPOOLFILE";                       <<0726>> 05748000
DISALLOW:         CON "DISALLOW";                              <<0726>> 05750000
JOBFENCE:         CON "JOBFENCE";                              <<0726>> 05752000
LIMIT:            CON "LIMIT";                                 <<0726>> 05754000
STOPSPOOL:        CON "STOPSPOOL";                             <<0726>> 05756000
SUSPENDSPOOL:     CON "SUSPENDSPOOL";                          <<0726>> 05758000
OUTFENCE:         CON "OUTFENCE";                              <<0726>> 05760000
RECALL:           CON "RECALL";                                <<0726>> 05762000
RESUMEJOB:        CON "RESUMEJOB";                             <<0726>> 05764000
RESUMESPOOL:      CON "RESUMESPOOL";                           <<0726>> 05766000
STREAMS:          CON "STREAMS";                               <<0726>> 05768000
CONSOLE:          CON "CONSOLE";                               <<0726>> 05770000
WARN:             CON "WARN";                                  <<0726>> 05772000
WELCOME:          CON "WELCOME";                               <<0726>> 05774000
MON:              CON "MON";                                   <<0726>> 05776000
MOFF:             CON "MOFF";                                  <<0726>> 05778000
VMOUNT:           CON "VMOUNT";                                <<0726>> 05780000
LMOUNT:           CON "LMOUNT";                                <<0726>> 05782000
LDISMOUNT:        CON "LDISMOUNT";                             <<0726>> 05784000
MRJECONTRL:       CON "MRJECONTROL";                           <<0726>> 05786000
JOBSECURITY:      CON "JOBSECURITY";                           <<0726>> 05788000
DOWNLOAD:         CON "DOWNLOAD";                              <<0726>> 05790000
MIOENABLE:        CON "MIOENABLE";                             <<0726>> 05792000
MIODISABLE:       CON "MIODISABLE";                            <<0726>> 05794000
LOG:              CON "LOG";                                   <<00792>>05796000
FOREIGN:          CON "FOREIGN";                               <<00792>>05798000
IMLCONTROL:       CON "IMLCONTROL";                            <<00792>>05800000
SHOWCOM:          CON "SHOWCOM";                                        05802000
END'OF'TABLE: );                                               <<00792>>05804000
                                                               <<0726>> 05806000
ASSEMBLE(                                                      <<0726>> 05808000
PTR'TABLE:                                                     <<0726>> 05810000
CON ABORTIO,ACCEPT,DOWN,GIVE,HEADOFF,HEADON,REFUSE,REPLY,      <<0726>> 05812000
     STARTSPOOL,TAKE,UP,MPLIN,DSCONTRL,ABORTJOB,ALLOW,         <<0726>> 05814000
     ALTSPOOLFILE,ALTJOB,BREAKJOB,DELETESPOOLFILE,DISALLOW,    <<0726>> 05816000
     JOBFENCE,LIMIT,STOPSPOOL,SUSPENDSPOOL,OUTFENCE,RECALL,    <<0726>> 05818000
     RESUMEJOB,RESUMESPOOL,STREAMS,CONSOLE,WARN,WELCOME,       <<0726>> 05820000
     MON,MOFF,VMOUNT,LMOUNT,LDISMOUNT,MRJECONTRL,JOBSECURITY,  <<0726>> 05822000
     DOWNLOAD,MIOENABLE,MIODISABLE,LOG,FOREIGN,IMLCONTROL,SHOWCOM,      05824000
     END'OF'TABLE);                                            <<0726>> 05826000
END;                                                           <<0726>> 05828000
$PAGE "SHOWALLOW EXECUTOR"                                     <<0726>> 05830000
PROCEDURE CXSHOWALLOW EXECUTORHEAD;                            <<0726>> 05832000
COMMENT                                                        <<0726>> 05834000
      SHOWALLOW   [@   ].[@    ]                               <<0726>> 05836000
                  [USER].[ACCT ]                               <<0726>> 05838000
;                                                              <<0726>> 05840000
BEGIN                                                          <<0726>> 05842000
   ARRAY MASK(0:JIT'ALLOW'L-1)=Q;                              <<0726>> 05844000
   LOGICAL FOUND,JITDST;                                       <<0726>> 05846000
   DOUBLE DL:=[8/";",8/".",8/CR,8/0]D;                         <<0726>> 05848000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);               <<0726>> 05850000
   INTEGER ARRAY JMATENTRY(0:JMATENTRYSIZE-1);                 <<0726>> 05852000
   BYTE ARRAY JMATENTRY'(*)=JMATENTRY;                         <<0726>> 05854000
   BYTE ARRAY CURRUSER(0:8),CURRACCT(0:8);                     <<0726>> 05856000
   BYTE ARRAY CURRJOBNAME(0:8), CURRJOBNUM(0:8);               <<02342>>05858000
   BYTE ARRAY DL'(*)=DL;                                       <<0726>> 05860000
   DOUBLE ARRAY PARM(0:2)=Q;                                   <<0726>> 05862000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4;<<0726>> 05864000
   BYTE LEN=PARM+1, SNDLEN=PARM+3;                             <<0726>> 05866000
   INTEGER I,ENTRYP,LASTP,SAVESIR,NUMPARMS;                    <<0726>> 05868000
   LOGICAL PARM1=PARM+1,PARM2=PARM+3;                          <<0726>> 05870000
   ARRAY USERNAME(0:4),ACCTNAME(0:4);                          <<0726>> 05872000
   INTEGER ARRAY PCBXGLOB(0:PCBX'GLOBALSIZE-1);                <<0726>> 05874000
   INTEGER POINTER PCB=3;                                      <<0726>> 05876000
   BYTE ARRAY USERNAME'(*)=USERNAME,ACCTNAME'(*)=ACCTNAME;     <<0726>> 05878000
   INTEGER ARRAY LOGON'ACCOUNT(0:3),LOGON'USER(0:3);           <<00906>>05880000
   BYTE ARRAY LOGON'ACCOUNT'(*)=LOGON'ACCOUNT;                 <<00906>>05882000
   BYTE ARRAY LOGON'USER'(*)=LOGON'USER;                       <<00906>>05884000
   DOUBLE DCAPABILITY; LOGICAL CAPABILITY=DCAPABILITY;                  05886000
   EQUATE PERIOD=1;                                            <<0726>> 05888000
   EQUATE NOTLOGON'SM'OR'MASTEROP=970,                         <<01683>>05890000
          NOTLOGON'AM'OR'MASTEROP=968;                         <<01683>>05892000
   EQUATE NOCRLF = -2;  <<NO CRLF IN GENMSG>>                  <<02342>>05894000
   << SM'OR'MOP'CAP IS TRUE IF USER HAS SYSTEM MANAGER OR    >><<01683>>05896000
   << IS THE MASTER OPERATOR                                 >><<01683>>05898000
   DEFINE SM'OR'MOP'CAP=((CAPABILITY.SMCAP = 1) LOR            <<01683>>05900000
                         (MASTEROP = TRUE))#;                  <<01683>>05902000
   << AM'OR'MOP'CAP IS TRUE IF USER HAS ACCOUNT MANAGER OR   >><<01683>>05904000
   << IS THE MASTER OPERATOR                                 >><<01683>>05906000
   DEFINE AM'OR'MOP'CAP=((CAPABILITY.AMCAP =1) LOR             <<01683>>05908000
                         (MASTEROP = TRUE))#;                  <<01683>>05910000
   SUBROUTINE DEF'MOVEFROMDSEG;                                <<0726>> 05912000
LOGICAL SUBROUTINE NAME(A,B);                                  <<0726>> 05914000
VALUE A,B; INTEGER POINTER A,B;                                <<0726>> 05916000
BEGIN                                                          <<0726>> 05918000
   COMMENT THIS SUBROUTINE TRUE IF THE FOUR WORD ENTRIES       <<0726>> 05920000
      POINTED TO BY 'A' AND 'B' ARE EQUAL, OTHERWISE FALSE     <<0726>> 05922000
   ;                                                           <<0726>> 05924000
   I:=-1;                                                      <<0726>> 05926000
   NAME:=TRUE;                                                 <<0726>> 05928000
   WHILE (I:=I+1)<4 DO IF A(I)<>B(I) THEN NAME:=FALSE;         <<0726>> 05930000
END;                                                           <<0726>> 05932000
   << NO LOG OF SHOWALLOW. >>                                  <<01527>>05934000
   WHO(,DCAPABILITY,,LOGON'USER',,LOGON'ACCOUNT');             <<00906>>05936000
   MYCOMMAND(PARMSP,DL',3,NUMPARMS,PARM);                      <<0726>> 05938000
   IF NUMPARMS=2 THEN <<USER & ACCT BOTH SPECIFIED>>           <<0726>> 05940000
   BEGIN                                                       <<0726>> 05942000
      IF LEN>8 THEN <<USERNAME TO LONG>>                       <<0726>> 05944000
      BEGIN                                                    <<0726>> 05946000
         PARMNUM:=1;                                           <<0726>> 05948000
         CIERR(ERRNUM:=UORANAMEMAX8,FIRSTPARM);                <<0726>> 05950000
         RETURN;                                               <<0726>> 05952000
      END                                                      <<0726>> 05954000
      ELSE                                                     <<0726>> 05956000
      IF LEN=0 THEN <<NO USERNAME SPECIFIED>>                  <<0726>> 05958000
      BEGIN                                                    <<0726>> 05960000
         PARMNUM:=1;                                           <<0726>> 05962000
         CIERR(ERRNUM:=EXPUSERNAME,FIRSTPARM);                 <<0726>> 05964000
         RETURN;                                               <<0726>> 05966000
      END                                                      <<0726>> 05968000
      ELSE                                                     <<0726>> 05970000
      IF PARM1.DELIMITER<>PERIOD THEN << NO PERIOD BETWEEN NAME<<0726>> 05972000
      BEGIN                                                    <<0726>> 05974000
         PARMNUM:=1;                                           <<0726>> 05976000
         CIERR(ERRNUM:=PERIODEXP,FIRSTPARM(LEN));              <<0726>> 05978000
         RETURN;                                               <<0726>> 05980000
      END;                                                     <<0726>> 05982000
      IF SNDLEN>8 THEN <<ACCT NAME TOO LONG>>                  <<0726>> 05984000
      BEGIN                                                    <<0726>> 05986000
         PARMNUM:=2;                                           <<0726>> 05988000
         CIERR(ERRNUM:=UORANAMEMAX8,SNDPARM);                  <<0726>> 05990000
         RETURN;                                               <<0726>> 05992000
      END                                                      <<0726>> 05994000
      ELSE                                                     <<0726>> 05996000
      IF SNDLEN=0 THEN <<NO ACCTNAME>>                         <<0726>> 05998000
      BEGIN                                                    <<0726>> 06000000
         PARMNUM:=2;                                           <<0726>> 06002000
         CIERR(ERRNUM:=EXPACCTNAME,SNDPARM);                   <<0726>> 06004000
         RETURN;                                               <<0726>> 06006000
      END;                                                     <<0726>> 06008000
      USERNAME:="  ";                                          <<0726>> 06010000
      USERNAME(4):=0;                                          <<0726>> 06012000
      MOVE USERNAME(1):=USERNAME,(3);                          <<0726>> 06014000
      MOVE ACCTNAME:=USERNAME,(5); <<INITIALIZED USERNAME,ACCTN<<0726>> 06016000
      MOVE USERNAME':=FIRSTPARM,(LEN);                         <<0726>> 06018000
      MOVE ACCTNAME':=SNDPARM,(SNDLEN);                        <<0726>> 06020000
      IF SNDLEN=1 AND ACCTNAME'="@       " THEN                <<0726>> 06022000
      BEGIN                                                    <<0726>> 06024000
                                                               <<00906>>06026000
      IF NOT SM'OR'MOP'CAP THEN                                <<01683>>06028000
         BEGIN                                                 <<0726>> 06030000
            PARMNUM:=2;                                        <<0726>> 06032000
             CIERR(ERRNUM:=NEED'SM'OR'MASTEROP,SNDPARM);       <<01683>>06034000
            RETURN;                                            <<0726>> 06036000
         END;                                                  <<0726>> 06038000
      END                                                      <<0726>> 06040000
      ELSE                                                     <<0726>> 06042000
      IF SNDPARM<>ALPHA OR PARM2.SPECIAL'CHAR THEN             <<0726>> 06044000
      BEGIN                                                    <<0726>> 06046000
         PARMNUM:=2;                                           <<0726>> 06048000
         CIERR(ERRNUM:=BADNAME,SNDPARM);                       <<0726>> 06050000
         RETURN;                                               <<0726>> 06052000
      END                                                      <<0726>> 06054000
      ELSE                                                     <<0726>> 06056000
      IF ACCTNAME'<>LOGON'ACCOUNT',(8) AND                     <<00906>>06058000
      NOT SM'OR'MOP'CAP THEN                                   <<01683>>06060000
      BEGIN                                                    <<00906>>06062000
         PARMNUM:=2;                                           <<00906>>06064000
          CIERR(ERRNUM:=NOTLOGON'SM'OR'MASTEROP,SNDPARM);      <<01683>>06066000
         RETURN;                                               <<00906>>06068000
      END;                                                     <<00906>>06070000
      IF LEN=1 AND USERNAME'="@       " THEN                   <<0726>> 06072000
      BEGIN                                                    <<0726>> 06074000
                                                               <<00906>>06076000
      IF NOT AM'OR'MOP'CAP THEN                                <<01683>>06078000
         BEGIN                                                 <<0726>> 06080000
            PARMNUM:=1;                                        <<0726>> 06082000
          CIERR(ERRNUM:=NEED'AM'OR'MASTEROP,FIRSTPARM);        <<01683>>06084000
            RETURN;                                            <<0726>> 06086000
         END;                                                  <<0726>> 06088000
      END                                                      <<0726>> 06090000
      ELSE                                                     <<0726>> 06092000
      IF FIRSTPARM<>ALPHA OR PARM1.SPECIAL'CHAR THEN           <<0726>> 06094000
      BEGIN                                                    <<0726>> 06096000
         PARMNUM:=1;                                           <<0726>> 06098000
         CIERR(ERRNUM:=BADNAME,FIRSTPARM);                     <<0726>> 06100000
         RETURN;                                               <<0726>> 06102000
         END                                                   <<00906>>06104000
         ELSE                                                  <<00906>>06106000
         IF USERNAME'<>LOGON'USER',(8) AND                     <<00906>>06108000
         NOT AM'OR'MOP'CAP THEN                                <<01683>>06110000
         BEGIN                                                 <<00906>>06112000
            PARMNUM:=1;                                        <<00906>>06114000
          CIERR(ERRNUM:=NOTLOGON'AM'OR'MASTEROP,FIRSTPARM);    <<01683>>06116000
            RETURN;                                            <<00906>>06118000
         END;                                                  <<00906>>06120000
   END                                                         <<0726>> 06122000
   ELSE IF NUMPARMS=0 THEN <<USE LOGON USER & ACCT>>           <<0726>> 06124000
      WHO(,,,USERNAME',,ACCTNAME')                             <<0726>> 06126000
   ELSE                                                        <<0726>> 06128000
   BEGIN <<MUST HAVE ZERO OR TWO PARAMETERS>>                  <<0726>> 06130000
      PARMNUM:=1;                                              <<0726>> 06132000
      CIERR(ERRNUM:=EXP0OR2PARMS);                             <<0726>> 06134000
      RETURN;                                                  <<0726>> 06136000
   END;                                                        <<0726>> 06138000
$PAGE                                                          <<0726>> 06140000
                                                               <<0726>> 06142000
<< HAVE USER & ACCT NAMES.  NOW SCAN JMAT FOR USERS WHO >>     <<0726>> 06144000
<< QUALIFY UNDER THE INPUTTED NAMES>>                          <<0726>> 06146000
                                                               <<0726>> 06148000
   MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);         <<0726>> 06150000
   ENTRYP:=JMATHEADER(JMAT'H'ENTRYP); << FIRST ENTRY>>         <<0726>> 06152000
   LASTP:=JMATHEADER(JMAT'H'CURSIZE)*128-                      <<0726>> 06154000
          JMATHEADER(JMAT'H'ENTRYSIZE);                        <<0726>> 06156000
   SAVESIR:=GETSIR(JMATSIR);                                   <<0726>> 06158000
   FOUND:=FALSE;                                               <<0726>> 06160000
   DO <<PRINT ALLOW MASK FOR EACH QUALIFIED USER>>             <<0726>> 06162000
   BEGIN                                                       <<0726>> 06164000
      IF REQUESTSERVICE THEN                                   <<01683>>06166000
         BEGIN                                                 <<01683>>06168000
           RELSIR(JMATSIR,SAVESIR);                            <<01683>>06170000
           RETURN;                                             <<01683>>06172000
           END;                                                <<01683>>06174000
      MOVEFROMDSEG(@JMATENTRY,JMATDST,ENTRYP,JMATENTRYSIZE);   <<0726>> 06176000
      IF JMATENTRY<>0 THEN <<GOT VALID ENTRY>>                 <<0726>> 06178000
      BEGIN                                                    <<0726>> 06180000
         IF (USERNAME'="@       " OR                           <<0726>> 06182000
             NAME(USERNAME,JMATENTRY(JMAT'USERNAME))) AND      <<0726>> 06184000
            (ACCTNAME'="@       " OR                           <<0726>> 06186000
             NAME(ACCTNAME,JMATENTRY(JMAT'ACCTNAME))) AND      <<0726>> 06188000
            JMATENTRY(JMAT'JSTATE)=JOBEXEC THEN <<HAVE MATCH>> <<0726>> 06190000
         BEGIN                                                 <<0726>> 06192000
            FOUND:=TRUE; <<FOUND AT LEAST QUALIFYING ENTRY>>   <<0726>> 06194000
            TOS:=@PCBXGLOB;                                    <<0726>> 06196000
            TOS:=PCB(JMATENTRY(JMAT'PINNUM)*PCBSIZE+PCB'STK);  <<0726>> 06198000
            MOVEFROMDSEG(*,*,0,PCBX'GLOBALSIZE);<<SET PCBXGLOB><<0726>> 06200000
            JITDST:=PCBXGLOB(PCBX'JIT); <<GET USER'S JIT'S DST <<0726>> 06202000
            MOVEFROMDSEG(@MASK,JITDST,JIT'ALLOW,               <<0726>> 06204000
                         JIT'ALLOW'L); <<GET ALLOWMASK>>       <<0726>> 06206000
            MOVE CURRJOBNUM:= 8(" ");                          <<02342>>06208000
             IF JMATENTRY(JMAT'JOBTYPE)=JOBTYPE'JOB            <<02342>>06210000
              THEN  MOVE CURRJOBNUM:="#J"                      <<02342>>06212000
             ELSE  MOVE CURRJOBNUM:="#S";                      <<02342>>06214000
             ASCII(JMATENTRY(JMAT'JOBNUM),10,CURRJOBNUM(2));   <<02342>>06216000
             CURRJOBNUM(8):=CURRJOBNAME(8):=0;                 <<02342>>06218000
             GENMSG(NOCRLF,@CURRJOBNUM);                       <<02342>>06220000
            MOVE CURRUSER:=JMATENTRY'(JMAT'USERNAME*2),(8);    <<0726>> 06222000
            MOVE CURRACCT:=JMATENTRY'(JMAT'ACCTNAME*2),(8);    <<0726>> 06224000
            CURRUSER(8):=CURRACCT(8):=0;                       <<0726>> 06226000
            MOVE CURRUSER:=CURRUSER WHILE AN,1;                <<0726>> 06228000
            BPS0:=0; <<TERMINATE USER NAME WITH ZERO BYTE>>    <<0726>> 06230000
            MOVE CURRACCT:=CURRACCT WHILE AN,1;                <<0726>> 06232000
            BPS0:=0;                                           <<0726>> 06234000
            DDEL;                                              <<0726>> 06236000
            MOVE CURRJOBNAME:=JMATENTRY'(JMAT'JOBNAME*2),(8);  <<02342>>06238000
            IF CURRJOBNAME <> "        "  THEN                 <<02342>>06240000
             BEGIN                                             <<02342>>06242000
                MOVE CURRJOBNAME:=CURRJOBNAME WHILE AN,1;      <<02342>>06244000
                BPS0:=",";   <<SEPARATE FROM UNAME>>           <<02342>>06246000
                BPS0(1):=0;  <<TERM WITH ZERO BYTE>>           <<02342>>06248000
                DEL;                                           <<02342>>06250000
                GENMSG(NOCRLF,@CURRJOBNAME);                   <<02342>>06252000
             END;                                              <<02342>>06254000
            GENMSG(CIGENERALMSGSET,USERHEADER,[1/0,3/0,3/0,9/0],        06256000
               @CURRUSER,@CURRACCT);                           <<0726>> 06258000
            PRINTALLOW(MASK,USERHASALLOW,USERNOALLOW);         <<0726>> 06260000
         END;                                                  <<0726>> 06262000
      END;                                                     <<0726>> 06264000
   END                                                         <<0726>> 06266000
   UNTIL (ENTRYP:=ENTRYP+JMATHEADER(JMAT'H'ENTRYSIZE))>LASTP;  <<0726>> 06268000
   RELSIR(JMATSIR,SAVESIR);                                    <<0726>> 06270000
   IF NOT FOUND THEN <<NO QUALIFYING USERS>>                   <<0726>> 06272000
   BEGIN                                                       <<0726>> 06274000
      PARMNUM:=1;                                              <<0726>> 06276000
      CIERR(ERRNUM:=NOQUALIFYUSERS);                           <<0726>> 06278000
   END;                                                        <<0726>> 06280000
   IF REQUESTSERVICE THEN RETURN;                              <<01683>>06282000
   MASK:=ABSOLUTE(ALLOWMASK);                                  <<0726>> 06284000
   MASK(1):=ABSOLUTE(ALLOWMASK+1);                             <<0726>> 06286000
   MASK(2):=ABSOLUTE(ALLOWMASK+2);                             <<0726>> 06288000
   PRINTALLOW(MASK,GLOBALALLOW,NOGLOBALALLOW);                 <<0726>> 06290000
END;                                                           <<0726>> 06292000
$PAGE "HEADON/HEADOFF EXECUTORS"                                        06294000
$CONTROL SEGMENT=OPLOW                                                  06296000
PROCEDURE CXHEADON EXECUTORHEAD;                                        06298000
BEGIN                                                                   06300000
   ENTRY CXHEADOFF;                                                     06302000
   COMMENT                                                              06304000
      THE SYNTAX OF THESE COMMANDS IS:                                  06306000
         HEADON  LDEV                                                   06308000
         HEADOFF LDEV                                                   06310000
      WHERE LDEV IS A REAL CONFIGURED DEVICE                            06312000
   ;                                                                    06314000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  06316000
   BYTE ARRAY DL'(*)=DL;   <<DELIMITERS FOR SCAN>>                      06318000
   DOUBLE ARRAY PARM(0:1)=Q;     <<PARAMETER DESCRIPTOR ARRAY>>         06320000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2; <<PTR TO 1ST & 2ND PAR>>06322000
   BYTE FIRSTLEN=PARM+1;   <<LENGTH OF 1ST PARAMETER>>                  06324000
   INTEGER SAVESIR,NUMPARMS;                                            06326000
   LOGICAL LDEV,ON:=TRUE, DTYPE;                                        06328000
   ARRAY LDT(0:LDTSIZE-1);                                              06330000
                                                                        06332000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         06334000
   SUBROUTINE DEF'MOVETODSEG;                                           06336000
                                                                        06338000
<<CXHEADON ENTRY POINT>>                                                06340000
   GO TO MAINCODE;                                                      06342000
                                                                        06344000
<<CXHEADOFF ENTRY POINT>>                                               06346000
CXHEADOFF:                                                              06348000
   ON:=FALSE;                                                           06350000
                                                                        06352000
MAINCODE:                                                               06354000
   LOGIMAGE( ( IF ON                                           <<01527>>06356000
                  THEN M'HEADON                                <<01527>>06358000
                  ELSE M'HEADOFF ), PARMSP );                  <<01527>>06360000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM); <<DECODE COMMAND>>            06362000
   IF NUMPARMS<>1 THEN                                                  06364000
   BEGIN                                                                06366000
      TOS:=ERRNUM:=IF ON THEN HEADONREQ1P ELSE HEADOFFREQ1P;            06368000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                             06370000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     06372000
      CIERR(*,*);                                                       06374000
   END                                                                  06376000
   ELSE                                                                 06378000
   BEGIN                                                                06380000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,ERRNUM,PARMNUM,1);          06382000
      IF < THEN RETURN;                                                 06384000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>06386000
      IF CHECKASS(LDEV) <<HAS USER ASSOCIATED DEVICE ?>>                06388000
         OR CHECKALLOW(IF ON THEN M'HEADON ELSE M'HEADOFF) THEN         06390000
      BEGIN                                                             06392000
         SAVESIR:=GETSIR(LDTSIR);  <<LOCK LDT>>                         06394000
         MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE); <<GET LDT>>    06396000
         DTYPE:=LDT(LDT'DTYPE);    <<GET DEVICE TYPE>>                  06398000
         IF DTYPE=READERPUNCH OR DTYPE=PRINTER OR                       06400000
            DTYPE=CARDPUNCH OR DTYPE=TERMINAL THEN <<OUTPUT SPOOLEE>>   06402000
         BEGIN   <<VALID DEVICE>>                                       06404000
            LDT(LDT'HT):=NOT ON;  <<SET THE HEADER/TRAILER BIT >>       06406000
            MOVETODSEG(LDTDST,LDEV*LDTSIZE,@LDT,LDTSIZE);               06408000
         END                                                            06410000
         ELSE ERRNUM:=LDEVNOTCRPRPNCH;                                  06412000
         RELSIR(LDTSIR,SAVESIR);   <<UNLOCK LDT>>                       06414000
         IF ERRNUM<>0 THEN <<NOT VALID DEVICE>>                         06416000
         BEGIN                                                          06418000
            PARMNUM:=1;                                                 06420000
            CIERR(ERRNUM,PARMSP);                                       06422000
         END;                                                           06424000
      END                                                               06426000
      ELSE                                                              06428000
      BEGIN                                                             06430000
         PARMNUM:=1;                                                    06432000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                           06434000
      END;                                                              06436000
   END;                                                                 06438000
END;                                                                    06440000
$PAGE "CXTUNE -- :TUNE COMMAND EXECUTOR"                       <<01549>>06442000
$CONTROL SEGMENT=OPLOW                                         <<01549>>06444000
PROCEDURE CXTUNE EXECUTORHEAD;                                 <<01549>>06446000
BEGIN                                                          <<01549>>06448000
$INCLUDE INCLICS                                               <<01552>>06450000
   <<                                                          ((MPEIV))06452000
      THEY SYNTAX OF THE :TUNE COMMAND IS:                     ((MPEIV))06454000
      TUNE [clockcyle][;CQ=cbase,climit,cmin,cmax]             ((MPEIV))06456000
                      [;DQ=dbase,dlimit,dmin,dmax]             ((MPEIV))06458000
                      [;EQ=ebase,elimit,emin,emax]             ((MPEIV))06460000
      each of the base,limit,emin,emax are optional.           ((MPEIV))06462000
      >>                                                       <<01549>>06464000
   LOGICAL POINTER ICS=%177005; <<SYSBLOB REL. PTR TO ICS>>    <<01549>>06466000
   EQUATE NO'OF'PARMS=16,     <<MAXIMUM # OF PARMS FOR COMMAND>>        06468000
          COMMA=0, SEMICOLON=1, EQUALS=2, CARRIAGE=3; <<SEPARATORS>>    06470000
   DOUBLE DL:=[8/",",8/";",8/"=",8/CR]D;                       <<01549>>06472000
   BYTE ARRAY DL'(*)=DL;                                       <<01549>>06474000
   DOUBLE ARRAY PARM(0:NO'OF'PARMS)=Q;                         <<01549>>06476000
   BYTE POINTER PARM17=PARM+32;                                <<01549>>06478000
                                                               <<01549>>06480000
<< CURRENT PARAMETER DESCRIPTOR VARIABLES>>                    <<01549>>06482000
                                                               <<01549>>06484000
   INTEGER I,NUMPARMS,LAST'DELIMITER,CURRENT'DELIMITER,PARM'LENGTH;     06486000
   LOGICAL L; <<WORK VARIABLE>>                                <<01549>>06488000
   BYTE POINTER QUEUEPTR,PARMPTR;                              <<01549>>06490000
   INTEGER QUEUE'INDEX; <<0=CQ, 1=DQ, 2=EQ>>                   <<01549>>06492000
   LONG CHAR':=[8/",",8/0,8/";",8/0,8/"=",24/0]L;              <<01549>>06494000
   BYTE ARRAY CHAR(*)=CHAR';                                   <<01549>>06496000
   INTEGER SCAN'STATE:=0;<<SCANNING FOR 0=;CQ, ;DQ, ;EQ >>     <<01549>>06498000
                         <<             1= QUEUEBASE    >>     <<01549>>06500000
                         <<             2= QUEUELIMIT   >>     <<01549>>06502000
                         <<             3= QUEUEMIN     >>     <<01549>>06504000
                         <<             4= QUEUEMAX     >>     <<01549>>06506000
   INTEGER ARRAY LAST(0:4)=PB:=SEMICOLON,EQUALS,COMMA,COMMA,COMMA;      06508000
   INTEGER ARRAY CURRENT(0:4)=PB:=EQUALS,COMMA,COMMA,COMMA,SEMICOLON;   06510000
                                                               <<01549>>06512000
<<  VARIABLES TO CONTAIN THE VALUES SET BY THE COMMAND>>       <<01549>>06514000
                                                               <<01549>>06516000
   LOGICAL ARRAY FLAG(0:2),MINQUANTUM(0:2)=Q,MAXQUANTUM(0:2)=Q;<<01549>>06518000
   LOGICAL MINCLOCKCYCLE;                                      <<01549>>06520000
   INTEGER ARRAY BASE(0:2)=Q,LIMIT(0:2)=Q;                     <<01549>>06522000
   LOGICAL CLOCKFLAG:=FALSE;                                   <<01549>>06524000
   EQUATE BASE'MIN=150, BASE'MAX=255, LIMIT'MIN=150, LIMIT'MAX=255;     06526000
EQUATE CQMIN=-ICS'MINCFILTERCELL-%1000, CQMAX=-ICS'MAXCFILTERCELL-%1000,06528000
    CQBASE=-ICS'CSCHEDBASECELL-%1000, CQLIMIT=-ICS'WORSTCPRICELL-%1000, 06530000
    DQMIN=-ICS'CURDFILTERCELL-%1000, DQMAX=-ICS'CURDFILTERCELL-%1000,   06532000
    DQBASE=-ICS'DSCHEDBASECELL-%1000, DQLIMIT=-ICS'WORSTDPRICELL-%1000, 06534000
    EQMIN=-ICS'CUREFILTERCELL-%1000,  EQMAX=-ICS'CUREFILTERCELL-%1000,  06536000
    EQBASE=-ICS'ESCHEDBASECELL-%1000, EQLIMIT=-ICS'WORSTEPRICELL-%1000; 06538000
         <<SYSGLOB RELATIVE OFFSETS INTO ICS>>                 <<01549>>06540000
  EQUATE CLOCKCYCLE=%1353;                                     <<01549>>06542000
                                                               <<01549>>06544000
   LOGICAL SUBROUTINE GETNEXT;                                 <<01549>>06546000
   BEGIN                                                       <<01549>>06548000
      PARMNUM:=PARMNUM+1;                                      <<01549>>06550000
      IF PARMNUM<NUMPARMS THEN <<MORE PARAMETERS TO LOOK AT>>  <<01549>>06552000
      BEGIN                                                    <<01549>>06554000
         GETNEXT:=TRUE;                                        <<01549>>06556000
         LAST'DELIMITER:=CURRENT'DELIMITER;                    <<01549>>06558000
         TOS:=PARM(PARMNUM); <<GET CURRENT PARAMETER DESCRIPTOR>>       06560000
         CURRENT'DELIMITER:=S0.DELIMITER;                      <<01549>>06562000
         PARM'LENGTH:=TOS&LSR(8);  <<GET CURRENT PARAMETER LENGTH>>     06564000
         @PARMPTR:=TOS;      <<GET BYTE POINTER TO CURRENT PARAMETER>>  06566000
      END ELSE GETNEXT:=FALSE; <<NO MORE PARAMETERS>>          <<01549>>06568000
   END;                                                        <<01549>>06570000
                                                               <<01549>>06572000
$PAGE                                                          <<01549>>06574000
   MYCOMMAND(PARMSP,DL',NO'OF'PARMS+1,NUMPARMS,PARM);<<PARSE PARMS>>    06576000
   IF NUMPARMS<1 THEN <<EXPECT AT LEAST ONE PARAMETER>>        <<01549>>06578000
   BEGIN                                                       <<01549>>06580000
      CIERR(ERRNUM:=-EXPMINCLOCKCYCLE,PARMSP);                 <<01549>>06582000
      RETURN;                                                  <<01549>>06584000
      END                                                      <<01549>>06586000
   ELSE                                                        <<01549>>06588000
   IF NUMPARMS>NO'OF'PARMS THEN <<TOO MANY PARAMETERS>>        <<01549>>06590000
   BEGIN                                                       <<01549>>06592000
      PARMNUM:=NO'OF'PARMS;                                    <<01549>>06594000
      CIERR(ERRNUM:=TUNEHAS16PARMS,PARM17);                    <<01549>>06596000
      RETURN;                                                  <<01549>>06598000
   END;                                                        <<01549>>06600000
                                                               <<01549>>06602000
<< NOW READY TO START SYNTAX AND SEMANTIC ANALYSIS OF COMMAND>><<01549>>06604000
                                                               <<01549>>06606000
   MINCLOCKCYCLE:=ABSOLUTE(CLOCKCYCLE+1);                      <<01549>>06608000
   CURRENT'DELIMITER:=0;                                       <<01549>>06610000
   PARMNUM:=-1;                                                <<01549>>06612000
   GETNEXT; <<WE HAVE ALREADY CHECKED FOR AT LEAST ONE PARAMETER>>      06614000
   IF PARM'LENGTH<>0 THEN <<MINCLOCKCYLE SPECIFIED>>           <<01549>>06616000
   BEGIN                                                       <<01549>>06618000
      MINCLOCKCYCLE:=BINARY(PARMPTR,PARM'LENGTH);              <<01549>>06620000
      IF <> THEN                                               <<01549>>06622000
      BEGIN     <<GOT BAD NUMBER FOR CLOCKCYLE>>               <<01549>>06624000
         CIERR(ERRNUM:=EXPNUMBERFORCLOCK,PARMPTR);             <<01549>>06626000
         RETURN;                                               <<01549>>06628000
      END                                                      <<01549>>06630000
      ELSE CLOCKFLAG:=TRUE;  <<HAVE VALID NUMBER>>             <<01549>>06632000
   END;                                                        <<01549>>06634000
   FLAG:=FLAG(1):=FLAG(2):=FALSE;                              <<01549>>06636000
<<>>                                                           <<01549>>06638000
<< GET OLD VALUES FROM ICS Q-AREA>>                            <<01549>>06640000
<<>>                                                           <<01549>>06642000
   DISABLE;                                                    <<01549>>06644000
   MINQUANTUM:=ICS(CQMIN);                                     <<01549>>06646000
   MINQUANTUM(1):=ICS(DQMIN);                                  <<01549>>06648000
   MINQUANTUM(2):=ICS(EQMIN);                                  <<01549>>06650000
   MAXQUANTUM:=ICS(CQMAX);                                     <<01549>>06652000
   MAXQUANTUM(1):=ICS(DQMAX);                                  <<01549>>06654000
   MAXQUANTUM(2):=ICS(EQMAX);                                  <<01549>>06656000
   BASE:=ICS(CQBASE);                                          <<01549>>06658000
   BASE(1):=ICS(DQBASE);                                       <<01549>>06660000
   BASE(2):=ICS(EQBASE);                                       <<01549>>06662000
   LIMIT:=ICS(CQLIMIT);                                        <<01549>>06664000
   LIMIT(1):=ICS(DQLIMIT);                                     <<01549>>06666000
   LIMIT(2):=ICS(EQLIMIT);                                     <<01549>>06668000
   ENABLE;                                                     <<01549>>06670000
                                                               <<01549>>06672000
                                                               <<01549>>06674000
<< MAJOR PARSE LOOP >>                                         <<01549>>06676000
                                                               <<01549>>06678000
   WHILE GETNEXT DO                                            <<01549>>06680000
   BEGIN                                                       <<01549>>06682000
      IF SCAN'STATE>4 THEN <<TOO MANY QUEUE PARAMETERS>>       <<01549>>06684000
      BEGIN                                                    <<01549>>06686000
         CIERR(ERRNUM:=QUEUEHAS4PARMS,PARMPTR(-1));            <<01549>>06688000
         RETURN;                                               <<01549>>06690000
      END;                                                     <<01549>>06692000
      IF LAST'DELIMITER<>LAST(SCAN'STATE) THEN                 <<01549>>06694000
      BEGIN                                                    <<01549>>06696000
         CIERR(ERRNUM:=EXPECTBEFORE,PARMPTR(-1),               <<01549>>06698000
               1,@CHAR(LAST(SCAN'STATE)*2));                   <<01549>>06700000
         RETURN;                                               <<01549>>06702000
      END;                                                     <<01549>>06704000
      IF CURRENT'DELIMITER<>CARRIAGE AND CURRENT'DELIMITER<>   <<01549>>06706000
         SEMICOLON AND CURRENT'DELIMITER<>CURRENT(SCAN'STATE) THEN      06708000
      BEGIN                                                    <<01549>>06710000
         CIERR(ERRNUM:=EXPECTAFTER,PARMPTR(PARM'LENGTH),1,     <<01549>>06712000
               @CHAR(CURRENT(SCAN'STATE)*2));                  <<01549>>06714000
         RETURN;                                               <<01549>>06716000
      END;                                                     <<01549>>06718000
      CASE SCAN'STATE OF                                       <<01549>>06720000
      BEGIN                                                    <<01549>>06722000
         <<>>                                                  <<01549>>06724000
         << STATE 0 -- LOOKING FOR ;CQ, ;DQ, ;EQ>>             <<01549>>06726000
         <<>>                                                  <<01549>>06728000
         BEGIN                                                 <<01549>>06730000
            QUEUE'INDEX:=PARMPTR-"C"; <<0=CQ, 1=DQ, 2=EQ >>    <<01549>>06732000
            IF PARM'LENGTH<>2 OR PARMPTR(1)<>"Q"               <<01549>>06734000
               OR NOT (0<=QUEUE'INDEX<=2) THEN <<BAD QUEUE PARM>>       06736000
            BEGIN                                              <<01549>>06738000
               CIERR(ERRNUM:=EXPECT1OFCQDQEQ,PARMPTR);         <<01549>>06740000
               RETURN;                                         <<01549>>06742000
            END;                                               <<01549>>06744000
            IF FLAG(QUEUE'INDEX) THEN <<DUPLICATELY SPECIFIED QUEUES>>  06746000
            BEGIN                                              <<01549>>06748000
               CIERR(ERRNUM:=DUPLICATEQUEUE,PARMPTR);          <<01549>>06750000
               RETURN;                                         <<01549>>06752000
            END;                                               <<01549>>06754000
            FLAG(QUEUE'INDEX):=TRUE;                           <<01549>>06756000
            @QUEUEPTR:=@PARMPTR;                               <<01549>>06758000
         END;  <<END STATE 0>>                                 <<01549>>06760000
         <<>>                                                  <<01549>>06762000
         << SCAN STATE 1 -- SCANNING FOR QUEUEBASE>>           <<01549>>06764000
         <<>>                                                  <<01549>>06766000
         IF PARM'LENGTH<>0 THEN <<PARAMETER NOT SKIPPED>>      <<01549>>06768000
         BEGIN                                                 <<01549>>06770000
            I:=BINARY(PARMPTR,PARM'LENGTH);                    <<01549>>06772000
            IF <> THEN <<BAD QUEUE BASE #>>                    <<01549>>06774000
            BEGIN                                              <<01549>>06776000
               CIERR(ERRNUM:=EXPECTNUMBER,PARMPTR);            <<01549>>06778000
               RETURN;                                         <<01549>>06780000
            END;                                               <<01549>>06782000
            IF NOT (BASE'MIN<=I<=BASE'MAX) THEN                <<01549>>06784000
            BEGIN                                              <<01549>>06786000
               CIERR(ERRNUM:=QUEUEBASELIMIT,PARMPTR);          <<01549>>06788000
               RETURN;                                         <<01549>>06790000
            END;                                               <<01549>>06792000
            BASE(QUEUE'INDEX):=I;                              <<01549>>06794000
         END;                                                  <<01549>>06796000
         <<>>                                                  <<01549>>06798000
         << SCAN STATE 2 -- SCAN FOR QUEUELIMIT>>              <<01549>>06800000
         <<>>                                                  <<01549>>06802000
         IF PARM'LENGTH<>0 THEN <<PARAMETER NOT SKIPPED>>      <<01549>>06804000
         BEGIN                                                 <<01549>>06806000
            I:=BINARY(PARMPTR,PARM'LENGTH);                    <<01549>>06808000
            IF <> THEN                                         <<01549>>06810000
            BEGIN                                              <<01549>>06812000
               CIERR(ERRNUM:=EXPECTNUMBER,PARMPTR);            <<01549>>06814000
               RETURN;                                         <<01549>>06816000
            END;                                               <<01549>>06818000
            IF NOT (LIMIT'MIN<=I<=LIMIT'MAX) THEN              <<01549>>06820000
            BEGIN                                              <<01549>>06822000
               CIERR(ERRNUM:=QUEUEBASELIMIT,PARMPTR);          <<01549>>06824000
               RETURN;                                         <<01549>>06826000
            END;                                               <<01549>>06828000
            LIMIT(QUEUE'INDEX):=I;                             <<01549>>06830000
         END;                                                  <<01549>>06832000
         <<>>                                                  <<01549>>06834000
         << SCAN STATE 3 -- SCANNING FOR QUEUEMIN>>            <<01549>>06836000
         <<>>                                                  <<01549>>06838000
         IF PARM'LENGTH<>0 THEN <<PARAMETER NOT SKIPPED>>      <<01549>>06840000
         BEGIN                                                 <<01549>>06842000
            L:=BINARY(PARMPTR,PARM'LENGTH);                    <<01549>>06844000
            IF <> THEN                                         <<01549>>06846000
            BEGIN                                              <<01549>>06848000
               CIERR(ERRNUM:=EXPECTNUMBER,PARMPTR);            <<01549>>06850000
               RETURN;                                         <<01549>>06852000
            END;                                               <<01549>>06854000
            MINQUANTUM(QUEUE'INDEX):=L;                        <<01549>>06856000
         END;                                                  <<01549>>06858000
         <<>>                                                  <<01549>>06860000
         << SCAN STATE 4 -- SCANNING FOR QUEUEMAX>>            <<01549>>06862000
         <<>>                                                  <<01549>>06864000
         IF PARM'LENGTH<>0 THEN <<PARAMETER NOT SKIPPED>>      <<01549>>06866000
         BEGIN                                                 <<01549>>06868000
            L:=BINARY(PARMPTR,PARM'LENGTH);                    <<01549>>06870000
            IF <> THEN                                         <<01549>>06872000
            BEGIN                                              <<01549>>06874000
               CIERR(ERRNUM:=EXPECTNUMBER,PARMPTR);            <<01549>>06876000
               RETURN;                                         <<01549>>06878000
            END;                                               <<01549>>06880000
            MAXQUANTUM(QUEUE'INDEX):=L;                        <<01549>>06882000
         END;                                                  <<01549>>06884000
      END;                                                     <<01549>>06886000
      SCAN'STATE:=SCAN'STATE+1;                                <<01549>>06888000
      IF CURRENT'DELIMITER=SEMICOLON OR CURRENT'DELIMITER=CARRIAGE THEN 06890000
      BEGIN  <<HAVE END OF QUEUE DESCIPTION>>                  <<01549>>06892000
         IF SCAN'STATE<2 THEN <<MUST GET AT LEAST QUEUE DESCRIPTOR>>    06894000
         BEGIN                                                 <<01549>>06896000
            CIERR(ERRNUM:=EXPECTATLEAST1QPARM,PARMPTR(PARM'LENGTH));    06898000
            RETURN;                                            <<01549>>06900000
         END;                                                  <<01549>>06902000
         IF BASE(QUEUE'INDEX)>LIMIT(QUEUE'INDEX)               <<01549>>06904000
            OR MINQUANTUM(QUEUE'INDEX)>MAXQUANTUM(QUEUE'INDEX) THEN     06906000
         BEGIN                                                 <<01549>>06908000
            CIERR(ERRNUM:=RELATIONSHIPBAD,QUEUEPTR);           <<01549>>06910000
            RETURN;                                            <<01549>>06912000
         END;                                                  <<01549>>06914000
         SCAN'STATE:=0;                                        <<01549>>06916000
      END;                                                     <<01549>>06918000
   END;                                                        <<01549>>06920000
   <<>>                                                        <<01549>>06922000
   <<  LOAD NEW VALUES BACK ONTO ICS Q- AREA>>                 <<01549>>06924000
   <<>>                                                        <<01549>>06926000
   DISABLE;                                                    <<01549>>06928000
   ICS(CQMIN):=MINQUANTUM;                                     <<01549>>06930000
   ICS(DQMIN):=MINQUANTUM(1);                                  <<01549>>06932000
   ICS(EQMIN):=MINQUANTUM(2);                                  <<01549>>06934000
   ICS(CQMAX):=MAXQUANTUM;                                     <<01549>>06936000
   ICS(DQMAX):=MAXQUANTUM(1);                                  <<01549>>06938000
   ICS(EQMAX):=MAXQUANTUM(2);                                  <<01549>>06940000
   ICS(CQBASE):=BASE;                                          <<01549>>06942000
   ICS(DQBASE):=BASE(1);                                       <<01549>>06944000
   ICS(EQBASE):=BASE(2);                                       <<01549>>06946000
   ICS(CQLIMIT):=LIMIT;                                        <<01549>>06948000
   ICS(DQLIMIT):=LIMIT(1);                                     <<01549>>06950000
   ICS(EQLIMIT):=LIMIT(2);                                     <<01549>>06952000
   ABSOLUTE(CLOCKCYCLE+1):=MINCLOCKCYCLE;                      <<01549>>06954000
   ENABLE;                                                     <<01549>>06956000
   RESETDISPQ; <<INITIALIZE THE DISPATCHING Q >>               <<01847>>06958000
END;                                                           <<01549>>06960000
$PAGE "GIVE & TAKE EXECUTORS"                                           06962000
$CONTROL SEGMENT=OPLOW                                                  06964000
PROCEDURE CXGIVE EXECUTORHEAD;                                          06966000
BEGIN                                                                   06968000
   ENTRY CXTAKE;                                                        06970000
   COMMENT                                                              06972000
      THE SYNTAX OF THE GIVE & TAKE COMMANDS IS:                        06974000
         GIVE LDN                                                       06976000
         TAKE LDN                                                       06978000
      THE COMMANDS EITHER GIVE A 'DOWN'ED DEVICE TO DIAGNOSTICS OR      06980000
   TAKE A DEVICE FROM DIAGNOSTICS.                                      06982000
   ;                                                                    06984000
   LOGICAL LDEV,GIVE:=TRUE;                                             06986000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  06988000
   BYTE ARRAY DL'(*)=DL;                                                06990000
   INTEGER SAVESIR,NUMPARMS;                                            06992000
   DOUBLE ARRAY PARM(0:1)=Q;                                            06994000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         06996000
   BYTE LEN=PARM+1;                                                     06998000
   ARRAY LDT(0:LDTSIZE-1);                                              07000000
                                                                        07002000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         07004000
   SUBROUTINE DEF'MOVETODSEG;                                           07006000
                                                                        07008000
<< CXGIVE ENTRY POINT>>                                                 07010000
   GO TO MAINCODE;                                                      07012000
                                                                        07014000
<< CXTAKE ENTRY POINT>>                                                 07016000
CXTAKE:                                                                 07018000
   GIVE:=FALSE;                                                         07020000
                                                                        07022000
MAINCODE:                                                               07024000
   LOGIMAGE( ( IF GIVE                                         <<01527>>07026000
                  THEN M'GIVE                                  <<01527>>07028000
                  ELSE M'TAKE ), PARMSP );                     <<01527>>07030000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM); <<PARSE INPUT>>               07032000
   IF NUMPARMS<>1 <<MUST HAVE 1>> THEN                                  07034000
   BEGIN                                                                07036000
      TOS:=ERRNUM:=IF GIVE THEN GIVEREQ1P ELSE TAKEREQ1P;               07038000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                             07040000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     07042000
      CIERR(*,*);                                                       07044000
      RETURN;                                                           07046000
   END;                                                                 07048000
   LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);                  07050000
   IF < THEN RETURN;                                                    07052000
   IF VERIFY'MASTEROP(LDEV) THEN RETURN; <<MASTEROP MADE INADV. ENTRY>> 07054000
   IF CHECKASS(LDEV) OR                                                 07056000
      CHECKALLOW(IF GIVE THEN M'GIVE ELSE M'TAKE) THEN <<USER HAS ACC>> 07058000
   BEGIN                                                                07060000
      SAVESIR:=GETSIR(LDTSIR);     <<LOCK LDT >>                        07062000
      MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);<<GET LDT 4 LDEV>> 07064000
      IF GIVE THEN                                                      07066000
         IF LDT(LDT'F) THEN ERRNUM:=LDEVINBYF <<IN USE BY SYSTEM>>      07068000
         ELSE IF LDT(LDT'D) THEN ERRNUM:=-LDEVALINBYDIAG <<IN DIAG.>>   07070000
              ELSE LDT(LDT'D):=TRUE <<SET DEVICE DOWN>>                 07072000
      ELSE IF LDT(LDT'D) THEN LDT(LDT'D):=FALSE <<TAKE OUT OF DIAG.>>   07074000
           ELSE ERRNUM:=LDEVNOTINDIAG; <<LDEV NOT IN DIAGNOSTICS>>      07076000
      IF ERRNUM=0 <<SUCCESSFULLY DID GIVE OR TAKE>>                     07078000
      THEN MOVETODSEG(LDTDST,LDEV*LDTSIZE,@LDT,LDTSIZE);                07080000
      RELSIR(LDTSIR,SAVESIR); <<UNLOCK LDT>>                            07082000
      IF ERRNUM<>0 THEN <<NEED TO ISSUE A WARNING OR ERROR MSG>>        07084000
      BEGIN                                                             07086000
         PARMNUM:=1;                                                    07088000
         CIERR(ERRNUM,PARMSP,%10000,LDEV);                              07090000
      END;                                                              07092000
   END                                                                  07094000
   ELSE                                                                 07096000
   BEGIN  <<USER HAS NEITHER ALLOW OR ASSOCIATE ACCESS TO COMMAND>>     07098000
      PARMNUM:=1;                                                       07100000
      CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                              07102000
   END;                                                                 07104000
END;                                                                    07106000
$PAGE "UP & DOWN EXECUTORS"                                             07108000
$CONTROL SEGMENT=OPLOW                                                  07110000
PROCEDURE CXUP EXECUTORHEAD;                                            07112000
BEGIN                                                                   07114000
   ENTRY CXDOWN;                                                        07116000
   COMMENT                                                              07118000
      THE SYNTAX OF THE UP & DOWN COMMANDS IS:                          07120000
         UP   LDN                                                       07122000
         DOWN LDN                                                       07124000
      THE COMMANDS EITHER RETURN THE DEVICE TO USE BY THE SYSTEM (UP)   07126000
      OR REMOVE IT FROM THE SYSTEM'S DOMAIN (DOWN).                     07128000
   ;                                                                    07130000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  07132000
   BYTE ARRAY DL'(*)=DL;                                                07134000
   DOUBLE ARRAY PARM(0:1)=Q;                                            07136000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         07138000
   ARRAY LDT(0:LDTSIZE-1);                                              07140000
   INTEGER NUMPARMS,SAVESIR'LPDT,SAVESIR'LDT;                           07142000
   BYTE LEN=PARM+1;                                                     07144000
   LOGICAL LDEV,UP:=TRUE;                                               07146000
   INTEGER SYS'OR'PV;                                          <<03519>>07148000
   LOGICAL DFS'STAT;                                           <<03519>>07150000
   DEFINE                                                      <<04195>>07152000
      DEV'IS'DISC = ( LDT(2).(10:6) < 8 ) #,                   <<04195>>07154000
      SYS'DISC    = ( LPDT(LDEV*LPDTSIZE+1).(4:1) = 0 ) #;     <<04195>>07156000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         07158000
   SUBROUTINE DEF'MOVETODSEG;                                           07160000
                                                                        07162000
<< CXUP ENTRY POINT>>                                                   07164000
   GO TO MAINCODE;                                                      07166000
                                                                        07168000
<<CXDOWN ENTRY POINT>>                                                  07170000
CXDOWN:                                                                 07172000
   UP:=FALSE;                                                           07174000
                                                                        07176000
MAINCODE:                                                               07178000
   LOGIMAGE( ( IF UP                                           <<01527>>07180000
                  THEN M'UP                                    <<01527>>07182000
                  ELSE M'DOWN ), PARMSP );                     <<01527>>07184000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM); <<PARSE PARAMETERS>>          07186000
   IF NUMPARMS<>1 <<MUST HAVE 1>> THEN                                  07188000
   BEGIN                                                                07190000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                             07192000
      TOS:=ERRNUM:=IF UP THEN UPREQ1P ELSE DOWNREQ1P;                   07194000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     07196000
      CIERR(*,*);                                                       07198000
   END                                                                  07200000
   ELSE                                                                 07202000
   BEGIN                                                                07204000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);               07206000
      IF < THEN RETURN;                                                 07208000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>07210000
      IF CHECKASS(LDEV) OR                                              07212000
         CHECKALLOW(IF UP THEN M'UP ELSE M'DOWN) THEN                   07214000
      BEGIN                                                             07216000
         SAVESIR'LDT:=GETSIR(LDTSIR); <<LOCK LDT>>                      07218000
         MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);<<GET LDT4 DEV>>07220000
         IF UP THEN <<PROCESS UP COMMAND>>                              07222000
            IF LDT(LDT'D) THEN ERRNUM := -LDEVINBYDIAG         <<04801>>07224000
            ELSE IF LDT(LDT'F) AND NOT LDT(LDT'R)                       07226000
                 THEN ERRNUM:=-LDEVALINBYF <<ALREADY UP>>               07228000
                 ELSE <<SET THE DEVICE UP>>                             07230000
                 IF LDT(LDT'R) THEN  << Down pending? >>       <<03519>>07232000
                    LDT(LDT'R) := FALSE   << Clear >>          <<03519>>07234000
                 ELSE                                          <<03519>>07236000
                 BEGIN                                                  07238000
                    LDT(LDT'R):=FALSE; <<CLEAR DOWN PENDING FLAG>>      07240000
                    LDT(LDT'F):=TRUE;  <<SET DEVICE IN USE BY SYSTEM>>  07242000
                                                               <<03519>>07244000
                    << If this is a system disc or PV then >>  <<03519>>07246000
                    << then set up disc free space data    >>  <<03519>>07248000
                    << segment.                            >>  <<03519>>07250000
                                                               <<03519>>07252000
                    SYS'OR'PV := CHECK'IF'SYS'DISC'OR'PV (LDEV,<<03519>>07254000
                                                      LDT);    <<03519>>07256000
                                                               <<03519>>07258000
                    IF SYS'OR'PV > 0 THEN                      <<03519>>07260000
                       BEGIN  << Needs Free space DST >>       <<03519>>07262000
                                                               <<03519>>07264000
                          DFS'STAT := CREATE'DFS'DATA'SEG (    <<03519>>07266000
                                LDEV, ,, IF SYS'OR'PV = 1 THEN <<03519>>07268000
                                TRUE ELSE FALSE);              <<03519>>07270000
                                                               <<03519>>07272000
                          IF NOT DFS'STAT THEN                 <<03519>>07274000
                             SEND'PROCESS'DFS'ERROR (LDEV,     <<03528>>07276000
                                   DFS'STAT, 0);               <<03528>>07278000
                                                               <<03519>>07280000
                       END;   << Needs free space DST >>       <<03519>>07282000
                                                               <<03519>>07284000
                 END                                                    07286000
         ELSE <<PROCESS DOWN COMMAND>>                                  07288000
         BEGIN                                                          07290000
            SAVESIR'LPDT:=GETSIR(LPDTSIR); <<LOCK LPDT>>                07292000
            IF LDEV = ABSOLUTE(CONSLDEV) THEN                  <<01027>>07294000
              ERRNUM := DOWNCONSOLE  <<CAN'T DOWN CONSOLE!!>>  <<01027>>07296000
            ELSE                                               <<01027>>07298000
            IF DEV'IS'DISC  AND  SYS'DISC                      <<04195>>07300000
               THEN ERRNUM := CANT'DOWN'SYS'DISC               <<04195>>07302000
            ELSE                                               <<04195>>07304000
            IF LPDT(LDEV*LPDTSIZE+LPDT'DRSTART)=0                       07306000
               AND LDT(LDT'USECNT)=0 THEN <<DEVICE IS NOT IN USE>>      07308000
               IF LDT (LDT'F) THEN                             <<03519>>07310000
                  BEGIN  << Down device >>                     <<03519>>07312000
                                                               <<03519>>07314000
                     LDT(LDT'F) := FALSE;                      <<03519>>07316000
                                                               <<03519>>07318000
                     << If it is a sys disc or PV then >>      <<03519>>07320000
                     << deallocate and delete the disc >>      <<03519>>07322000
                     << free space data segement.      >>      <<03519>>07324000
                                                               <<03519>>07326000
                     SYS'OR'PV := CHECK'IF'SYS'DISC'OR'PV (    <<03519>>07328000
                                     LDEV, LDT);               <<03519>>07330000
                                                               <<03519>>07332000
                     IF SYS'OR'PV > 0 THEN                     <<03519>>07334000
                        BEGIN  << Has free space DST >>        <<03519>>07336000
                                                               <<03519>>07338000
                           DEALLOCATE'DFS'DATA'SEG (LDEV);     <<03519>>07340000
                                                               <<03519>>07342000
                           DELETE'DFS'DATA'SEG (LDEV);         <<03519>>07344000
                                                               <<03519>>07346000
                        END;   << Has free space DST >>        <<03519>>07348000
                                                               <<03519>>07350000
                  END    << Down device >>                     <<03519>>07352000
               ELSE ERRNUM:=-LDEVALDOWN <<DEVICE ALREADY DOWN>>         07354000
            ELSE IF LDT(LDT'R) THEN ERRNUM:=-LDEVALDOWNP <<ALREADY D>>  07356000
                 ELSE                                                   07358000
                 BEGIN <<MAKE DOWN PENDING>>                            07360000
                    LDT(LDT'R):=TRUE;                                   07362000
                    ERRNUM:=-LDEVINUSEDOWNP; <<IN USE, DOWN PENDING>>   07364000
                 END;                                                   07366000
            RELSIR(LPDTSIR,SAVESIR'LPDT); <<UNLOCK LPDT>>               07368000
         END;                                                           07370000
         IF ERRNUM<=0 THEN MOVETODSEG(LDTDST,LDEV*LDTSIZE,@LDT,LDTSIZE);07372000
         RELSIR(LDTSIR,SAVESIR'LDT); <<UNLOCK LDT>>                     07374000
         IF UP AND ERRNUM=0                                             07376000
            AND LDT(LDT'DTYPE'M)>=LDT'DTYPE'LIST THEN                   07378000
            AWAKE(SYSPROC(UCOP),%20,0); <<AWAKEN UCOP TO TRY SCHED>>    07380000
         IF ERRNUM<>0 THEN <<NEED TO GIVE USE DIAG. OR WARNING>>        07382000
         BEGIN                                                          07384000
            PARMNUM:=1;                                                 07386000
            CIERR(ERRNUM,PARMSP);                                       07388000
         END;                                                           07390000
      END                                                               07392000
      ELSE                                                              07394000
      BEGIN                                                             07396000
         PARMNUM:=1;  <<USE HAS NEITHER ALLOW OR ASSOCIATE TO COMMAND>> 07398000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                           07400000
      END;                                                              07402000
   END;                                                                 07404000
END;                                                                    07406000
$PAGE "FOREIGN COMMAND EXECUTOR"                               <<01115>>07408000
$CONTROL SEGMENT=OPLOW                                         <<01115>>07410000
PROCEDURE CXFOREIGN EXECUTORHEAD;                              <<01115>>07412000
BEGIN                                                          <<01115>>07414000
   DOUBLE ARRAY PARM(0:1)=Q;                                   <<01115>>07416000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                <<01115>>07418000
   BYTE FIRSTLEN=PARM+1;                                       <<01115>>07420000
   INTEGER NUMPARMS,LDEV;                                      <<01115>>07422000
   ARRAY LDT(0:LDTSIZE-1);                                     <<01115>>07424000
   SUBROUTINE DEF'MOVEFROMDSEG;                                <<01115>>07426000
                                                               <<01115>>07428000
                                                               <<01115>>07430000
CXFOREIGN:                                                     <<01115>>07432000
   LOGIMAGE( M'FOREIGN, PARMSP );  << LOG OP COMMAND >>        <<01527>>07434000
   MYCOMMAND(PARMSP,,2,NUMPARMS,PARM); <<PARSE COMMAND>>       <<01115>>07436000
   IF NUMPARMS<>1 THEN <<EXPECTED DISC LDEV #>>                <<01115>>07438000
   BEGIN                                                       <<01115>>07440000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                    <<01115>>07442000
      TOS:=ERRNUM:=FOREIGNREQ1P;                               <<01115>>07444000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;            <<01115>>07446000
      CIERR(*,*);                                              <<01115>>07448000
   END                                                         <<01115>>07450000
   ELSE                                                        <<01115>>07452000
   BEGIN                                                       <<01115>>07454000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,ERRNUM,PARMNUM,1); <<01115>>07456000
      IF < THEN RETURN; <<INVALID LDEV # SPECIFIED>>           <<01115>>07458000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<INADVERTENT OPERATOR<<FDF>>07460000
      IF CHECKASS(LDEV) OR                                     <<01115>>07462000
         CHECKALLOW(M'FOREIGN) THEN <<VALIDATE LEGAL USE OF COMMA<<FDF>>07464000
      BEGIN                                                    <<01115>>07466000
         CASE FOREIGN(LDEV) OF                                 <<01115>>07468000
           BEGIN                                               <<01115>>07470000
             ERRNUM:=0;                 <<CASE 0>>             <<01115>>07472000
             ERRNUM:=-ALREADYFOREIGN;   <<CASE 1>>             <<01115>>07474000
             ERRNUM:=MUSTBEDISC;        <<CASE 2>>             <<01115>>07476000
             ERRNUM:=VOLMUSTBEMTD;      <<CASE 3>>             <<01115>>07478000
             ERRNUM:=INUSEPV;           <<CASE 4>>             <<01115>>07480000
             ERRNUM:=INUSESERDISC;      <<CASE 5>>             <<01115>>07482000
             ERRNUM:=LDEVINSYSDOMAIN;   <<CASE 6>>             <<01115>>07484000
             ERRNUM := CANTMAKEFOREIGN;   <<CASE 7>>           <<03713>>07486000
           END;                                                <<01115>>07488000
                                                               <<01115>>07490000
         IF ERRNUM<>0 THEN                                     <<01115>>07492000
           BEGIN                                               <<01115>>07494000
             PARMNUM:=1;                                       <<01115>>07496000
             CIERR(ERRNUM, FIRSTPARM);                         <<01115>>07498000
           END;                                                <<01115>>07500000
      END                                                      <<01115>>07502000
      ELSE                                                     <<01115>>07504000
      BEGIN                                                    <<01115>>07506000
         PARMNUM:=1;                                           <<01115>>07508000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                  <<01115>>07510000
      END;                                                     <<01115>>07512000
   END;                                                        <<01115>>07514000
END;                                                           <<01115>>07516000
$PAGE "RECALL EXECUTOR"                                        <<01649>>07518000
$CONTROL SEGMENT=OPHI                                          <<04535>>07520000
PROCEDURE RECALL(ERRNUM);                                      <<04535>>07522000
 INTEGER ERRNUM;                                               <<04535>>07524000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04535>>07526000
BEGIN                                                          <<04535>>07528000
   COMMENT                                                     <<04535>>07530000
      THIS PROCEDURE WILL DISPLAY ALL PENDING REPLIES          <<04535>>07534000
   ;                                                           <<04535>>07538000
   ARRAY RIT(0:RIT'SIZE) =Q; << RIT ENTRY, PAD FOR GENMSG >>   <<04803>>07540000
   BYTE ARRAY RIT'(*)=RIT;                                     <<04535>>07542000
   INTEGER MAXINX,I;                                           <<04535>>07544000
   INTEGER NUMQUEUED;                                          <<04803>>07546000
   LOGICAL NOT'PRINTHEADER:=TRUE;                              <<04535>>07548000
   SUBROUTINE DEF'MOVEFROMDSEG;                                <<04535>>07550000
                                                               <<04535>>07552000
   MOVEFROMDSEG(@MAXINX,RIT'DST,1,1); <<GET MAX. # OF ENTRIES>><<04803>>07556000
   <<CALCULATE MAX INDEX INTO RIT DST>>                        <<04535>>07558000
   MAXINX:=(MAXINX)*RIT'SIZE+RIT'HEADSIZE;                     <<04803>>07560000
   I:=RIT'HEADSIZE-RIT'SIZE;<<INIT ENTRY PTR BEFORE 1ST ENTRY>><<04803>>07562000
   WHILE (I:=I+RIT'SIZE)<MAXINX DO <<EXAMINE EACH RIT ENTRY>>  <<04803>>07564000
   BEGIN                                                       <<04535>>07566000
      MOVEFROMDSEG(@RIT,RIT'DST,I,RIT'SIZE);<<GET A RIT ENTRY>><<04803>>07568000
      IF RIT<>0 THEN <<RIT IN USE>>                            <<04535>>07570000
      BEGIN                                                    <<04535>>07572000
         IF NOT'PRINTHEADER THEN <<PRINT LEADING HEADER>>      <<04535>>07574000
         BEGIN                                                 <<04535>>07576000
            NOT'PRINTHEADER:=FALSE;                            <<04535>>07578000
            GENMSG(CIGENERALMSGSET,RECALLHEADER);              <<04535>>07580000
         END;                                                  <<04535>>07582000
         RIT'(RIT(RIT'MSGLEN)+RIT'MSGBASE*2):=0;               <<04535>>07584000
<< GENMSG REQUIRES A ZERO BYTE TERMINATOR ON MESSAGES>>        <<04535>>07586000
         GENMSG(-1,@RIT'(RIT'MSGBASE*2));                      <<04535>>07588000
      END;                                                     <<04535>>07590000
   END;                                                        <<04535>>07592000
   IF NOT'PRINTHEADER THEN ERRNUM:=-NOREPLYPENDING;            <<04535>>07594000
   MOVEFROMDSEG(@NUMQUEUED,RIT'DST,QUEUED'ENTRIES,1);          <<04803>>07596000
   IF NUMQUEUED > 0                                            <<04803>>07598000
      THEN GENMSG(GENERALSET,NUM'QUEUED,%10000,NUMQUEUED);     <<04803>>07600000
END;                                                           <<04535>>07602000
$CONTROL SEGMENT=OPHI                                          <<04535>>07604000
 PROCEDURE CXRECALL EXECUTORHEAD;                              <<04535>>07606000
 OPTION PRIVILEGED,UNCALLABLE;                                 <<04535>>07608000
 << THIS WILL EXECUTE A RECALL FROM THE CI                   >><<04535>>07610000
<< THE SYNTAX OF THIS COMMAND IS:                            >><<04535>>07612000
<<                               RECALL                      >><<04535>>07614000
<<  THIS PROCEDURE WILL ALSO PRINT A WARNING MESSAGE IF THERE>><<04535>>07616000
<<  ARE EXTRA PARAMETERS AND A MESSAGE IF THERE ARE NO       >><<04535>>07618000
<<  REPLIES PENDING                                          >><<04535>>07620000
 BEGIN                                                         <<04535>>07622000
   BYTE POINTER ADDR;                                          <<04535>>07624000
   ERRNUM := 0;                                                <<04535>>07626000
   SCAN PARMSP WHILE[8/CR,8/" "],1; << CHECK FOR EXTRA PARMS>> <<04535>>07628000
   IF NOCARRY THEN                                             <<04535>>07630000
      BEGIN                                                    <<04535>>07632000
        @ADDR := TOS;                                          <<04535>>07634000
        CIERR(-WARNXPARMSIGNORED,ADDR);                        <<04535>>07636000
        END                                                    <<04535>>07638000
      ELSE DEL;                                                <<04535>>07640000
   RECALL(ERRNUM);                                             <<04535>>07642000
   IF ERRNUM = -NOREPLYPENDING                                 <<04535>>07644000
      THEN CIERR(ERRNUM);                                      <<04535>>07646000
 END; << CXRECALL >>                                           <<04535>>07648000
$CONTROL SEGMENT=OPHI                                          <<04535>>07650000
 LOGICAL PROCEDURE CONSRECALL(PARMSP);                         <<04535>>07652000
 BYTE ARRAY PARMSP;                                            <<04535>>07654000
 OPTION PRIVILEGED,UNCALLABLE;                                 <<04535>>07656000
 << THIS PROCEDURE WILL EXECUTE A =RECALL FROM THE CONSOLE   >><<04535>>07658000
 << NOT THE CI                                               >><<04535>>07660000
<< THE SYNTAX OF THIS COMMAND IS:                            >><<04535>>07662000
<<                               (CNTL/A)RECALL              >><<04535>>07664000
<<  THIS PROCEDURE WILL ALSO PRINT A WARNING MESSAGE IF THERE>><<04535>>07666000
<<  ARE EXTRA PARAMETERS AND A MESSAGE IF THERE ARE NO       >><<04535>>07668000
<<  REPLIES PENDING                                          >><<04535>>07670000
 BEGIN                                                         <<04535>>07672000
   INTRINSIC PRINT;                                            <<04535>>07674000
   LOGICAL ARRAY BUF(0:35);<<PROGEN WILL ONLY READ 70 CHARS>>  <<04535>>07676000
   BYTE ARRAY BBUF(*) = BUF;                                   <<04535>>07678000
   INTEGER I;                                                  <<04535>>07680000
   INTEGER ERRNUM;                                             <<04535>>07682000
   ERRNUM := 0;                                                <<04535>>07684000
   BBUF(0) :=" ";                                              <<04535>>07686000
   MOVE BBUF(1) := BBUF(0),(70);                               <<04535>>07688000
   << CHECK FOR EXTRA PARAMETERS >>                            <<04535>>07690000
   SCAN PARMSP WHILE [8/CR,8/" "],1;                           <<04535>>07692000
   IF NOCARRY  << THERE ARE EXTRA PARAMETERS >>                <<04535>>07694000
      THEN BEGIN                                               <<04535>>07696000
             I := (TOS-@PARMSP)+7;<< ADD 7 FOR "RECALL" >>     <<04535>>07698000
             BBUF(I) := "^";                                   <<04535>>07700000
             PRINT(BUF,-(I+1),%0);                             <<04535>>07702000
             GENMSG(GENERALSET,PARMSIGNORED);                  <<04535>>07704000
             END                                               <<04535>>07706000
       ELSE DEL; << DECREMENT TOP OF STACK >>                  <<04535>>07708000
   RECALL(ERRNUM);                                             <<04535>>07710000
   IF ERRNUM = -NOREPLYPENDING                                 <<04535>>07712000
      THEN GENMSG(GENERALSET,NOREPENDING);                     <<04535>>07714000
   CONSRECALL := TRUE;                                         <<04535>>07716000
 END; << CONSRECALL >>                                         <<04535>>07718000
$PAGE "LOG COMMAND EXECUTOR"                                   <<00601>>07720000
$CONTROL SEGMENT=OPLOW                                         <<00601>>07722000
PROCEDURE CXLOG EXECUTORHEAD;                                  <<00601>>07724000
BEGIN                                                          <<00601>>07726000
<<                                                      >>     <<02345>>07728000
<< Command executeor for the :LOG command.              >>     <<02345>>07730000
<< Syntax:                                              >>     <<02345>>07732000
<<     :LOG logid,{START,RESTART,STOP}                  >>     <<02345>>07734000
<<                                                      >>     <<02345>>07736000
   DOUBLE ARRAY PARM(0:2)=Q;                                   <<00601>>07738000
   ARRAY PARMS(*) = PARM;                                      <<02345>>07740000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                <<00601>>07742000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3;                        <<00601>>07744000
   BYTE ARRAY LOGNAME(0:8);                                    <<00601>>07746000
   INTEGER NUMPARMS,LEN,TARGET:=0;                             <<00601>>07748000
                                                               <<00601>>07750000
   DEFINE                                                      <<02345>>07752000
      FIRSTDELIM  =  PARMS(1).(11:5)#,                         <<02345>>07754000
      SNDDELIM    =  PARMS(3).(11:5)#;                         <<02345>>07756000
                                                               <<02345>>07758000
   EQUATE                                                      <<02345>>07760000
      COMMA  = 0,                                              <<02345>>07762000
      CR     = 3;                                              <<02345>>07764000
                                                               <<02345>>07766000
   SUBROUTINE START;                                           <<00601>>07768000
   BEGIN                                                       <<00601>>07770000
      IF FINDLOG(LOGNAME,LEN) THEN <<LOG PROCESS ALREADY ACTIVE>>       07772000
      BEGIN                                                    <<00601>>07774000
         PARMNUM:=1;                                           <<00601>>07776000
         CIERR(ERRNUM:=LOGIDACTIVE,FIRSTPARM);                 <<00601>>07778000
      END                                                      <<00601>>07780000
      ELSE                                                     <<00601>>07782000
      IF NOT INITLOG(LOGNAME,TARGET) THEN <<UNABLE TO START LOG >>      07784000
      BEGIN                                                    <<00601>>07786000
         PARMNUM:=1;                                           <<00601>>07788000
         CIERR(ERRNUM:=NOINITLOG,FIRSTPARM);                   <<00601>>07790000
      END;                                                     <<00601>>07792000
   END;                                                        <<00601>>07794000
                                                               <<00601>>07796000
   LOGIMAGE( M'LOG, PARMSP );  << LOG OP COMMAND >>            <<01527>>07798000
   MYCOMMAND(PARMSP,,2,NUMPARMS,PARM);                         <<00601>>07800000
   IF NUMPARMS<>2 THEN <<MUST HAVE EXACTLY 2 PARAMETERS>>      <<00601>>07802000
   BEGIN                                                       <<00601>>07804000
      PARMNUM:=IF NUMPARMS<2 THEN 1 ELSE 2;                    <<00601>>07806000
      CIERR(ERRNUM:=LOGEXP2PARM);                              <<00601>>07808000
      RETURN;                                                  <<00601>>07810000
   END                                                         <<00601>>07812000
   ELSE                                                        <<00601>>07814000
   IF NOT (1<=INTEGER(FIRSTLEN)<=8) THEN <<LOG ID 1 TO 8 CHARS>>        07816000
   BEGIN                                                       <<00601>>07818000
      PARMNUM:=1;                                              <<00601>>07820000
      CIERR(ERRNUM:=LOGMUSTBE1TO8,FIRSTPARM);                  <<00601>>07822000
      RETURN;                                                  <<00601>>07824000
   END                                                         <<00601>>07826000
   ELSE                                                        <<00601>>07828000
   IF FIRSTPARM<>ALPHA THEN <<LOGID MUST START WITH ALPHA CHAR>>        07830000
   BEGIN                                                       <<00601>>07832000
      PARMNUM:=1;                                              <<00601>>07834000
      CIERR(ERRNUM:=LOG1STCHARALPHA,FIRSTPARM);                <<00601>>07836000
      RETURN;                                                  <<00601>>07838000
   END                                                         <<00601>>07840000
   ELSE                                                        <<00601>>07842000
   BEGIN                                                       <<00601>>07844000
      MOVE LOGNAME:="         "; <<INITIALIZE LOG ID STRING>>  <<01549>>07846000
      MOVE LOGNAME:=FIRSTPARM,(FIRSTLEN); <<LOG ID LOCAL COPY>>         07848000
      MOVE LOGNAME:=LOGNAME WHILE AN,1;                        <<00601>>07850000
      LEN:=TOS-@LOGNAME; <<LENGTH OF LOG ID>>                  <<00601>>07852000
      IF LEN<>INTEGER(FIRSTLEN) THEN <<NON-ALPHANUMERIC CHAR. IN ID>>   07854000
      BEGIN                                                    <<00601>>07856000
         PARMNUM:=1;                                           <<00601>>07858000
         CIERR(ERRNUM:=LOGIDMUSTBEAN,FIRSTPARM(LEN-1));        <<00601>>07860000
         RETURN;                                               <<00601>>07862000
      END;                                                     <<00601>>07864000
   END;                                                        <<00601>>07866000
   IF FIRSTDELIM <> COMMA THEN                                 <<02345>>07868000
   BEGIN                                                       <<02345>>07870000
      PARMNUM := 1;                                            <<02345>>07872000
      CIERR(ERRNUM:=EXPCOMMA,FIRSTPARM(INTEGER(FIRSTLEN)));    <<02345>>07874000
      RETURN;                                                  <<02345>>07876000
   END;                                                        <<02345>>07878000
                                                               <<02345>>07880000
   IF SNDLEN=7 AND SNDPARM="RESTART" THEN                      <<00601>>07882000
   BEGIN                                                       <<00601>>07884000
      TARGET:=[8/5,8/0];                                       <<00601>>07886000
      START;  <<DO RESTART>>                                   <<00601>>07888000
   END                                                         <<00601>>07890000
   ELSE                                                        <<00601>>07892000
   IF SNDLEN=5 AND SNDPARM="START" THEN START <<DO START>>     <<00601>>07894000
   ELSE                                                        <<00601>>07896000
   IF SNDLEN=4 AND SNDPARM="STOP" THEN <<DO STOP>>             <<00601>>07898000
   BEGIN                                                       <<00601>>07900000
      IF NOT FINDLOG(LOGNAME,LEN) OR NOT STOPLOG(LOGNAME) THEN <<00601>>07902000
      BEGIN                                                    <<00601>>07904000
         PARMNUM:=1;                                           <<00601>>07906000
         CIERR(ERRNUM:=LOGNOTACTIVE,SNDPARM);<<NO SUCH LOG PROCESS>>    07908000
      END;                                                     <<00601>>07910000
   END                                                         <<00601>>07912000
   ELSE                                                        <<00601>>07914000
   BEGIN                                                       <<00601>>07916000
      PARMNUM:=2;                                              <<00601>>07918000
      CIERR(ERRNUM:=EXP1OFSSR,SNDPARM);                        <<00601>>07920000
   END;                                                        <<00601>>07922000
                                                               <<02345>>07924000
   IF SNDDELIM <> CR THEN                                      <<02345>>07926000
   BEGIN                                                       <<02345>>07928000
      PARMNUM := 2;                                            <<02345>>07930000
      CIERR(ERRNUM:=-EXTRADELIM,SNDPARM(INTEGER(SNDLEN)));     <<02345>>07932000
   END;                                                        <<02345>>07934000
                                                               <<02345>>07936000
END;                                                           <<00601>>07938000
$PAGE "OUTFENCE/JOBFENCE COMMAND PROCESSOR"                             07940000
$CONTROL SEGMENT=OPMED                                                  07942000
PROCEDURE CXOUTFENCE EXECUTORHEAD;                                      07944000
BEGIN                                                                   07946000
   ENTRY CXJOBFENCE;                                                    07948000
   COMMENT                                                              07950000
      THE SYNTAX OF THIS COMMAND IS:                                    07952000
         OUTFENCE PRIORITY                                              07954000
         WHERE 1<=PRIORITY<=14 SETS THE PRIORITY OF OUTPUT FENCE        07956000
   ;                                                                    07958000
   DOUBLE DL:=[8/",",8/";",8/"=",8/CR]D;                       <<00874>>07960000
   BYTE ARRAY DL'(*)=DL;                                                07962000
   DOUBLE ARRAY PARM(0:4) = Q;                                 <<00874>>07964000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         07966000
   BYTE POINTER TRDPARM = PARM + 4;                            <<00874>>07968000
   BYTE LEN=PARM+1;                                                     07970000
   BYTE SNDLEN = PARM + 3, TRDLEN = PARM + 5;                  <<00874>>07972000
   INTEGER DELIM, LDEV, HEADENTRY;                             <<00874>>07974000
   LOGICAL ALLDEVS := TRUE;                                    <<00874>>07976000
   INTEGER ARRAY HEADER(0:3);                                  <<00874>>07978000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                             <<04216>>07980000
   DEFINE                                                      <<00874>>07982000
          HDR'LDEV = 0).(8:8        #,                         <<00874>>07984000
          HDR'FENCE= 0).(0:8        #,                         <<00874>>07986000
          HEAD'LIMIT = (0:8)       #;                          <<00874>>07988000
   INTEGER ARRAY HEAD'SIZE(0:1);                               <<00874>>07990000
   INTEGER ARRAY HEAD'SUBAREAP(*) = HEAD'SIZE(1);              <<00874>>07992000
   EQUATE COMMA = 0,                                           <<00874>>07994000
          EQUALS = 2,                                          <<04216>>07996000
          SEMICOLON = 1;                                       <<00912>>07998000
   INTEGER SAVESIR,NUMPARMS,PRIORITY,OLDPRIORITY,MINPRI:=1;             08000000
   INTEGER SAVELDT;                                            <<04216>>08002000
   LOGICAL OUTFENCE:=TRUE;                                              08004000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);                        08006000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         08008000
   SUBROUTINE DEF'MOVETODSEG;                                           08010000
<<CXOUTFENCE ENTRY POINT>>                                              08012000
   GO TO MAINCODE;                                                      08014000
                                                                        08016000
<<CXJOBFENCE ENTRY POINT>>                                              08018000
CXJOBFENCE:                                                             08020000
   OUTFENCE:=FALSE;                                                     08022000
   MINPRI:=0;                                                           08024000
                                                                        08026000
MAINCODE:                                                               08028000
                                                                        08030000
   LOGIMAGE( ( IF OUTFENCE                                     <<01527>>08032000
                  THEN M'OUTFENCE                              <<01527>>08034000
                  ELSE M'JOBFENCE ), PARMSP );                 <<01527>>08036000
   MYCOMMAND(PARMSP,DL',4,NUMPARMS,PARM); <<PARSE COMMAND>>    <<00874>>08038000
   IF NOT OUTFENCE AND NUMPARMS <> 1 THEN                      <<00902>>08040000
     <<MUST HAVE 1 PARM>>                                      <<00902>>08042000
   BEGIN                                                                08044000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                             08046000
      TOS:=ERRNUM:=JOBFENCEREQ1P;                              <<00874>>08048000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     08050000
      CIERR(*,*);                                                       08052000
      RETURN;                                                  <<00902>>08054000
   END                                                         <<00902>>08056000
   ELSE                                                        <<00874>>08058000
   IF OUTFENCE THEN                                            <<00902>>08060000
   BEGIN  <<  OUTFENCE >>                                      <<00874>>08062000
      IF NUMPARMS < 1 THEN                                     <<00874>>08064000
      BEGIN                                                    <<00874>>08066000
         PARMNUM := 1;                                         <<00874>>08068000
         RETURN;                                               <<00902>>08070000
      END                                                      <<00874>>08072000
      ELSE                                                     <<00874>>08074000
      IF NUMPARMS > 3 THEN                                     <<00874>>08076000
      BEGIN                                                    <<00874>>08078000
         PARMNUM := 3;                                         <<00874>>08080000
         CIERR(ERRNUM := OUTFENCEXP3PARMS, TRDPARM);           <<00874>>08082000
         RETURN;                                               <<00902>>08084000
      END                                                      <<00874>>08086000
   END;                                                        <<00902>>08088000
      PRIORITY:=BINARY(FIRSTPARM,LEN); <<GET BINARY OF OUTFENCE>>       08090000
      IF <> THEN <<BAD CHARACTERS IN PRIORITY>>                         08092000
      BEGIN                                                             08094000
         PARMNUM:=1;                                                    08096000
         CIERR(ERRNUM:=IF OUTFENCE THEN EXPPRIOR1TO14 ELSE EXP0TO14,    08098000
            FIRSTPARM);                                                 08100000
      END                                                               08102000
      ELSE                                                              08104000
      BEGIN                                                             08106000
         IF PRIORITY>14 THEN                                            08108000
         BEGIN                                                          08110000
            PRIORITY:=14;    <<PRIORITY TO HIGH, USE MAX.>>             08112000
            ERRNUM:=-EXPPRIORGT14;<<WARN USER>>                         08114000
         END                                                            08116000
         ELSE IF PRIORITY<MINPRI THEN                                   08118000
              BEGIN                                                     08120000
                 PRIORITY:=MINPRI;     <<PRIORITY TO LOW, USE MIN.>>    08122000
                ERRNUM:=IF OUTFENCE THEN -EXPPRIORLT1 ELSE -EXPPRIORLT0;08124000
              END;                                                      08126000
         IF ERRNUM<>0 THEN <<ISSUE ANY NECESSARY WARNINGS>>             08128000
         BEGIN                                                          08130000
            PARMNUM:=1; <<CIERR WILL RETURN IF WARNING>>                08132000
            CIERR(ERRNUM,FIRSTPARM);                                    08134000
         END;                                                           08136000
         IF OUTFENCE THEN                                      <<00902>>08138000
         BEGIN                                                 <<00902>>08140000
         <<SEE IF LDEV SPECIFIED>>                             <<00874>>08142000
         IF NUMPARMS > 1 THEN                                  <<00874>>08144000
         BEGIN                                                 <<00874>>08146000
            TOS := PARM;                                       <<00912>>08148000
            DELIM := S0.DELIMITER;                             <<00874>>08150000
            LEN := TOS &LSR(8);                                <<00874>>08152000
            DEL;                                               <<00874>>08154000
            IF DELIM <> SEMICOLON THEN                         <<00874>>08156000
            BEGIN                                              <<00874>>08158000
               PARMNUM := 1;                                   <<00874>>08160000
               CIERR(ERRNUM := EXPSEMICOLON, FIRSTPARM(LEN));  <<00874>>08162000
               RETURN;                                         <<00874>>08164000
            END;                                               <<00874>>08166000
            TOS := PARM(1);  << GET SECOND PARM,LDEV >>        <<04216>>08168000
            DELIM := S0.DELIMITER;  << GET EQUAL SIGN DELIM >> <<04216>>08170000
            LEN := TOS&LSR(8);  <<LENGTH OF PARM>>             <<04216>>08172000
            DEL;   <<DELETE PARM OFF TOP OF STACK>>            <<04216>>08174000
            IF SNDPARM <> "LDEV" OR LEN <> 4 OR                <<04216>>08176000
               DELIM <> EQUALS THEN                            <<04216>>08178000
            BEGIN                                              <<00874>>08180000
               PARMNUM := 2;                                   <<00874>>08182000
               CIERR(ERRNUM := EXPLDEVEQ,SNDPARM);             <<00874>>08184000
               RETURN;                                         <<00874>>08186000
            END                                                <<00874>>08188000
            ELSE                                               <<00874>>08190000
            BEGIN                                              <<00874>>08192000
               LDEV := VERIFY'RLDEV(TRDPARM,TRDLEN,ERRNUM,     <<00874>>08194000
                          PARMNUM,1);                          <<00874>>08196000
               IF < THEN RETURN;                               <<00874>>08198000
               IF VERIFY'MASTEROP(LDEV) THEN RETURN;           <<00874>>08200000
               IF CHECKASS(LDEV) OR CHECKALLOW(M'OUTFENCE)     <<00874>>08202000
               THEN <<USER HAS ACCESS>>                        <<00874>>08204000
               ALLDEVS := FALSE                                <<00874>>08206000
               ELSE                                            <<00874>>08208000
               BEGIN <<USER DOES NOT HAVE ACCESS>>             <<00874>>08210000
                  PARMNUM := 1;                                <<00874>>08212000
                  CIERR(ERRNUM := USERNOACC2DEV, PARMSP);      <<00874>>08214000
                  RETURN;                                      <<00874>>08216000
               END                                             <<00874>>08218000
            END;                                               <<00874>>08220000
<<>>                                                           <<00874>>08222000
            SAVELDT:=GETSIR(LDTSIR); <<LOCK LDT>>              <<04216>>08224000
            SAVESIR:=GETSIR(ODDSIR); <<LOCK ODD>>                       08226000
            MOVEFROMDSEG(@HEAD'SIZE,ODDDST,1,2);               <<00874>>08228000
            IF NOT ALLDEVS THEN <<OUTFENCE TO BE SET FOR>>     <<00874>>08230000
            BEGIN               << A PARTICULAR LDEV>>         <<00874>>08232000
               HEADENTRY := 8 ; <<BEGINNING OF HEAD ODD>>      <<00874>>08234000
               DO                                              <<00874>>08236000
               BEGIN                                           <<00874>>08238000
                  MOVEFROMDSEG(@HEADER,ODDDST,HEADENTRY,       <<00874>>08240000
                        HEAD'SIZE.HEAD'LIMIT);                 <<00874>>08242000
               END                                             <<00874>>08244000
               UNTIL (LDEV = HEADER(HDR'LDEV) OR               <<00874>>08246000
                     (HEADENTRY := HEADENTRY +                 <<00874>>08248000
                           HEAD'SIZE.HEAD'LIMIT) >=            <<00874>>08250000
                                      HEAD'SUBAREAP );         <<00874>>08252000
               IF LDEV = HEADER(HDR'LDEV) THEN                 <<00874>>08254000
               BEGIN                                           <<00874>>08256000
               MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE); <<04216>>08258000
               << If spooler doesn't own (LD'SP=0) and >>      <<04630>>08260000
               << spooling enable bit (LD'SQ) = 0 then >>      <<04630>>08262000
               << DON'T change OUTFENCE.  Else go      >>      <<04630>>08264000
               << and try.                             >>      <<04630>>08266000
               IF((LDT(LD'SP)=NOSPOOLER)LAND(LDT(LD'SQ)=0))    <<04630>>08268000
                  THEN                                         <<04630>>08270000
                  BEGIN                                        <<04216>>08272000
                     PARMNUM := 1;                             <<04216>>08274000
                     RELSIR(ODDSIR,SAVESIR);                   <<04216>>08276000
                     RELSIR(LDTSIR,SAVELDT); <<RELEASE LDT SIR><<04216>>08278000
                     CIERR(ERRNUM:=DEVICENOTSPOOLED,TRDPARM);  <<04216>>08280000
                     RETURN;                                   <<04216>>08282000
                  END;                                         <<04216>>08284000
                  OLDPRIORITY := HEADER(HDR'FENCE);            <<00874>>08286000
                  HEADER(HDR'FENCE) := PRIORITY;               <<00874>>08288000
                  MOVETODSEG(ODDDST,HEADENTRY,@HEADER,         <<00874>>08290000
                      HEAD'SIZE.HEAD'LIMIT);                   <<00874>>08292000
                  IF OLDPRIORITY = 0 THEN                      <<00874>>08294000
                  BEGIN                                        <<00874>>08296000
                     MOVEFROMDSEG( @OLDPRIORITY,ODDDST,        <<00874>>08298000
                           ODD'PRIOR'W,1);                     <<00874>>08300000
                  END;                                         <<00874>>08302000
               END                                             <<00874>>08304000
               ELSE                                            <<00874>>08306000
               BEGIN  <<LDEV NOT FOUND IN ODD>>                <<00874>>08308000
                  PARMNUM := 1;                                <<00874>>08310000
                  RELSIR(ODDSIR,SAVESIR);                      <<00874>>08312000
                  RELSIR(LDTSIR,SAVELDT);                      <<04216>>08314000
                  CIERR(ERRNUM := LDEVNOTINODD,TRDPARM);       <<00874>>08316000
                  RETURN;                                      <<00874>>08318000
               END;                                            <<00874>>08320000
             END;                                              <<00874>>08322000
               RELSIR(ODDSIR,SAVESIR);                         <<04216>>08324000
               RELSIR(LDTSIR,SAVELDT);                         <<04216>>08326000
            END                                                <<00874>>08328000
            ELSE                                               <<00874>>08330000
            BEGIN          <<RESET ALL OUTFENCES>>             <<00874>>08332000
            IF NOT CHECKALLOW(M'OUTFENCE) THEN                 <<04174>>08334000
               BEGIN                                           <<04174>>08336000
               PARMNUM := 0;                                   <<04174>>08338000
               CIERR(ERRNUM := OPCOMMNOTALLOW);                <<04174>>08340000
               RETURN;                                         <<04174>>08342000
               END;                                            <<04174>>08344000
            SAVESIR := GETSIR(ODDSIR);                         <<00874>>08346000
            MOVEFROMDSEG(@OLDPRIORITY,ODDDST,ODD'PRIOR'W,1);            08348000
                                                                        08350000
            <<GET OLD PRIORITY & MASK IN NEW PRIORITY>>                 08352000
                                                                        08354000
            PRIORITY.NOT'ODD'PRIOR:=OLDPRIORITY.NOT'ODD'PRIOR;          08356000
            MOVETODSEG(ODDDST,ODD'PRIOR'W,@PRIORITY,1);                 08358000
            MOVEFROMDSEG(@HEAD'SIZE,ODDDST,1,2);               <<00874>>08360000
            HEADENTRY := 8;                                    <<00874>>08362000
            DO                                                 <<00874>>08364000
            BEGIN                                              <<00874>>08366000
               MOVEFROMDSEG(@HEADER,ODDDST,HEADENTRY,1);       <<00874>>08368000
               HEADER(HDR'FENCE) := 0;  <<RESET FENCE>>        <<00874>>08370000
                <<IF LDEV ENTRY = 0 THEN GLOBAL OUTFENCE USED>><<00874>>08372000
               MOVETODSEG(ODDDST,HEADENTRY,@HEADER,1);         <<00874>>08374000
            END                                                <<00874>>08376000
            UNTIL ((HEADENTRY:= HEADENTRY +                    <<00874>>08378000
                     HEAD'SIZE.HEAD'LIMIT) >=  HEAD'SUBAREAP); <<00874>>08380000
               RELSIR(ODDSIR,SAVESIR); <<UNLOCK ODD>>          <<04216>>08382000
         END;                                                  <<00874>>08384000
                                                                        08388000
            <<IF NEW FENCE < OLD FENCE, POTENTIALLY DEFERRED>>          08390000
            <<OUTPUT FILES COULD BE PRINTED, SO USE 'SROOSTER'>>        08392000
            <<TO AWAKE ANY OUTPUT SPOOLERS>>                            08394000
                                                                        08396000
               SROOSTER(0);                                             08400000
         END;                                                  <<00874>>08402000
      END;                                                     <<00902>>08404000
         IF NOT OUTFENCE THEN                                  <<00874>>08406000
         BEGIN                                                          08408000
            SAVESIR:=GETSIR(JMATSIR); <<LOCK JMAT>>                     08410000
            MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);         08412000
            OLDPRIORITY:=JMATHEADER(JMAT'H'JOBFENCE);                   08414000
            JMATHEADER(JMAT'H'JOBFENCE):=PRIORITY;                      08416000
            MOVETODSEG(JMATDST,0,@JMATHEADER,JMATHEADERSIZE);           08418000
            RELSIR(JMATSIR,SAVESIR);                                    08420000
            IF OLDPRIORITY>PRIORITY THEN <<NEED TO DO SOME SCHEDULING>> 08422000
            BEGIN                                                       08424000
               DISABLE;                                                 08426000
               ABSOLUTE(JOBSYNC).READYFLAG:=TRUE;                       08428000
               ENABLE;                                                  08430000
               AWAKE(SYSPROC(UCOP),%20,0);                              08432000
            END;                                                        08434000
         END;                                                           08436000
END;                                                                    08438000
$PAGE "ABORTIO EXECUTOR"                                                08440000
$CONTROL SEGMENT=OPHI                                                   08442000
PROCEDURE CXABORTIO EXECUTORHEAD;                                       08444000
BEGIN                                                                   08446000
   COMMENT                                                              08448000
      THE SYNTAX OF THIS COMMAND IS:                                    08450000
         ABORTIO LDEV                                                   08452000
         WHERE LDEV IS ANY REAL LOGICAL DEVICE                          08454000
   ;                                                                    08456000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  08458000
   BYTE ARRAY DL'(*)=DL;                                                08460000
   DOUBLE ARRAY PARM(0:1)=Q;                                            08462000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         08464000
   BYTE LEN=PARM+1;                                                     08466000
   LOGICAL LDEV;                                                        08468000
   INTEGER NUMPARMS;                                                    08470000
                                                                        08472000
   LOGIMAGE( M'ABORTIO, PARMSP );  << LOG OP COMMAND >>        <<01527>>08474000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM);                               08476000
   IF NUMPARMS<>1 <<MUST HAVE 1>> THEN                                  08478000
   BEGIN                                                                08480000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                             08482000
      TOS:=ERRNUM:=ABORTIOREQ1P;                                        08484000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     08486000
      CIERR(*,*);                                                       08488000
   END                                                                  08490000
   ELSE                                                                 08492000
   BEGIN                                                                08494000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);               08496000
      IF < THEN RETURN;                                                 08498000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>08500000
      IF CHECKASS(LDEV) OR CHECKALLOW(M'ABORTIO) THEN <<USER HAS ACC.>> 08502000
      BEGIN                                                             08504000
         PARMNUM := 1;   << In case ABORTIO fails. >>          <<02677>>08506000
         ABORTIO(LDEV);                                                 08508000
                                                               <<02677>>08512000
         << ABORTIO returns CCL if device is a disk, and CCG >><<02677>>08514000
         << if there is no I/O pending for the device. >>      <<02677>>08516000
                                                               <<02677>>08518000
         IF < THEN                                             <<02677>>08520000
            CIERR(ERRNUM:=CANTABORTIODISK,FIRSTPARM)           <<02677>>08522000
         ELSE IF > THEN                                        <<02677>>08524000
            CIERR(ERRNUM:=-NOIOQED4DEV,FIRSTPARM,%10000,LDEV); <<02677>>08526000
      END                                                               08528000
      ELSE                                                              08530000
      BEGIN                                                             08532000
         PARMNUM:=1;                                                    08534000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                           08536000
      END;                                                              08538000
   END;                                                                 08540000
END;                                                                    08542000
$PAGE "ACCEPT & REFUSE EXECUTORS"                                       08544000
$CONTROL SEGMENT=OPLOW                                                  08546000
PROCEDURE CXACCEPT EXECUTORHEAD;                                        08548000
BEGIN                                                                   08550000
   COMMENT                                                              08552000
      THE SYNTAX OF THE ACCEPT AND REFUSE COMMANDS IS:                  08554000
         ACCEPT  [JOBS,] LDEV                                           08556000
         REFUSE  [DATA,] LDEV                                           08558000
      THESE COMMANDS ENABLE OR DISABLE THE CAPABILITY OF A              08560000
   DEVICE TO ACCEPT JOBS OR DATA OR BOTH.                               08562000
      AS ALWAYS THIS PROCEDURE ASSUMES DB SET TO USER'S STACK.          08564000
   ;                                                                    08566000
   ENTRY CXREFUSE;                                                      08568000
   LOGICAL ACCEPT:=TRUE,LDEV,JOB:=TRUE,DATA:=TRUE;                      08570000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  08572000
   BYTE ARRAY DL'(*)=DL;                                                08574000
   DOUBLE ARRAY PARM(0:2)=Q;                                            08576000
   BYTE POINTER FIRSTPARM=PARM,SNDPARM=PARM+2,TRDPARM=PARM+4;           08578000
   BYTE FIRSTLEN=PARM+1,SNDLEN=PARM+3;                                  08580000
   LOGICAL FIRSTDESC=PARM+1,SNDDESC=PARM+3;                             08582000
   INTEGER SAVESIR,NUMPARMS;                                            08584000
   ARRAY LDT(0:LDTSIZE-1);                                              08586000
   DEFINE FIRSTDEL=FIRSTDESC.(11:5)#;                                   08588000
   EQUATE COMMA=0,SEMICOLON=1;                                          08590000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         08592000
                                                                        08594000
<<CXACCEPT ENTRY POINT>>                                                08596000
   GO TO MAINCODE;                                                      08598000
                                                                        08600000
<<CXREFUSE ENTRY POINT>>                                                08602000
CXREFUSE:                                                               08604000
   ACCEPT:=FALSE;                                                       08606000
                                                                        08608000
MAINCODE:                                                               08610000
   LOGIMAGE( ( IF ACCEPT                                       <<01527>>08612000
                  THEN M'ACCEPT                                <<01527>>08614000
                  ELSE M'REFUSE ), PARMSP );                   <<01527>>08616000
   MYCOMMAND(PARMSP,DL,3,NUMPARMS,PARM); <<PARSE PARAMETERS>>           08618000
   IF NUMPARMS>2 THEN <<TOO MANY PARAMETERS>>                           08620000
   BEGIN                                                                08622000
      PARMNUM:=3;                                                       08624000
      CIERR(ERRNUM:=IF ACCEPT THEN ACCEPTREQ2PARM ELSE REFUSEREQ2PARM,  08626000
            TRDPARM);                                                   08628000
      RETURN;                                                           08630000
   END                                                                  08632000
   ELSE                                                                 08634000
   IF NUMPARMS<1 THEN <<NOT ENOUGH PARAMETERS>>                         08636000
   BEGIN                                                                08638000
      PARMNUM:=1;                                                       08640000
      CIERR(ERRNUM:=IF ACCEPT THEN ACCEPTREQ1P ELSE REFUSEREQ1P,PARMSP);08642000
      RETURN;                                                           08644000
   END                                                                  08646000
   ELSE                                                                 08648000
   IF > THEN <<TWO PARAMETERS>>                                         08650000
   BEGIN                                                                08652000
      IF FIRSTDEL<>COMMA THEN                                           08654000
      BEGIN <<BAD SYNTAX, MUST BE COMMA AFTER 1ST PARAMETER>>           08656000
         PARMNUM:=1;                                                    08658000
         CIERR(ERRNUM:=COMMAAFTERDJ,FIRSTPARM(FIRSTLEN));               08660000
         RETURN;                                                        08662000
      END                                                               08664000
      ELSE                                                              08666000
      IF FIRSTLEN=4 THEN                                                08668000
         IF FIRSTPARM="JOBS" THEN DATA:=FALSE                           08670000
         ELSE IF FIRSTPARM="DATA" THEN JOB:=FALSE                       08672000
              ELSE ERRNUM:=FIRSTMUSTBEDJ                                08674000
      ELSE ERRNUM:=FIRSTMUSTBEDJ;                                       08676000
      IF ERRNUM<>0 THEN                                                 08678000
      BEGIN                                                             08680000
         PARMNUM:=1;                                                    08682000
         CIERR(ERRNUM,FIRSTPARM);                                       08684000
         RETURN;                                                        08686000
      END;                                                              08688000
      PARM:=PARM(1); <<MOVE 2ND PARAM. DESCR. TO 1ST PARAM. DESC.>>     08690000
   END;                                                                 08692000
   LDEV:=VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,ERRNUM,PARMNUM,NUMPARMS);      08694000
   IF < THEN RETURN;                                                    08696000
   IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MASTEROP MADE INADVERT. ENTR>>08698000
   IF CHECKASS(LDEV) OR                                                 08700000
      CHECKALLOW(IF ACCEPT THEN M'ACCEPT ELSE M'REFUSE) THEN            08702000
   BEGIN                                                                08704000
      MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);                   08706000
      IF NOT (1<=INTEGER(LDT(LDT'DTYPE'M))<=3) THEN<<NOT DATA/JOB ACC.>>08708000
      BEGIN                                                             08710000
         PARMNUM:=NUMPARMS;                                             08712000
         CIERR(ERRNUM:=LDEVNOTDJ,FIRSTPARM);                            08714000
      END                                                               08716000
      ELSE                                                              08718000
      IF JOB AND LDT(LDT'DEFOUT)=0 THEN <<DEVICE HAS NO DEFAULT OUT DE>>08720000
      BEGIN                                                             08722000
         PARMNUM:=NUMPARMS;                                             08724000
         CIERR(ERRNUM:=LDEVHASNODEFOUT,FIRSTPARM);                      08726000
      END                                                               08728000
      ELSE                                                              08730000
      BEGIN                                                             08732000
         SAVESIR:=GETSIR(LPDTSIR);                                      08734000
         IF JOB THEN LPDT(LDEV*LPDTSIZE+LPDT'JOB):=ACCEPT;              08736000
         IF DATA THEN LPDT(LDEV*LPDTSIZE+LPDT'DATA):=ACCEPT;            08738000
         RELSIR(LPDTSIR,SAVESIR);                                       08740000
      END;                                                              08742000
   END                                                                  08744000
   ELSE                                                                 08746000
   BEGIN                                                                08748000
      PARMNUM:=1;                                                       08750000
      CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                              08752000
   END;                                                                 08754000
END;                                                                    08756000
$PAGE "WELCOME EXECUTOR"                                                08758000
$CONTROL SEGMENT=OPLOW                                                  08760000
PROCEDURE CXWELCOME EXECUTORHEAD;                                       08762000
BEGIN                                                                   08764000
   COMMENT                                                              08766000
      THIS COMMAND HAS NO PARAMETERS. IT PROMPTS WITH A '#' AND THEN    08768000
      ACCEPTS THE LINES WHICH ARE TO BE SENT TO A SESSION UPON LOGON.   08770000
      AS ALWAYS THIS EXECUTOR EXPECTS THE DB TO BE AT THE USER'S STACK. 08772000
                                                                        08774000
      THIS PROCEDURE IS DIFFERENT FROM MOST OTHER CODE IN THIS MODULE   08776000
   BECAUSE IT USES EXCHANGEDB INSTEAD OF MOVEFROMDSEG AND MOVETODSEG.   08778000
   THIS IS BECAUSE THE CODE BE VERY GROSS TO WRITE OR READ IF WRITTEN   08780000
   OTHERWISE.                                                           08782000
                                                                        08784000
      THE ACTION OF THIS EXECUTOR IS TO PLACE THE LOGON MESSAGE INTO ONE08786000
   OF TWO PERMANENTLY ALLOCATED EXTRA DATA SEGMENTS.  THE LAYOUT OF THIS08788000
   THESE DATA SEGMENTS IS AS FOLLOWS:                                   08790000
                                                                        08792000
         ______________________________________                         08794000
       0 !C!                  !USER COUNT     ! 0                       08796000
         --------------------------------------                         08798000
       1 ! LENGTH OF DST IN WORDS             ! 2                       08800000
         --------------------------------------                         08802000
       2 !     "#"        !BYTE LENGTH OF LINE! 4                       08804000
         --------------------------------------                         08806000
       3 !          1 ST LINE                 ! 6                       08808000
         .                .                   .                         08810000
         .                .                   .                         08812000
         .                .-------------------.                         08814000
         !                !BYTE LENGTH OF LINE!                         08816000
         --------------------------------------                         08818000
         !         SUBSEQUENT LINE            !                         08820000
         .                .                   .                         08822000
         .                .                   .                         08824000
         .                .-------------------.                         08826000
         !                !        -1         !                         08828000
         --------------------------------------                         08830000
   ;                                                                    08832000
ARRAY WELCOME(*)=DB+0;                                                  08834000
INTEGER WELCOME'LENGTH=WELCOME+1;                                       08836000
BYTE WELCOME'PROMPT=WELCOME+2;                                          08838000
DEFINE WELCOME'CURRENT=WELCOME.(0:1)#, <<CURRENT WELCOME MESSAGE FLAG>> 08840000
       WELCOME'USECNT=WELCOME.(10:6)#; <<USER COUNT>>                   08842000
EQUATE WELCOME'FIRST=3;                <<OFFSET TO FIRST LINE>>         08844000
EQUATE WELCOME'DST1=%57;               <<DST # OF 1ST WELCOME DST>>     08846000
EQUATE WELCOMEDST=SYSGLOB+%277;        <<DST # OF CURRENT WELCOME DST>> 08848000
EQUATE WELCOMESIR=%27;                 <<WELCOME SIR>>                  08850000
EQUATE WELCOME'PROMPT'W=2;             <<WORD CONTAINING PROMPT>>       08852000
$PAGE                                                                   08854000
INTEGER WDST, SAVESIR, TOTAL:=0, IOCOUNT;                      <<01523>>08856000
INTEGER                                                        <<01523>>08858000
   CURR'WDST,       << CURRENT WDST BEFORE EXECUTING COMMAND >><<02319>>08860000
   STDIN,                                                      <<01523>>08862000
   STDLIST  := 2;                                              <<01523>>08864000
LOGICAL                                                        <<02319>>08866000
   CRIT'STATE;      << OLD CRITICAL STATE >>                   <<02319>>08868000
LOGICAL POINTER L'PROMPT;                                      <<01523>>08870000
LOGICAL IS'INTERACT, IS'DUP;                                   <<01523>>08872000
LOGICAL POINTER  INBUF;                                        <<01523>>08874000
   BYTE POINTER NEXTLINE;                                               08876000
   EQUATE READLENGTH = 72;  << MAXIMUM READ LENGTH. >>         <<01523>>08878000
                                                                        08880000
INTRINSIC  FREAD, FWRITE, FOPEN, FCLOSE;                       <<01523>>08882000
                                                               <<01523>>08884000
<< $STDIN MUST BE REOPENED TO HANDLE THE EOF RIGHT. >>         <<01523>>08886000
   STDIN := FOPEN( , %44 );                                    <<01523>>08888000
                                                               <<01523>>08890000
                                                                        08892000
   @L'PROMPT := @WELCOME + WELCOME'PROMPT'W;                   <<01523>>08894000
   LOGIMAGE( M'WELCOME, PARMSP );  << LOG OP COMMAND >>        <<01527>>08896000
   SCAN PARMSP WHILE [8/CR,8/" "]; <<INSURE NOTHING PAST COMMAND>>      08898000
   IF NOCARRY THEN CIERR(ERRNUM:=-WARNXPARMSIGNORED,PARMSP);            08900000
   SETXPXGLOB;                                                          08902000
   IS'INTERACT := PXGLOBINTERACT;                              <<01523>>08904000
   IS'DUP := PXGLOBDUP;                                        <<01523>>08906000
   SAVESIR:=GETSIR(WELCOMESIR); <<LOCK WELCOME DST'S>>                  08908000
<< GET CURRENT WELCOME DST NUMBER. >>                          <<02319>>08910000
   CURR'WDST := WDST := ABSOLUTE(WELCOMEDST);                  <<02319>>08912000
   WDST:=WDST.(15:1)+WELCOME'DST1;<<CALCULATE NEXT WELCOME DST #>>      08916000
   EXCHANGEDB(WDST); <<POINT DB AT NEW WELCOME DST>>                    08918000
   IF WELCOME'USECNT<>0 THEN <<OTHER ONE IN USE>>                       08920000
   BEGIN                                                                08922000
   EXCHANGEDB(0);    <<BACK TO USER'S STACK>>                           08924000
      RELSIR(WELCOMESIR,SAVESIR); <<UNLOCK DST'S>>                      08926000
      FCLOSE( STDIN, 0, 0 );                                   <<01523>>08928000
      CIERR(ERRNUM:=WELMSGBUSY);                                        08930000
   END                                                                  08932000
   ELSE                                                                 08934000
   BEGIN                                                                08936000
   << CANNOT ABORT UNTIL FINISHED PROCESSING COMMAND >>        <<02319>>08938000
   << SO THAT 1) USECOUNT WILL BE DECREMENTED AND    >>        <<02319>>08940000
   << 2) SYSGLOB CELL UPDATED.                       >>        <<02319>>08942000
      CRIT'STATE := SETCRITICAL;                               <<02319>>08944000
      WELCOME'USECNT:=1; <<SET IT IN USE SO ONE CAN TOUCH DST>>         08946000
      RELSIR(WELCOMESIR,SAVESIR); <<UNCLOCK DST'S>>                     08948000
      IF WELCOME'LENGTH>124 THEN <<ONE SECTOR, INCLUDING OVERHEAD>>     08950000
         WELCOME'LENGTH:=ALTDSEGSIZE(WDST,124-WELCOME'LENGTH);          08952000
      @NEXTLINE:=WELCOME'FIRST*2;                                       08954000
      WELCOME'PROMPT:="#";  <<INITIALIZE PROMPT CHARACTER>>             08956000
READLOOP:                                                               08958000
      IOCOUNT:=READLENGTH;  <<DEFAULT READ LENGTH>>                     08960000
      IF (TOS:=WELCOME'LENGTH&ASL(1)-TOTAL-WELCOME'FIRST*2)<READLENGTH  08962000
         THEN <<NOT ENOUGH ROOM IN DST FOR FULL LENGTH READ>>           08964000
         BEGIN                                                          08966000
            TOS:=ALTDSEGSIZE(WDST,128); <<EXTEND BY ONE SECTOR>>        08968000
            IF <> THEN <<COULDN'T EXPAND DST ANYMORE>> DEL              08970000
            ELSE                                                        08972000
            BEGIN                                                       08974000
               WELCOME'LENGTH:=TOS;                                     08976000
               S0:=READLENGTH;                                          08978000
            END;                                                        08980000
            IOCOUNT:=TOS;                                               08982000
         END ELSE DEL;                                                  08984000
      IF IOCOUNT=0 THEN <<DST FULL>> GO TO EXITREADLOOP;                08986000
      IF IS'INTERACT THEN                                      <<01523>>08988000
         FWRITE( STDLIST, L'PROMPT, -1, %320 );                <<01523>>08990000
      @INBUF := @NEXTLINE&LSR(1);                              <<01523>>08992000
      IOCOUNT := FREAD( STDIN, INBUF, -READLENGTH );           <<01523>>08994000
      IF >                                                     <<01523>>08996000
         THEN GO EXITREADLOOP                                  <<01523>>08998000
      ELSE IF < THEN                                           <<01523>>09000000
      BEGIN                                                    <<01523>>09002000
                                                               <<01523>>09004000
      << AN READ ERROR OCCURRED.  QUIT.   >>                   <<01523>>09006000
         WELCOME'USECNT := 0;                                  <<01523>>09008000
         RESETCRITICAL(CRIT'STATE);  << NOW, CAN ABORT >>      <<02319>>09010000
         EXCHANGEDB(0);                                        <<01523>>09012000
         FCLOSE( STDIN, 0, 0 );                                <<01523>>09014000
         CIERR( ERRNUM := WELCREADERR );                       <<01523>>09016000
         RETURN;                                               <<01523>>09018000
                                                               <<01523>>09020000
      END                                                      <<01523>>09022000
      ELSE IF IOCOUNT = 0                                      <<01523>>09024000
         THEN GO EXITREADLOOP;                                 <<01523>>09026000
      IF NOT IS'DUP THEN                                       <<01523>>09028000
         FWRITE( STDLIST, INBUF, -IOCOUNT, 0 );                <<01523>>09030000
      IF NOT LOGICAL(IOCOUNT) THEN                                      09032000
      BEGIN                                                             09034000
         NEXTLINE(IOCOUNT):=" "; <<LINES ARE ALWAYS ODD LENGTH>>        09036000
         IOCOUNT:=IOCOUNT+1;                                            09038000
      END;                                                              09040000
      NEXTLINE(-1):=IOCOUNT;    <<SET LINE LENGTH>>                     09042000
      @NEXTLINE:=@NEXTLINE(IOCOUNT+1);                                  09044000
      TOTAL:=TOTAL+IOCOUNT+1;                                           09046000
      GO TO READLOOP;                                                   09048000
EXITREADLOOP:                                                           09050000
      IF TOTAL=0 THEN WDST:=0 <<KILL THE WELCOME MESSAGE>>              09052000
      ELSE                                                              09054000
      BEGIN                                                             09056000
         WELCOME'CURRENT:=TRUE; <<MAKE THIS THE CURRENT WELCOME MESSAG>>09058000
         NEXTLINE(-1):=-1;                                              09060000
      END;                                                              09062000
   << LOCK DATA SEGMENTS WHILE UPDATING SYSGLOB CELL >>        <<02319>>09064000
   << AND STATUS OF BOTH DATA SEGMENTS.              >>        <<02319>>09066000
      SAVESIR := GETSIR(WELCOMESIR);                           <<02319>>09068000
      WELCOME'USECNT:=0; <<RELEASE DST>>                                09070000
      EXCHANGEDB(0); <<BACK TO USER'S STACK>>                           09072000
      IF WDST <> 0 THEN                                        <<02319>>09074000
         UPDATEDISCCOPY(WDST);  << FORCE GOOD COPY INTO VM. >> <<02319>>09076000
      IF CURR'WDST <> 0 THEN   << IS THERE A CURRENT ONE? >>   <<02319>>09078000
         BEGIN                                                 <<02319>>09080000
         EXCHANGEDB(CURR'WDST);                                <<02319>>09082000
         WELCOME'CURRENT := FALSE;  << MARK IT NON-CURRENT.  >><<02319>>09084000
         UPDATEDISCCOPY(CURR'WDST); << FORCE IT OUT TO DISK. >><<02319>>09086000
         EXCHANGEDB(0);                                        <<02319>>09088000
         END;                                                  <<02319>>09090000
      ABSOLUTE(WELCOMEDST) := WDST;  << UPDATE SYSGLOB CELL. >><<02319>>09092000
      RELSIR(WELCOMESIR,SAVESIR);    << RELEASE DATA SEGS.   >><<02319>>09094000
      RESETCRITICAL(CRIT'STATE);     << NOW, CAN ABORT.      >><<02319>>09096000
      FCLOSE( STDIN, 0, 0 );                                   <<01523>>09098000
   END;                                                                 09102000
END;                                                                    09104000
$PAGE "BREAKJOB & RESUMEJOB EXECUTORS"                                  09106000
$CONTROL SEGMENT=OPLOW                                                  09108000
PROCEDURE CXBREAKJOB EXECUTORHEAD;                                      09110000
BEGIN                                                                   09112000
   COMMENT                                                              09114000
      THE SYNTAX OF THESE COMMANDS IS:                                  09116000
         BREAKJOB  #JNNN                                                09118000
         RESUMEJOB #JNNN                                                09120000
      AS ALWAYS, CODE ASSUMES EXECUTION ON USER'S STACK.                09122000
   ;                                                                    09124000
   ENTRY CXRESUMEJOB;                                                   09126000
   DOUBLE ARRAY PARM(0:1)=Q;                                            09128000
   BYTE POINTER FIRSTPARM=PARM,SNDPARM=PARM+2;                          09130000
   BYTE LEN=PARM+1;                                                     09132000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  09134000
   BYTE ARRAY DL'(*)=DL;                                                09136000
   LOGICAL BREAK:=TRUE,ENTRYP;                                          09138000
   INTEGER SAVESIR,NUMPARMS,JOBNUM,N,LDEV,LASTLDEV;                     09140000
   EQUATE MAXN=10;         <<MAXIMUM # OF OWNDED DEVICE TO BE REPORTED>>09142000
   INTEGER ARRAY OWNED(0:MAXN-1);                                       09144000
   ARRAY LDT(0:LDTSIZE-1);                                              09146000
   ARRAY JMATENTRY(0:JMATENTRYSIZE-1);                                  09148000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         09150000
   SUBROUTINE DEF'MOVETODSEG;                                           09152000
                                                                        09154000
<<CXBREAKJOB ENTRY POINT>>                                              09156000
   GO TO MAINCODE;                                                      09158000
                                                                        09160000
<<CXRESUMEJOB ENTRY POINT>>                                             09162000
CXRESUMEJOB:                                                            09164000
   BREAK:=FALSE;                                                        09166000
                                                                        09168000
MAINCODE:                                                               09170000
   LOGIMAGE( ( IF BREAK                                        <<01527>>09172000
                THEN M'BREAKJOB                                <<01527>>09174000
                ELSE M'RESUMEJOB ), PARMSP );                  <<01527>>09176000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM);<<PARSE PARAMETERS>>           09178000
   IF NUMPARMS<>1 THEN <<MUST BE EXACTLY ONE PARAMETER>>                09180000
   BEGIN                                                                09182000
      PARMNUM:=IF < THEN 1 ELSE 2;                                      09184000
      TOS:=ERRNUM:=IF BREAK THEN BREAKJOBREQ1P ELSE RESUMEJOBREQ1P;     09186000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     09188000
      CIERR(*,*);                                                       09190000
   END                                                                  09192000
   ELSE                                                                 09194000
   IF LEN<3 OR FIRSTPARM<>"#J" THEN <<EXPECTED #JNNN>>                  09196000
   BEGIN                                                                09198000
      PARMNUM:=1;                                                       09200000
      CIERR(ERRNUM:=PARMNOTJOBID,FIRSTPARM);                            09202000
   END                                                                  09204000
   ELSE                                                                 09206000
   BEGIN                                                                09208000
      JOBNUM:=BINARY(FIRSTPARM(2),LEN-2); <<CONVERT ASCII TO BINARY #J>>09210000
      IF <> THEN <<BAD JOB NUM #>>                                      09212000
      BEGIN                                                             09214000
         PARMNUM:=1;                                                    09216000
         CIERR(ERRNUM:=BADJOBNUM,FIRSTPARM(2));                         09218000
      END                                                               09220000
      ELSE                                                              09222000
      BEGIN                                                             09224000
         IF NOT FINDJOB(JMATENTRY,ENTRYP,JOBNUM,TRUE,,,,SAVESIR) THEN   09226000
         BEGIN                                                          09228000
            PARMNUM:=1;                                                 09230000
            RELSIR(JMATSIR,SAVESIR);                                    09232000
            CIERR(ERRNUM:=NOSUCHJOB,FIRSTPARM(2));                      09234000
         END                                                            09236000
         ELSE                                                           09238000
        IF (CHECKJOB(JMATENTRY) = 0) OR                        <<04684>>09240000
            CHECKALLOW(IF BREAK THEN M'BREAKJOB ELSE M'RESUMEJOB) THEN  09242000
         BEGIN                                                          09244000
            IF BREAK THEN <<BREAKJOB>>                                  09246000
               IF JMATENTRY(JMAT'JSTATE)<>JOBEXEC THEN <<NOT EXECUTING>>09248000
                  ERRNUM:=JOBNOTACTIVE                                  09250000
               ELSE SUSPENDJOB(JMATENTRY(JMAT'PINNUM),ERRNUM)           09252000
            ELSE <<RESUMEJOB>>                                          09254000
               IF JMATENTRY(JMAT'JSTATE)<>JOBSUSP THEN <<NOT SUSPENDED>>09256000
                  ERRNUM:=JOBNOTSUSPENDED                               09258000
               ELSE RESUMEJOB(JMATENTRY(JMAT'PINNUM),ERRNUM);           09260000
            IF ERRNUM=0 THEN <<SUCCESSFULLY CHANGED JOB STATE>>         09262000
            BEGIN                                                       09264000
             JMATENTRY(JMAT'JSTATE):=IF BREAK THEN JOBSUSP ELSE JOBEXEC;09266000
               MOVETODSEG(JMATDST,ENTRYP,@JMATENTRY,JMATENTRYSIZE);     09268000
            END;                                                        09270000
            RELSIR(JMATSIR,SAVESIR); <<UNLOCK JMAT NOW>>                09272000
            IF ERRNUM<>0 THEN                                           09274000
            BEGIN                                                       09276000
               PARMNUM:=1;                                              09278000
               CIERR(ERRNUM,FIRSTPARM);                                 09280000
            END                                                         09282000
            ELSE                                                        09284000
            IF BREAK THEN <<LIST DEVICES OWNED BY SUSPENDED JOB>>       09286000
            BEGIN                                                       09288000
               N:=-1;                                                   09290000
               SAVESIR:=GETSIR(LDTSIR);  <<LOCK LDT>>                   09292000
               LDEV:=0;                                                 09294000
               LASTLDEV:=LPDT(LPDT'MAXDEV);                             09296000
               WHILE ((LDEV:=LDEV+1)<=LASTLDEV) AND (N<MAXN) DO         09298000
               BEGIN                                                    09300000
                  MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);       09302000
                  IF LDT(LDT'DTYPE)>8 <<OWNABLE DEVICE>>                09304000
                     AND LDT(LDT'PINNUM)=JMATENTRY(JMAT'PINNUM)         09306000
                     AND LDT(LDT'USECNT)<>0 THEN OWNED(N:=N+1):=LDEV;   09308000
               END;                                                     09310000
               RELSIR(LDTSIR,SAVESIR); <<UNLOCK LDT>>                   09312000
               WHILE N>=0 DO                                            09314000
               BEGIN  <<INFORM USER OF DEVICE SUSPEND JOB OWNS>>        09316000
                  IF LPDT(OWNED(N)*LPDTSIZE+LPDT'VIRTUAL)=0 THEN        09318000
               GENMSG(CIGENERALMSGSET,SUSPENDJOBOWN,[1/0,3/1,3/1,9/0],  09320000
                         JOBNUM,OWNED(N));                              09322000
                  N:=N-1;                                               09324000
               END;                                                     09326000
            END;                                                        09328000
         END                                                            09330000
         ELSE <<IT ISN'T USER'S JOB OR HE HAS BEEN 'ALLOW'ED>>          09332000
         BEGIN                                                          09334000
            RELSIR(JMATSIR,SAVESIR);                                    09336000
            PARMNUM:=1;                                                 09338000
            CIERR(ERRNUM:=NOTUSERSJOB,PARMSP);                          09340000
         END;                                                           09342000
      END;                                                              09344000
   END;                                                                 09346000
END;                                                                    09348000
$PAGE "ALLOW & DISALLOW EXECUTORS"                                      09350000
$CONTROL SEGMENT=OPLOW                                                  09352000
PROCEDURE CXALLOW EXECUTORHEAD;                                         09354000
BEGIN                                                                   09356000
   ENTRY CXDISALLOW;                                                    09358000
   BYTE ARRAY COMMANDLIST(0:1)=PB:=                                     09360000
      10,7,"ABORTIO",M'ABORTIO,                                         09362000
      11,8,"ABORTJOB",M'ABORTJOB,                                       09364000
      9,6,"ACCEPT",M'ACCEPT,                                            09366000
      8,5,"ALLOW",M'ALLOW,                                              09368000
      15,12,"ALTSPOOLFILE",M'ALTSPOOLFILE,                              09370000
      9,6,"ALTJOB",M'ALTJOB,                                            09372000
      11,8,"BREAKJOB",M'BREAKJOB,                                       09374000
      18,15,"DELETESPOOLFILE",M'DELETESPOOLFILE,                        09376000
      11,8,"DISALLOW",M'DISALLOW,                                       09378000
      7,4,"DOWN",M'DOWN,                                                09380000
      7,4,"GIVE",M'GIVE,                                                09382000
      10,7,"HEADOFF",M'HEADOFF,                                         09384000
      9,6,"HEADON",M'HEADON,                                            09386000
      11,8,"JOBFENCE",M'JOBFENCE,                                       09388000
      8,5,"LIMIT",M'LIMIT,                                              09390000
      12,9,"STOPSPOOL",M'STOPSPOOL,                                     09392000
      15,12,"SUSPENDSPOOL",M'SUSPENDSPOOL,                              09394000
      11,8,"OUTFENCE",M'OUTFENCE,                                       09396000
      9,6,"REFUSE",M'REFUSE,                                            09398000
      8,5,"REPLY",M'REPLY,                                              09400000
      12,9,"RESUMEJOB",M'RESUMEJOB,                                     09402000
      14,11,"RESUMESPOOL",M'RESUMESPOOL,                                09404000
      13,10,"STARTSPOOL",M'STARTSPOOL,                                  09406000
      10,7,"STREAMS",M'STREAMS,                                         09408000
      10,7,"CONSOLE",M'CONSOLE,                                         09410000
      7,4,"TAKE",M'TAKE,                                                09412000
      5,2,"UP",M'UP,                                                    09414000
      7,4,"WARN",M'WARN,                                                09416000
      10,7,"WELCOME",M'WELCOME,                                         09418000
      12,9,"DSCONTROL",M'DSCONTROL,                                     09420000
      9,6,"MPLINE",M'MPLINE,                                            09422000
      14,11,"MRJECONTROL",M'MRJECONTROL,                                09424000
      6,3,"MON",M'MON,                                                  09426000
      7,4,"MOFF",M'MOFF,                                                09428000
      9,6,"VMOUNT",M'VMOUNT,                                            09430000
      9,6,"LMOUNT",M'LMOUNT,                                            09432000
      12,9,"LDISMOUNT",M'LDISMOUNT,                                     09434000
      12,9,"MIOENABLE",M'MIOENABLE,                            <<00575>>09436000
      13,10,"MIODISABLE",M'MIODISABLE,                         <<00575>>09438000
      11,8,"DOWNLOAD",M'DOWNLOAD,                                       09440000
      6,3,"LOG",M'LOG,                                         <<00601>>09442000
      14,11,"JOBSECURITY",M'JOBSCRTY,                                   09444000
       10,7,"FOREIGN",M'FOREIGN,                               <<01115>>09446000
      13,10,"IMLCONTROL",M'IMLCONTROL,                         <<00792>>09448000
      10,7,"SHOWCOM",M'SHOWCOM,                                         09450000
      0;                                                                09452000
                                                                        09454000
EQUATE COMMAND'LIST'L=465; <<LENGTH OF COMMAND LIST>>          <<01239>>09456000
                                                                        09458000
BYTE ARRAY COMMAND'DICT(0:COMMAND'LIST'L-1); <<COMMAND DICTIONARY>>     09460000
LOGICAL ALLOW:=TRUE;                                                    09462000
                                                                        09464000
EQUATE MAXPARMS=20, IOBUFFERL=72;                                       09466000
EQUATE COMMA=0, EQUAL=1, SEMICOLON=2, EOL=3;                            09468000
DEFINE ASCII=(13:1)#, CCTL=(7:1)#, DEFAULT=(10:3)#;                     09470000
LOGICAL EOF:=FALSE, FILE:=FALSE, PROMPT:=FALSE, FOUND;                  09472000
   LOGICAL DUPLICATIVE;                                        <<0726>> 09474000
DOUBLE ARRAY PARM(0:MAXPARMS)=Q;                                        09476000
BYTE POINTER CURRENT'PARM;                                              09478000
INTEGER CURRENT'LENGTH;                                                 09480000
INTEGER CURRENT'DELIMITER;                                              09482000
INTEGER NUMPARMS:=0,FILENUM,LENGTH:=0,STATE,PARMSTATE;                  09484000
ARRAY L'IOBUFFER(0:IOBUFFERL/2);<<EXTRA WORD FOR TERMINATION CHAR>>     09486000
ARRAY CARET(0:IOBUFFERL/2);<<ROOM FOR "^" & 0 CHARACETERS>>             09488000
BYTE ARRAY CARET'(*)=CARET;                                             09490000
BYTE ARRAY IOBUFFER(*)=L'IOBUFFER;                                      09492000
INTEGER PROMPTCHR:="> ";                                                09494000
BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4;            09496000
BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3, TRDLEN=PARM+5;                     09498000
INTEGER PARM1=PARM+1, PARM2=PARM+3;                                     09500000
LOGICAL SHOW:=FALSE;                                                    09502000
LOGICAL APTR', GPTR', ERRPTR',FOPTIONS;                                 09504000
BYTE POINTER APTR=APTR', GPTR=GPTR', ERRPTR=ERRPTR';                    09506000
INTEGER ARRAY USERNAME(0:3),ACCTNAME(0:3);                              09508000
BYTE ARRAY USERNAME'(*)=USERNAME, ACCTNAME'(*)=ACCTNAME;                09510000
ARRAY MASK(0:JIT'ALLOW'L);                                              09512000
BYTE POINTER COMMAND'DESCR;                                             09514000
BYTE POINTER ACCTNAMEPTR;                                               09516000
INTEGER ACCTNAMELENGTH,FILETYP;                                         09518000
INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);                           09520000
INTEGER ARRAY JMATENTRY(0:JMATENTRYSIZE-1);                             09522000
INTEGER ARRAY PCBXGLOB(0:PCBX'GLOBALSIZE-1);                            09524000
INTEGER I,ENTRYP,LASTP,SAVESIR,JITDST,OFFSET;                           09526000
LOGICAL ARRAY JITALLOW(0:JIT'ALLOW'L-1);                                09528000
DOUBLE TEMPD;                                                           09530000
INTEGER TEMPD2=TEMPD+1;                                                 09532000
$PAGE                                                                   09534000
SUBROUTINE ERR(ERRNO);                                                  09536000
VALUE ERRNO; INTEGER ERRNO;                                             09538000
BEGIN                                                                   09540000
   IF FILE THEN <<NEED TO LIST LINE CONTAINING ERR>>                    09542000
   BEGIN                                                                09544000
      FCLOSE(FILENUM,0,0);                                              09546000
      IOBUFFER(LENGTH):=0;                                              09548000
      IF NOT PROMPT AND NOT SHOW THEN GENMSG(-1,@IOBUFFER);             09550000
   END;                                                                 09552000
   ERRNUM:=ERRNO;                                                       09554000
   IF FILE THEN <<DO CARET MYSELF, SINCE NOT IN CI'S COMMAND BUFFER>>   09556000
   BEGIN                                                                09558000
      OFFSET:=@CURRENT'PARM-@IOBUFFER;                                  09560000
      CARET:="  ";                                                      09562000
      MOVE CARET(1):=CARET,(IOBUFFERL/2);                               09564000
      MOVE CARET'(OFFSET):=("^",0);                                     09566000
      GENMSG(-1,@CARET');                                               09568000
      CIERR(ERRNUM);                                                    09570000
   END                                                                  09572000
   ELSE CIERR(ERRNUM,CURRENT'PARM);                                     09574000
END;                                                                    09576000
                                                                        09578000
                                                                        09580000
INTEGER SUBROUTINE GETNEXTPARM;                                         09582000
BEGIN                                                                   09584000
   COMMENT                                                              09586000
      THIS SUBROUTINE GETS THE NEXT PARAMETER AND PUTS A PTR TO IT      09588000
   IN CURRENT'PARM, PUT ITS LENGTH IN CURRENT'LENGTH, AND PUTS ITS      09590000
   DELIMITER IN CURRENT'DELIMITER.  IF THE NEXT PARAMETER IS ON THE     09592000
   NEXT LINE, IT DOES I/O TO GET THE NEXT LINE.  IT RETURNS -1, IF      09594000
   AT END OF COMMAND, ZERO IF NEXT PARAMETER ON NEW LINE, AND 1         09596000
   OTHERWISE.                                                           09598000
      ***NOTE*** TO INITIALIZE INPUT TO THIS ROUTINE, PARMNUM MUST BE   09600000
                 SET TO THE PARAMETER NUMBER-1 TO BE GOTTEN NEXT.       09602000
               FOR EXAMPLE, IF THE NEXT PARAMETER IS THE FIRST ON       09604000
                 THE LINE, THEN PARMNUM:=-1.                            09606000
      ***NOTE*** TO FORCE GETNEXTPARM TO READ THE NEXT LINE BEFORE      09608000
                 GETTING NEXT PARAMETER, SET PARMNUM:=MAXPARMS+1.       09610000
   ;                                                                    09612000
   GETNEXTPARM:=-1;                                                     09614000
   IF PARMNUM=NUMPARMS THEN GO TO GETNEXTLINE;                          09616000
   PARMNUM:=PARMNUM+1;                                                  09618000
   IF PARMNUM<NUMPARMS THEN                                             09620000
   BEGIN                                                                09622000
      TOS:=PARM(PARMNUM);                                               09624000
      CURRENT'DELIMITER:=S0.DELIMITER;                                  09626000
      CURRENT'LENGTH:=TOS&LSR(8);                                       09628000
      @CURRENT'PARM:=TOS;                                               09630000
      GETNEXTPARM:=1;                                                   09632000
   END                                                                  09634000
   ELSE                                                                 09636000
   IF PARMNUM=MAXPARMS THEN <<TOO MANY PARMS>>                          09638000
      ERR(TOOMANYPARM)                                                  09640000
   ELSE                                                                 09642000
   IF PARMNUM=NUMPARMS THEN GETNEXTPARM:=0                              09644000
   ELSE                                                                 09646000
GETNEXTLINE:                                                            09648000
   IF FILE AND NOT EOF THEN <<GET NEXT FILE RECORD>>                    09650000
   BEGIN                                                                09652000
      IF PROMPT THEN PRINT(PROMPTCHR,-1,%320);<<DO PROMPTING>>          09654000
      LENGTH:=FREAD(FILENUM,L'IOBUFFER,-IOBUFFERL);                     09656000
      IF < THEN <<I/O ERROR>>                                           09658000
      BEGIN                                                             09660000
         FCHECK(FILENUM,LENGTH);                                        09662000
         GENMSG(FILESYSMSGSET,LENGTH);                                  09664000
         FCLOSE(FILENUM,0,0);                                           09666000
         CIERR(ERRNUM:=ALLDISALLIOERR);                                 09668000
      END                                                               09670000
      ELSE                                                              09672000
      IF REQUESTSERVICE THEN <<BREAK HAS OCCURRED>>                     09674000
      BEGIN                                                             09676000
         SETXPXGLOB; <<SET X TO PXGLOB DB RELATIVE>>                    09678000
         ATTACHIO(PXGLOBOUTDEV,0,0,0,25,0,%320,0,1);<<FLUSH BREAK>>     09680000
         EOF:=TRUE;                                                     09682000
         FCLOSE(FILENUM,0,0);                                           09684000
         IF NOT SHOW AND NOT PROMPT THEN <<LIST LAST COMPLETED LINE>>   09686000
         BEGIN                                                          09688000
            IOBUFFER(LENGTH):=0;  <<GENMSG LOVES ZERO BYTES>>           09690000
            GENMSG(CIGENERALMSGSET,LASTALLOW);                          09692000
            GENMSG(-1,@IOBUFFER);                                       09694000
         END;                                                           09696000
      END                                                               09698000
      ELSE                                                              09700000
         IF > THEN  <<GET I/O END OF FILE>>                    <<0726>> 09702000
      BEGIN                                                             09704000
         EOF:=TRUE;                                                     09706000
         FCLOSE(FILENUM,0,0);                                           09708000
      END                                                               09710000
      ELSE                                                              09712000
      BEGIN                                                             09714000
         IF (NOT DUPLICATIVE LAND PROMPT) OR                   <<04173>>09716000
            (SHOW LAND NOT PROMPT) THEN                        <<04173>>09718000
               PRINT(L'IOBUFFER,-LENGTH,0);                    <<0726>> 09720000
         @PARMSP:=@IOBUFFER;                                            09722000
         IOBUFFER(LENGTH):=CR;                                          09724000
         PARMNUM:=-1;                                                   09726000
         MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARM);                   09728000
            IF NUMPARMS=1 AND FIRSTLEN=4 AND FIRSTPARM="EXIT" THEN      09730000
            BEGIN                                              <<0726>> 09732000
               EOF:=TRUE;                                      <<0726>> 09734000
               FCLOSE(FILENUM,0,0);                            <<0726>> 09736000
            END                                                <<0726>> 09738000
            ELSE                                               <<0726>> 09740000
            BEGIN                                              <<0726>> 09742000
         IF NUMPARMS<3 THEN                                             09744000
         BEGIN                                                          09746000
            @CURRENT'PARM:=@PARMSP + (IF PROMPT THEN 1 ELSE 0);         09748000
            ERR(EXP1OFUSERFILE);                                        09750000
            RETURN;                                                     09752000
         END;                                                           09754000
         GETNEXTPARM:=GETNEXTPARM;                                      09756000
            END;                                               <<0726>> 09758000
      END;                                                              09760000
   END;                                                                 09762000
END;                                                                    09764000
                                                                        09766000
LOGICAL SUBROUTINE NAME(A,B);                                           09768000
VALUE A,B; INTEGER POINTER A,B;                                         09770000
BEGIN                                                                   09772000
   COMMENT                                                              09774000
      THIS SUBROUTINE RETURNS TRUE IF THE FOUR WORD ENTRIES             09776000
   POINTED TO BY 'A' AND 'B' ARE EQUAL, OTHERWISE FALSE                 09778000
   ;                                                                    09780000
   I:=-1;                                                               09782000
   NAME:=TRUE;                                                          09784000
   WHILE (I:=I+1)<4 DO IF A(I)<>B(I) THEN NAME:=FALSE;                  09786000
END;                                                                    09788000
                                                                        09790000
SUBROUTINE DEF'MOVEFROMDSEG;                                            09792000
SUBROUTINE DEF'MOVETODSEG;                                              09794000
$PAGE                                                                   09796000
<<CXALLOW ENTRY POINT>>                                                 09798000
   GO TO MAINCODE;                                                      09800000
                                                                        09802000
<<CXDISALLOW ENTRY POINT>>                                              09804000
CXDISALLOW:                                                             09806000
   ALLOW:=FALSE;                                                        09808000
                                                                        09810000
MAINCODE:                                                               09812000
   LOGIMAGE( ( IF ALLOW                                        <<01527>>09814000
                  THEN M'ALLOW                                 <<01527>>09816000
                  ELSE M'DISALLOW ), PARMSP );                 <<01527>>09818000
   MOVE COMMAND'DICT:=COMMANDLIST,(COMMAND'LIST'L);                     09820000
                                                                        09822000
   MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARM);<<PARSE INITIAL PARMS>>  09824000
   IF NUMPARMS=0 THEN <<ACT LIKE SUBSYSTEM>>                            09826000
   BEGIN                                                                09828000
      FILE:=PROMPT:=TRUE;                                               09830000
      FILENUM:=FOPEN(,%2044,%1300); <<OPEN $STDIN>>                     09832000
      IF <> THEN <<UNABLE TO OPEN $STDIN ????>>                         09834000
      BEGIN                                                             09836000
         CIERR(ERRNUM:=ALLDISALLIOERR);                                 09838000
         RETURN;                                                        09840000
      END;                                                              09842000
      PARMNUM:=MAXPARMS+1; <<THIS FORCES NEW READ IN 'GETNEXTPARM'>>    09844000
   END                                                                  09846000
   ELSE                                                                 09848000
   IF FIRSTPARM="FILE" AND FIRSTLEN=4 AND                               09850000
      PARM1.DELIMITER=EQUAL THEN <<GOT A FILE= PARAMETER>>              09852000
   BEGIN                                                                09854000
      IF NOT (2<=NUMPARMS<=3) THEN <<FILE= VERSION IS 2 OR 3 PARAMETER>>09856000
      BEGIN                                                             09858000
         PARMNUM:=2;                                                    09860000
         CIERR(ERRNUM:=EXPFILESHOW,SNDPARM(SNDLEN));                    09862000
         RETURN;                                                        09864000
      END;                                                              09866000
      FILE:=TRUE;                                                       09868000
      TEMPD:=PARM(1);  <<GET 2ND PARAMETER DESCRIPTION>>                09870000
      TEMPD2:=SNDLEN;  <<STRIP OFF PARAMETER DESC, EXCEPT 4 LENGTH>>    09872000
      FILETYP:=CHECKFILENAME'(TEMPD,GPTR',APTR',ERRPTR');<<CHECK FILEN>>09874000
      IF < THEN <<INVALID FILE NAME>>                                   09876000
      BEGIN                                                             09878000
         PARMNUM:=2;                                                    09880000
         CIERR(ERRNUM:=FILETYP,ERRPTR);                                 09882000
         RETURN;                                                        09884000
      END                                                               09886000
      ELSE                                                              09888000
      IF > AND FILETYP<>0 THEN <<SYSTEM FILE NAME>>                     09890000
      BEGIN                                                             09892000
         PARMNUM:=2;                                                    09894000
         CIERR(ERRNUM:=CANTBESYSFILE,SNDPARM);                          09896000
         RETURN;                                                        09898000
      END;                                                              09900000
      FILENUM:=FOPEN(SNDPARM,3,%300);<<OPEN ASCII,READ,SHARE,NOCCTL>>   09902000
      IF <> THEN <<COULDN'T GET USER'S FILE OPEN>>                      09904000
      BEGIN                                                             09906000
         PARMNUM:=2;                                                    09908000
         FCHECK(0,LENGTH); <<GET OPEN ERROR REASON>>                    09910000
         GENMSG(FILESYSMSGSET,LENGTH);                                  09912000
         CIERR(ERRNUM:=ALLDISALLIOERR,SNDPARM);                         09914000
         RETURN;                                                        09916000
      END;                                                              09918000
      FGETINFO(FILENUM,,FOPTIONS);<<FIND OUT ABOUT FILE>>               09920000
      IF NOT FOPTIONS.ASCII OR FOPTIONS.CCTL OR                         09922000
         (FOPTIONS.DEFAULT<>0 LAND FOPTIONS.DEFAULT<>4) THEN            09924000
      BEGIN <<FILE NOT ASCII, OR IS CCTL, OR IS NOT $STDIN OR FILE>>    09926000
         FCLOSE(FILENUM,0,0);                                           09928000
         PARMNUM:=2;                                                    09930000
         CIERR(ERRNUM:=MUSTBEASNOCTL,SNDPARM);                          09932000
         RETURN;                                                        09934000
      END;                                                              09936000
      IF FOPTIONS.DEFAULT=4 THEN PROMPT:=TRUE;                          09938000
      IF NUMPARMS=3 THEN <<LOOKING FOR ;SHOW THEN>>                     09940000
         IF PARM2.DELIMITER<>SEMICOLON OR TRDPARM<>"SHOW" OR            09942000
            TRDLEN<>4 THEN <<DIDN'T FIND ;SHOW>>                        09944000
         BEGIN                                                          09946000
            PARMNUM:=3;                                                 09948000
            CIERR(ERRNUM:=EXPSHOW,TRDPARM);                             09950000
            RETURN;                                                     09952000
         END                                                            09954000
         ELSE SHOW:=TRUE;                                               09956000
      PARMNUM:=MAXPARMS+1; <<MAKE GETNEXTPARM DO A READ>>               09958000
   END                                                                  09960000
   ELSE                                                                 09962000
   IF NUMPARMS<3 THEN <<IMPROPERLY FORMATTED COMMAND>>                  09964000
   BEGIN                                                                09966000
      PARMNUM:=NUMPARMS;                                                09968000
      TOS:=ERRNUM:=EXP1OFUSERFILE;                                      09970000
      TOS:=PARM(NUMPARMS-1);                                            09972000
      DEL;                                                              09974000
      CIERR(*,*);                                                       09976000
      RETURN;                                                           09978000
   END ELSE PARMNUM:=-1;                                                09980000
$PAGE                                                                   09982000
<<    WE ARE NOW READY TO START SCAN OF ALLOW/DISALLOW COMMAND        >>09984000
<<    LOOKING FOR THE FOLLOWING FORMAT:                               >>09986000
<<    ALLOW USER.ACCT;COMMANDS=COMM1,...,COMMN                        >>09988000
<<    THE COMMAND'S SYNTAX HAS BEEN CHECKED ON, AND ANY FOPENS        >>09990000
<<    TO DO INDIRECT READS EITHER AS SUBSYSTEM OR FILE HAVE BEEN DONE.>>09992000
                                                                        09994000
   WHO(DUPLICATIVE);                                           <<0726>> 09996000
   DUPLICATIVE:=DUPLICATIVE.(14:1);                            <<0726>> 09998000
   STATE:=0;                                                            10000000
                                                                        10002000
SCANLOOP:                                                               10004000
   PARMSTATE:=GETNEXTPARM; <<GET NEXT PARAMETER>>                       10006000
                                                                        10008000
<< STATE 0 -- PROCESSES USER.ACCT>>                                     10010000
                                                                        10012000
   IF STATE=0 THEN <<LOOKING FOR 'USERNAME.ACCTNAME'>>                  10014000
   BEGIN                                                                10016000
      IF PARMSTATE<0 THEN RETURN;                                       10018000
      IF CURRENT'DELIMITER<>SEMICOLON THEN                              10020000
      BEGIN                                                             10022000
         ERR(EXPSEMICOLON);                                             10024000
         RETURN;                                                        10026000
      END;                                                              10028000
      SCAN CURRENT'PARM UNTIL [8/".",8/";"],1;                          10030000
      @ACCTNAMEPTR:=TOS;                                                10032000
      ACCTNAMELENGTH:=CURRENT'LENGTH-@ACCTNAMEPTR+@CURRENT'PARM-1;      10034000
      IF ACCTNAMEPTR<>"." THEN                                          10036000
      BEGIN                                                             10038000
         ERR(PERIODEXP);                                                10040000
         RETURN;                                                        10042000
      END                                                               10044000
      ELSE                                                              10046000
      IF (CURRENT'LENGTH-1-ACCTNAMELENGTH)>8 OR ACCTNAMELENGTH>8 THEN   10048000
      BEGIN                                                             10050000
         ERR(UORANAMEMAX8);                                             10052000
         RETURN;                                                        10054000
      END;                                                              10056000
      IF CURRENT'LENGTH-ACCTNAMELENGTH-1<=0 THEN                        10058000
      BEGIN                                                             10060000
         ERR(EXPUSERNAME);                                              10062000
         RETURN;                                                        10064000
      END;                                                              10066000
      IF ACCTNAMELENGTH<=0 THEN                                         10068000
      BEGIN                                                             10070000
         ERR(EXPACCTNAME);                                              10072000
         RETURN;                                                        10074000
      END;                                                              10076000
      USERNAME:="  ";                                                   10078000
      MOVE USERNAME(1):=USERNAME,(3);                                   10080000
      MOVE ACCTNAME:=USERNAME,(4);                                      10082000
      MOVE USERNAME':=CURRENT'PARM,(CURRENT'LENGTH-ACCTNAMELENGTH-1);   10084000
      MOVE ACCTNAME':=ACCTNAMEPTR(1),(ACCTNAMELENGTH);                  10086000
      STATE:=1;                                                         10088000
   END                                                                  10090000
$PAGE                                                                   10092000
                                                                        10094000
<< STATE 1 -- PROCESSES ;COMMAND=>>                                     10096000
                                                                        10098000
   ELSE                                                                 10100000
   IF STATE=1 THEN <<LOOKING FOR 'COMMANDS='>>                          10102000
      IF PARMSTATE<1 OR CURRENT'PARM<>"COMMANDS" OR                     10104000
         CURRENT'LENGTH<>8 OR CURRENT'DELIMITER<>EQUAL THEN             10106000
      BEGIN                                                             10108000
         ERR(EXPCOMMANDS);                                              10110000
         RETURN;                                                        10112000
      END                                                               10114000
      ELSE                                                              10116000
      BEGIN                                                             10118000
         MASK:=MASK(1):=MASK(2):=0;                                     10120000
         STATE:=2;                                                      10122000
      END                                                               10124000
$PAGE                                                                   10126000
                                                                        10128000
<< STATE 2 -- PROCESSES THE COMMAND LIST & END OF COMMAND>>             10130000
                                                                        10132000
   ELSE  <<LOOKING FOR OPERATOR COMMAND NAMES>>                         10134000
   BEGIN                                                                10136000
      IF PARMSTATE<=0 THEN                                              10138000
      BEGIN  <<AT END OF CURRENT LINE>>                                 10140000
         FOUND:=FALSE;                                                  10142000
         IF USERNAME'="@       " AND ACCTNAME'="@       " THEN          10144000
         BEGIN                                                          10146000
            I:=-1; <<NEED TO SET GLOBAL ALLOW MASK IN SYSGLOB>>         10148000
            DISABLE;                                                    10150000
            WHILE (I:=I+1)<JIT'ALLOW'L DO                               10152000
            ABSOLUTE(ALLOWMASK+I):=                            <<00638>>10154000
               IF ALLOW THEN ABSOLUTE(ALLOWMASK+I) LOR MASK(I) <<00638>>10156000
               ELSE ABSOLUTE(ALLOWMASK+I) LAND (NOT MASK(I));  <<00638>>10158000
            ENABLE;                                                     10160000
            FOUND:=TRUE;                                                10162000
         END;                                                           10164000
         MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);            10166000
         ENTRYP:=JMATHEADER(JMAT'H'ENTRYP);                             10168000
         LASTP:=JMATHEADER(JMAT'H'CURSIZE)*128                          10170000
               -JMATHEADER(JMAT'H'ENTRYSIZE);                           10172000
         SAVESIR:=GETSIR(JMATSIR);                                      10174000
         DO <<SCAN JMAT FOR SPECIFIED JOBS>>                            10176000
         BEGIN                                                          10178000
            MOVEFROMDSEG(@JMATENTRY,JMATDST,ENTRYP,JMATENTRYSIZE);      10180000
            IF JMATENTRY<>0 THEN <<GO VALID ENTRY>>                     10182000
            BEGIN                                                       10184000
               IF (USERNAME'="@       " OR                              10186000
                   NAME(USERNAME,JMATENTRY(JMAT'USERNAME))) AND         10188000
                  (ACCTNAME'="@       " OR                              10190000
                   NAME(ACCTNAME,JMATENTRY(JMAT'ACCTNAME))) THEN        10192000
               BEGIN                                                    10194000
                  TOS:=JMATENTRY(JMAT'JSTATE);                          10196000
                  IF S0=JOBEXEC OR S0=JOBSUSP OR S0=JOBCIINIT THEN      10198000
                  BEGIN <<HAVE JOB IN GOOD STATE>>                      10200000
                     FOUND:=TRUE;                                       10202000
                     S0:=PCB(JMATENTRY(JMAT'PINNUM)*PCBSIZE+PCB'STK);   10204000
                     MOVEFROMDSEG(@PCBXGLOB,S0,0,PCBX'GLOBALSIZE);      10206000
                     JITDST:=PCBXGLOB(PCBX'JIT);                        10208000
                     MOVEFROMDSEG(@JITALLOW,JITDST,JIT'ALLOW,           10210000
                                  JIT'ALLOW'L); <<GET ALLOW MASK>>      10212000
                     I:=-1;                                             10214000
                     WHILE (I:=I+1)<JIT'ALLOW'L DO <<ALTER ALLOW MASK>> 10216000
                     JITALLOW(I):=IF ALLOW                              10218000
                                  THEN (JITALLOW(I) LOR MASK(I))        10220000
                                  ELSE (JITALLOW(I) LAND NOT MASK(I));  10222000
                     MOVETODSEG(JITDST,JIT'ALLOW,@JITALLOW,JIT'ALLOW'L);10224000
                  END; <<HAVE UPDATED JIT ALLOW MASK>>                  10226000
                  DEL;                                                  10228000
               END;                                                     10230000
            END;                                                        10232000
         END                                                            10234000
         UNTIL (ENTRYP:=ENTRYP+JMATHEADER(JMAT'H'ENTRYSIZE))>LASTP;     10236000
         RELSIR(JMATSIR,SAVESIR);                                       10238000
         IF NOT FOUND THEN <<NO JOBS THAT QUALIFY>>                     10240000
         BEGIN                                                          10242000
            @CURRENT'PARM:=IF FILE THEN @IOBUFFER ELSE @PARMSP;         10244000
            ERR(NOJOBINGOODSTATE);                                      10246000
            RETURN;                                                     10248000
         END;                                                           10250000
         IF PARMSTATE<0 THEN RETURN <<END OF COMMAND>>                  10252000
         ELSE STATE:=0;                                                 10254000
      END                                                               10256000
      ELSE                                                              10258000
      BEGIN <<PROCESS COMMAND NAME>>                                    10260000
         IF CURRENT'DELIMITER<>COMMA AND CURRENT'DELIMITER<>EOL THEN    10262000
         BEGIN                                                          10264000
            ERR(COMMANDSEPBYCOMMA);                                     10266000
            RETURN;                                                     10268000
         END;                                                           10270000
         IF SEARCH(CURRENT'PARM,CURRENT'LENGTH,COMMAND'DICT,            10272000
                   COMMAND'DESCR)=0 THEN <<NOT AN OPERATOR COMMAND>>    10274000
         BEGIN                                                          10276000
            ERR(NOSUCHCOMMAND);                                         10278000
            RETURN;                                                     10280000
         END;                                                           10282000
         TOS:=MASK(COMMAND'DESCR.(10:2));                               10284000
         X:=COMMAND'DESCR.(12:4);                                       10286000
         ASSEMBLE(TSBC 0,X);                                            10288000
         MASK(COMMAND'DESCR.(10:2)):=TOS;                               10290000
      END;                                                              10292000
   END;                                                                 10294000
   GO TO SCANLOOP;                                                      10296000
END;                                                                    10298000
$PAGE "REPLY EXECUTOR"                                                  10300000
$CONTROL SEGMENT=OPHI                                                   10302000
PROCEDURE CXREPLY EXECUTORHEAD;                                         10304000
BEGIN                                                                   10306000
   COMMENT                                                              10308000
      THE SYNTAX OF THIS COMMAND IS:                                    10310000
         REPLY PINNUM,REPLY[,PARAM]                                     10312000
         WHERE PINNUM IS THE PIN NUMBER OF THE PROCESS WAITING FOR THE  10314000
REQUEST. REPLY IS THE REPLY IT IS WAITING FOR AND PARAM IS ANY          10316000
      ADDITIONAL INFORMATION IT MAY BE WAITING FOR.  WHEN THREE         10318000
      PARAMETERS ARE SUPPLIED, BOTH 'REPLY' AND 'PARAM' ARE TREATED     10320000
      AS STRINGS AND ARE CONCATENTATED TOGETHER WITH A SEPARATING COMMA 10322000
      AND SENT TO WAITING PROCESS.                                      10324000
      ;                                                                 10326000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  10328000
   BYTE ARRAY DL'(*)=DL;                                                10330000
   ARRAY TEMPHOLD(0:36); BYTE ARRAY B'TEMPHOLD(*)=TEMPHOLD;             10332000
   DOUBLE ARRAY PARM(0:3)=Q;                                            10334000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4,         10336000
                FOURTHPARM=PARM+6;                                      10338000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3, TRDLEN=PARM+5;                  10340000
   INTEGER NUMPARMS,I,MAXINX,SAVESIR,PIN,IVALUE;                        10342000
   INTEGER LEN;                                                <<00622>>10344000
   ARRAY RIT(0:RIT'SIZE-1);                                    <<04803>>10346000
   INTEGER SAVEDSTN;                                           <<04803>>10348000
   INTEGER ARRAY RITHEAD(0:RIT'HEADSIZE-1)=Q;                           10350000
   LOGICAL LVALUE=IVALUE,FOUND;                                         10352000
   INTEGER PARM1=PARM+1,PARM2=PARM+3;                                   10354000
   EQUATE COMMA=0,SEMICOLON=1;                                          10356000
                                                                        10358000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         10360000
   SUBROUTINE DEF'MOVETODSEG;                                           10362000
   LOGICAL SUBROUTINE CHKYN;                                            10364000
   BEGIN                                                                10366000
      CHKYN:=TRUE;                                                      10368000
      IF SNDLEN=1 THEN <<CHECK FOR 'N' OR 'Y'>>                         10370000
         IF SNDPARM="Y" THEN LVALUE:=TRUE                               10372000
         ELSE IF SNDPARM="N" THEN LVALUE:=FALSE                         10374000
              ELSE CHKYN:=FALSE                                         10376000
      ELSE IF SNDLEN=2 AND SNDPARM="NO" THEN LVALUE:=FALSE              10378000
           ELSE IF SNDLEN=3 AND SNDPARM="YES" THEN LVALUE:=TRUE         10380000
                ELSE CHKYN:=FALSE;                                      10382000
   END;                                                                 10384000
   LOGICAL SUBROUTINE CHKVALUE;                                         10386000
   BEGIN                                                                10388000
      IVALUE:=BINARY(SNDPARM,SNDLEN);                                   10390000
      CHKVALUE:=IF <> THEN FALSE ELSE TRUE;                             10392000
   END;                                                                 10394000
                                                                        10396000
   LOGIMAGE( M'REPLY, PARMSP );  << LOG OP COMMAND >>          <<01527>>10398000
   TOS:=@I;                                                             10400000
   SETJIT;                                                              10402000
   MOVEFROMDSEG(*,*,JIT'ASSPTR,1); <<GET USER'S ASSOCIATE PTR>>         10404000
   IF I=0 AND NOT MASTEROP AND NOT CHECKALLOW(M'REPLY) THEN<<NO ACCESS>>10406000
   BEGIN                                                                10408000
      PARMNUM:=1;                                                       10410000
      CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                              10412000
      RETURN;                                                           10414000
   END;                                                                 10416000
   MYCOMMAND(PARMSP,DL',4,NUMPARMS,PARM);  <<PARSE PARAMETERS>>         10418000
   IF NUMPARMS<2 THEN <<TOO FEW PARAMETERS>>                            10420000
   BEGIN                                                                10422000
      PARMNUM:=1;                                                       10424000
      CIERR(ERRNUM:=REPLYREQ2P,PARMSP);                                 10426000
   END                                                                  10428000
   ELSE                                                                 10430000
   IF PARM1.DELIMITER<>COMMA THEN <<BAD SEPARATOR>>                     10432000
   BEGIN                                                                10434000
      PARMNUM:=1;                                                       10436000
      CIERR(ERRNUM:=EXPCOMMABREPLYP,FIRSTPARM(FIRSTLEN));               10438000
   END                                                                  10440000
   ELSE                                                                 10442000
   BEGIN                                                                10444000
      PIN:=BINARY(FIRSTPARM,FIRSTLEN); <<GET PIN #>>                    10446000
      IF <> OR NOT (3<=PIN<=255) THEN <<BAD PIN #>>                     10448000
      BEGIN                                                             10450000
         PARMNUM:=1;                                                    10452000
         CIERR(ERRNUM:=INVALIDPIN,FIRSTPARM);                           10454000
         RETURN;                                                        10456000
      END;                                                              10458000
      SAVESIR:=GETSIR(RIT'SIR); << LOCK RIT TABLE >>           <<04803>>10460000
      MOVEFROMDSEG(@RITHEAD,RIT'DST,0,RIT'HEADSIZE);           <<04803>>10462000
  << Get RIT header  >>                                        <<04803>>10464000
      <<MAX INDEX INTO RIT DST>>                               <<41.MM>>10466000
      MAXINX:=(RITHEAD(RIT'HEAD'MAXENT))*RIT'SIZE+RIT'HEADSIZE;<<04803>>10468000
      I:=RIT'HEADSIZE-RIT'SIZE;                                <<04803>>10470000
      FOUND:=FALSE;                                                     10472000
      WHILE NOT FOUND AND (I:=I+RIT'SIZE)<MAXINX               <<04803>>10474000
  << Search for PIN  >>                                        <<04803>>10476000
      DO                                                                10478000
      BEGIN                                                             10480000
         MOVEFROMDSEG(@RIT,RIT'DST,I,RIT'SIZE); <<GET RIT ENTRY<<04803>>10482000
         IF PIN=INTEGER(RIT(RIT'PINNUM)) THEN FOUND:=TRUE;              10484000
      END;                                                              10486000
      IF NOT FOUND THEN <<PIN NOT WAITING FOR REPLY>>                   10488000
      BEGIN                                                             10490000
         RELSIR(RIT'SIR,SAVESIR);                              <<04803>>10492000
         PARMNUM:=1;                                                    10494000
         CIERR(ERRNUM:=NOREQ4PIN,FIRSTPARM);                            10496000
      END                                                               10498000
      ELSE                                                              10500000
      IF NUMPARMS > 3 AND                                      <<00622>>10502000
            RIT(RIT'REPLYTYPE)<>REPLYTYPE'ONESTRING THEN       <<00622>>10504000
      BEGIN                                                    <<00622>>10506000
         RELSIR(RIT'SIR,SAVESIR);                              <<04803>>10508000
         PARMNUM := 4;                                         <<00622>>10510000
         CIERR(ERRNUM := REPLYTOOMANYP,FOURTHPARM);            <<00622>>10512000
      END                                                      <<00622>>10514000
      ELSE                                                     <<00622>>10516000
      IF NUMPARMS = 3 THEN                                     <<00622>>10518000
         IF RIT(RIT'REPLYTYPE) <> REPLYTYPE'ONESTRING THEN     <<00622>>10520000
            IF RIT(RIT'REPLYTYPE) <> REPLYTYPE'STRINGS THEN    <<00622>>10522000
            BEGIN                                              <<00622>>10524000
               RELSIR(RIT'SIR,SAVESIR);                        <<04803>>10526000
               PARMNUM := 3;                                   <<00622>>10528000
               CIERR(ERRNUM := REPLYEXP2PARM,TRDPARM);         <<00622>>10530000
            END                                                <<00622>>10532000
            ELSE <<TWOSTRINGS EXPECTED. 2ND DELIM MUST BE ','>><<00622>>10534000
               IF PARM2.DELIMITER <> COMMA THEN                <<00622>>10536000
               BEGIN                                           <<00622>>10538000
               RELSIR(RIT'SIR,SAVESIR);                        <<04803>>10540000
               PARMNUM := 2;                                   <<00622>>10542000
               CIERR(ERRNUM:=EXPCOMMABREPLYP,SNDPARM(SNDPARM));<<00622>>10544000
               END;                                            <<00622>>10546000
      IF ERRNUM>0 THEN RETURN;                                          10548000
      CASE RIT(RIT'REPLYTYPE) OF                                        10550000
      BEGIN                                                             10552000
                                                                        10554000
         <<EXPECTING NUMBER>>                                           10556000
         IF NOT CHKVALUE THEN <<DIDN'T GET A NUMBER>>                   10558000
            ERRNUM:=REPLYEXPNUMBER;                                     10560000
                                                                        10562000
         <<EXPECTING YES/NO>>                                           10564000
         IF NOT CHKYN THEN <<DIDN'T GET A YES/NO>>                      10566000
            ERRNUM:=REPLYEXPYN;                                         10568000
                                                                        10570000
         <<EXPECTING STRING(S)>>                                        10572000
         BEGIN                                                          10574000
            IF INTEGER(SNDLEN+(IF NUMPARMS=3 THEN TRDLEN+1 ELSE 0))>    10576000
               INTEGER(RIT(RIT'REPLYLEN)) THEN <<STRING TOO LONG>>      10578000
               ERRNUM:=STRINGTOOLONG                                    10580000
            ELSE                                                        10582000
            BEGIN                                                       10584000
               MOVE B'TEMPHOLD(2):=SNDPARM,(SNDLEN),2;         <<00622>>10586000
               IF NUMPARMS=2 THEN DEL ELSE                              10588000
               BEGIN                                                    10590000
                  MOVE *:=",",2;                                        10592000
                  MOVE *:=TRDPARM,(TRDLEN);                             10594000
               END;                                                     10596000
               IVALUE:=@TEMPHOLD;                                       10598000
               TEMPHOLD := SNDLEN +                            <<00622>>10600000
                          (IF NUMPARMS=3 THEN TRDLEN+1 ELSE 0);<<00622>>10602000
            END;                                                        10604000
         END;                                                           10606000
                                                                        10608000
         <<EXPECTING YES/NO OR NUMBER>>                                 10610000
         IF NOT CHKVALUE AND NOT CHKYN THEN <<DIDN'T GET YES/NO OR #>>  10612000
            ERRNUM:=REPLYEXPYN'NUM;                                     10614000
                                                               <<00622>>10616000
         <<EXPECTING ONE STRING TERMINATED BY CR >>            <<00622>>10618000
         BEGIN                                                 <<00622>>10620000
            SCAN SNDPARM UNTIL %6415,1;  <<FIND END OF STRING>><<00622>>10622000
            LEN := TOS - @SNDPARM;                             <<00622>>10624000
                                                               <<01459>>10626000
            << DEBLANK ON RIGHT >>                             <<01459>>10628000
            X := LEN;                                          <<01459>>10630000
            WHILE (LEN > 0) AND (SNDPARM(X := X-1) = " ")      <<01459>>10632000
               DO LEN := LEN - 1;                              <<01459>>10634000
                                                               <<01459>>10636000
            IF LEN > INTEGER(RIT(RIT'REPLYLEN)) THEN           <<00622>>10638000
               ERRNUM := STRINGTOOLONG                         <<00622>>10640000
            ELSE                                               <<00622>>10642000
            BEGIN                                              <<00622>>10644000
               TEMPHOLD := LEN;                                <<00622>>10646000
               MOVE B'TEMPHOLD(2) := SNDPARM,(LEN);            <<00622>>10648000
               IVALUE := @TEMPHOLD;                            <<00622>>10650000
            END;                                               <<00622>>10652000
         END;                                                  <<00622>>10654000
      END;                                                              10656000
      IF ERRNUM<>0 THEN <<REPLY HAD AN ERROR>>                          10658000
      BEGIN                                                             10660000
         RELSIR(RIT'SIR,SAVESIR);                              <<04803>>10662000
         PARMNUM:=2;                                                    10664000
         IF ERRNUM<>STRINGTOOLONG THEN CIERR(ERRNUM,SNDPARM)            10666000
         ELSE CIERR(ERRNUM,SNDPARM,%10000,RIT(RIT'REPLYLEN));           10668000
         RETURN;                                                        10670000
      END;                                                              10672000
      IF (RIT(RIT'REPLYTYPE)<>REPLYTYPE'STRINGS) AND           <<00622>>10674000
         (RIT(RIT'REPLYTYPE)<>REPLYTYPE'ONESTRING) THEN        <<00622>>10676000
     MOVETODSEG(RIT(RIT'REPLYPIN),RIT(RIT'DSTOFFSET),@IVALUE,1)<<04803>>10678000
   ELSE MOVETODSEG(RIT(RIT'REPLYPIN),RIT(RIT'DSTOFFSET),IVALUE,<<04803>>10680000
                      (TEMPHOLD+1)&ASR(1) + 1);                <<00622>>10682000
      RIT(RIT'PINNUM):=0; <<CLEAR PENDING REQUEST>>                     10684000
      MOVETODSEG(RIT'DST,I,@RIT,RIT'SIZE);                     <<04803>>10686000
      RITHEAD(RIT'HEAD'ENT):=RITHEAD(RIT'HEAD'ENT)-1;                   10688000
      MOVETODSEG(RIT'DST,0,@RITHEAD,RIT'HEADSIZE);             <<04803>>10690000
  << Update header  >>                                         <<04803>>10692000
      RELSIR(RIT'SIR,SAVESIR);  <<UNLOCK RIT>>                 <<04803>>10694000
      SAVEDSTN :=EXCHANGEDB(RIT'DST);                          <<04803>>10696000
      REM'QUEUED'ENTRY;  << CHECK FOR QUEUED ENRIES >>         <<04803>>10698000
      EXCHANGEDB(SAVEDSTN);                                    <<04803>>10700000
      PCB(PIN*PCBSIZE+PCB'ACTORG):=PCB'REPLYDONE;              <<00594>>10702000
      AWAKE(PIN*PCBSIZE,%40,0); <<AWAKEN WAITING PROCESS>>     <<00594>>10704000
   END;                                                                 10706000
END;                                                                    10708000
$PAGE "ASSOCIATE AND DISASSOCIATE EXECUTORS"                            10710000
$CONTROL SEGMENT=OPMED                                                  10712000
PROCEDURE CXASSOCIATE EXECUTORHEAD;                                     10714000
BEGIN                                                                   10716000
   COMMENT                                                              10718000
      THE SYNTAX OF THE ASSOCIATE AND DISASSOCIATE COMMANDS IS:         10720000
         ASSOCIATE LDEV                                                 10722000
         DISASSOCIATE LDEV                                              10724000
   ;                                                                    10726000
   EQUATE SESSION=1;  <<SESSION JOB TYPE>>                              10728000
   ENTRY CXDISASSOCIATE;                                                10730000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  10732000
   BYTE ARRAY DL'(*)=DL;                                                10734000
   DOUBLE ARRAY PARM(0:1)=Q;                                            10736000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         10738000
   BYTE LEN=PARM+1;                                                     10740000
   INTEGER OLDJMAT,NUMPARMS,JMAT,SAVESIR,MATCH,HE,I,THEY,JIT;           10742000
   LOGICAL ASSOCIATE:=TRUE;                                             10744000
   ARRAY ASS'ENTRY(0:ASS'ENTRYSIZE-1);                                  10746000
   BYTE ARRAY ASS'ENTRY'(*)=ASS'ENTRY;                                  10748000
   ARRAY UNAME(0:4),ANAME(0:4);                                         10750000
   BYTE ARRAY UNAME'(*)=UNAME,ANAME'(*)=ANAME;                          10752000
   ARRAY JMATENTRY(0:JMATENTRYSIZE-1);                                  10754000
   LOGICAL USERS;                                                       10756000
   INTEGER ARRAY CLASSNAME(0:4);                                        10758000
   BYTE ARRAY CLASSNAME'(*)=CLASSNAME;                                  10760000
   INTEGER ARRAY CLASSINFO(0:130);                                      10762000
   BYTE ARRAY DEVICES(*)=CLASSINFO(3);                                  10764000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         10766000
                                                                        10768000
<<CXASSOCIATE ENTRY POINT>>                                             10770000
   GO TO MAINCODE;                                                      10772000
                                                                        10774000
<<CXDISASSOCIATE ENTRY POINT>>                                          10776000
CXDISASSOCIATE:                                                         10778000
   ASSOCIATE:=FALSE;                                                    10780000
                                                                        10782000
MAINCODE:                                                               10784000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM);                               10786000
   IF NUMPARMS<>1 THEN <<MUST HAVE EXACTLY ONE PARAMETER>>              10788000
   BEGIN                                                                10790000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                             10792000
      TOS:=ERRNUM:=IF ASSOCIATE THEN ASSREQ1P ELSE DISASSREQ1P;         10794000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     10796000
      CIERR(*,*);                                                       10798000
   END                                                                  10800000
   ELSE                                                                 10802000
   BEGIN                                                                10804000
      MOVE CLASSNAME:="        ";                                       10806000
      CLASSNAME'(8):=0; <<TERMINATOR FOR GENMSG>>                       10808000
      MOVE CLASSNAME':=FIRSTPARM,(LEN);                                 10810000
      IF NOT GETCLASS(CLASSINFO,TRUE,,,CLASSNAME) THEN                  10812000
      BEGIN                                                             10814000
         CIERR(ERRNUM:=NOSUCHDEVCLASS,FIRSTPARM);                       10816000
         PARMNUM:=1;                                                    10818000
         RETURN;                                                        10820000
      END;                                                              10822000
      SETXPXGLOB;                                                       10824000
      IF PXGLOBJOBTYPE<>SESSION THEN <<MUST BE IN SESSION TO ASS>>      10826000
      BEGIN                                                             10828000
         PARMNUM:=1;                                                    10830000
         CIERR(ERRNUM:=ASSREQSESSION);                                  10832000
         RETURN;                                                        10834000
      END;                                                              10836000
      SAVESIR:=GETSIR(ASS'SIR);<<LOCK ASSOCIATION TABLE>>               10838000
      MATCH:=HE:=I:=THEY:=0;                                            10840000
      WHILE (I:=I+1)<=INTEGER(DEVICES) DO <<GET OWNERSHIP OF D>>        10842000
      IF CHECKASS(DEVICES(I),ASS'ENTRY) THEN <<USERS OWNS DEVI>>        10844000
      BEGIN                                                             10846000
         HE:=HE+1; <<INCREMENT # OF DEVICES HE OWNS IN CLASS>>          10848000
         IF CLASSNAME'=ASS'ENTRY'(2*ASS'CLASS),(8) THEN                 10850000
            MATCH:=MATCH+1;<<INCREMENT #0F DEV IN CLASS HE OWN>>        10852000
      END                                                               10854000
      ELSE                                                              10856000
      IF ASS'ENTRY(ASS'JIT)<>0 THEN <<OWNED BY OTHERS>>                 10858000
      BEGIN                                                             10860000
         THEY:=THEY+1;  <<INCREMENT # OF DEVICES OWNED BY OTHE>>        10862000
         OLDJMAT:=ASS'ENTRY(ASS'JMAT);                                  10864000
         IF CLASSNAME'=ASS'ENTRY'(2*ASS'CLASS),(8) THEN                 10866000
            MATCH:=MATCH+1;                                             10868000
      END;                                                              10870000
      IF ASSOCIATE THEN                                                 10872000
         IF HE<>0 THEN ERRNUM:=USERHASDEVASS                            10874000
         ELSE                                                           10876000
         IF THEY<>0 THEN ERRNUM:=ASSBYOTHERS ELSE                       10878000
      ELSE <<DISASSOCIATE>>                                             10880000
         IF MATCH<INTEGER(DEVICES) THEN <<CLASS NOT ASSOCIATED>>        10882000
         IF MASTEROP THEN ERRNUM:=DEVNOTASS                             10884000
         ELSE ERRNUM:=USERNOTASS2DEV                                    10886000
         ELSE                                                           10888000
         IF NOT MASTEROP AND HE<>MATCH THEN ERRNUM:=ASSBYOTHERS;        10890000
      IF ERRNUM<>0 THEN                                                 10892000
      BEGIN                                                             10894000
         RELSIR(ASS'SIR,SAVESIR);                                       10896000
         PARMNUM:=1;                                                    10898000
         CIERR(ERRNUM,FIRSTPARM);                                       10900000
         RETURN;                                                        10902000
      END;                                                              10904000
      UNAME'(8):=ANAME'(8):=0; <<INSURE ZERO TERMINATOR>>               10906000
      TOS:=@UNAME;                                                      10908000
      SETJIT;                                                           10910000
      MOVEFROMDSEG(*,*,JIT'USERNAME,4);<<GET USERNAME FROM JIT>>        10912000
      TOS:=@ANAME;                                                      10914000
      SETJIT;                                                           10916000
      MOVEFROMDSEG(*,*,JIT'ACCTNAME,4);<<GET ACCTNAME FROM JIT>>        10918000
      MOVE UNAME':=UNAME' WHILE AN,1;                                   10920000
      BPS0:=0; <<FORCE ZERO TERMINATOR FOR GENMSG>>                     10922000
      MOVE ANAME':=ANAME' WHILE AN,1;                                   10924000
      BPS0:=0; <<FORCE ZERO TERMINATOR FOR GENMSG>>                     10926000
      DDEL;                                                             10928000
      SETJIT; <<GET JIT DST #>>                                         10930000
      JIT:=TOS;                                                         10932000
      IF ASSOCIATE THEN <<DO THE ASSOCIATION>>                          10934000
      BEGIN                                                             10936000
         I:=HE:=0; <<INIT # OF DEVICE HAS PERMISSION FOR>>              10938000
         WHILE (I:=I+1)<=INTEGER(DEVICES) DO                            10940000
         IF CHK'ASS'SECURITY(JIT,DEVICES(I),CLASSNAME)                  10942000
            THEN HE:=HE+1;                                              10944000
         IF HE<INTEGER(DEVICES) THEN                                    10946000
         BEGIN                                                          10948000
            PARMNUM:=1;                                                 10950000
            RELSIR(ASS'SIR,SAVESIR);                                    10952000
            CIERR(ERRNUM:=USERCANTASSDEV,FIRSTPARM);                    10954000
         END                                                            10956000
         ELSE <<USER MAY ASSOCIATE DEVICE>>                             10958000
         BEGIN                                                          10960000
            SETJMAT;                                                    10962000
            JMAT:=TOS;                                                  10964000
            I:=0;                                                       10966000
            WHILE (I:=I+1)<=INTEGER(DEVICES)                            10968000
               DO ADDASS(JIT,JMAT,DEVICES(I),CLASSNAME');               10970000
            IF NOT MASTEROP THEN                                        10972000
               GENMSG(CIGENERALMSGSET,LDEVWASASS,                       10974000
            [1/0,3/0,3/0,3/0,6/0],@UNAME',@ANAME',@CLASSNAME',          10976000
               ,,ABSOLUTE(CONSLDEV),,,,1);                              10978000
         END                                                            10980000
      END                                                               10982000
         ELSE <<DO DISASSOCIATE>>                                       10984000
         BEGIN                                                          10986000
         IF MASTEROP AND HE<INTEGER(DEVICES) THEN                       10988000
         BEGIN <<MASTEROP DISASSOCIATING SOMEBODY ELSE>>                10990000
            MOVEFROMDSEG(@JMATENTRY,JMATDST,                            10992000
              OLDJMAT*JMATENTRYSIZE,JMATENTRYSIZE);                     10994000
            GENMSG(CIGENERALMSGSET,MASTEROPDISASS,                      10996000
            [1/0,3/0,12/0],@CLASSNAME',,,,,                             10998000
               JMATENTRY(JMAT'JLIST),,,,1);<<TELL USER OF DISASS.>>     11000000
         END;                                                           11002000
         I:=0;                                                          11004000
         WHILE (I:=I+1)<=INTEGER(DEVICES) DO                            11006000
            DELASS(DEVICES(I)*ASS'ENTRYSIZE,ASS'ENTRY(ASS'JIT));        11008000
         IF NOT MASTEROP THEN GENMSG(CIGENERALMSGSET,                   11010000
            LDEVWASDISASS,[1/0,3/0,3/0,3/0,6/0],@UNAME',@ANAME',        11012000
            @CLASSNAME',,,ABSOLUTE(CONSLDEV),,,,1);                     11014000
      END;                                                              11016000
      RELSIR(ASS'SIR,SAVESIR);                                          11018000
   END;                                                                 11020000
END;                                                                    11022000
$PAGE "STREAMS EXECUTOR"                                                11024000
$CONTROL SEGMENT=OPLOW                                                  11026000
PROCEDURE CXSTREAMS EXECUTORHEAD;                                       11028000
BEGIN                                                                   11030000
   COMMENT                                                              11032000
      THE SYNTAX OF THIS COMMAND IS:                                    11034000
         STREAMS LDEV                                                   11036000
      WHERE LDEV IS ANY JOB & DATA ACCEPTING DEVICE OTHER THAN          11038000
      A TERMINAL                                                        11040000
   ;                                                                    11042000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  11044000
   BYTE ARRAY DL'(*)=DL;                                                11046000
   DOUBLE ARRAY PARM(0:1)=Q;                                            11048000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         11050000
   BYTE LEN=PARM+1;                                                     11052000
   INTEGER NUMPARMS,LDEV,SAVESIR;                                       11054000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                                      11056000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         11058000
   SUBROUTINE DEF'MOVETODSEG;                                           11060000
   LOGIMAGE( M'STREAMS, PARMSP );  << LOG OP COMMAND >>        <<01527>>11062000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM);<<PARSE PARAMETERS>>           11064000
   IF NUMPARMS<>1 THEN <<MUST HAVE EXACTLY ONE PARAMETER>>              11066000
   BEGIN                                                                11068000
      PARMNUM:=IF NUMPARMS<1 THEN 1 ELSE 2;                             11070000
      TOS:=ERRNUM:=STREAMSREQ1P;                                        11072000
      TOS:=IF PARMNUM=1 THEN @PARMSP ELSE @SNDPARM;                     11074000
      CIERR(*,*);                                                       11076000
   END                                                                  11078000
   ELSE                                                                 11080000
   BEGIN                                                                11082000
      IF LEN=3 AND FIRSTPARM="OFF" THEN LDEV:=0                         11084000
      ELSE                                                              11086000
      BEGIN                                                             11088000
         LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);            11090000
         IF < THEN RETURN;                                              11092000
         MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);<<GET LDT ENTR>>11094000
         IF LDT(LDT'DTYPE)=16 THEN ERRNUM:=CANTBETERM                   11096000
         ELSE                                                           11098000
         IF LPDT(LDEV*LPDTSIZE+LPDT'JOB)=0 AND                          11100000
            LPDT(LDEV*LPDTSIZE+LPDT'DATA)=0 THEN ERRNUM:=DEVNOTDJ;      11102000
      END;                                                              11104000
      IF ERRNUM=0 THEN <<ENABLE STREAMS>>                               11106000
      BEGIN                                                             11108000
         SAVESIR:=GETSIR(LDTSIR); <<LOCK LDT>>                          11110000
         MOVEFROMDSEG(@LDT,LDTDST,0,LDTSIZE);<<GET LDT HEADER>>         11112000
         LDT(LDT'STREAMS):=LDEV;                                        11114000
         MOVETODSEG(LDTDST,0,@LDT,LDTSIZE);                             11116000
         RELSIR(LDTSIR,SAVESIR);                                        11118000
      END                                                               11120000
      ELSE                                                              11122000
      BEGIN                                                             11124000
         PARMNUM:=1;                                                    11126000
         CIERR(ERRNUM,FIRSTPARM);                                       11128000
      END;                                                              11130000
   END;                                                                 11132000
END;                                                                    11134000
$PAGE "CONSOLE EXECUTOR"                                                11136000
$CONTROL SEGMENT=OPLOW                                                  11138000
PROCEDURE CXCONSOLE EXECUTORHEAD;                                       11140000
BEGIN                                                                   11142000
   COMMENT                                                              11144000
      THE SYNTAX OF THIS COMMAND IS:                                    11146000
         CONSOLE LDEV                                                   11148000
         WHERE LDEV IS ANY REAL TERMINAL.                               11150000
   ;                                                                    11152000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                                      11154000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  11156000
   BYTE ARRAY DL'(*)=DL;                                                11158000
   DOUBLE ARRAY PARM(0:1)=Q;                                            11160000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         11162000
   BYTE LEN=PARM+1;                                                     11164000
   DOUBLE DCAPABILITY; LOGICAL CAPABILITY=DCAPABILITY;         <<01042>>11166000
   INTEGER NUMPARMS,LDEV;                                               11168000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         11170000
                                                                        11172000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM);<<PARSE THE PARAMETERS>>       11174000
   IF NUMPARMS>1 THEN <<MUST BE 0 OR 1 PARAMETERS>>            <<00893>>11176000
   BEGIN                                                                11178000
      PARMNUM:=2;                                              <<00893>>11180000
      CIERR(ERRNUM:=CONSOLEREQ1P,SNDPARM);                     <<00893>>11182000
   END                                                                  11184000
   ELSE                                                                 11186000
   IF NUMPARMS=0 THEN <<JUST REPORT WHERE CONSOLE IS NOW>>     <<00893>>11188000
   BEGIN                                                       <<00893>>11190000
      DL'(ASCII(ABSOLUTE(CONSLDEV),10,DL')):=0;                <<00893>>11192000
      GENMSG(CIGENERALMSGSET,CONSOLEIS,0,@DL');                <<00893>>11194000
   END                                                         <<00893>>11196000
   ELSE                                                        <<00893>>11198000
   BEGIN                                                                11200000
      LOGIMAGE( M'CONSOLE, PARMSP );  << LOG OP COMMAND >>     <<01527>>11202000
      WHO(,DCAPABILITY);                                       <<01042>>11204000
      IF CHECKALLOW(M'CONSOLE) OR CAPABILITY.SMCAP THEN        <<01042>>11206000
      BEGIN   <<USER HAS ACCESS TO COMMAND>>                   <<01042>>11208000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);               11210000
      IF < THEN RETURN;                                                 11212000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>11214000
      IF LPDT(LDEV*LPDTSIZE+LPDT'JOB)=0 THEN <<DEVICE NOT JOB ACCEPTIN>>11216000
      BEGIN                                                             11218000
         PARMNUM:=1;                                                    11220000
         CIERR(ERRNUM:=DEVNOTJOB,FIRSTPARM);                            11222000
      END                                                               11224000
      ELSE                                                              11226000
      BEGIN                                                             11228000
         MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);                11230000
         IF LDT(LDT'DTYPE)<>TERMINAL THEN <<DEVICE MUST BE TERMINAL>>   11232000
         BEGIN                                                          11234000
            PARMNUM:=1;                                                 11236000
            CIERR(ERRNUM:=LDEVMUSTBETERM,FIRSTPARM);                    11238000
         END                                                            11240000
        ELSE                                                   <<00874>>11242000
        IF LPDT(LDEV*LPDTSIZE +                                <<00874>>11244000
              LPDT'DRSTART) <> 0  <<LDEV IS OWNED>>            <<00874>>11246000
           AND                    <<    AND      >>            <<00874>>11248000
           PCB(LDT(LD'MAINPIN)*PCBSIZE +                       <<00874>>11250000
              PCB'PTYPE) <> CITYPE << NOT A JOB OR SESSION>>   <<00874>>11252000
           THEN                   <<I.E. LDEV IS ALLOCATED>>   <<00874>>11254000
           BEGIN                  << BY A SPOOLER, OR SON >>   <<00874>>11256000
              PARMNUM := 1;                                    <<00874>>11258000
              CIERR (ERRNUM := DEVOWNEDOTHER, FIRSTPARM);      <<04801>>11260000
           END                                                 <<00874>>11262000
         ELSE                                                           11264000
         IF GET'DSDEVICE(LDEV) = 3 OR << ds terminal >>        <<04167>>11266000
            ABSOLUTE(LPDT(LDEV*LPDTSIZE                        <<04167>>11268000
            +LPDT'DITP)+SYSGLOB).(0:1) = 0 THEN << mp term >>  <<04167>>11270000
         BEGIN                                                          11272000
            PARMNUM:=1;                                                 11274000
            CIERR(ERRNUM:=LDEVCANTBEDSTERM,FIRSTPARM);                  11276000
         END                                                            11278000
         ELSE                                                  <<00671>>11280000
         IF ABSOLUTE(LPDT(ABSOLUTE(CONSLDEV)*LPDTSIZE + LPDT'DITP)      11282000
               + SYSGLOB + DIT'LPLEVEL) = 4 THEN               <<00671>>11284000
         BEGIN   <<CONTROL A ON OLD CONSOLE>>                  <<00671>>11286000
            PARMNUM := 1;                                      <<00671>>11288000
            CIERR(ERRNUM := CONSOLEBUSY,FIRSTPARM);            <<00671>>11290000
         END                                                   <<00671>>11292000
            ELSE                                               <<01027>>11294000
            IF LOGICAL(LDT(LDT'R)) OR                          <<01027>>11296000
               NOT LOGICAL(LDT(LDT'F)) THEN                    <<01027>>11298000
            BEGIN <<DOWN OR DOWN PENDING ON DEVICE>>           <<01027>>11300000
               PARMNUM := 1;                                   <<01027>>11302000
               CIERR(ERRNUM := CONSOLEDOWN,FIRSTPARM);         <<01027>>11304000
            END                                                <<01027>>11306000
         ELSE                                                  <<00671>>11308000
         BEGIN   <<TELL OLD CONSOLE OF SWITCH AND COMPLETE>>   <<00671>>11310000
                 <<SUCCESSFULLY>>                              <<00671>>11312000
            GENMSG(CIGENERALMSGSET,CONSOLESWITCHED,%11000,     <<00671>>11314000
                   ABSOLUTE(CONSLDEV),LDEV,,,,                 <<00671>>11316000
                   ABSOLUTE(CONSLDEV),,,,2);                   <<00692>>11318000
            ABSOLUTE(CONSLDEV) := LDEV;                        <<00671>>11320000
         END;                                                  <<00671>>11322000
      END;                                                              11324000
      END                                                      <<01042>>11326000
      ELSE <<USER HAS NO ACCESS TO COMMAND>>                   <<01042>>11328000
      BEGIN                                                    <<01042>>11330000
         PARMNUM:=1;                                           <<01042>>11332000
         CIERR(ERRNUM:=OPCOMMNOTALLOW,PARMSP);                 <<01042>>11334000
      END;                                                     <<01042>>11336000
   END;                                                                 11338000
END;                                                                    11340000
$PAGE "LIMIT EXECUTOR"                                                  11342000
$CONTROL SEGMENT=OPMED                                                  11344000
PROCEDURE GETMAXJS(JLIMIT,SLIMIT,ERRNUM);                      <<01108>>11346000
INTEGER SLIMIT,JLIMIT,ERRNUM; << PASSED BY REFERENCE >>        <<01108>>11348000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01108>>11350000
                                                               <<01108>>11352000
COMMENT                                                        <<01108>>11354000
THE FOLLOWING PROCEDURE WILL RETURN THE ABSOLUTE               <<01108>>11356000
NUMBER OF SESSIONS AND JOBS ALLOWED ON THE SYSTEM.             <<01108>>11358000
THOSE NUMBERS ARE ESTABLISHED AT SYSTEM CONFIGURATION          <<01108>>11360000
TIME AND ARE STORED IN THE FILE "CONFDATA.PUB.SYS" TOGETHER    <<01108>>11362000
WITH OTHER SYSTEM PERTINENT INFORMATION.                       <<01108>>11364000
THE ABOVE SYSTEM FILE IS ALSO USED BY "INITIAL" AND            <<01108>>11366000
THEREFOR CONSIDERED "STABLE".;                                 <<01108>>11368000
                                                               <<01108>>11370000
BEGIN                                                          <<01108>>11372000
INTEGER CONF'F'NUM, << FILE NUMBER >>                          <<01108>>11374000
        CONF'RECSIZE; << RECORD SIZE >>                        <<01108>>11376000
                                                               <<01108>>11378000
ARRAY CONF'REC(0:199); << RECORD BUFFER >>                     <<01108>>11380000
                                                               <<01108>>11382000
INTRINSIC FOPEN,FCLOSE,FREAD,FWRITE,FPOINT,FGETINFO;           <<01108>>11384000
ARRAY CONF'DATA(0:20) ;                                        <<01108>>11386000
DEFINE CONFDATA'ERROR = BEGIN                                  <<01108>>11388000
                            FERROR'(CONF'F'NUM,ERRNUM);        <<01457>>11390000
                            CIERR(ERRNUM := CONF'ERROR);       <<01108>>11392000
                            RETURN;                            <<01108>>11394000
                        END#,                                  <<01108>>11396000
       ABS'SLIMIT = CONF'REC(40)#,                             <<01108>>11398000
       ABS'JLIMIT = CONF'REC(41)#,                             <<01108>>11400000
                                                               <<01108>>11402000
       CORE'SIZE'INDEX = CONF'REC(1) + 1#;                     <<01108>>11404000
                                                               <<01108>>11406000
<< MAIN LINE >>                                                <<01108>>11408000
    << INITIALIZE >>                                           <<01108>>11410000
    MOVE CONF'DATA := "CONFDATA.PUB.SYS ";                     <<01108>>11412000
                                                               <<01108>>11414000
                                                               <<01108>>11416000
    << OPEN THE FILE >>                                        <<01108>>11418000
    CONF'F'NUM := FOPEN(CONF'DATA,%2001,%57);<<R,L,NOSECURITY>><<01457>>11420000
    IF < THEN CONFDATA'ERROR;                                  <<01108>>11422000
                                                               <<01108>>11424000
    << GET THE RECORD SIZE >>                                  <<01108>>11426000
    FGETINFO(CONF'F'NUM,,,,CONF'RECSIZE);                      <<01108>>11428000
    IF < THEN CONFDATA'ERROR;                                  <<01108>>11430000
                                                               <<01108>>11432000
    << READ RECORD ZERO >>                                     <<01108>>11434000
    FREAD(CONF'F'NUM,CONF'REC,CONF'RECSIZE);                   <<01108>>11436000
    IF <> THEN CONFDATA'ERROR;                                 <<01108>>11438000
                                                               <<01108>>11440000
    << MOVE THE POINTER TO THE RELEVANT RECORD >>              <<01108>>11442000
    FPOINT(CONF'F'NUM,DOUBLE(CORE'SIZE'INDEX));                <<01108>>11444000
    IF <> THEN CONFDATA'ERROR;                                 <<01108>>11446000
                                                               <<01108>>11448000
    << READ IT >>                                              <<01108>>11450000
    FREAD(CONF'F'NUM,CONF'REC,CONF'RECSIZE);                   <<01108>>11452000
    IF <> THEN CONFDATA'ERROR;                                 <<01108>>11454000
                                                               <<01108>>11456000
    << PULL IT IN >>                                           <<01108>>11458000
    JLIMIT := ABS'JLIMIT;                                      <<01108>>11460000
    SLIMIT := ABS'SLIMIT;                                      <<01108>>11462000
                                                               <<01108>>11464000
    << CLOSE THE FILE >>                                       <<01108>>11466000
    FCLOSE(CONF'F'NUM,0,0);                                    <<01108>>11468000
    IF <> THEN CONFDATA'ERROR;                                 <<01108>>11470000
                                                               <<01108>>11472000
                                                               <<01108>>11474000
END; << PROCEDURE GETMAXJS >>                                  <<01108>>11476000
PROCEDURE CXLIMIT EXECUTORHEAD;                                         11478000
BEGIN                                                                   11480000
   COMMENT                                                              11482000
      THE SYNTAX OF THIS COMMAND IS:                                    11484000
         LIMIT [JLIMIT][,SLIMIT]                                        11486000
         WHERE JLIMIT IS THE JOB LIMIT AND SLIMIT IS SESSION LIMIT      11488000
   ;                                                                    11490000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  11492000
   BYTE ARRAY DL'(*)=DL;                                                11494000
   BYTE ARRAY LIMITS(0:11);                                    <<02371>>11496000
   INTEGER LEN;                                                <<02371>>11498000
   DOUBLE ARRAY PARM(0:2)=Q;                                            11500000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4;         11502000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3;                                 11504000
   INTEGER PARM1=PARM+1, PARM2=PARM+3, NUMPARMS,JLIMIT,SLIMIT,SAVESIR;  11506000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);                        11508000
INTEGER ABS'JLIMIT,ABS'SLIMIT; << ABSOLUTE LIMITS ON NUMBER OF <<01108>>11510000
                               << JOBS AND SESSIONS, DETERMINED<<01108>>11512000
                               << AT CONFIGURATION TIME.       <<01108>>11514000
   EQUATE COMMA=0, SEMICOLON=1;                                         11516000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         11518000
   SUBROUTINE DEF'MOVETODSEG;                                           11520000
   LOGIMAGE( M'LIMIT, PARMSP );  << LOG OP COMMAND >>          <<01527>>11522000
   MYCOMMAND(PARMSP,DL',3,NUMPARMS,PARM);<<PARSE PARAMETERS>>           11524000
   IF NUMPARMS=0 THEN <<MUST HAVE AT LEAST ONE PARM>>                   11526000
   BEGIN                                                                11528000
      CIERR(ERRNUM:=-EXP1OFSORJLIMIT,PARMSP);                           11530000
      RETURN;                                                           11532000
   END                                                                  11534000
   ELSE                                                                 11536000
   IF NUMPARMS>2 THEN                                                   11538000
   BEGIN                                                                11540000
      PARMNUM:=2;                                                       11542000
      CIERR(ERRNUM:=LIMITHAS2PARM,TRDPARM);                             11544000
      RETURN;                                                           11546000
   END;                                                                 11548000
    GETMAXJS(ABS'JLIMIT,ABS'SLIMIT,ERRNUM);                    <<01108>>11550000
    IF ERRNUM <> 0 THEN RETURN;                                <<01108>>11552000
   MOVE LIMITS := 12(0);                                       <<02371>>11554000
   LEN := ASCII(ABS'JLIMIT,10,LIMITS);                         <<02371>>11556000
   LIMITS(LEN) := 0;                                           <<02371>>11558000
   LEN := ASCII(ABS'SLIMIT,10,LIMITS(LEN + 1));                <<02371>>11560000
   IF NUMPARMS=2 THEN                                                   11562000
   BEGIN                                                                11564000
      IF PARM1.DELIMITER<>COMMA THEN <<MUST HAVE COMMA SEPARATOR>>      11566000
      BEGIN                                                             11568000
         PARMNUM:=2;                                                    11570000
         CIERR(ERRNUM:=EXPCOMMASJ,FIRSTPARM(FIRSTLEN));                 11572000
      END                                                               11574000
      ELSE                                                              11576000
      IF SNDLEN<>0 THEN                                                 11578000
      BEGIN                                                             11580000
         SLIMIT:=BINARY(SNDPARM,SNDLEN);                                11582000
         IF <> OR SLIMIT<0 THEN <<BAD SESSION LIMIT SPECIFIED>>         11584000
         BEGIN                                                          11586000
            PARMNUM:=2;                                                 11588000
            CIERR(ERRNUM:=SLIMITBAD,SNDPARM);                           11590000
            RETURN;                                                     11592000
         END;                                                           11594000
            IF SLIMIT > ABS'SLIMIT THEN                        <<01108>>11596000
            BEGIN                                              <<01108>>11598000
                CIERR(ERRNUM := ABSLIMITEXCEEDED,,2,@LIMITS);  <<02371>>11600000
                RETURN;                                        <<01108>>11602000
            END;                                               <<01108>>11604000
      END;                                                              11606000
   END;                                                                 11608000
   IF ERRNUM<>0 THEN RETURN;                                            11610000
   IF FIRSTLEN<>0 THEN <<JOB LIMIT SPECIFIED>>                          11612000
   BEGIN                                                                11614000
      JLIMIT:=BINARY(FIRSTPARM,FIRSTLEN);                               11616000
      IF <> OR JLIMIT<0 THEN <<BADNESS!>>                               11618000
      BEGIN                                                             11620000
         PARMNUM:=1;                                                    11622000
         CIERR(ERRNUM:=JLIMITBAD,FIRSTPARM);                            11624000
         RETURN;                                                        11626000
      END;                                                              11628000
        IF JLIMIT > ABS'JLIMIT THEN                            <<01108>>11630000
        BEGIN                                                  <<01108>>11632000
                CIERR(ERRNUM := ABSLIMITEXCEEDED,,2,@LIMITS);  <<02371>>11634000
            RETURN;                                            <<01108>>11636000
        END;                                                   <<01108>>11638000
   END;                                                                 11640000
   SAVESIR:=GETSIR(JMATSIR);<<LOCK JMAT>>                               11642000
   MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);                  11644000
   IF FIRSTLEN<>0 THEN JMATHEADER(JMAT'H'JLIMIT):=JLIMIT;               11646000
   IF NUMPARMS=2 AND SNDLEN<>0 THEN                                     11648000
      JMATHEADER(JMAT'H'SLIMIT):=SLIMIT;                                11650000
   MOVETODSEG(JMATDST,0,@JMATHEADER,JMATHEADERSIZE);                    11652000
   RELSIR(JMATSIR,SAVESIR);                                             11654000
   IF FIRSTLEN<>0 THEN <<NEED TO WAKE UP SCHEDULING>>                   11656000
   BEGIN                                                                11658000
      DISABLE;                                                          11660000
      ABSOLUTE(JOBSYNC).READYFLAG:=TRUE;                                11662000
      ENABLE;                                                           11664000
      AWAKE(SYSPROC(UCOP),%20,0);                                       11666000
   END;                                                                 11668000
END;                                                                    11670000
$PAGE "ABORTJOB EXECUTOR"                                               11672000
$CONTROL SEGMENT=OPHI                                                   11674000
PROCEDURE CXABORTJOB EXECUTORHEAD;                                      11676000
BEGIN                                                                   11678000
   COMMENT                                                              11680000
      THE SYNTAX OF THIS COMMAND IS:                                    11682000
         ABORTJOB #JNNN                                                 11684000
         ABORTJOB #SNNN                                                 11686000
         ABORTJOB [JOBNAME,]USERNAME.ACCTNAME                           11688000
   ;                                                                    11690000
   DOUBLE DL:=[8/",",8/".",8/";",8/CR]D;                                11692000
   BYTE ARRAY DL'(*)=DL;                                                11694000
   DOUBLE ARRAY PARM(0:3)=Q;                                            11696000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4,         11698000
                FOURTHPARM=PARM+6;                                      11700000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3, TRDLEN=PARM+5;                  11702000
   INTEGER PARM1=PARM+1, PARM2=PARM+3, PARM3=PARM+5;                    11704000
   INTEGER NUMPARMS,JOBNUM,SAVESIR,ENTRYP;                              11706000
   INTEGER ARRAY JMATENTRY(0:JMATENTRYSIZE);                            11708000
   INTEGER ARRAY JNAME(0:3),UNAME(0:3),ANAME(0:3);                      11710000
   BYTE ARRAY JNAME'(*)=JNAME,UNAME'(*)=UNAME,ANAME'(*)=ANAME;          11712000
   EQUATE COMMA=0, PERIOD=1, SEMICOLON=2;                               11714000
                                                                        11716000
   LOGIMAGE( M'ABORTJOB, PARMSP );  << LOG OP COMMAND >>       <<01527>>11718000
   MYCOMMAND(PARMSP,DL',4,NUMPARMS,PARM);<<PARSE PARAMETERS>>           11720000
   IF NUMPARMS=0 THEN <<NEED AT LEAST ONE PARAMETER>>                   11722000
   BEGIN                                                                11724000
      PARMNUM:=1;                                                       11726000
      CIERR(ERRNUM:=EXPJNUMORJNAME,PARMSP);                             11728000
   END                                                                  11730000
   ELSE                                                                 11732000
   IF FIRSTLEN>0 AND FIRSTPARM="#" THEN <<JOBNUM SPECIFIED>>            11734000
      IF NUMPARMS<>1 THEN <<TOO MANY PARMS SPECIFIED>>                  11736000
      BEGIN                                                             11738000
         PARMNUM:=2;                                                    11740000
         CIERR(ERRNUM:=JOBNUMNOOTHERP,SNDPARM);                         11742000
      END                                                               11744000
      ELSE <<PARSE JOB NUM>>                                            11746000
         IF (FIRSTLEN<3) OR                                             11748000
           (NOT ((FIRSTPARM(1)="S") LOR (FIRSTPARM(1)="J"))) THEN       11750000
         BEGIN                                                          11752000
            PARMNUM:=1;                                                 11754000
            CIERR(ERRNUM:=EXPJORSNUM,FIRSTPARM(1));                     11756000
         END                                                            11758000
         ELSE                                                           11760000
         BEGIN                                                          11762000
            JOBNUM:=BINARY(FIRSTPARM(2),FIRSTLEN-2);                    11764000
            IF <> OR NOT (1<=JOBNUM<=%37777) THEN <<BAD JOB NUM>>       11766000
            BEGIN                                                       11768000
               PARMNUM:=1;                                              11770000
               CIERR(ERRNUM:=BADJOBNUM,FIRSTPARM(2));                   11772000
            END;                                                        11774000
         END                                                            11776000
   ELSE <<PARSE [JOBNAME,]USERNAME.ACCTNAME>>                           11778000
   BEGIN                                                                11780000
      JOBNUM:=0;                                                        11782000
      JNAME:="  ";                                                      11784000
      MOVE JNAME(1):=JNAME,(3);                                         11786000
      MOVE ANAME:=JNAME,(4);                                            11788000
      MOVE UNAME:=JNAME,(4);                                            11790000
      IF PARM1.DELIMITER=COMMA THEN <<JOB NAME SPECIFIED>>              11792000
      BEGIN                                                             11794000
         IF NUMPARMS<>3 THEN <<MUST HAVE EXACTLY 3 PARMS>>              11796000
         BEGIN                                                          11798000
            PARMNUM:=NUMPARMS;                                          11800000
            CIERR(ERRNUM:=EXPACCTNAME,FIRSTPARM(FIRSTLEN));             11802000
            RETURN;                                                     11804000
         END;                                                           11806000
         IF FIRSTLEN>8 THEN <<JNAME TOO LONG>>                          11808000
         BEGIN                                                          11810000
            PARMNUM:=1;                                                 11812000
            CIERR(ERRNUM:=UORANAMEMAX8,FIRSTPARM);                      11814000
            RETURN;                                                     11816000
         END;                                                           11818000
         MOVE JNAME':=FIRSTPARM,(FIRSTLEN);                             11820000
         PARM:=PARM(1); <<FINISHED PROCESSING JOBNAME>>                 11822000
         PARM(1):=PARM(2);<<SO ACT AS IF IT DIDN'T EXIST>>              11824000
      END                                                               11826000
      ELSE IF NUMPARMS<>2 THEN <<EXPECTED JUST USERNAME.ACCTNAME>>      11828000
      BEGIN                                                             11830000
         PARMNUM:=3;                                                    11832000
         CIERR(ERRNUM:=EXPUANDANAME,FIRSTPARM(FIRSTLEN));      <<00654>>11834000
         RETURN;                                                        11836000
      END;                                                              11838000
      IF PARM1.DELIMITER<>PERIOD THEN <<MUST BE PERIOD BETWEEN NAMES>>  11840000
      BEGIN                                                             11842000
         PARMNUM:=NUMPARMS-1;                                           11844000
         CIERR(ERRNUM:=PERIODEXP,SNDPARM);                              11846000
         RETURN;                                                        11848000
      END                                                               11850000
      ELSE                                                              11852000
      IF FIRSTLEN=0 OR SNDLEN=0 THEN <<USERNAME AD ACCTNAME MUST BE SP>>11854000
      BEGIN                                                             11856000
         PARMNUM:=2;                                                    11858000
         CIERR(ERRNUM:=UORANAMEZERO,FIRSTPARM(FIRSTLEN));               11860000
         RETURN;                                                        11862000
      END                                                               11864000
      ELSE                                                              11866000
      IF FIRSTLEN>8 OR SNDLEN>8 THEN <<USERNAME OR ACCTNAME TOO LONG>>  11868000
      BEGIN                                                             11870000
         PARMNUM:=2;                                                    11872000
         CIERR(ERRNUM:=UORANAMEMAX8,FIRSTPARM(FIRSTLEN));               11874000
         RETURN;                                                        11876000
      END                                                               11878000
      ELSE                                                              11880000
      BEGIN                                                             11882000
         MOVE UNAME':=FIRSTPARM,(FIRSTLEN);                             11884000
         MOVE ANAME':=SNDPARM,(SNDLEN);                                 11886000
      END;                                                              11888000
   END;                                                                 11890000
   IF ERRNUM<>0 THEN RETURN;                                            11892000
   TOS:=IF JOBNUM<>0 THEN FINDJOB(JMATENTRY,ENTRYP,JOBNUM,              11894000
                                 (FIRSTPARM(1)="J"),,,,SAVESIR)         11896000
                     ELSE FINDJOB(JMATENTRY,ENTRYP,,,JNAME,             11898000
                                  UNAME,ANAME,SAVESIR);                 11900000
   IF NOT TOS THEN                                                      11902000
   BEGIN  <<NO SUCH JOB>>                                               11904000
      PARMNUM:=1;                                                       11906000
      CIERR(ERRNUM:=NOSUCHJOB,FIRSTPARM);                               11908000
   END                                                                  11910000
   ELSE                                                                 11912000
   IF(CHECKJOB(JMATENTRY)=0) OR CHECKALLOW(M'ABORTJOB) THEN    <<04684>>11914000
   BEGIN                                                                11916000
      TOS:=0;   <<STACK PARMS BECAUSE DELETEJOB EXPECTS>>               11918000
      TOS:=ENTRYP;  <<AN INTEGER POINTER,NOT AN INTEGER>>               11920000
      EXCHANGEDB(JMATDST);<<DELETEJOB EXPECTS IT>>                      11922000
      TOS:=DELETEJOB(*);                                                11924000
      EXCHANGEDB(0);                                                    11926000
      RELSIR(JMATSIR,SAVESIR);                                          11928000
      IF NOT TOS THEN <<UNABLE TO ABORTJOB>>                            11930000
      BEGIN                                                             11932000
         PARMNUM:=1;                                                    11934000
         CIERR(ERRNUM:=JOBBEINTRO,FIRSTPARM);                           11936000
      END;                                                              11938000
   END                                                                  11940000
   ELSE                                                                 11942000
   BEGIN <<NOT USER'S JOB>>                                             11944000
      RELSIR(JMATSIR,SAVESIR);                                          11946000
      PARMNUM:=1;                                                       11948000
      CIERR(ERRNUM:=NOTUSERSJOB,FIRSTPARM);                             11950000
   END;                                                                 11952000
END;                                                                    11954000
$PAGE "ALTJOB EXECUTOR"                                                 11956000
$CONTROL SEGMENT=OPMED                                                  11958000
PROCEDURE CXALTJOB EXECUTORHEAD;                                        11960000
BEGIN                                                                   11962000
   EQUATE COMMA=0, EQUAL=1, SEMICOLON=2;                                11964000
   EQUATE OUTPUTDEV=4;                                                  11966000
   DOUBLE ARRAY PARM(0:5)=Q;                                            11968000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4,         11970000
                FOURTHPARM=PARM+6, FIFTHPARM=PARM+8,SIXTHPARM=PARM+10;  11972000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3, TRDLEN=PARM+5,                  11974000
        FOURTLEN=PARM+7, FIFTHLEN=PARM+9;                               11976000
   INTEGER PARM1=PARM+1, PARM2=PARM+3, PARM3=PARM+5, PARM4=PARM+7,      11978000
           PARM5=PARM+9;                                                11980000
   LOGICAL CLASS;                                                       11982000
   INTEGER SAVESIR,NUMPARMS,ENTRYP,JOBNUM,PRI:=-1,DEVICE:=0;            11984000
   BYTE POINTER PARMPTR;                                                11986000
   BYTE LEN,OLDBYTE;                                                    11988000
   INTEGER CHECKJOB'VALUE;                                     <<04684>>11990000
   INTEGER LASTDEL,CURRDEL;                                             11992000
   INTEGER ARRAY JMATENTRY(0:JMATENTRYSIZE-1);                          11994000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);                        11996000
   INTEGER ARRAY DEVINFO(0:8)=Q;                                        11998000
   INTEGER ARRAY LPDT(*)=DEVINFO+2;                                     12000000
   INTEGER ARRAY LDT(*)=DEVINFO+4;                                      12002000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         12004000
   SUBROUTINE DEF'MOVETODSEG;                                           12006000
   LOGICAL SUBROUTINE GETNEXT;                                          12008000
   BEGIN                                                                12010000
      PARMNUM:=PARMNUM+1;                                               12012000
      IF PARMNUM<NUMPARMS THEN                                          12014000
      BEGIN                                                             12016000
         GETNEXT:=TRUE;                                                 12018000
         LASTDEL:=CURRDEL;                                              12020000
         TOS:=PARM(PARMNUM);                                            12022000
         CURRDEL:=S0.DELIMITER;                                         12024000
         LEN:=TOS&LSR(8);                                               12026000
         @PARMPTR:=TOS;                                                 12028000
      END ELSE GETNEXT:=FALSE;                                          12030000
   END;                                                                 12032000
$PAGE                                                                   12034000
   LOGIMAGE( M'ALTJOB, PARMSP );  << LOG OP COMMAND >>         <<01527>>12036000
   MYCOMMAND(PARMSP,,6,NUMPARMS,PARM); <<PARSE PARAMETERS>>             12038000
   IF NUMPARMS<>3 AND NUMPARMS<>5 THEN                                  12040000
   BEGIN                                                                12042000
      TOS:=ERRNUM:=EXPJAND1PARM;                                        12044000
      IF NUMPARMS = 0 THEN TOS := @PARMSP                               12046000
      ELSE                                                              12048000
      IF NUMPARMS<6 THEN                                                12050000
      BEGIN                                                             12052000
         PARMNUM:=NUMPARMS;                                             12054000
         TOS:=PARM(NUMPARMS-1);                                         12056000
         DEL;                                                           12058000
      END                                                               12060000
      ELSE                                                              12062000
      BEGIN                                                             12064000
         PARMNUM:=6;                                                    12066000
         TOS:=@SIXTHPARM;                                               12068000
      END;                                                              12070000
      CIERR(*,*);                                                       12072000
   END                                                                  12074000
   ELSE                                                                 12076000
   BEGIN                                                                12078000
      IF FIRSTLEN<3 OR FIRSTPARM<>"#" OR                                12080000
      (FIRSTPARM(1)<>"J" LAND FIRSTPARM(1)<>"S") THEN                   12082000
         ERRNUM:=EXPJORSNUM                                             12084000
      ELSE                                                              12086000
      BEGIN                                                             12088000
         JOBNUM:=BINARY(FIRSTPARM(2),FIRSTLEN-2);                       12090000
         IF <> OR NOT(1<=JOBNUM<=%37777) THEN ERRNUM:=BADJOBNUM;        12092000
      END;                                                              12094000
      IF ERRNUM<>0 THEN                                                 12096000
      BEGIN                                                             12098000
         PARMNUM:=1;                                                    12100000
         CIERR(ERRNUM,FIRSTPARM);                                       12102000
         RETURN;                                                        12104000
      END;                                                              12106000
      CURRDEL:=PARM1.DELIMITER;                                         12108000
      PARMNUM:=0;                                                       12110000
      WHILE GETNEXT DO <<PROCESS EACH KEY>>                             12112000
      BEGIN                                                             12114000
         IF PARMPTR="INPRI" AND LEN=5 THEN TOS:=TRUE                    12116000
         ELSE                                                           12118000
         IF PARMPTR="OUTDEV" AND LEN=6 THEN TOS:=FALSE                  12120000
         ELSE                                                           12122000
         BEGIN                                                          12124000
            CIERR(ERRNUM:=EXP1OFINOUT,PARMPTR);                         12126000
            RETURN;                                                     12128000
         END;                                                           12130000
         IF LASTDEL<>SEMICOLON THEN                                     12132000
         BEGIN                                                          12134000
            CIERR(ERRNUM:=EXPSEMICOLON,PARMPTR);                        12136000
            RETURN;                                                     12138000
         END;                                                           12140000
         IF CURRDEL<>EQUAL THEN                                         12142000
         BEGIN                                                          12144000
            CIERR(ERRNUM:=EXPEQUALS,PARMPTR);                           12146000
            RETURN;                                                     12148000
         END;                                                           12150000
         GETNEXT; <<GET PARAMETER FOLLOWING EQUALS>>                    12152000
         IF TOS THEN <<INPRI>>                                          12154000
         BEGIN                                                          12156000
            PRI:=BINARY(PARMPTR,LEN);                                   12158000
            IF <> OR NOT (0<=PRI<=14) THEN                              12160000
            BEGIN                                                       12162000
               CIERR(ERRNUM:=EXP0TO14,PARMPTR);                         12164000
               RETURN;                                                  12166000
            END;                                                        12168000
         END                                                            12170000
         ELSE <<OUTDEV>>                                                12172000
         BEGIN                                                          12174000
            OLDBYTE:=PARMPTR(LEN);                                      12176000
            PARMPTR(LEN):=" "; <<TERMINATE DEV WITH BLANK>>             12178000
            TOS:=GETDEVINFO(PARMPTR,DEVINFO); <<GET INFO ON DEVICE>>    12180000
            PARMPTR(LEN):=OLDBYTE; <<RESTORE DEVICE TERMINATING CHAR.>> 12182000
            IF TOS<>0 THEN <<BAD DEVICE>>                               12184000
            BEGIN                                                       12186000
               CIERR(ERRNUM:=NOSUCHDEV,PARMPTR);                        12188000
               RETURN;                                                  12190000
            END;                                                        12192000
            IF LDT(LDT'DTYPE'M)<>OUTPUTDEV THEN <<DEVICE NOT OUTPUT>>   12194000
            BEGIN                                                       12196000
               CIERR(ERRNUM:=DEVNOTOUTPUT,PARMPTR);                     12198000
               RETURN;                                                  12200000
            END;                                                        12202000
            IF DEVINFO<0 THEN <<GOT DEVICE CLASS>>                      12204000
            BEGIN                                                       12206000
               CLASS:=TRUE;                                             12208000
               DEVICE:=-DEVINFO;                                        12210000
            END                                                         12212000
            ELSE  <<GOT DEVICE #>>                                      12214000
            BEGIN                                                       12216000
               CLASS:=FALSE;                                            12218000
               DEVICE:=DEVINFO;                                         12220000
            END;                                                        12222000
         END;                                                           12224000
      END;                                                              12226000
      IF NOT FINDJOB(JMATENTRY,ENTRYP,JOBNUM,(FIRSTPARM(1)="J"),,,,     12228000
                     SAVESIR) THEN <<NO SUCH JOB>>                      12230000
      BEGIN                                                             12232000
         PARMNUM:=1;                                                    12234000
         CIERR(ERRNUM:=NOSUCHJOB,FIRSTPARM);                            12236000
         RETURN;                                                        12238000
      END;                                                              12240000
   CHECKJOB'VALUE := CHECKJOB(JMATENTRY,PRI);                  <<04684>>12242000
   IF (CHECKJOB'VALUE = 0) OR CHECKALLOW(M'ALTJOB) THEN        <<04684>>12244000
      BEGIN                                                             12246000
         IF JMATENTRY(JMAT'JSTATE)<>JOBWAIT AND                         12248000
            JMATENTRY(JMAT'JSTATE)<>JOBINTRO THEN                       12250000
         BEGIN                                                          12252000
            RELSIR(JMATSIR,SAVESIR);                                    12254000
            PARMNUM:=1;                                                 12256000
            CIERR(ERRNUM:=MUSTWAITORINTRO,FIRSTPARM);                   12258000
            RETURN;                                                     12260000
         END;                                                           12262000
         IF DEVICE<>0 THEN <<CHANGE DEVICE>>                            12264000
         BEGIN                                                          12266000
            JMATENTRY(JMAT'C):=CLASS;                                   12268000
            JMATENTRY(JMAT'JLIST):=DEVICE;                              12270000
         END;                                                           12272000
         IF PRI>=0 THEN JMATENTRY(JMAT'INPRI):=PRI;                     12274000
         MOVETODSEG(JMATDST,ENTRYP,@JMATENTRY,JMATENTRYSIZE);           12276000
         IF PRI>=0 AND JMATENTRY(JMAT'JSTATE)=JOBWAIT THEN              12278000
         BEGIN  <<MUST BE IN CORRECT QUEUE>>                            12280000
            MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);         12282000
            TOS:=JMAT'H'SCHEDHEADP;  <<TOS PARAMS TO AVOID>>            12284000
            TOS:=ENTRYP;             <<SPLIT STACK PROBLEMS>>           12286000
            EXCHANGEDB(JMATDST);<<DELINKENTRY NEEDS JMAT>>              12288000
            DELINKENTRY(*,*);                                           12290000
            EXCHANGEDB(0);                                              12292000
            MOVEFROMDSEG(@JMATENTRY,JMATDST,ENTRYP,JMATENTRYSIZE);      12294000
            JMATENTRY(JMAT'JSTATE):=JOBINTRO; <<RE-INTRODUCE JOB>>      12296000
            MOVETODSEG(JMATDST,ENTRYP,@JMATENTRY,JMATENTRYSIZE);        12298000
            TOS:=ENTRYP; <<SCHEDULEJOB EXPECT INTEGER POINTER >>        12300000
            SCHEDULEJOB(*);<<AND ENTRYP IS SIMPLE INTEGER>>             12302000
         END;                                                           12304000
         IF DEVICE<>0 AND PRI<0 THEN <<FORCE JOB SCHEDULING>>           12306000
         BEGIN                                                          12308000
            DISABLE;                                                    12310000
            ABSOLUTE(JOBSYNC).READYFLAG:=TRUE;                          12312000
            ENABLE;                                                     12314000
            AWAKE(SYSPROC(UCOP),%20,0);                                 12316000
         END;                                                           12318000
      END                                                               12320000
      ELSE                                                              12322000
      BEGIN                                                             12324000
         RELSIR(JMATSIR,SAVESIR);                                       12326000
         PARMNUM:=1;                                                    12328000
         IF CHECKJOB'VALUE = 1                                 <<04684>>12330000
            THEN CIERR(ERRNUM :=NOTUSERSJOB,FIRSTPARM)         <<04684>>12332000
            ELSE CIERR(ERRNUM :=ILLEGALVALUE,FIRSTPARM);       <<04684>>12334000
         RETURN;                                                        12336000
      END;                                                              12338000
      RELSIR(JMATSIR,SAVESIR);                                          12340000
   END;                                                                 12342000
END;                                                                    12344000
$PAGE "VMOUNT EXECUTOR"                                                 12346000
$CONTROL SEGMENT=OPMED                                                  12348000
PROCEDURE CXVMOUNT EXECUTORHEAD;                                        12350000
BEGIN                                                                   12352000
                                                                        12354000
<<    THE SYNTAX OF THIS COMMAND IS:                                  >>12356000
<<    VMOUNT ON[,AUTO][;ALL]                                          >>12358000
<<    VMOUNT OFF[;ALL]                                                >>12360000
                                                                        12362000
   DOUBLE DL:=[8/",",8/";",8/CR,8/0]D;                                  12364000
   BYTE ARRAY DL'(*)=DL;                                                12366000
   DOUBLE ARRAY PARM(0:3)=Q;                                            12368000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4,         12370000
                FOURTHPARM=PARM+6;                                      12372000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3, TRDLEN=PARM+5;                  12374000
   EQUATE COMMA=0, SEMICOLON=1;                                         12376000
   INTEGER NUMPARMS,VMOUNT:=0,PARM1=PARM+1, PARM2=PARM+3;               12378000
   LOGICAL JMATWORD;                                           <<00716>>12380000
   INTEGER SAVESIR;                                            <<00716>>12382000
   SUBROUTINE DEF'MOVEFROMDSEG;                                <<00716>>12384000
   SUBROUTINE DEF'MOVETODSEG;                                  <<00716>>12386000
                                                                        12388000
   LOGIMAGE( M'VMOUNT, PARMSP );  << LOG OP COMMAND >>         <<01527>>12390000
   MYCOMMAND(PARMSP,DL',4,NUMPARMS,PARM);<<PARSE PARAMETERS>>           12392000
   IF NUMPARMS<1 THEN <<MUST HAVE AT LEAST ON/OFF>>                     12394000
   BEGIN                                                                12396000
      PARMNUM:=1;                                                       12398000
      CIERR(ERRNUM:=EXP1OFONOFF,PARMSP);                                12400000
      RETURN;                                                           12402000
   END;                                                                 12404000
   IF FIRSTLEN=2 AND FIRSTPARM="ON" THEN <<HAVE ON>>                    12406000
   BEGIN                                                                12408000
      VMOUNT.ONOFFFLG:=1;                                               12410000
      IF NUMPARMS>1 AND PARM1.DELIMITER=COMMA THEN <<EXPECT "AUTO">>    12412000
      BEGIN                                                             12414000
         IF SNDLEN<>4 OR SNDPARM<>"AUTO" THEN                           12416000
         BEGIN                                                          12418000
            PARMNUM:=2;                                                 12420000
            CIERR(ERRNUM:=EXPAUTO,SNDPARM);                             12422000
            RETURN;                                                     12424000
            END                                                         12426000
         ELSE                                                           12428000
         BEGIN                                                          12430000
            VMOUNT.AUTOFLG:=1;                                          12432000
            PARM(0):=PARM(1);                                           12434000
            PARM(1):=PARM(2);                                           12436000
            NUMPARMS:=NUMPARMS-1;                                       12438000
         END;                                                           12440000
      END;                                                              12442000
   END                                                                  12444000
   ELSE <<MUST FIND "OFF">>                                             12446000
   IF FIRSTLEN<>3 OR FIRSTPARM<>"OFF" THEN <<NEITHER ON OR OFF>>        12448000
   BEGIN                                                                12450000
      PARMNUM:=1;                                                       12452000
      CIERR(ERRNUM:=EXP1OFONOFF,FIRSTPARM);                             12454000
      RETURN;                                                           12456000
   END;                                                                 12458000
   IF NUMPARMS=2 THEN <<EXPECT ;ALL>>                                   12460000
      IF PARM1.DELIMITER<>SEMICOLON THEN                                12462000
      BEGIN                                                             12464000
         PARMNUM:=2;                                                    12466000
         CIERR(ERRNUM:=EXPSEMICOLON,FIRSTPARM(FIRSTLEN));               12468000
         RETURN;                                                        12470000
      END                                                               12472000
      ELSE                                                              12474000
         IF SNDLEN<>3 OR SNDPARM<>"ALL" THEN                            12476000
         BEGIN                                                          12478000
            PARMNUM:=2;                                                 12480000
            CIERR(ERRNUM:=EXPALL,SNDPARM);                              12482000
            RETURN;                                                     12484000
         END                                                            12486000
         ELSE VMOUNT.ALLFLG:=1                                          12488000
   ELSE                                                                 12490000
   IF NUMPARMS>2 THEN                                                   12492000
   BEGIN                                                                12494000
      PARMNUM:=3;                                                       12496000
      CIERR(ERRNUM:=EXP1OFONOFF,SNDPARM(SNDLEN));                       12498000
      RETURN;                                                           12500000
   END;                                                                 12502000
   ABSOLUTE(VMOUNTCNTL):=VMOUNT;                                        12504000
   SAVESIR:=GETSIR(JMATSIR);                                   <<00716>>12506000
   MOVEFROMDSEG(@JMATWORD,JMATDST,1,1);                        <<00716>>12508000
   JMATWORD.(0:8):=VMOUNT;                                     <<00716>>12510000
   MOVETODSEG(JMATDST,1,@JMATWORD,1);                          <<00716>>12512000
   WRITEDSEG(JMATDST);                                         <<00716>>12514000
   RELSIR(JMATSIR,SAVESIR);                                    <<00716>>12516000
END;                                                                    12518000
$PAGE "LMOUNT & DISMOUNT EXECUTORS"                                     12520000
$CONTROL SEGMENT=OPMED                                                  12522000
PROCEDURE CXLMOUNT EXECUTORHEAD;                                        12524000
BEGIN                                                                   12526000
   ENTRY CXLDISMOUNT;                                                   12528000
                                                                        12530000
<<    THE SYNTAX OF THESE COMMANDS ARE:                               >>12532000
<<       LMOUNT SETNAME.GROUP.ACCOUNT[;GEN=GENERATION]                >>12534000
<<       LMOUNT *.GROUP.ACCOUNT[;GEN=GENERATION]                      >>12536000
<<       LDISMOUNT SETNAME.GROUP.ACCOUNT                              >>12538000
<<       LDISMOUNT *.GROUP.ACCOUNT                                    >>12540000
                                                                        12542000
   EQUATE PERIOD=0, SEMICOLON=1, EQUAL=2, COMMA=3, EOL=4;               12544000
   BYTE ARRAY DL'(0:4);                                                 12546000
   DOUBLE ARRAY PARM(0:5)=Q;                                            12548000
   LOGICAL LMOUNT:=TRUE, ALPHABETIC, NUMERAL, NOT'ALPHANUMERIC;         12550000
   BYTE ARRAY SETNAME(0:8), GROUPNAME(0:8), ACCTNAME(0:8);              12552000
   INTEGER NUMPARMS,GENERATION:=-1,REQUEST'TYPE:=4,I;                   12554000
   BYTE POINTER CURRENT'PARM;                                           12556000
   INTEGER CURRENT'LENGTH;                                              12558000
   INTEGER CURRENT'DELIMITER;                                           12560000
                                                                        12562000
   LOGICAL SUBROUTINE CHECKNAME;                                        12564000
   BEGIN                                                                12566000
      COMMENT                                                           12568000
         THIS SUBROUTINE RETURNS TRUE IF STRING IN CURRENT PARAMETER    12570000
      IS A VALID NAME (1 TO 8 CHARS WITH LEADING ALPHA AND NO SPECIALS. 12572000
      ;                                                                 12574000
      CHECKNAME:=FALSE;                                                 12576000
      IF (1<=CURRENT'LENGTH<=8) AND CURRENT'PARM=ALPHA                  12578000
         AND NOT NOT'ALPHANUMERIC THEN CHECKNAME:=TRUE                  12580000
      ELSE CIERR(ERRNUM:=INVALIDNAME,CURRENT'PARM);                     12582000
   END;                                                                 12584000
                                                                        12586000
<<CXLMOUNT ENTRY POINT>>                                                12588000
   GO TO MAINCODE;                                                      12590000
                                                                        12592000
<<CXLDISMOUNT ENTRY POINT>>                                             12594000
CXLDISMOUNT:                                                            12596000
   LMOUNT:=FALSE;                                                       12598000
                                                                        12600000
MAINCODE:                                                               12602000
   LOGIMAGE( ( IF LMOUNT                                       <<01527>>12604000
                  THEN M'LMOUNT                                <<01527>>12606000
                  ELSE M'LDISMOUNT ), PARMSP );                <<01527>>12608000
   MOVE DL':=(".;=,",CR);<<SET UP DELIMITERS>>                          12610000
   MYCOMMAND(PARMSP,DL',6,NUMPARMS,PARM);<<PARSE PARAMETERS>>           12612000
   IF NUMPARMS<3 THEN <<MUST HAVE AT LEAST SETNAME.GROUP.ACCT>>         12614000
   BEGIN                                                                12616000
      PARMNUM:=NUMPARMS;                                                12618000
      CIERR(ERRNUM:=REQSETGRPACCT);                                     12620000
   END                                                                  12622000
   ELSE                                                                 12624000
   IF LMOUNT AND NUMPARMS<>5 AND NUMPARMS<>3 THEN                       12626000
   BEGIN                                                                12628000
      PARMNUM:=4;                                                       12630000
      CIERR(ERRNUM:=LMHAS5PARMS);                                       12632000
   END                                                                  12634000
   ELSE                                                                 12636000
   IF NOT LMOUNT AND NUMPARMS<>3 THEN                                   12638000
   BEGIN                                                                12640000
      PARMNUM:=4;                                                       12642000
      CIERR(ERRNUM:=LDMEXP3PARMS);                                      12644000
   END                                                                  12646000
   ELSE                                                                 12648000
   BEGIN                                                                12650000
      SETNAME:=" "; <<INITIALIZE SETNAME, GROUPNAME, ACCTNAME>>         12652000
      MOVE SETNAME(1):=SETNAME,(8);                                     12654000
      MOVE GROUPNAME:=SETNAME,(9);                                      12656000
      MOVE ACCTNAME:=SETNAME,(9);                                       12658000
      I:=-1;                                                            12660000
      WHILE (I:=I+1)<NUMPARMS DO <<SCAN THRU EACH PARAMETER>>           12662000
      BEGIN                                                             12664000
         TOS:=PARM(I);                                                  12666000
         CURRENT'DELIMITER:=S0.DELIMITER;                               12668000
         NOT'ALPHANUMERIC:=(S0.SPECIAL'CHAR=1);                         12670000
         NUMERAL:=(S0.NUMERICAL'CHAR=1);                                12672000
         ALPHABETIC:=(S0.ALPHA'CHAR=1);                                 12674000
         CURRENT'LENGTH:=TOS&LSR(8);                                    12676000
         @CURRENT'PARM:=TOS;                                            12678000
         CASE I OF                                                      12680000
         BEGIN                                                          12682000
                                                                        12684000
            <<SETNAME PARAMETER>>                                       12686000
                                                                        12688000
            BEGIN                                                       12690000
               IF CURRENT'DELIMITER<>PERIOD THEN                        12692000
               BEGIN                                                    12694000
                  PARMNUM:=1;                                           12696000
                  CIERR(ERRNUM:=SETNAMEPERIOD,                          12698000
                        CURRENT'PARM(CURRENT'LENGTH));                  12700000
                  RETURN;                                               12702000
               END;                                                     12704000
               IF NOT'ALPHANUMERIC THEN <<POSSIBLE "*">>                12706000
                  IF CURRENT'PARM<>"*" OR CURRENT'LENGTH<>1 THEN        12708000
                  BEGIN                                                 12710000
                     PARMNUM:=1;                                        12712000
                     CIERR(ERRNUM:=BADSETNAME,CURRENT'PARM);            12714000
                     RETURN;                                            12716000
                  END                                                   12718000
                  ELSE                                                  12720000
               ELSE                                                     12722000
               IF NOT CHECKNAME THEN RETURN;                            12724000
               MOVE SETNAME:=CURRENT'PARM,(CURRENT'LENGTH);             12726000
            END;                                                        12728000
                                                                        12730000
            <<GROUP NAME>>                                              12732000
                                                                        12734000
            IF CURRENT'DELIMITER<>PERIOD THEN                           12736000
            BEGIN                                                       12738000
               PARMNUM:=2;                                              12740000
               CIERR(ERRNUM:=GROUPPERIOD,CURRENT'PARM(CURRENT'LENGTH)); 12742000
               RETURN;                                                  12744000
            END                                                         12746000
            ELSE                                                        12748000
            IF CHECKNAME THEN MOVE GROUPNAME:=CURRENT'PARM,             12750000
               (CURRENT'LENGTH) ELSE RETURN;                            12752000
                                                                        12754000
            <<ACCT NAME>>                                               12756000
                                                                        12758000
            IF CURRENT'DELIMITER<>EOL AND CURRENT'DELIMITER<>SEMICOLON  12760000
            THEN                                                        12762000
            BEGIN                                                       12764000
               PARMNUM:=3;                                              12766000
               CIERR(ERRNUM:=EXPSEMICOLON,CURRENT'PARM(CURRENT'LENGTH));12768000
               RETURN;                                                  12770000
            END                                                         12772000
            ELSE                                                        12774000
            IF CHECKNAME THEN MOVE ACCTNAME:=CURRENT'PARM,              12776000
               (CURRENT'LENGTH) ELSE RETURN;                            12778000
                                                                        12780000
            <<;GEN=>>                                                   12782000
                                                                        12784000
            IF CURRENT'LENGTH<>3 OR CURRENT'PARM<>"GEN" THEN            12786000
            BEGIN                                                       12788000
               PARMNUM:=4;                                              12790000
               CIERR(ERRNUM:=EXPGENERATION,CURRENT'PARM);               12792000
               RETURN;                                                  12794000
            END                                                         12796000
            ELSE                                                        12798000
            IF CURRENT'DELIMITER<>EQUAL THEN                            12800000
            BEGIN                                                       12802000
               PARMNUM:=4;                                              12804000
               CIERR(ERRNUM:=EXPEQUALS,CURRENT'PARM(CURRENT'LENGTH));   12806000
               RETURN;                                                  12808000
            END;                                                        12810000
                                                                        12812000
            <<GENERATION NUMBER>>                                       12814000
                                                                        12816000
            BEGIN                                                       12818000
               GENERATION:=BINARY(CURRENT'PARM,CURRENT'LENGTH);         12820000
               IF <> THEN                                               12822000
               BEGIN                                                    12824000
                  PARMNUM:=5;                                           12826000
                  CIERR(ERRNUM:=BADGENERATION,CURRENT'PARM);            12828000
                  RETURN;                                               12830000
               END;                                                     12832000
            END;                                                        12834000
         END;                                                           12836000
      END;                                                              12838000
      IF LMOUNT THEN MOUNT(SETNAME,GROUPNAME,ACCTNAME,                  12840000
                        REQUEST'TYPE,GENERATION)                        12842000
      ELSE DISMOUNT(SETNAME,GROUPNAME,ACCTNAME,REQUEST'TYPE);           12844000
      IF REQUEST'TYPE<>0 THEN <<ERROR DURING MOUNT/DISMOUNT>>           12846000
         GENMSG(GENERALSET,MOUNTERRS+(IF LMOUNT THEN 0 ELSE 1),         12848000
                %10000,REQUEST'TYPE);                                   12850000
   END;                                                                 12852000
END;                                                                    12854000
$PAGE "DSCONTROL & MPLINE & MRJECONTROL EXECUTORS"                      12856000
$CONTROL SEGMENT=OPLOW                                                  12858000
PROCEDURE CXDSCONTROL EXECUTORHEAD;                                     12860000
BEGIN                                                                   12862000
   ENTRY CXMPLINE,CXMRJECONTROL;                                        12864000
   INTEGER ARRAY XFER(0:2)=PB:=DSCONTROL,MPLINE,MRJECONTROL;            12866000
   INTEGER ROUTINE;                                                     12868000
   INTEGER ARRAY NOTHERE(0:2)=PB:=NODS,NOMP,NOMRJE;                     12870000
                                                                        12872000
<<CXDSCONTROL ENTRY POINT>>                                             12874000
   ROUTINE:=0;                                                          12876000
   GO TO MAINCODE;                                                      12878000
                                                                        12880000
<<CXMPLINE ENTRY POINT>>                                                12882000
CXMPLINE:                                                               12884000
   ROUTINE:=1;                                                          12886000
   GO TO MAINCODE;                                                      12888000
                                                                        12890000
<<CXMRJECONTROL ENTRY POINT>>                                           12892000
CXMRJECONTROL:                                                          12894000
   ROUTINE:=2;                                                          12896000
                                                                        12898000
MAINCODE:                                                               12900000
   CASE *ROUTINE OF                                            <<01527>>12902000
   BEGIN               << LOG OP COMMAND >>                    <<01527>>12904000
                                                               <<01527>>12906000
      LOGIMAGE( M'DSCONTROL, PARMSP );                         <<01527>>12908000
      LOGIMAGE( M'MPLINE, PARMSP );                            <<01527>>12910000
      LOGIMAGE( M'MRJECONTROL, PARMSP );                       <<01527>>12912000
                                                               <<01527>>12914000
   END;                                                        <<01527>>12916000
                                                               <<01527>>12918000
   IF ABSOLUTE(XFER(ROUTINE))=0 THEN <<SUBSYSTEM DOESN'T EXIST>>        12920000
      CIERR(ERRNUM:=NOTHERE(ROUTINE))                                   12922000
   ELSE                                                                 12924000
   BEGIN                                                                12926000
      TOS:=@PARMSP; <<BUILD PARAMETER LIST FOR CI EXECUTOR'S>>          12928000
      TOS:=@ERRNUM;                                                     12930000
      TOS:=@PARMNUM;                                                    12932000
      TOS:=ABSOLUTE(XFER(ROUTINE)); <<PLABEL FOR PCAL>>                 12934000
      ASSEMBLE(PCAL 0);                                                 12936000
   END;                                                                 12938000
END;                                                                    12940000
$PAGE "MON & MOFF EXECUTORS"                                            12942000
$CONTROL SEGMENT=OPLOW                                                  12944000
PROCEDURE CXMON EXECUTORHEAD;                                           12946000
BEGIN                                                                   12948000
   ENTRY CXMOFF;                                                        12950000
                                                                        12952000
<<    THE SYNTAX OF THIS COMMANDS ARE:                                >>12954000
<<       MON LDEV[;E=MASKBIT1,...,MASKBITN]                           >>12956000
<<       MOFF                                                         >>12958000
                                                                        12960000
   INTEGER ARRAY MASK(0:1)=Q;                                           12962000
   INTEGER NUMPARMS,LDEV,SYSBUF1,SYSBUF2;                               12964000
                                                                        12966000
   EQUATE MAXPARMS=28; <<LDEV, "E=", + 26 MASKBITS>>                    12968000
                                                                        12970000
   EQUATE COMMA=0, EQUAL=1, SEMICOLON=2, EOL=3;                         12972000
   EQUATE DST=2,DSTSIZE=4;                                     <<00575>>12974000
   DOUBLE ARRAY PARM(0:MAXPARMS)=Q;                                     12976000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                                      12978000
   ARRAY BUF(0:5);                                             <<00575>>12980000
   BYTE ARRAY MIOPROC(*)=BUF;                                  <<00575>>12982000
   INTEGER PARM1=PARM+1, PARM2=PARM+3;                                  12984000
   BYTE POINTER CURRENT'PARM;                                           12986000
   INTEGER CURRENT'LENGTH;                                              12988000
   INTEGER CURRENT'DELIMITER;                                           12990000
   INTEGER I,N;                                                         12992000
   INTEGER SAVECC =I;                                          <<00575>>12994000
   INTEGER MEASIOCODE;                                         <<00575>>12996000
   INTEGER SEGNUM;                                             <<00575>>12998000
   INTEGER IDENT;                                              <<00575>>13000000
   INTEGER PLABEL;                                             <<00575>>13002000
   INTEGER POINTER MEASBUF;                                    <<00575>>13004000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         13006000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3;                                 13008000
   DOUBLE TOTAL'LINKED'MEMORY;                                          13010000
   LOGICAL ON:=TRUE;                                                    13012000
   DEFINE MMSTAT'ENABLED = LOGICAL(MEAS'FLAG.(0:1))#,          <<00575>>13014000
          EOT  = LOGICAL(MEAS'FLAG.(13:1))    #,               <<00575>>13016000
          IOERROR = LOGICAL(MEAS'FLAG.(12:1))#;                <<00575>>13018000
$PAGE                                                                   13020000
   COMMENT                                                              13022000
      A GREAT DEAL OF THIS PROCEDURE EXECUTES WITH DB POINTING          13024000
   AT SYSTEM GLOBAL. THE FOLLOWING VARIABLES ARE SYSTEM GLOBAL          13026000
   RELATIVE.                                                            13028000
   ;                                                                    13030000
   INTEGER POINTER BANK'TABLE=DB+%50;                                   13032000
   INTEGER NO'OF'BANKS=DB+%47;                                          13034000
   INTEGER DFC=DB+%32, DFS=DB+%33;                                      13036000
   INTEGER UPDATEL = DB+%114,                                  <<00575>>13038000
           FIXL    = DB+%115,                                  <<00575>>13040000
           VERSION = DB+%116;                                  <<00575>>13042000
   INTEGER PROGEN=DB+%141, MAM=DB+%142, UCOP=DB+%143,                   13044000
           PFAIL=DB+%144, DEVREC=DB+%145, DRUSG=DB+%146,                13046000
           STMSG=DB+%147, LOG=DB+%150, LOAD=DB+%151,                    13048000
           IOMESSPROC=DB+%152,SYSIOPROC=DB+%153,               <<01362>>13050000
           MEMLOGP=DB+%154;                                    <<01362>>13052000
                                                               <<01549>>13054000
                                                               <<01549>>13056000
LOGICAL    MEAS'FLAG = DB+%267;                                <<01549>>13058000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         13062000
$PAGE                                                                   13064000
<< CXMON ENTRY POINT>>                                                  13066000
   GO TO MAINCODE;                                                      13068000
                                                                        13070000
<< CXMOFF ENTRY POINT>>                                                 13072000
CXMOFF:                                                                 13074000
   ON:=FALSE;                                                           13076000
                                                                        13078000
MAINCODE:                                                               13080000
   LOGIMAGE( ( IF ON                                           <<01527>>13082000
                  THEN M'MON                                   <<01527>>13084000
                  ELSE M'MOFF ), PARMSP );                     <<01527>>13086000
   MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARM);<<PARSE PARAMETER>>      13088000
   IF ON THEN                                                           13090000
   BEGIN  << ENABLE >>                                         <<00575>>13092000
      TOS := SETSYSDB;                                         <<00575>>13094000
      IF MMSTAT'ENABLED THEN                                   <<00575>>13096000
      BEGIN                                                    <<00575>>13098000
        RESETDB(*);                                            <<00575>>13100000
        CIERR(ERRNUM:=SYSMONENABLED);                          <<00575>>13102000
        RETURN;                                                <<00575>>13104000
      END;                                                     <<00575>>13106000
      RESETDB(*);                                              <<00575>>13108000
      IF NUMPARMS>MAXPARMS THEN <<TOO MANY PARMS>>                      13110000
      BEGIN                                                             13112000
         CIERR(ERRNUM:=MONMAXPARM,,%10000,MAXPARMS-2);                  13114000
         RETURN;                                                        13116000
      END;                                                     <<00575>>13118000
                                                               <<00575>>13120000
      LDEV :=VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,ERRNUM,PARMNUM,1);<<00575>>13122000
      IF <> THEN RETURN;                                       <<00575>>13124000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MASTEROP INVALID>><<00575>>13126000
      IF NUMPARMS=0 THEN <<MON REQUIRES AT LEAST ONE PARAMETER>>        13128000
      BEGIN                                                             13130000
         CIERR(ERRNUM:=MONREQLDEV);                                     13132000
         RETURN;                                                        13134000
      END;                                                     <<00575>>13136000
      IF NUMPARMS = 1 THEN   << DEFAULT EVENT GROUP MASK>>     <<00575>>13138000
      BEGIN                                                    <<00575>>13140000
          MASK    := %44020;   <<GROUPS 1,4,11 >>              <<00575>>13142000
          MASK(1) := %3001;    <<GROUPS 21,22  >>              <<00575>>13144000
      END                                                               13146000
      ELSE <<GO PROCESS ;E=>>                                           13148000
      BEGIN                                                             13150000
         IF NUMPARMS=2 OR SNDLEN<>1 OR SNDPARM<>"E"                     13152000
            OR PARM2.DELIMITER<>EQUAL OR PARM1.DELIMITER<>SEMICOLON THEN13154000
            BEGIN                                                       13156000
            PARMNUM:=2;                                                 13158000
            CIERR(ERRNUM:=EXPSEMI'E'EQUALS,SNDPARM);                    13160000
            RETURN;                                                     13162000
         END;                                                           13164000
         MASK:=0;                                                       13166000
         MASK(1) := 0;                                         <<00575>>13168000
         I:=2; <<SCAN THE MASK BIT PARAMETERS>>                         13170000
         DO                                                             13172000
         BEGIN                                                          13174000
            TOS:=PARM(I); <<GET PARAMETER DESCRIPTION>>                 13176000
            CURRENT'DELIMITER:=S0.DELIMITER;                            13178000
            CURRENT'LENGTH:=TOS&LSR(8);                                 13180000
            @CURRENT'PARM:=TOS;                                         13182000
            IF CURRENT'DELIMITER<> COMMA AND CURRENT'DELIMITER<>EOL THEN13184000
            BEGIN                                                       13186000
               PARMNUM:=I+1;                                            13188000
               CIERR(ERRNUM:=MASKCOMMA,CURRENT'PARM(CURRENT'LENGTH));   13190000
               RETURN;                                                  13192000
            END;                                                        13194000
            IF CURRENT'LENGTH=0 THEN                                    13196000
               CIERR(ERRNUM:=-IGNOREDNULL,CURRENT'PARM)                 13198000
            ELSE                                                        13200000
            BEGIN                                                       13202000
               N:=BINARY(CURRENT'PARM,CURRENT'LENGTH);                  13204000
               IF <> OR NOT(0<=N<=25) THEN <<BAD MASK>>                 13206000
               BEGIN                                                    13208000
                  PARMNUM:=I+1;                                         13210000
                  CIERR(ERRNUM:=BADMASK,CURRENT'PARM);                  13212000
                  RETURN;                                               13214000
               END;                                                     13216000
               TOS:=MASK(N.(11:1));                                     13218000
               X:=N.(12:4);                                             13220000
               ASSEMBLE(TSBC 0,X); <<SET MASK BIT>>                     13222000
               MASK(N.(11:1)):=TOS;                                     13224000
            END;                                                        13226000
         END                                                            13228000
         UNTIL (I:=I+1)>=NUMPARMS;                                      13230000
                                                               <<00575>>13232000
      END;                                                     <<00575>>13234000
$PAGE                                                                   13236000
                                                                        13238000
<< HAVE COMPLETELY PARSED THE PARAMETERS, NOW START UP MONITORING >>    13240000
                                                               <<00575>>13242000
                                                               <<00575>>13244000
<< GET A DATA SEG. FOR BUFFER>>                                <<00575>>13246000
                                                               <<00575>>13248000
      SEGNUM := GETDATASEG(1024,1024);                         <<00575>>13250000
      IF <> THEN   <<CANT GET DSEG BUFFER>>                    <<00575>>13252000
      BEGIN                                                    <<00575>>13254000
         CIERR(ERRNUM:=CANTGETBUF);                            <<00575>>13256000
         RETURN;                                               <<00575>>13258000
      END;                                                     <<00575>>13260000
                                                               <<00575>>13262000
<< Lock the data segment in its bank.  Note:  the bank    >>   <<02726>>13264000
<< number in LOCKSEG is ignored (with MPE IV).            >>   <<02726>>13266000
                                                               <<00575>>13268000
      LOCKSEG(SEGNUM,5,0);                                     <<00575>>13270000
      IF <> THEN                                               <<00575>>13272000
      BEGIN                                                    <<00575>>13274000
         RELDATASEG(SEGNUM);                                   <<00575>>13276000
         CIERR(ERRNUM:=CANTGETBUF);                            <<00575>>13278000
         RETURN;                                               <<00575>>13280000
      END;                                                     <<00575>>13282000
                                                               <<00707>>13284000
<<  FREEZE DATA SEG  >>                                        <<00707>>13286000
                                                               <<00707>>13288000
      FREEZE(SEGNUM,5,0);                                      <<00707>>13290000
                                                               <<00707>>13292000
<< ENABLE MEASIO >>                                            <<00575>>13294000
                                                               <<00575>>13296000
      CXMIOENABLE(PARMSP,ERRNUM,PARMNUM);                      <<00575>>13298000
      IF <> THEN     <<MIOENABLE FAIL>>                        <<00575>>13300000
      BEGIN                                                    <<00575>>13302000
         UNFREEZE(SEGNUM,5,0);                                 <<00707>>13304000
         UNLOCKSEG(SEGNUM,5,0);                                <<00575>>13306000
         RELDATASEG(SEGNUM);                                   <<00575>>13308000
         RETURN;                                               <<00575>>13310000
      END;                                                     <<00575>>13312000
                                                               <<00575>>13314000
      MOVE MIOPROC := "MEASIO ";                               <<00575>>13316000
      IDENT:= LOADPROC(MIOPROC,0,PLABEL); <<LOAD MEASIO>>      <<00575>>13318000
                                                               <<00575>>13320000
<< REWIND TAPE >>                                              <<00575>>13322000
                                                               <<00575>>13324000
      TOS := SETSYSDB;                                         <<00575>>13326000
      TOS := 0;  <<SET UP FOR RESULT>>                         <<00575>>13328000
      <<SET UP MEASIO PARAMETERS >>                            <<00575>>13330000
      TOS := LDEV;                                             <<00575>>13332000
      TOS := 3;                                                <<00575>>13334000
      ASSEMBLE(ZERO;DZRO);                                     <<00575>>13336000
      TOS := PLABEL;                                           <<00575>>13338000
      ASSEMBLE(PCAL 0);  << CALL MEASIO>>                      <<00575>>13340000
      MEASIOCODE:=TOS;                                         <<00575>>13342000
      PUSH(STATUS);                                            <<00575>>13344000
      SAVECC := TOS.(6:2); <<SAVE CC>>                         <<00575>>13346000
      UNLOADPROC(IDENT);                                       <<00575>>13348000
      IF SAVECC = CCL THEN                                     <<00575>>13350000
      BEGIN                                                    <<00575>>13352000
        RESETDB(*);                                            <<00575>>13354000
        CIERR(DEVICEERROR);                                    <<00575>>13356000
        UNFREEZE(SEGNUM,5,0);                                  <<00707>>13358000
        UNLOCKSEG(SEGNUM,5,0);                                 <<00575>>13360000
        RELDATASEG(SEGNUM);                                    <<00575>>13362000
        CXMIOMONOFF(PARMSP,LDEV,PARMNUM);                      <<00575>>13364000
        RETURN;                                                <<00575>>13366000
      END;                                                     <<00575>>13368000
                                                                        13370000
<< INIT SYSDB VALUES >>                                        <<00575>>13372000
                                                               <<00575>>13374000
      MEAS'MSK0 := 0;                                          <<00575>>13376000
      MEAS'MSK1 := %1000;   <<TEMPORARY>>                      <<00575>>13378000
      MEAS'LDEV := LDEV;                                       <<00575>>13380000
   << MEAS'BUF0 is the absolute address of the buffer. >>      <<02726>>13382000
      MEAS'BANK := ABS( ABS(DST) + SEGNUM*DSTSIZE + 2 );       <<02726>>13384000
      MEAS'BUF0 := ABS( ABS(DST) + SEGNUM*DSTSIZE + 3 );       <<02726>>13386000
      MEAS'PLAB := PLABEL; <<PLABEL OF MEASIO>>                <<00575>>13388000
      MEAS'IDX := 0;  <<INIT BUFF INDEX>>                      <<00575>>13390000
      MEAS'FLAG  := %100001;  << INIT FLAGS >>                 <<00575>>13392000
      MEAS'DSTN := SEGNUM;                                     <<00575>>13394000
                                                               <<00575>>13396000
<< CALCULATE TOTAL LINKED MEMORY >>                                     13398000
                                                                        13400000
      I:=0;                                                             13402000
      TOTAL'LINKED'MEMORY:=0D;                                          13404000
      DO                                                                13406000
      BEGIN                                                             13408000
         TOS:=0;                                                        13410000
         TOS:=BANK'TABLE(I*6+1); <<GET BANK FIRST ADDR>>                13412000
         TOS:=BANK'TABLE(I*6)+4; <<GET LAST ADDR+4>>                    13414000
         TOS:=LOGICAL(TOS)-TOS;  <<DO 16-BIT SUBTRACT>>                 13416000
         TOTAL'LINKED'MEMORY:=TOTAL'LINKED'MEMORY+TOS;                  13418000
      END                                                               13420000
      UNTIL (I:=I+1)>NO'OF'BANKS; <<UNTIL SCANNED ALL BANKS>>           13422000
                                                               <<00575>>13424000
<< LOG EVENTS>>                                                <<00575>>13426000
                                                               <<00575>>13428000
      TOS := -228;  <<228 INSTEAD OF 220, CRIPPLE MONITOR>>    <<01575>>13430000
      TOS := CALENDAR;                                         <<00575>>13432000
      TOS := CLOCK;                                            <<00575>>13434000
      MMSTAT(*,*,*,*);  << TIME STAMP>>                        <<00575>>13436000
      MMSTAT(-221,MASK,MASK(1),0);                             <<00575>>13438000
      MMSTAT(-222,VERSION,FIXL,UPDATEL);                       <<00575>>13440000
      MMSTAT(-223,DFC,DFS,LOGICAL(TOTAL'LINKED'MEMORY&DLSR(4)));        13442000
                                                               <<00575>>13444000
      MMSTAT(-224,PROGEN,MAM,UCOP);                            <<00575>>13446000
      MMSTAT(-225,PFAIL,DEVREC,DRUSG);                         <<00575>>13448000
      MMSTAT(-226,STMSG,LOG,LOAD);                             <<00575>>13450000
      MMSTAT(-227,IOMESSPROC,SYSIOPROC,MEMLOGP);               <<00575>>13452000
                                                               <<00575>>13454000
<< RESET MASK TO PROPER EVENT GROUPS>>                         <<00575>>13456000
                                                               <<00575>>13458000
      MEAS'MSK0 := MASK;                                       <<00575>>13460000
      MEAS'MSK1 := MASK(1);                                    <<00575>>13462000
      RESETDB(*);                                              <<00575>>13464000
      CIERR(ERRNUM:=MONENABLED);                               <<00575>>13466000
   END                                                         <<00575>>13468000
$PAGE                                                          <<00575>>13470000
   ELSE                                                        <<00575>>13472000
<< PROCESS MONITOR OFF >>                                      <<00575>>13474000
   BEGIN                                                       <<00575>>13476000
      IF NUMPARMS<>0 THEN CIERR(ERRNUM:=WARNXPARMSIGNORED);    <<00575>>13478000
      TOS := SETSYSDB;  <<SWITCH DB TO SYSGLOBAL >>            <<00575>>13480000
      LDEV := MEAS'LDEV;                                       <<00575>>13482000
      SEGNUM := MEAS'DSTN;  <<SAVE SEGMENT NUMBER>>            <<00575>>13484000
      PLABEL := MEAS'PLAB;  <<MEASIO PLABEL>>                  <<00575>>13486000
                                                               <<00575>>13488000
<< VERIFY SYSMON ENABLED >>                                    <<00575>>13490000
                                                               <<00575>>13492000
      IF NOT MMSTAT'ENABLED THEN                               <<00575>>13494000
      BEGIN                                                    <<00575>>13496000
        RESETDB(*);                                            <<00575>>13498000
        CIERR(ERRNUM:=NOTSYSMON);                              <<00575>>13500000
        RETURN;                                                <<00575>>13502000
      END;                                                     <<00575>>13504000
                                                               <<00575>>13506000
<< CHECK FOR ERRORS >>                                         <<00575>>13508000
                                                               <<00575>>13510000
      IF EOT OR IOERROR THEN                                   <<00575>>13512000
      BEGIN                                                    <<00575>>13514000
        I := IF EOT THEN ENDOFTAPE ELSE TAPEERROR;             <<00575>>13516000
        RESETDB(*);                                            <<00575>>13518000
        CIERR(ERRNUM:=I);                                      <<00575>>13520000
        TOS := SETSYSDB;                                       <<00575>>13522000
      END;                                                     <<00575>>13524000
      IF NOT IOERROR THEN                                      <<00575>>13526000
      BEGIN   <<CLEANUP>>                                      <<00575>>13528000
                                                               <<00575>>13530000
<< LOG EVENT 229 >>                                            <<00575>>13532000
                                                               <<00575>>13534000
        MEAS'MSK0 := 0;                                        <<00575>>13536000
        MEAS'MSK1 := %1000;                                    <<00575>>13538000
        MMSTAT(-229,0,0,0);                                    <<00575>>13540000
                                                               <<00575>>13542000
<< FLUSH BUFFER AND WRITE FILE MARK>>                          <<00575>>13544000
                                                               <<00575>>13546000
        TOS := MEAS'FLAG; <<LEAVE ON STACK AS RESULT>>         <<00575>>13548000
        ASSEMBLE(TBC 14);                                      <<00575>>13550000
        @MEASBUF := IF = THEN MEAS'BUF0 ELSE MEAS'BUF0+512;    <<00575>>13552000
        TOS := LDEV;  <<ADD PARAMETERS>>                       <<00575>>13554000
        TOS := 1;                                              <<00575>>13556000
        TOS := 0;                                              <<00575>>13558000
        TOS := @MEASBUF+SYSGLOB;                               <<00575>>13560000
        TOS := MEAS'IDX;                                       <<00575>>13562000
        TOS := PLABEL;                                         <<00575>>13564000
        ASSEMBLE(PCAL 0);  <<CALL MEASIO>>                     <<00575>>13566000
        TOS := LDEV;  <<ADD PARAMETERS>>                       <<00575>>13568000
        TOS := 2;                                              <<00575>>13570000
        ASSEMBLE(ZERO,DZRO);                                   <<00575>>13572000
        TOS := PLABEL;                                         <<00575>>13574000
        ASSEMBLE(PCAL 0);  <<CALL MEASIO>>                     <<00575>>13576000
                                                               <<00575>>13578000
<< REWIND AND RESET >>                                         <<00575>>13580000
                                                               <<00575>>13582000
        TOS := LDEV;                                           <<00575>>13584000
        TOS := 4;                                              <<00575>>13586000
        ASSEMBLE(ZERO,DZRO);                                   <<00575>>13588000
        TOS := PLABEL;                                         <<00575>>13590000
        ASSEMBLE(PCAL 0); <<CALL MEASIO>>                      <<00575>>13592000
        DEL;                                                   <<00575>>13594000
      END;    <<CLEANUP>>                                      <<00575>>13596000
                                                               <<00575>>13598000
<< RESET SYSDB WORDS >>                                        <<00575>>13600000
                                                               <<00575>>13602000
      MEAS'MSK0 := 0;                                          <<00575>>13604000
      MEAS'MSK1 := 0;                                          <<00575>>13606000
      MEAS'LDEV := 0;                                          <<00575>>13608000
      MEAS'BANK := 0;                                          <<02726>>13610000
      MEAS'BUF0 := 0;                                          <<00575>>13612000
      MEAS'PLAB := 0;                                          <<00575>>13614000
      MEAS'IDX := 0;                                           <<00575>>13616000
      MEAS'FLAG :=0;                                           <<00575>>13618000
      MEAS'DSTN :=0;                                           <<00575>>13620000
      RESETDB(*);                                              <<00575>>13622000
                                                               <<00575>>13624000
<< DISABLE MEASIO >>                                           <<00575>>13626000
                                                               <<00575>>13628000
      CXMIOMONOFF(PARMSP,LDEV,PARMNUM);                        <<00575>>13630000
                                                               <<00575>>13632000
<< RELEASE AND UNLOCK BUFFER >>                                <<00575>>13634000
                                                               <<00575>>13636000
      UNFREEZE(SEGNUM,5,0);                                    <<00707>>13638000
      UNLOCKSEG(SEGNUM,5,0);                                   <<00575>>13640000
      RELDATASEG(SEGNUM);                                      <<00575>>13642000
      CIERR(ERRNUM:=MONDISABLED);                              <<00575>>13644000
   END;                                                        <<00575>>13646000
END;                                                           <<00575>>13648000
$PAGE "MIOENABLE & MIODISABLE EXECUTORS"                       <<00575>>13650000
$CONTROL SEGMENT=OPLOW                                         <<00575>>13652000
PROCEDURE CXMIOENABLE EXECUTORHEAD;                            <<00575>>13654000
                                                               <<00575>>13656000
                                                               <<00575>>13658000
BEGIN                                                          <<00575>>13660000
   ENTRY   CXMIODISABLE;                                       <<00575>>13662000
   ENTRY CXMIOMONOFF;  <<SPECIAL ENTRY FOR CXMOFF>>            <<00575>>13664000
                                                               <<00575>>13666000
   EQUATE MAXPARMS=28; <<LDEV, "E=", + 26 MASKBITS>>           <<00575>>13668000
   EQUATE COMMA=0, EQUAL=1, SEMICOLON=2, EOL=3;                <<00575>>13670000
   EQUATE TAPE=24;      <<DEVICE TYPE FOR TAPES>>              <<00575>>13672000
   DOUBLE ARRAY PARM(0:MAXPARMS)=Q;                            <<00575>>13674000
   INTEGER ARRAY                                               <<00575>>13676000
           LDT(0:LDTSIZE-1),                                   <<00575>>13678000
           LPDT(0:LPDTSIZE-1);                                 <<02677>>13680000
   INTEGER I,                                                  <<00575>>13684000
           COUNT,                                              <<00575>>13686000
           DEVICE,                                             <<00575>>13688000
           DOWNBITMAP:=0,                                      <<01362>>13690000
           TAPE'INFO = I,   << Return from TGETINFO >>         <<02677>>13692000
           IDENT,                                              <<00575>>13694000
           LDEV,                                               <<00575>>13696000
           MEASIOCODE,                                         <<00575>>13698000
           N,                                                  <<00575>>13700000
           NUMPARMS,                                           <<00575>>13702000
           PARM1=PARM+1, PARM2=PARM+3,                         <<00575>>13704000
           PLABEL,                                             <<00575>>13706000
           SAVESIR'LDT,                                        <<00575>>13708000
           SAVESIR'LPDT,                                       <<00575>>13710000
           SAVECC=I,                                           <<00575>>13712000
           SEGNUM,                                             <<00575>>13714000
           UNITNUM;                                            <<00575>>13716000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                <<00575>>13718000
   BYTE POINTER CURRENT'PARM;                                  <<00575>>13720000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3;                        <<00575>>13724000
   LOGICAL ON:=TRUE;                                           <<00575>>13726000
   DOUBLE MISC := 0D;                                          <<00575>>13728000
                                                               <<00575>>13730000
   EQUATE                                                      <<02677>>13732000
      << Item numbers for TGETINFO >>                          <<02677>>13734000
      LABEL'TYPE  = 7,                                         <<02677>>13736000
      EXPIRE'DATE = 2,                                         <<02677>>13738000
                                                               <<02677>>13740000
      << Possible returns for label type >>                    <<02677>>13742000
      NOT'MOUNTED = 0,                                         <<02677>>13744000
      UNLABELED   = 1,                                         <<02677>>13746000
      ANSI'LABEL  = 2,                                         <<02677>>13748000
      IBM'LABEL   = 3;                                         <<02677>>13750000
                                                               <<02677>>13752000
<< SYSGLOB DEFINES >>                                          <<00575>>13754000
                                                               <<00575>>13756000
   DEFINE SYSGLOBEXT = %377#;                                  <<00575>>13758000
   DEFINE MEAS'FLAG = %267#;                                   <<00575>>13760000
   DEFINE MEASIOCOUNT=ABS(SYSGLOB+ABS(SYSGLOB+SYSGLOBEXT)+%71).(13:3)#; 13764000
   ARRAY BUF(0:36);                                            <<00575>>13766000
   BYTE ARRAY BBUF(*)=BUF;                                     <<00575>>13768000
   DEFINE MIOPROC = BBUF#;                                     <<00575>>13770000
   BYTE ARRAY  ASCIILDEV(0:3);                                 <<00575>>13772000
                                                               <<00575>>13774000
   SUBROUTINE DEF'MOVEFROMDSEG;                                <<00575>>13776000
   SUBROUTINE DEF'MOVETODSEG;                                  <<00575>>13778000
                                                               <<00575>>13780000
SUBROUTINE GETLDEVSIRS;                                        <<00575>>13782000
  BEGIN                                                        <<00575>>13784000
    SAVESIR'LDT := GETSIR(LDTSIR);                             <<00575>>13786000
    SAVESIR'LPDT := GETSIR(LPDTSIR);                           <<00575>>13788000
  END;  <<GETLDEVSIRS>>                                        <<00575>>13790000
                                                               <<00575>>13792000
SUBROUTINE RELLDEVSIRS;                                        <<00575>>13794000
  BEGIN                                                        <<00575>>13796000
    RELSIR(LPDTSIR,SAVESIR'LPDT);                              <<00575>>13798000
    RELSIR(LDTSIR,SAVESIR'LDT);                                <<00575>>13800000
  END;  <<RELLDEVSIRS>>                                        <<00575>>13802000
                                                               <<00575>>13804000
SUBROUTINE SENDMSG(N);  << MESSAGE SENDER >>                   <<00575>>13806000
  VALUE N; INTEGER N;                                          <<00575>>13808000
  BEGIN                                                        <<00575>>13810000
    RELLDEVSIRS; <<REL SIRS>>                                  <<00575>>13812000
<< MESSAGE CODE = N                              >>            <<00575>>13814000
                                                               <<00575>>13816000
    IF N < LDEVUNAVAIL THEN                                    <<00575>>13818000
       CIERR(N)                                                <<00575>>13820000
    ELSE                                                       <<00575>>13822000
       CIERR(N,FIRSTPARM);                                     <<00575>>13824000
    IF (N=ENABLEMIO  OR  N=DISABLEMIO) AND MISC <> 0D THEN     <<00575>>13826000
    BEGIN    <<COMPLETION MESSAGE >>                           <<00575>>13828000
       TOS := @BBUF;                                           <<00575>>13830000
       WHILE MISC <> 0D DO                                     <<00575>>13832000
       BEGIN                                                   <<00575>>13834000
          DEVICE := LOGICAL(MISC) LAND %377;                   <<00575>>13836000
          COUNT  := ASCII(DEVICE,10,ASCIILDEV);                <<00575>>13838000
          MOVE * := ASCIILDEV,(COUNT),2;                       <<00575>>13840000
          MOVE * := "  ",2;                                    <<00575>>13842000
          MISC := MISC&DLSR(8);                                <<00575>>13844000
       END;                                                    <<00575>>13846000
       BPS0 := 0;  << GENMSG NEEDS THIS  >>                    <<00575>>13848000
       DEL;       << BUFFER POINTER   >>                       <<00575>>13850000
       ERRNUM:=N+1;  <<"DEVICES EN/DIS ABLED" MESSAGE>>        <<00575>>13852000
       GENMSG(2,ERRNUM,0,@BBUF);                               <<00575>>13854000
       CC := CCE;  <<GOOD STATUS>>                             <<00575>>13856000
    END      <<COMPLETION MESSAGE>>                            <<00575>>13858000
    ELSE                                                       <<00575>>13860000
       CC := CCL;  << ERROR RETURN >>                          <<00575>>13862000
  END;   <<END SENDMSG >>                                      <<00575>>13864000
SUBROUTINE RESET(N); << RESET ALL DEVICES  TO ORIG. STATE >>   <<00575>>13866000
  VALUE N; INTEGER N;                                          <<00575>>13868000
  BEGIN                                                        <<00575>>13870000
    IF DOWNBITMAP <> 0 THEN  << RESET DEVICES >>               <<00575>>13872000
    BEGIN                                                      <<00575>>13874000
       MOVEFROMDSEG(@LPDT,LPDTDST,LDEV*LPDTSIZE,LPDTSIZE);     <<00575>>13876000
       LPDT(LPDT'DRSTART) := 0;   <<SET NOT OWNED >>           <<00575>>13878000
       MOVETODSEG(LPDTDST,LDEV*LPDTSIZE,@LPDT,LPDTSIZE);       <<00575>>13880000
       DOWNBITMAP.(8:8) := 0;                                  <<00575>>13882000
       UNITNUM := 0;   << INIT UNITNUM >>                      <<00575>>13884000
       WHILE DOWNBITMAP <> 0 DO                                <<00575>>13886000
       BEGIN                                                   <<00575>>13888000
          IF DOWNBITMAP < 0 THEN                               <<00575>>13890000
          BEGIN                                                <<00575>>13892000
             DEVICE := IOTABLEINFO(1,LPDT(LPDT'DITP),UNITNUM); <<00575>>13894000
             MOVEFROMDSEG(@LDT,LDTDST,DEVICE*LDTSIZE,LDTSIZE); <<00575>>13896000
             LDT(LDT'F) := 1;      << UP DEVICE >>             <<00575>>13898000
             MOVETODSEG(LDTDST,DEVICE*LDTSIZE,@LDT,LDTSIZE);   <<00575>>13900000
             MISC := MISC&DLSL(8) + DOUBLE(DEVICE);            <<00575>>13902000
          END;                                                 <<00575>>13904000
          DOWNBITMAP := DOWNBITMAP&LSL(1);                     <<00575>>13906000
          UNITNUM := UNITNUM +1;                               <<00575>>13908000
       END;                                                    <<00575>>13910000
    END;                                                       <<00575>>13912000
    SENDMSG(N);                                                <<00575>>13914000
  END;  <<RESET  >>                                            <<00575>>13916000
SUBROUTINE RESETMIO;                                           <<00575>>13918000
                                                               <<00575>>13920000
  BEGIN                                                        <<00575>>13922000
    MOVE MIOPROC := "MIO'RESET ";                              <<00575>>13924000
    IDENT:=LOADPROC(MIOPROC,0,PLABEL);                         <<00575>>13926000
    IF < THEN                                                  <<00575>>13928000
    BEGIN                                                      <<00575>>13930000
      RESET(CANTLOADMIORE);                                    <<00575>>13932000
      RETURN;                                                  <<00575>>13934000
    END;                                                       <<00575>>13936000
    TOS := 0;  <<RESULT>>                                      <<00575>>13938000
    TOS := LDEV;  <<PARAMETERS>>                               <<00575>>13940000
    TOS := PLABEL;                                             <<00575>>13942000
    ASSEMBLE(PCAL 0);  <<CALL MIO'RESET>>                      <<00575>>13944000
    DOWNBITMAP := TOS;                                         <<00575>>13946000
    UNLOADPROC(IDENT);                                         <<00575>>13948000
  END; <<RESETMIO>>                                            <<00575>>13950000
                                                               <<00575>>13952000
SUBROUTINE STATUSMIO;                                          <<00575>>13954000
  BEGIN                                                        <<00575>>13956000
    MOVE MIOPROC :="MEASIO ";                                  <<00575>>13958000
    IDENT := LOADPROC(MIOPROC,0,PLABEL);                       <<00575>>13960000
    IF < THEN                                                  <<00575>>13962000
    BEGIN                                                      <<00575>>13964000
      IF MEASIOCOUNT = 0 THEN DEALLOCATEPROC(MIOPROC);         <<00575>>13966000
      RESETMIO;                                                <<00575>>13968000
      GETLDEVSIRS;                                             <<00575>>13970000
      RESET(CANTLOADMIO);                                      <<00575>>13972000
      RETURN;                                                  <<00575>>13974000
    END;                                                       <<00575>>13976000
    SEGNUM := PLABEL.(8:8);                                    <<00575>>13978000
    TOS:=SETSYSDB;                                             <<00575>>13980000
    TOS := 0;          <<RESULT>>                              <<00575>>13982000
    TOS := LDEV;       <<PARAMETERS >>                         <<00575>>13984000
    ASSEMBLE(DZRO,DZRO);                                       <<00575>>13986000
    TOS:=PLABEL;                                               <<00575>>13988000
    ASSEMBLE(PCAL 0);  <<CALL MEASIO,READ STATUS>>             <<00575>>13990000
    MEASIOCODE:=TOS;                                           <<00575>>13992000
    PUSH(STATUS);                                              <<00575>>13994000
    SAVECC := TOS.(6:2); <<SAVE CC>>                           <<00575>>13996000
    RESETDB(*);                                                <<00575>>13998000
    UNLOADPROC(IDENT);                                         <<00575>>14000000
  END;  <<STATUSMIO>>                                          <<00575>>14002000
$PAGE                                                          <<00575>>14004000
<< CXMIOENABLE >>                                              <<00575>>14006000
   GO TO MAINCODE;                                             <<00575>>14008000
                                                               <<00575>>14010000
<< CXMIOMONOFF   SPECIAL ENTRY FOR CXMOFF>>                    <<00575>>14012000
CXMIOMONOFF:                                                   <<00575>>14014000
   LDEV := ERRNUM;                                             <<00575>>14016000
   GO TO CXMONOFF;                                             <<00575>>14018000
                                                               <<00575>>14020000
<< CXMIODISABLE >>                                             <<00575>>14022000
CXMIODISABLE:                                                  <<00575>>14024000
   ON := FALSE;                                                <<00575>>14026000
                                                               <<00575>>14028000
MAINCODE:                                                      <<00575>>14030000
                                                               <<00575>>14032000
<< VERIFY PARAMETERS >>                                        <<00575>>14034000
                                                               <<00575>>14036000
   LOGIMAGE( ( IF ON                                           <<01527>>14038000
                  THEN M'MIOENABLE                             <<01527>>14040000
                  ELSE M'MIODISABLE ), PARMSP );               <<01527>>14042000
   MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARM);  <<PARSE>>     <<00575>>14044000
   IF NUMPARMS=0 THEN  <<MUST HAVE LDEV NUM >>                 <<00575>>14046000
   BEGIN                                                       <<00575>>14048000
     CIERR(ERRNUM:=LDEVREQRD);                                 <<00575>>14050000
     RETURN;                                                   <<00575>>14052000
   END                                                         <<00575>>14054000
   ELSE                                                        <<00575>>14056000
   IF NUMPARMS <> 1 AND SNDPARM <> "E" THEN <<CALL FROM CXMON>><<00575>>14058000
   BEGIN                                                       <<00575>>14060000
     CIERR(ERRNUM:=MAXPARAMS,,%10000,MAXPARMS-2);              <<00575>>14062000
     RETURN;                                                   <<00575>>14064000
   END;                                                        <<00575>>14066000
   LDEV :=VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,ERRNUM,PARMNUM,1);   <<00575>>14068000
   IF <> THEN RETURN;                                          <<00575>>14070000
   IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MASTEROP INVALID>>   <<00575>>14072000
                                                               <<00575>>14074000
<< VERIFY LDEV = TAPE >>                                       <<00575>>14076000
                                                               <<00575>>14078000
   MOVEFROMDSEG(@LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);             <<00575>>14080000
   IF LDT(LDT'DTYPE) <> TAPE THEN                              <<00575>>14082000
   BEGIN                                                       <<00575>>14084000
      GETLDEVSIRS;                                             <<00575>>14086000
      RESET(LDEVMUSTBETAPE);                                   <<00575>>14088000
      RETURN;                                                  <<00575>>14090000
   END;                                                        <<00575>>14092000
                                                               <<00575>>14094000
   MOVEFROMDSEG(@LPDT,LPDTDST,LDEV*LPDTSIZE,LPDTSIZE);         <<02513>>14096000
   IF LPDT(LPDT'SUBTYPE) <> 0 THEN                             <<02513>>14098000
   BEGIN                                                       <<02513>>14100000
      GETLDEVSIRS;                                             <<02513>>14102000
      RESET(LDEVMUSTBE7970X);                                  <<02513>>14104000
      RETURN;                                                  <<02513>>14106000
   END;                                                        <<02513>>14108000
                                                               <<02513>>14110000
   IF ON THEN                                                  <<00575>>14112000
   BEGIN  <<CXMIOENABLE>>                                      <<00575>>14114000
                                                               <<00575>>14116000
<< VERIFY LDEV AVAILABLE >>                                    <<00575>>14118000
                                                               <<00575>>14120000
      GETLDEVSIRS; <<GET SIRS LPDT AND LDT>>                   <<00575>>14122000
      IF LPDT(LPDT'DRSTART) <> 0 OR  <<OWNED>>                 <<00575>>14126000
         LDT(LDT'USECNT) <> 0 OR     <<USE COUNT>>             <<00575>>14128000
         LDT(LDT'F) = 0 THEN                                   <<00575>>14130000
         BEGIN                                                 <<00575>>14132000
           RESET(LDEVUNAVAIL);                                 <<00575>>14134000
           RETURN;                                             <<00575>>14136000
         END;                                                  <<00575>>14138000
                                                               <<00575>>14140000
<< CHECK FOR PROPER TAPE DISPOSITION >>                        <<00575>>14142000
                                                               <<00575>>14144000
      TGETINFO(LDEV,TAPE'INFO,LABEL'TYPE);                     <<02677>>14148000
      IF <> THEN                                               <<02677>>14150000
         BEGIN   << Something's wrong.  It's not a tape. >>    <<02677>>14152000
         RESET(ERRNUM:=LDEVMUSTBETAPE);                        <<02677>>14154000
         RETURN;                                               <<02677>>14156000
         END;                                                  <<02677>>14158000
                                                               <<02677>>14160000
      IF TAPE'INFO <> UNLABELED THEN                           <<02677>>14162000
         BEGIN                                                 <<02677>>14164000
         IF TAPE'INFO = NOT'MOUNTED THEN                       <<02677>>14166000
            BEGIN   << Tape not mounted on tape drive. >>      <<02677>>14168000
            RESET(ERRNUM:=NOTAPE);                             <<02677>>14170000
            RETURN;                                            <<02677>>14172000
            END;                                               <<02677>>14174000
                                                               <<02677>>14176000
         << Check to see if labeled tape has expired. >>       <<02677>>14178000
         TGETINFO(LDEV,TAPE'INFO,EXPIRE'DATE);                 <<02677>>14180000
         IF LOGICAL(TAPE'INFO) > CALENDAR THEN                 <<02677>>14182000
            BEGIN   << Labeled tape has not expired. >>        <<02677>>14184000
            RESET(ERRNUM:=LABELEDTAPE);                        <<02677>>14186000
            RETURN;                                            <<02677>>14188000
            END;                                               <<02677>>14190000
         END;   << of not an unlabeled tape >>                 <<02677>>14192000
                                                               <<02677>>14194000
<< ALLOCATE DEVICE  >>                                         <<00575>>14196000
                                                               <<00575>>14198000
      LPDT(LPDT'DRSTART) := 1;    <<SET DEVICE OWNED>>         <<00575>>14200000
      MOVETODSEG(LPDTDST,LDEV*LPDTSIZE,@LPDT,LPDTSIZE);        <<00575>>14202000
                                                               <<00575>>14204000
<< DOWN DEVICES ON THIS CONTROLLER >>                          <<00575>>14206000
                                                               <<00575>>14208000
      TOS := LDEV;     <<DOWNBITMAP>>                          <<00575>>14210000
      UNITNUM:= IOTABLEINFO(2,LPDT(LPDT'DITP),0);              <<00575>>14212000
                << NUMBER OF UNITS ON THIS CONTROLLER>>        <<00575>>14214000
      WHILE (UNITNUM:=UNITNUM-1) <> -1 DO                      <<00575>>14216000
      BEGIN                                                    <<00575>>14218000
        DEVICE := IOTABLEINFO(1,LPDT(LPDT'DITP),UNITNUM);      <<00575>>14220000
        IF DEVICE <> 0 THEN                                    <<01575>>14222000
        BEGIN                                                  <<01575>>14224000
          MOVEFROMDSEG(@LPDT,LPDTDST,DEVICE*LPDTSIZE,LPDTSIZE);<<01575>>14226000
          IF LPDT(LPDT'DRSTART) <> 0 AND                       <<01575>>14228000
             LDEV <> DEVICE THEN                               <<01575>>14230000
             BEGIN                                             <<01575>>14232000
               RESET(CONTROLLERUNAV);                          <<01575>>14234000
               RETURN;                                         <<01575>>14236000
             END;                                              <<01575>>14238000
          MOVEFROMDSEG(@LDT,LDTDST,DEVICE*LDTSIZE,LDTSIZE);    <<01575>>14240000
          IF LDT(LDT'USECNT) <> 0 THEN                         <<01575>>14242000
          BEGIN                                                <<01575>>14244000
            RESET(CONTROLLERUNAV);                             <<01575>>14246000
            RETURN;                                            <<01575>>14248000
          END;                                                 <<01575>>14250000
          IF LDT(LDT'F) <> 0 THEN                              <<01575>>14252000
          BEGIN                                                <<01575>>14254000
             LDT(LDT'F) := 0;    <<DOWN DEVICE>>               <<01575>>14256000
             MOVETODSEG(LDTDST,DEVICE*LDTSIZE,@LDT,LDTSIZE);   <<01575>>14258000
             MISC := MISC&DLSL(8) + DOUBLE(DEVICE);            <<01575>>14260000
             TOS := LOGICAL(TOS) LOR (1&LSL(15-UNITNUM));      <<01575>>14262000
          END;                                                 <<01575>>14264000
        END;                                                   <<01575>>14266000
      END;                                                     <<00575>>14268000
      DOWNBITMAP := TOS;                                       <<00575>>14270000
                                                               <<00575>>14272000
<< MUST RELSIR LDT BEFORE CALLING LOADPROC >>                  <<00575>>14274000
                                                               <<00575>>14276000
      RELLDEVSIRS; <<REL SIRS LPDT AND LDT>>                   <<00575>>14278000
                                                               <<00575>>14280000
<<  LOAD MEASIO CODE  >>                                       <<00575>>14282000
                                                               <<00575>>14284000
      MOVE MIOPROC := "MIO'INIT ";                             <<00575>>14286000
      IDENT := LOADPROC(MIOPROC,0,PLABEL);                     <<00575>>14288000
      IF < THEN  <<CANT LOAD MEASIO>>                          <<00575>>14290000
      BEGIN                                                    <<00575>>14292000
       GETLDEVSIRS;                                            <<00575>>14294000
        RESET(CANTLOADMIOIN);                                  <<00575>>14296000
        RETURN;                                                <<00575>>14298000
      END;                                                     <<00575>>14300000
                                                               <<00575>>14302000
<< INITIALIZE MEASURMENT IO SYSTEM >>                          <<00575>>14304000
                                                               <<00575>>14306000
      TOS := DOWNBITMAP;                                       <<00575>>14308000
      TOS := PLABEL;                                           <<00575>>14310000
      ASSEMBLE(PCAL 0);  <<CALL MIO'INIT>>                     <<00575>>14312000
      UNLOADPROC(IDENT);                                       <<00575>>14314000
      IF <> THEN                                               <<00575>>14316000
      BEGIN                                                    <<00575>>14318000
        RESETMIO;                                              <<00575>>14320000
        GETLDEVSIRS;                                           <<00575>>14322000
        RESET(CANTUNLOADMIO);                                  <<00575>>14324000
        RETURN;                                                <<00575>>14326000
      END;                                                     <<00575>>14328000
                                                               <<00575>>14330000
<< ALLOCATE MEASIO CST ENTRY >>                                <<00575>>14332000
                                                               <<00575>>14334000
      MOVE MIOPROC := "MEASIO ";                               <<00575>>14336000
      I := ALLOCATEPROC(MIOPROC);                              <<00575>>14338000
      IF < AND I <> 84 THEN   <<84 => ALREADY ALLOCATED >>     <<00575>>14340000
      BEGIN                                                    <<00575>>14342000
        RESETMIO;                                              <<00575>>14344000
        GETLDEVSIRS;                                           <<00575>>14346000
        RESET(CANTLOADMIO);                                    <<00575>>14348000
        RETURN;                                                <<00575>>14350000
      END;                                                     <<00575>>14352000
                                                               <<00575>>14354000
<< GET MEASIO STATUS  >>                                       <<00575>>14356000
                                                               <<00575>>14358000
      STATUSMIO;                                               <<00575>>14360000
      IF SAVECC = CCL THEN                                     <<00575>>14362000
      BEGIN                                                    <<00575>>14364000
        IF MEASIOCOUNT = 0 THEN DEALLOCATEPROC(MIOPROC);       <<00575>>14366000
        RESETMIO;                                              <<00575>>14368000
        GETLDEVSIRS;                                           <<00575>>14370000
        RESET(DEVICEERROR);                                    <<00575>>14372000
        RETURN;                                                <<00575>>14374000
      END                                                      <<00575>>14376000
      ELSE                                                     <<00575>>14378000
        IF MEASIOCODE <> 3 THEN                                <<00575>>14380000
        BEGIN                                                  <<00575>>14382000
          IF MEASIOCODE > 7 THEN ERRNUM := DEVICEATEOT         <<00575>>14384000
          ELSE                                                 <<00575>>14386000
            IF MEASIOCODE > 3 THEN ERRNUM := DEVICENOWRING     <<00575>>14388000
            ELSE                                               <<00575>>14390000
              IF MEASIOCODE = 2 THEN ERRNUM := DEVICENOTATLP   <<00575>>14392000
              ELSE                                             <<00575>>14394000
                ERRNUM := DEVICENOTONLINE;                     <<00575>>14396000
           IF MEASIOCOUNT = 0 THEN DEALLOCATEPROC(MIOPROC);    <<00575>>14398000
           RESETMIO;                                           <<00575>>14400000
           GETLDEVSIRS;                                        <<00575>>14402000
           RESET(ERRNUM);                                      <<00575>>14404000
           RETURN;                                             <<00575>>14406000
        END;                                                   <<00575>>14408000
                                                               <<00575>>14410000
<< LOCK AND FREEZE MEASIO SEGNUM >>                            <<00575>>14412000
                                                               <<00575>>14414000
      LOCKSEG(SEGNUM,0,0);                                     <<00575>>14416000
      IF <> THEN                                               <<00575>>14418000
      BEGIN                                                    <<00575>>14420000
         IF MEASIOCOUNT = 0 THEN DEALLOCATEPROC(MIOPROC);      <<00575>>14422000
         RESETMIO;                                             <<00575>>14424000
         GETLDEVSIRS;                                          <<00575>>14426000
         RESET(CANTLOCKMIO);                                   <<00575>>14428000
         RETURN;                                               <<00575>>14430000
      END;                                                     <<00575>>14432000
      FREEZE(SEGNUM,0,0);                                      <<00707>>14434000
                                                               <<00575>>14436000
<< SEND "SUCCESSFUL MIOENABLE" MESSAGE AND TERMINATE>>         <<00575>>14438000
                                                               <<00575>>14440000
      MEASIOCOUNT := MEASIOCOUNT+1; <<# CONTRLRS USING MEASIO>><<00575>>14442000
      SENDMSG(ENABLEMIO);                                      <<00575>>14444000
   END    <<CXMIOENABLE>>                                      <<00575>>14446000
                                                               <<00575>>14448000
<<------------------------    END   CONSMIOENABLE  ------>>    <<00575>>14450000
                                                               <<00575>>14452000
                                                               <<00575>>14454000
   ELSE                                                        <<00575>>14456000
   BEGIN  <<CXMIODISABLE>>                                     <<00575>>14458000
                                                               <<00575>>14460000
<< CHECK FOR SYSTEM MONITOR RUNNING ON THIS DEVICE >>          <<00575>>14462000
                                                               <<00575>>14464000
      IF ABS(SYSGLOB+MEAS'FLAG) < 0 AND                        <<00575>>14466000
         INTEGER(MEAS'LDEV) = LDEV THEN                        <<01549>>14468000
      BEGIN                                                    <<00575>>14470000
        CIERR(ERRNUM:=SYSMONRUN);                              <<00575>>14472000
        RETURN;                                                <<00575>>14474000
      END;                                                     <<00575>>14476000
                                                               <<00575>>14478000
<< LDEV MUST BE OWNED BY MEASIO >>                             <<00575>>14480000
                                                               <<00575>>14482000
      MOVEFROMDSEG(@LPDT,LPDTDST,LDEV*LPDTSIZE,LPDTSIZE);      <<00575>>14484000
      I := IOTABLEINFO(3,LPDT(LPDT'DITP),LDEV);                <<00575>>14486000
      IF I = 0 THEN   <<MEASIO NOT ENABLED ON THIS DEVICE>>    <<00575>>14488000
      BEGIN                                                    <<00575>>14490000
        CIERR(ERRNUM:=DEVICEINVALID);                          <<00575>>14492000
        RETURN;                                                <<00575>>14494000
      END;                                                     <<00575>>14496000
                                                               <<00575>>14498000
CXMONOFF:   <<SPECIAL ENTRY FOR CXMOFF>>                       <<00575>>14500000
                                                               <<00575>>14502000
<< GET MEASIO STATUS >>                                        <<00575>>14504000
                                                               <<00575>>14506000
      STATUSMIO;                                               <<00575>>14508000
      IF SAVECC =CCL THEN                                      <<00575>>14510000
      BEGIN                                                    <<00575>>14512000
        IF MEASIOCODE = 1 THEN                                 <<00575>>14514000
           CIERR(DEVICEINVALID)                                <<00575>>14516000
        ELSE                                                   <<00575>>14518000
           CIERR(DEVICEERROR);                                 <<00575>>14520000
        RETURN;                                                <<00575>>14522000
      END;                                                     <<00575>>14524000
                                                               <<00575>>14526000
<< RESET MEASURMENT IO SYSTEM>>                                <<00575>>14528000
                                                               <<00575>>14530000
      RESETMIO;                                                <<00575>>14532000
                                                               <<00575>>14534000
<< DO NOT DEALLOCATE IF MEASIO RUNNING ELSEWHERE >>            <<00575>>14536000
                                                               <<00575>>14538000
      IF MEASIOCOUNT = 1 THEN  <<NO OTHER MEASIO RUNNING >>    <<00575>>14540000
      BEGIN                                                    <<00575>>14542000
                                                               <<00575>>14544000
<< UNFREEZE MEASIO >>                                          <<01575>>14546000
                                                               <<01575>>14548000
        UNFREEZE(SEGNUM,0,0);                                  <<01575>>14550000
        UNLOCKSEG(SEGNUM,0,0);                                 <<01575>>14552000
                                                               <<01575>>14554000
<< DEALLOCATE MEASIO CST>>                                     <<01575>>14556000
                                                               <<01575>>14558000
        MOVE MIOPROC := "MEASIO ";                             <<01575>>14560000
        I := DEALLOCATEPROC(MIOPROC);                          <<01575>>14562000
      END;                                                     <<01575>>14564000
                                                               <<00575>>14566000
<< RESET DEVICES,SEND "SUCCESSFUL MIODISABLE" AND TERMINATE>>  <<00575>>14568000
                                                               <<00575>>14570000
      GETLDEVSIRS;                                             <<00575>>14572000
      MEASIOCOUNT := MEASIOCOUNT-1; <<CONTRLRS USING MEASIO>>  <<00575>>14574000
      RESET(DISABLEMIO);                                       <<00575>>14576000
      RETURN;                                                  <<00575>>14578000
      HELP;                                                    <<00575>>14580000
   END;   <<CXMIODISABLED>>                                    <<00575>>14582000
END;                                                           <<00575>>14584000
$PAGE "JOBSECURITY EXECUTOR"                                   <<00575>>14586000
$CONTROL SEGMENT=OPLOW                                         <<00575>>14588000
PROCEDURE CXJOBSECURITY EXECUTORHEAD;                          <<00575>>14590000
BEGIN                                                          <<00575>>14592000
   COMMENT                                                              14594000
      THE SYNTAX OF THIS COMMAND IS:                                    14596000
         JOBSECURITY HIGH                                               14598000
         JOBSECURITY LOW                                                14600000
   ;                                                                    14602000
   DOUBLE ARRAY PARM(0:1)=Q;                                            14604000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         14606000
   BYTE FIRSTLEN=PARM+1;                                                14608000
   INTEGER NUMPARMS,SAVESIR,SECURITY;                                   14610000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);                        14612000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         14614000
   SUBROUTINE DEF'MOVETODSEG;                                           14616000
                                                                        14618000
   LOGIMAGE( M'JOBSCRTY, PARMSP );  << LOG OP COMMAND >>       <<01527>>14620000
   MYCOMMAND(PARMSP,,2,NUMPARMS,PARM);<<PARSE PARAMETERS>>              14622000
   IF NUMPARMS<>1 THEN <<HAS EXACTLY ONE PARAMETER>>                    14624000
   BEGIN                                                                14626000
      PARMNUM:=IF NUMPARMS>1 THEN 1 ELSE 2;                             14628000
      TOS:=ERRNUM:=JOBSECURITY1PARM;                                    14630000
      TOS:=IF PARMNUM=1 THEN @SNDPARM ELSE @PARMSP;                     14632000
      CIERR(*,*);                                                       14634000
      RETURN;                                                           14636000
   END;                                                                 14638000
   IF FIRSTLEN=3 AND FIRSTPARM="LOW" THEN SECURITY:=JOBSECURITY'LOW     14640000
   ELSE                                                                 14642000
   IF FIRSTLEN=4 AND FIRSTPARM="HIGH" THEN SECURITY:=JOBSECURITY'HIGH   14644000
   ELSE                                                                 14646000
   BEGIN                                                                14648000
      PARMNUM:=1;                                                       14650000
      CIERR(ERRNUM:=EXP1OFHIGHLOW,FIRSTPARM);                           14652000
      RETURN;                                                           14654000
   END;                                                                 14656000
   SAVESIR:=GETSIR(JMATSIR); <<LOCK JMAT>>                              14658000
   MOVEFROMDSEG(@JMATHEADER,JMATDST,0,JMATHEADERSIZE);                  14660000
   JMATHEADER(JMAT'H'JOBSECURITY):=SECURITY;                            14662000
   MOVETODSEG(JMATDST,0,@JMATHEADER,JMATHEADERSIZE);                    14664000
   RELSIR(JMATSIR,SAVESIR); <<UNLOCK JMAT>>                             14666000
   RETURN;                                                              14668000
END;                                                                    14670000
$PAGE "DOWNLOAD EXECUTOR"                                               14672000
$CONTROL SEGMENT=OPMED                                                  14674000
PROCEDURE CXDOWNLOAD   EXECUTORHEAD;                                    14676000
<< PROCEDURE TO DOWNLOAD EITHER VFC IMAGE FROM>>                        14678000
<< ASCII FILE DESIGNATED BY USER IN FORMSMSG  >>                        14680000
<< AND/OR MARGIN SETTING FOR 2608 TYPE PRINTERS>>                       14682000
<< SYNTAX:                                     >>                       14684000
<<          :DOWNLOAD LDN ,FILENAME    OR         >>           <<04197>>14686000
<<          :DOWNLOAD LDN ,MARGIN=NN              >>           <<04197>>14688000
<< WHERE FILENAME CONTAINS EITHER VFC OR MARGIN CONTROL >>              14690000
<< OR BOTH AS WELL AS VFC IMAGE AS FOLLOWS      >>                      14692000
<< >>                                                                   14694000
<<COL  1234567890123456   >>                                            14696000
<<>>                                                                    14698000
<<     MARGIN=4         >>  <<SETS UP LEFT MARGIN TO BE COL 4>>         14700000
                        << THIS TRUNCATES LINE IN LAST 4 COLS>>         14702000
<<     VFC,6,66          >>  <<SETS UP  6 LINES>>                       14704000
                         << PER INCH AND 66 LINES PER PAGE   >>         14706000
<<     10111111100011111     >> <<CH 1 ALLOWED ONLY IN LINE1>>          14708000
<<     001                   >> <<BLANKS = 0>>                          14710000
<<     0011                  >> <<CHANNELS 3,4 SKIP TO LINE 3>>         14712000
<<     00101                 >>                                         14714000
<<     00110000000000001     >>                                         14716000
<<       100000000000010     >> <<CHANNEL 15 IS LINE 5>>                14718000
<<     00111000000000100     >>                                         14720000
<<          . . .           >>  << ETC >>                               14722000
<<     011                  >>  << LINE 60 HAS CHANNELS 2,3>>           14724000
<<                          >>  << LINE 61 - 65 ARE ZEROES>>            14726000
<<                          >>  << 62 >>                                14728000
<<                          >>  << 63 >>                                14730000
<<                          >>  << 64 >>                                14732000
<<                          >>  << 65 >>                                14734000
<<                100000    >>  << LINE 66  IS  CHANNEL 11>>            14736000
<<>>                                                                    14738000
BEGIN                                                                   14740000
<<PARSE VARIABLES>>                                                     14742000
INTEGER NUMPARMS;                                                       14744000
EQUATE       COMMA=0,                                                   14746000
             MARGINFUNC = %101,                                         14748000
             MODEFUNC =  146,                                  <<04390>>14750000
             TRANSPAR = 0,                                     <<04390>>14752000
             FEATURE  = 1,                                     <<04390>>14754000
             EQUAL=1,                                                   14756000
             VFCFUNC = %100,                                            14758000
             SEMI=2,                                                    14760000
                                                                        14762000
             CR=3,                                                      14764000
             VFCMAXPARMS = 4,  << VFC LINE IGNORES COMMENT.>>  <<02069>>14766000
             MINPARMS = 2,                                     <<04197>>14768000
             MAXPARMS = 3;    <<REMOVE "DEFAULT">>             <<00910>>14770000
INTEGER      PNUM;                                                      14772000
DOUBLE ARRAY PARMS(1:MAXPARMS+1);                                       14774000
BYTE POINTER PP;                                                        14776000
BYTE         PLEN;                                                      14778000
INTEGER      PDELWD=PLEN;                                               14780000
DOUBLE       PARM=PP;                                                   14782000
DEFINE       PSPECIAL= LOGICAL(PDELWD.(10:1))#,                         14784000
             PDEL    = PDELWD.(11:5)#,                                  14786000
             PNUMERIC= LOGICAL(PDELWD.(9:1))#,                          14788000
             PALPHA  = LOGICAL(PDELWD.(8:1))#;                          14790000
INTEGER      TARGET,                                                    14792000
             LDN=TARGET;                                                14794000
ARRAY        CARET(0:9);                                                14796000
BYTE ARRAY   CARET'(*) = CARET;                                         14798000
INTEGER      OFFSET;                                                    14800000
<<>>                                                                    14802000
<<ATTACHIO VARIABLES>>                                                  14804000
LOGICAL ARRAY DEVINFO(0:8);                                             14806000
BYTE ARRAY   LDNALPHA(0:8);                                             14808000
DOUBLE       DRETURN;                                                   14810000
INTEGER      BUFINDX;                                                   14812000
INTEGER      SRETURN=DRETURN;                                           14814000
INTEGER      COUNT,P1,P2,FLAGS;                                         14816000
INTEGER      FN,LNTH,QUOTIENT,REMAINDER,I,J;                            14818000
EQUATE       SYSDB = %1000,                                             14820000
             SYSBUF = 6,                                                14822000
             SBUFDST = 8;                                               14824000
EQUATE       MAX'VFC'LINES = 127;                              <<04197>>14826000
LOGICAL      VFC'ENCOUNTERED   << Marks the appearence of >>   <<04197>>14828000
                 := FALSE;     << a VFC record in the VFC >>   <<04197>>14830000
                               << file.  Once encountered,>>   <<04197>>14832000
                               << no more command sets are>>   <<04197>>14834000
                               << expected in the file.   >>   <<04197>>14836000
                                                               <<04197>>14838000
<<>>                                                                    14840000
<<VFC FILE PARAMETERS AND ARRAYS>>                                      14842000
ARRAY VFC(0:MAX'VFC'LINES);                                    <<04197>>14844000
ARRAY VFCIN(0:36);       <<36 WORDS OF ASCII INPUT>>           <<01878>>14846000
BYTE ARRAY BVFCIN(*) = VFCIN;                                           14848000
BYTE ARRAY BBUF(0:100);  <<WRITE TO OPERATOR GENMSG BUFFER>>            14850000
DOUBLE TEMPD;                                                           14852000
INTEGER TEMPD2 = TEMPD + 1;                                             14854000
INTEGER FILETYP;                                                        14856000
LOGICAL GPTR',APTR',ERRPTR',PRINTVFC;                                   14858000
BYTE POINTER ERRPTR = ERRPTR';                                          14860000
<<>>                                                                    14862000
<<FLAGS>>                                                               14864000
LOGICAL      WARNFLAG,CONTINUE;                                         14866000
LOGICAL     FLAG;                                                       14868000
LOGICAL  MARGIN'IN'VFC := FALSE,  MODE'IN'VFC := FALSE;        <<04390>>14870000
LOGICAL VFCLINE'OKAY;                                          <<04197>>14872000
INTEGER FOPEN'ERR;                                                      14874000
INTEGER LINES'IN'VFC := 0;   << Counts lines in VFCfile. >>    <<04197>>14876000
<<>>                                                                    14878000
INTEGER ERRF;                                                           14880000
DEFINE ERRN = ERRNUM#;                                                  14882000
                                                                        14884000
INTEGER DBSAVE;                                                         14886000
                                                                        14888000
SUBROUTINE MARGINSET;                                                   14890000
BEGIN                                                                   14892000
<< THIS SUBROUTINE DOWNLOADS THE MARGIN VIA FUNCTION=%101>>             14894000
IF NOT VALIDDEVTYPE(LDN,MARGINFUNC,FLAG) THEN                           14896000
   BEGIN                                                                14898000
   ERRN := ERR'WRONG'LDEV; ERRF := LDN;                                 14900000
   PARM := PARMS(PNUM := 1      );                                      14902000
    GO RETURN1;            <<CHECK LDEV VALIDITY FOR FUNCTION>>         14904000
   END;                                                                 14906000
PARM := PARMS(PNUM :=PNUM+1);   <<NN>>                                  14908000
P1 := BINARY( PP, PLEN );                                      <<04197>>14912000
IF <> THEN                                                     <<04197>>14914000
BEGIN                                                          <<04197>>14916000
   ERRN := ERR'NUMERIC'MARGIN;                                 <<04197>>14918000
   GO RETURN1;                                                 <<04197>>14920000
END;                                                           <<04197>>14922000
P1 := P1 - 1;  << Adjust to zero origin. >>                    <<04197>>14924000
                                                               <<04197>>14926000
<< Check the range for validity. >>                            <<04197>>14928000
IF NOT (0<= P1 <= 15) THEN                                              14930000
   BEGIN                                                                14932000
   ERRN := ERR'MARGIN'RANGE;                                            14934000
   GO RETURN1;                                                          14936000
   END;                                                                 14938000
                                                               <<04197>>14940000
<< MARGIN passed all validity checks.  Do download and >>      <<04197>>14942000
<< check return.                                       >>      <<04197>>14944000
P2 := 0; <<PARAMETER 2 IS ZERO >>                              <<00910>>14946000
DRETURN := ATTACHIO( LDN, 0, 0, 0, MARGINFUNC,                 <<04197>>14948000
                     0, P1, P2, %13              );            <<04197>>14950000
IF SRETURN = 0 THEN                                                     14952000
   BEGIN                                                                14954000
   ERRN := ERR'MARGIN'FAILED; ERRF := LDN;                              14956000
   GO RETURN1;                                                          14958000
   END                                                                  14960000
ELSE                                                                    14962000
END;  <<SUBROUTINE MARGINSET>>                                          14964000
                                                                        14966000
SUBROUTINE MODESET;                                            <<04390>>14968000
BEGIN                                                          <<04390>>14970000
                                                               <<04390>>14972000
   IF NOT VALIDDEVTYPE(LDN,MODEFUNC,FLAG) THEN                 <<04390>>14974000
   BEGIN                                                       <<04390>>14976000
      ERRN := ERR'CAN'T'DO'MODE;                               <<04390>>14978000
      ERRF := LDN;                                             <<04390>>14980000
      PARM := PARMS (PNUM := 1);                               <<04390>>14982000
      GO RETURN1;                                              <<04390>>14984000
   END;                                                        <<04390>>14986000
   PARM:=PARMS(PNUM:=PNUM+1);                                  <<04390>>14988000
   IF PP="TRANSPARENT" AND PLEN=11                             <<04390>>14990000
      THEN DRETURN:=ATTACHIO(LDN,0,0,0,MODEFUNC,               <<04390>>14992000
                             0,TRANSPAR,0,0)                   <<04390>>14994000
   ELSE IF PP="FEATURE" AND PLEN=7                             <<04390>>14996000
      THEN DRETURN:=ATTACHIO(LDN,0,0,0,MODEFUNC,               <<04390>>14998000
                             0,FEATURE,0,0)                    <<04390>>15000000
   ELSE                                                        <<04390>>15002000
   BEGIN                                                       <<04390>>15004000
      ERRN := EXP'VFC'MARGIN;                                  <<04390>>15006000
      PARM := PARMS( PNUM:=1 );                                <<04390>>15008000
      GO RETURN1;                                              <<04390>>15010000
   END;                                                        <<04390>>15012000
                                                               <<04390>>15014000
END << MODESET >>;                                             <<04390>>15016000
                                                               <<04390>>15018000
                                                               <<04378>>15022000
   LOGIMAGE( M'DOWNLOAD, PARMSP );  << LOG OP COMMAND >>       <<01527>>15024000
ERRN := ERRF := 0;                                                      15026000
PRINTVFC := FALSE;                                                      15028000
@PP := @PARMSP;                                                         15030000
MYCOMMAND(PARMSP,,MAXPARMS+1,NUMPARMS,PARMS(1));                        15032000
                                                               <<04197>>15034000
<< First checks:  right number of parameters in command >>     <<04197>>15036000
<<     image.  Verify that the target LDEV is real.     >>     <<04197>>15038000
IF NUMPARMS > MAXPARMS THEN                                             15040000
   BEGIN                                                                15042000
   ERRN := ERR'TOO'MANY;                                                15044000
   PARM := PARMS( PNUM := 2 );                                 <<04197>>15046000
   GO RETURN1;                                                          15048000
   END;                                                                 15050000
IF NUMPARMS < MINPARMS THEN                                    <<04197>>15052000
   BEGIN                                                                15054000
   PNUM := NUMPARMS;                                                    15056000
   ERRN := ERR'TOO'FEW;                                        <<04197>>15058000
   GO RETURN1;                                                 <<04197>>15060000
   END;                                                                 15062000
PARM := PARMS(PNUM := 1);                                               15064000
MOVE LDNALPHA := PP,(PLEN);                                             15066000
MOVE LDNALPHA(PLEN) := 0;                                               15068000
LDN := VERIFY'RLDEV(PP,PLEN,ERRNUM,PARMNUM,1);                          15070000
IF < THEN RETURN;                                                       15072000
                                                                        15074000
<< Make sure user has access to command and device.     >>     <<04197>>15076000
IF VERIFY'MASTEROP(LDN) THEN RETURN;                                    15078000
IF CHECKASS(LDN) OR CHECKALLOW(M'DOWNLOAD) THEN                         15080000
   <<PROCEED NORMALLY, USER HAS ACCESS>>                                15082000
   ELSE                                                                 15084000
      BEGIN                                                             15086000
      ERRN := USERNOACC2DEV;                                            15088000
      GO RETURN1;                                                       15090000
      END;                                                              15092000
                                                                        15094000
<< PARSE NEXT PARAMETERS       >>                                       15096000
<< PARSE SECOND , THIRD PARAMETERS >>                                   15098000
<< FILENAME OR MARGIN = NN >>                                  <<02069>>15100000
   IF PDEL <> COMMA THEN                                       <<04197>>15104000
   BEGIN                                                       <<04197>>15106000
      ERRN := EXP'LDN'COMMA;                                   <<04197>>15108000
      ERRF := LDN;                                             <<04197>>15110000
      GO RETURN1;                                              <<04197>>15112000
   END;                                                        <<04197>>15114000
                                                               <<04197>>15116000
<< LDEV okay so far.  Check next parameter.  It should  >>     <<04197>>15118000
<< be either "MARGIN=nn" or a VFC file name.  Check     >>     <<04197>>15120000
<< MARGIN first.                                        >>     <<04197>>15122000
   PARM := PARMS(PNUM := PNUM + 1);                                     15124000
   IF PDEL = EQUAL                                             <<04197>>15126000
      THEN IF PP = "MARGIN" AND PLEN = 6                       <<04197>>15128000
              THEN MARGINSET                                   <<04197>>15130000
              ELSE                                             <<04197>>15132000
              BEGIN                                            <<04197>>15134000
                 ERRN := ERR'TOO'MANY;                         <<04197>>15136000
                 GO RETURN1;                                   <<04197>>15138000
              END                                              <<04197>>15140000
   ELSE    << Not MARGIN.  Assume it's a file name   >>        <<04197>>15142000
   BEGIN   << that has been specified.               >>        <<04197>>15144000
                                                               <<04197>>15146000
      << There is an additional parameter specified when   >>  <<04197>>15148000
      << MARGIN is specified.  MARGIN was not specified in >>  <<04197>>15150000
      << this case, so :DOWNLOAD can't have the maximum    >>  <<04197>>15152000
      << number of parameters.                             >>  <<04197>>15154000
      IF NUMPARMS = MAXPARMS THEN                              <<04197>>15156000
      BEGIN                                                    <<04197>>15158000
         ERRN := ERR'TOO'MANY;                                 <<04197>>15160000
         GO RETURN1;                                           <<04197>>15162000
      END;                                                     <<04197>>15164000
                                                               <<04197>>15166000
      << Check and open the VFC file.                   >>     <<04197>>15168000
      IF NOT PALPHA THEN                                                15172000
         BEGIN                                                          15174000
         ERRN := ERR'FILENAME'ALPHA; GO RETURN1;                        15176000
         END;                                                           15178000
      TEMPD := PARM; <<GET 2ND PARAMETER DESCRIPTION>>                  15180000
      TEMPD2 := PLEN; <<STRIPOFF PARAMETER DESC, EXCEPT LEN>>           15182000
      FILETYP := CHECKFILENAME'(TEMPD,GPTR',APTR',ERRPTR');             15184000
      IF < THEN   <<INVALID FILE NAME>>                                 15186000
         BEGIN                                                          15188000
         ERRN := FILETYP;                                               15190000
         GO RETURN1;                                                    15192000
         END                                                            15194000
      ELSE                                                              15196000
         IF > AND FILETYP <> 0 THEN <<SYSTEM FILE NAME>>                15198000
             BEGIN                                                      15200000
            ERRN := CANTBESYSFILE;                                      15202000
            GO RETURN1;                                                 15204000
            END;                                                        15206000
      FN := FOPEN(PP,3,0);                                              15208000
      IF <> THEN BEGIN                                                  15210000
                 FCHECK(0,FOPEN'ERR); ERRF := FOPEN'ERR;                15212000
                 GENMSG(FILESYSMSGSET,ERRF);                            15214000
                 ERRN := ERR'FOPEN; GO RETURN1;                         15216000
                 END;                                                   15218000
                                                               <<04197>>15220000
   << The VFC file has been opened okay.  Process each  >>     <<04197>>15222000
   << record in the file.                               >>     <<04197>>15224000
      CONTINUE := TRUE;                                                 15226000
      WHILE CONTINUE DO                                                 15228000
                                                               <<04197>>15230000
      << Note:  we should not need to travel through    >>     <<04197>>15232000
      << this loop often.  This part of the loop should >>     <<04197>>15234000
      << process the MARGIN record (if there) and the   >>     <<04197>>15236000
      << VFC record (if there).  An inner loop handles  >>     <<04197>>15238000
      << the channel definitions.  The case of multiple >>     <<04197>>15240000
      << VFC definitions in one file doesn't make sense >>     <<04197>>15242000
      << and is not allowed.                            >>     <<04197>>15244000
         BEGIN                                                          15246000
         VFCIN := 0;                                                    15248000
         MOVE VFCIN(1) := VFCIN,(36);  <<ZERO FILL BUFFER>>    <<01878>>15250000
          PRINTVFC := TRUE;                                             15252000
         LNTH := FREAD(FN,VFCIN,36);                           <<01878>>15254000
         IF <> THEN                                                     15256000
             BEGIN                                                      15258000
             CONTINUE := FALSE;                                         15260000
             PRINTVFC := FALSE;                                         15262000
             END                                                        15264000
         ELSE                                                           15266000
            BEGIN                                                       15268000
                                                               <<04197>>15270000
         << At this point we expect either a "MARGIN"   >>     <<04197>>15272000
         << or a "VFC" record in the file.              >>     <<04197>>15274000
            LINES'IN'VFC := LINES'IN'VFC + 1;                  <<04197>>15276000
                                                               <<04197>>15278000
         << If we have already encountered a VFC record   >>   <<04197>>15280000
         << in the file, any subsequent lines are extra.  >>   <<04197>>15282000
            IF VFC'ENCOUNTERED THEN                            <<04197>>15284000
            BEGIN                                              <<04197>>15286000
               PARM := PARMS( PNUM := 1 );                     <<04390>>15288000
               IF ( PP = "MARGIN"  LAND PLEN = 6 ) OR          <<04390>>15290000
                  ( PP = "MODE"    LAND PLEN = 4 )             <<04390>>15292000
                  THEN ERRN := ERR'MODE'MARGIN'FIRST           <<04390>>15294000
                  ELSE ERRN := EXTRA'LINES'IGNORED;            <<04390>>15296000
               PRINTVFC := TRUE;                               <<04197>>15298000
               GO RETURN1;                                     <<04197>>15302000
            END;                                               <<04197>>15304000
                                                               <<04197>>15306000
            VFCIN(36) := %6415; <<CARRIAGE RETURNS>>           <<01878>>15308000
            MYCOMMAND(BVFCIN,,VFCMAXPARMS,NUMPARMS,PARMS(1));  <<02069>>15310000
            PARM := PARMS( PNUM := 1 );                        <<04197>>15312000
            IF NUMPARMS < MINPARMS THEN                        <<04197>>15314000
               BEGIN                                                    15316000
               ERRN := EXP'VFC'MARGIN;                         <<02069>>15318000
               GO RETURN1;                                              15320000
               END;                                                     15322000
                                                               <<04197>>15324000
            IF PP="MARGIN" AND PDEL=EQUAL AND                  <<02069>>15326000
               PLEN = 6 THEN                                   <<02069>>15328000
               BEGIN                                                    15330000
               IF MARGIN'IN'VFC THEN                           <<04390>>15332000
               BEGIN                                           <<04390>>15334000
                  ERRN := ERR'ONE'PER'VFC;                     <<04390>>15336000
                  PRINTVFC := TRUE;                            <<04390>>15338000
                  PARM := PARMS( PNUM:=1 );                    <<04390>>15340000
                  GO RETURN1;                                  <<04390>>15342000
               END;                                            <<04390>>15344000
                                                               <<04390>>15346000
               MARGIN'IN'VFC := TRUE;                          <<04197>>15348000
               IF NUMPARMS >= MAXPARMS THEN                    <<00910>>15350000
               BEGIN                                           <<00910>>15352000
                  ERRN := ERR'MARGIN'TOOMANY;                  <<04197>>15354000
                  PRINTVFC := TRUE;                            <<00910>>15356000
                  PARM := PARMS(PNUM := 3);                    <<02069>>15358000
                  GO RETURN1;                                  <<00910>>15360000
               END;                                            <<00910>>15362000
               IF LINES'IN'VFC > 2                             <<04390>>15364000
                  THEN IF NOT( (LINES'IN'VFC=2) LAND           <<04390>>15366000
                                MODE'IN'VFC         ) THEN     <<04390>>15368000
               BEGIN    << "MARGIN" must be first line  >>     <<04197>>15370000
                        << in VFC file.                 >>     <<04197>>15372000
                  ERRN := ERR'MARGIN'NOTFIRST;                 <<04197>>15374000
                  PRINTVFC := TRUE;                            <<04197>>15376000
                  PARM := PARMS( PNUM := 1 );                  <<04197>>15378000
                  GO RETURN1;                                  <<04197>>15380000
               END;                                            <<04197>>15382000
               NUMPARMS := 2;                                           15384000
               MARGINSET;     <<ATTACHIO MARGIN>>                       15386000
               END                                                      15388000
           ELSE IF PP="MODE" AND PDEL=EQUAL AND PLEN=4 THEN    <<04390>>15390000
           BEGIN                                               <<04390>>15392000
              IF MODE'IN'VFC THEN                              <<04390>>15394000
              BEGIN                                            <<04390>>15396000
                 ERRN := ERR'ONE'PER'VFC;                      <<04390>>15398000
                 PRINTVFC := TRUE;                             <<04390>>15400000
                 PARM := PARMS( PNUM:=1 );                     <<04390>>15402000
                 GO RETURN1;                                   <<04390>>15404000
              END;                                             <<04390>>15406000
              MODE'IN'VFC := TRUE;                             <<04390>>15408000
              IF NUMPARMS > 2 THEN                             <<04390>>15410000
              BEGIN                                            <<04390>>15412000
                 ERRN := ERR'MODE'TOOMANY;                     <<04390>>15414000
                 PRINTVFC := TRUE;                             <<04390>>15416000
                 PARM := PARMS(PNUM := 3);                     <<04390>>15418000
                 GO RETURN1;                                   <<04390>>15420000
              END;                                             <<04390>>15422000
              IF LINES'IN'VFC > 2                              <<04390>>15424000
                 THEN IF NOT( (LINES'IN'VFC=2) LAND            <<04390>>15426000
                               MARGIN'IN'VFC       ) THEN      <<04390>>15428000
                 BEGIN                                         <<04390>>15430000
                    ERRN := ERR'MODE'NOTFIRST;                 <<04390>>15432000
                    PRINTVFC := TRUE;                          <<04390>>15434000
                    PARM := PARMS(PNUM := 1);                  <<04390>>15436000
                    GO RETURN1;                                <<04390>>15438000
                 END;                                          <<04390>>15440000
              NUMPARMS := 2;                                   <<04390>>15442000
              MODESET;                                         <<04390>>15444000
           END                                                 <<04390>>15446000
            ELSE IF PP="VFC" AND PLEN=3 THEN                   <<02069>>15448000
               BEGIN                                                    15450000
               << The VFC line has a lines-per-inch and a >>   <<04197>>15452000
               << lines-per-page parameter (delimed by    >>   <<04197>>15454000
               << commas).  The text after the lines-per- >>   <<04197>>15456000
               << page parm (also delimed by ",") is a    >>   <<04197>>15458000
               << comment and is ignored.                 >>   <<04197>>15460000
                                                               <<04197>>15462000
                 IF VFC'ENCOUNTERED THEN                       <<04390>>15464000
                 BEGIN                                         <<04390>>15466000
                    ERRN := ERR'ONE'PER'VFC;                   <<04390>>15468000
                    PRINTVFC := TRUE;                          <<04390>>15470000
                    PARM := PARMS( PNUM:=1 );                  <<04390>>15472000
                    GO RETURN1;                                <<04390>>15474000
                 END;                                          <<04390>>15476000
                 VFC'ENCOUNTERED := TRUE;                      <<04390>>15478000
                                                               <<04197>>15480000
               << Make sure delimiter is a comma.         >>   <<04197>>15482000
                  IF PDEL <> COMMA THEN                        <<04197>>15484000
                  BEGIN                                        <<04197>>15486000
                     ERRN := ERR'VFC'DELIMS;                   <<04197>>15488000
                     PRINTVFC := TRUE;                         <<04197>>15490000
                     GO RETURN1;                               <<04197>>15492000
                  END;                                         <<04197>>15494000
                                                               <<04197>>15496000
               << Check LDEV validity for VFC func. >>         <<04197>>15498000
                  IF NOT VALIDDEVTYPE( LDN,VFCFUNC,FLAG ) THEN <<04197>>15500000
                  BEGIN                                        <<04197>>15502000
                     ERRF := LDN;                              <<04197>>15504000
                     PARM := PARMS( PNUM := 1 );               <<04197>>15506000
                     ERRN := ERR'WRONG'LDEV'2;                 <<04197>>15508000
                     GO RETURN1;                               <<04197>>15510000
                  END;                                         <<04197>>15512000
                                                               <<04197>>15514000
               << Check last parm (comment) delimed by "," >>  <<04197>>15516000
               << Note that this comment is optional.      >>  <<04197>>15518000
                  IF NUMPARMS > 3 THEN                         <<02069>>15520000
                  BEGIN                                        <<01878>>15522000
                     PARM:=PARMS(3);                           <<01878>>15524000
                     IF PDEL <> COMMA THEN                     <<02069>>15526000
                     BEGIN                                     <<01878>>15530000
                        ERRN:=ERR'EXPECTED'COMMA;              <<01878>>15534000
                        GO RETURN1;                            <<01878>>15536000
                     END;                                      <<01878>>15538000
                  END                                          <<02069>>15540000
                  ELSE IF NUMPARMS < 3 THEN                    <<02069>>15542000
                  BEGIN                                        <<02069>>15544000
                    ERRN := VFC'TOO'FEW;                       <<02069>>15546000
                    GO RETURN1;                                <<02069>>15548000
                  END;                                         <<02069>>15550000
               IF NOT ( LINES'IN'VFC = (IF MARGIN'IN'VFC AND   <<04390>>15552000
          MODE'IN'VFC THEN 3 ELSE IF MARGIN'IN'VFC OR          <<04390>>15554000
                    MODE'IN'VFC THEN 2 ELSE 1)) THEN           <<04390>>15556000
               BEGIN    << "VFC" line must be either the >>    <<04197>>15558000
                        << first or second line in the   >>    <<04197>>15560000
                        << VFC file.                     >>    <<04197>>15562000
                  ERRN := ERR'VFC'NOTFIRST;                    <<04197>>15564000
                  PRINTVFC := TRUE;                            <<04197>>15566000
                  PARM := PARMS( PNUM := 1 );                  <<04197>>15568000
                  GO RETURN1;                                  <<04197>>15570000
               END;                                            <<04197>>15572000
               PARM := PARMS(PNUM := PNUM + 1);                         15574000
               IF PDEL <> COMMA THEN                           <<04197>>15576000
               BEGIN                                           <<04197>>15578000
                  ERRN := ERR'VFC'DELIMS;                      <<04197>>15580000
                  PRINTVFC := TRUE;                            <<04197>>15582000
                  GO RETURN1;                                  <<04197>>15584000
               END;                                            <<04197>>15586000
               IF PLEN = 0 OR           <<SET DEFAULT 6LPI>>            15588000
               PP = " " THEN P1 := 6                                    15590000
                                                                        15592000
               ELSE                                                     15594000
                  BEGIN                                                 15596000
                  P1 := BINARY(PP,PLEN);                                15600000
                  IF <> THEN                                   <<04197>>15602000
                  BEGIN                                        <<04197>>15604000
                     ERRN := ERR'LPI'NUMERIC;                  <<04197>>15606000
                     PRINTVFC := TRUE;                         <<04197>>15608000
                     GO RETURN1;                               <<04197>>15610000
                  END;                                         <<04197>>15612000
                                                               <<04197>>15614000
              << Any number here <> to 6 or 8 will cause the >><<04197>>15616000
              << lines-per-inch to default to 6.  A warning  >><<04197>>15618000
              << is generated in this case.                  >><<04197>>15620000
                  IF P1 <> 6 THEN IF P1 <> 8 THEN              <<04197>>15622000
                  BEGIN                                        <<04197>>15624000
                     VFCIN(LNTH) := 0; << GENMSG terminator. >><<04197>>15626000
                     GENMSG( -1, @BVFCIN );                    <<04197>>15628000
                     OFFSET := @PP - @BVFCIN;                  <<04197>>15630000
                     CARET := "  ";                            <<04197>>15632000
                     MOVE CARET(1) := CARET, (8);              <<04197>>15634000
                     MOVE CARET'(OFFSET) := ("^", 0);          <<04197>>15636000
                     GENMSG( -1, @CARET' );                    <<04197>>15638000
                     CIERR( ERRN := -USING'6'LPI );            <<04197>>15640000
                     P1 := 6;                                  <<04197>>15642000
                  END;                                         <<04197>>15644000
                                                               <<04197>>15646000
                  END;         <<SET LINES PER INCH>>                   15648000
               <<NUMBER OF PRINTLINES IN VFC>>                          15650000
               PARM := PARMS(PNUM := PNUM + 1);                         15652000
               BUFINDX := 0;                                            15656000
               COUNT := BINARY(PP,PLEN);                                15658000
               IF <> THEN                                      <<04197>>15660000
               BEGIN                                           <<04197>>15662000
                  ERRN := ERR'NUMLINES;                        <<04197>>15664000
                  PRINTVFC := TRUE;                            <<04197>>15666000
                  GO RETURN1;                                  <<04197>>15668000
               END;                                            <<04197>>15670000
               IF COUNT > MAX'VFC'LINES THEN                   <<04197>>15672000
                   BEGIN                                                15674000
                   ERRN := ERR'TOO'LONG;                                15676000
                   PRINTVFC := TRUE;                           <<04197>>15678000
                   GO RETURN1;                                          15680000
                   END;                                                 15682000
            IF COUNT < 0 THEN                                  <<01330>>15684000
            BEGIN <<ERROR NEGATIVE LINECOUNT>>                 <<01330>>15686000
               ERRN := ERR'NEGATIVE'VFC;                       <<01330>>15688000
               PRINTVFC := TRUE;                               <<04197>>15690000
               GO RETURN1;                                     <<01330>>15692000
            END;                                               <<01330>>15694000
                                                               <<04197>>15696000
         << Note:  If COUNT (lines-per-page) equals zero >>    <<04197>>15698000
         <<        here, the lines-per-inch is simply    >>    <<04197>>15700000
         <<        reset.  No channel definition is      >>    <<04197>>15702000
         <<        expected.                             >>    <<04197>>15704000
             IF COUNT <> 0 THEN                                         15706000
             BEGIN                                                      15708000
               TOS := COUNT;                                            15710000
               TOS := P1;                                               15712000
               ASSEMBLE(DIV);                                           15714000
               REMAINDER := TOS;                                        15716000
               QUOTIENT := TOS;                                         15718000
               IF REMAINDER = 0 AND (QUOTIENT = 11 OR                   15720000
                            QUOTIENT = 12) THEN                <<SP 03>>15722000
               << FOR 8 LPI WE HAVE 88 LINES>>                          15724000
               << FOR 6 LPI WE HAVE 66 LINES>>                          15726000
         << EUROPEAN 12 INCHES>>                                        15728000
         <<  - 96 LINES OR 72 LINES>>                                   15730000
               WARNFLAG := FALSE  <<STANDARD FORMLENGTH>>               15732000
               ELSE WARNFLAG := TRUE;                                   15734000
               I := 0;                                                  15736000
               VFC := 0;                                                15738000
               MOVE VFC(1) := VFC, (MAX'VFC'LINES);            <<04197>>15740000
               DO                                                       15742000
                  BEGIN                                                 15744000
                  VFCIN := 0;                                           15746000
                  TOS := 0;                                             15748000
                  MOVE  VFCIN(1) := VFCIN, (7);                         15752000
                  LNTH := FREAD(FN, VFCIN,8);                           15754000
                  IF > THEN GO VFCREAD'DONE;                            15756000
                  LINES'IN'VFC := LINES'IN'VFC + 1;            <<04197>>15758000
                                                               <<04197>>15760000
               << Check each line for invalid characters. >>   <<04197>>15762000
                  VFCLINE'OKAY := TRUE;                        <<04197>>15764000
                  J := 0;                                      <<04197>>15766000
                  DO IF NOT  ( BVFCIN(J) = " "  LOR            <<04197>>15768000
                               BVFCIN(J) = "0"  LOR            <<04197>>15770000
                               BVFCIN(J) = "1"        )        <<04197>>15772000
                     THEN VFCLINE'OKAY := FALSE                <<04197>>15774000
                  UNTIL ( (J := J + 1) > 15);                  <<04197>>15776000
                  IF NOT VFCLINE'OKAY THEN                     <<04197>>15778000
                  BEGIN                                        <<04197>>15780000
                     ERRN := BAD'VFC'LINE;                     <<04197>>15782000
                     PRINTVFC := TRUE;                         <<04197>>15784000
                     GO RETURN1;                               <<04197>>15786000
                  END;                                         <<04197>>15788000
                                                               <<04197>>15790000
               << Process the VFC line.                 >>     <<04197>>15792000
                                                               <<04197>>15794000
               << First, translate the character string of >>  <<04197>>15796000
               << " "'s, "0"'s, and "1"'s into a logical   >>  <<04197>>15798000
               << value.  A set of logicals, one for each  >>  <<04197>>15800000
               << line in the form, will later be sent to  >>  <<04197>>15802000
               << the device via ATTACHIO.                 >>  <<04197>>15804000
                  J := 15;                                     <<04197>>15806000
                  DO                                                    15808000
                     BEGIN                                              15810000
                     TOS := TOS&LSL(1);                                 15812000
                     IF BVFCIN(J) = " " OR BVFCIN(J) = "0" THEN         15814000
                        BEGIN                                           15816000
                        END                                             15818000
                     ELSE                                               15820000
                        TOS := TOS LOR 1;                               15822000
                     END                                                15824000
                  UNTIL (J := J-1) < 0 ;                                15826000
                  VFC (I) := TOS;                                       15828000
                  END                                                   15830000
               UNTIL (I := I+1) >= COUNT   ;                   <<SP.09>>15832000
                                                                        15834000
VFCREAD'DONE:                                                           15836000
            << If the definition of Channel One has        >>  <<04197>>15838000
            << changed, then the device will have to be    >>  <<04197>>15840000
            << realigned to top of form when the next      >>  <<04197>>15842000
            << printjob is done.  The operator will have   >>  <<04197>>15844000
            << to be informed.                             >>  <<04197>>15846000
            << Note:  VFC(I) is TRUE (high order bit on)   >>  <<04197>>15848000
            << if Channel One is defined for line I.       >>  <<04197>>15850000
               IF NOT VFC THEN WARNFLAG := TRUE; <<NO CH1>>             15852000
                                     << SKIP IN POSITION 1>>            15854000
               I := 1;TOS := 0;                                         15856000
               DO                                                       15858000
                  TOS := TOS LOR VFC(I)                                 15860000
               UNTIL (I := I+1) >= COUNT -1;                            15862000
               IF  LOGICAL(TOS) THEN WARNFLAG := TRUE;                  15864000
               IF WARNFLAG THEN                                         15866000
               << WARN OPERATOR THAT THE NEXT PRINTJOB>>                15868000
               << WILL NEED REALIGNMENT   >>                            15870000
               << THIS IS TRUE BECAUSE CH 1 HAS CHANGED>>               15872000
               << AND PRINTER DRIVER USES CH1 BETWEEN OPENS>>           15874000
                  BEGIN                                                 15876000
                  ERRN := ERR'REALIGN;                                  15878000
                  PRINTVFC := FALSE;                           <<04197>>15880000
                  ERRF := LDN;                                          15882000
                                                                        15884000
                  END;                                                  15886000
               <<GET SYSTEM BUFFER AND ATTACHIO >>                      15888000
               PRINTVFC := FALSE; <<DONT PRINT VFCBUF >>                15890000
               BUFINDX := GETSYSBUF(1,FALSE);                           15892000
               IF <> THEN                                               15894000
                  BEGIN                                                 15896000
                  ERRN := ERR'NO'SYSBUFS;                               15898000
                  GO RETURN1;                                           15900000
                  END;                                                  15902000
               TOS := SBUFDST;  <<SYS BUFFERS>>                         15904000
               TOS := BUFINDX;                                          15906000
               TOS := @VFC; <<ADDRESS OF VFC>>                          15908000
               TOS := COUNT;                                            15910000
               ASSEMBLE(MTDS 4); <<TRANSFER VFC TO BUFFER>>             15912000
              END;    << IF COUNT <>0>>                                 15914000
                                                                        15916000
               P2 := 0;                                        <<04390>>15918000
               DRETURN := ATTACHIO( LDN, 0, SBUFDST, BUFINDX,  <<04197>>15920000
                             VFCFUNC, COUNT, P1, P2, %13     );<<04197>>15922000
               IF SRETURN = 0 THEN                                      15924000
                  BEGIN                                                 15926000
                  ERRN := ERR'VFC'FAILED;                               15928000
                  ERRF := LDN;                                          15930000
                  GO RETURN1;                                           15932000
                  END;                                                  15934000
            END                                                <<02069>>15936000
            ELSE                                               <<02069>>15938000
               BEGIN  << NO "MARGIN", NO "VFC" >>              <<02069>>15940000
                  ERRN := EXP'VFC'MARGIN;                      <<02069>>15942000
                  PARM := PARMS( PNUM := 1 );                  <<04197>>15944000
                  PRINTVFC := TRUE;                            <<02069>>15946000
                  GO RETURN1;                                  <<02069>>15948000
               END;                                            <<02069>>15950000
        END;                                                            15952000
    END;                                                                15954000
END;                                                                    15956000
RETURN1:                                                                15958000
PARMNUM := PNUM;                                                        15960000
                                                               <<04197>>15962000
<< If a VFC file was opened, then it needs closing.        >>  <<04197>>15964000
IF FN <> 0 THEN FCLOSE(FN,0,0);                                         15966000
                                                               <<04197>>15968000
<< Handle any errors that occurred.  Note that warnings  >>    <<04197>>15970000
<< that have already been issued are ignored.            >>    <<04197>>15972000
IF ERRN > 0 THEN                                               <<04197>>15974000
   BEGIN                                                                15976000
   IF ERRN =  ERR'REALIGN THEN                                 <<00910>>15978000
   BEGIN                                                       <<00910>>15980000
      ERRN := -ERRN;                                           <<00910>>15982000
      @PP := @PARMSP;                                          <<04197>>15984000
   END;                                                        <<00910>>15986000
   IF PRINTVFC THEN                                                     15988000
   BEGIN                                                                15990000
      VFCIN(LNTH) := 0; <<FOR GENMSG TERMINATOR>>                       15992000
      GENMSG(-1,@BVFCIN); <<PRINT VFC BUFFER>>                          15994000
      OFFSET := @PP-@BVFCIN;                                            15996000
      IF 0 <= OFFSET <= 15 THEN                                <<04197>>15998000
      BEGIN                  << Caret bounds check. >>         <<04197>>16000000
         CARET := "  ";                                        <<04197>>16002000
         MOVE CARET(1) := CARET, (8);                          <<04197>>16004000
         MOVE CARET'(OFFSET) := ("^", 0);                      <<04197>>16006000
         GENMSG( -1, @CARET' );                                <<04197>>16008000
      END;                                                     <<04197>>16010000
      CIERR(ERRN);                                                      16012000
   END                                                                  16014000
   ELSE                                                                 16016000
   IF ERRF = 0 THEN                                                     16018000
      CIERR(ERRN,PP)                                                    16020000
   ELSE                                                                 16022000
      CIERR(ERRN,PP,%10000,ERRF);                                       16024000
   END;                                                                 16026000
END;                                                                    16030000
$PAGE "   ***   SHOWDEV   ***"                                 <<04801>>16034000
$CONTROL SEGMENT=OPHI                                          <<04801>>16036000
                                                                        16038000
<< Note:  Procedure SHOWDEV was moved unchanged from SPOOL- >> <<04801>>16040000
<< COMS to OPCOMMAND as part of this enhancement.  Its  fix >> <<04801>>16042000
<< number(s) were not changed.                              >> <<04801>>16044000
                                                                        16046000
INTEGER PROCEDURE SHOWDEV (PARMSTRING, PARMNUM, CONSOLE);      <<04801>>16048000
   VALUE PARMNUM, CONSOLE;                                     <<04801>>16050000
   LOGICAL CONSOLE;  <<TRUE=> CONSSHOWDEV, FALSE=> USER>>      <<04801>>16052000
   BYTE ARRAY PARMSTRING;                                               16054000
   INTEGER PARMNUM;                                                     16056000
   OPTION PRIVILEGED, UNCALLABLE;                                       16058000
BEGIN                                                                   16060000
                                                                        16062000
<< DECLARATIONS >>                                                      16064000
                                                                        16066000
<< PARSE >>                                                             16068000
   BYTE POINTER      PP;                                                16070000
   INTEGER PLEN;                                               <<04801>>16072000
                                                                        16074000
<< NO PARAMETER (ALL) SCAN >>                                           16076000
   INTEGER           MAXDEV,           <<HIGHEST DEV NUM>>              16078000
                     DEVNUM := 1;      <<RUNNING DEV NUM>>              16080000
                                                                        16082000
<< CLASS SCAN >>                                                        16084000
   DOUBLE            CLASSN0 := "    ",<<CLASS NAME>>                   16086000
                     CLASSN1 := "    ";                                 16088000
   BYTE ARRAY        CLASSNB (*) = CLASSN0;                             16090000
   INTEGER POINTER   CLASSP,           <<RUNNING CLASS POINTER>>        16092000
                     LIMITP;           <<DCT END>>                      16094000
   DOUBLE POINTER    CLASSPD = CLASSP; <<FOR NAME COMPARE>>             16096000
   BYTE POINTER      CLDEVP,           <<INTER-CLASS DEV PNTR>>         16098000
                     CLLIMP;           <<CLESS ENTRY END>>              16100000
   LOGICAL           EXCH := FALSE;    <<EXCH(LDT) SIGNAL>>             16102000
                                                                        16104000
<< FOR PROCESSING SUBROUTINE >>                                         16106000
   INTEGER           DEV,              <<CAUSE OF SUBR PARM ADDRESSING>>16108000
                     ADEV,             <<ABSOLUTE LPDT DEV ADDR>>       16110000
                     SAVESIR;                                           16112000
   INTEGER           LPDT0,            <<LOCAL LPDT IMAGE>>             16114000
                     LPDT1;                                             16116000
   INTEGER ARRAY     LPDT (*)  = LPDT0;                                 16118000
   DOUBLE            LDT0,             <<LOCAL LDT IMAGE>>              16120000
                     LDT2;                                              16122000
   INTEGER           LDT4;                                              16124000
   INTEGER ARRAY     LDT (*) = LDT0;                                    16126000
   LOGICAL ARRAY     LDTL (*) = LDT;                                    16128000
   INTEGER POINTER   JMATP;            <<TO DETERMINE OWNIGN JOB NO.>>  16130000
   DEFINE            PC'PROCTYPE  = 9).(6:1  #;  <<PROC TYPE BIT>>      16132000
   EQUATE            SYSPROCESS  = 1;                                   16134000
   INTEGER           OWNER := 0;       <<OWNER JOBNUM; IF USER>>        16136000
INTEGER ARRAY                                                  <<04801>>16138000
   JITDST(0:ASS'ENTRYSIZE);  << ASSOCIATE TABLE ENTRY.     >>  <<04801>>16140000
BYTE ARRAY JITDST'(*)=JITDST;                                  <<04801>>16142000
EQUATE                                                         <<04801>>16144000
       JITJOBNUM=%11;<<JOB # LOCATION IN JIT>>                 <<04801>>16146000
INTEGER VOLLEN;   <<LENGTH OF OUTPUT FROM PVOLID ROUTINE>>     <<04801>>16148000
                                                                        16150000
<< PRINT VARIABLES >>                                                   16152000
   DEFINE            LP'JA  = 1).(2:2  #;  <<JOB&DATA ACCEPT BITS>>     16154000
   EQUATE            MAXBUF = 35;                              <<04801>>16156000
   ARRAY             BUF (0:MAXBUF);   <<OUTPUT BUFFER>>                16158000
   BYTE ARRAY        BUFB (*) = BUF;                                    16160000
   INTEGER           LEN;              <<PRINT LEN (+BYTES)>>           16162000
   DEFINE            HEADER =                                           16164000
      ("LDEV  AVAIL     OWNERSHIP         VOLID         ",     <<04801>>16166000
       "DEN   ASSOCIATION")#;                                  <<04801>>16168000
   EQUATE            HEADERLEN = -65;                          <<04801>>16170000
   LOGICAL           HEADERPRINTED := FALSE;                            16172000
                                                                        16174000
                                                                        16176000
SUBROUTINE CONSERR(ERRNUM, ERRPTR, PARMMASK, PARM);            <<04801>>16178000
VALUE ERRNUM, PARMMASK, PARM;                                  <<04801>>16180000
INTEGER ERRNUM, PARMMASK, PARM;                                <<04801>>16182000
BYTE ARRAY ERRPTR;                                             <<04801>>16184000
<<FOR THE MOMENT, THIS INTERFACE IS A DUMMY>>                  <<04801>>16186000
BEGIN                                                          <<04801>>16188000
SHOWDEV := ERRNUM;                                             <<04801>>16190000
END;   <<CONSERR>>                                             <<04801>>16192000
                                                                        16194000
                                                                        16196000
INTEGER SUBROUTINE EMITFILES (POS);                                     16198000
   VALUE POS;                                                           16200000
   INTEGER POS;                                                         16202000
<< EMITS:  "<USECOUNT> FILES" >>                                        16204000
BEGIN                                                                   16206000
   MOVE BUFB (POS +ASCII (LDT (LD'USECOUNT), 10, BUFB (POS))) :=        16208000
         " FILES";                                                      16210000
   EMITFILES := X + 6;                                                  16212000
   END;    <<EMITFILES>>                                                16214000
                                                                        16216000
                                                                        16218000
INTEGER SUBROUTINE EMITDP (POS);                                        16220000
   VALUE POS;                                                           16222000
   INTEGER POS;                                                         16224000
<< EMITS:  "; DP", IF DOWN PENDING >>                                   16226000
   IF LDTL (LD'R) THEN                                                  16228000
      BEGIN    <<DOWN PENDING>>                                         16230000
      MOVE BUFB (POS) := "; DP";                                        16232000
      EMITDP := POS +4;                                                 16234000
      END                                                               16236000
   ELSE                                                                 16238000
      EMITDP := POS;                                                    16240000
   <<EMITDP>>                                                           16242000
                                                                        16244000
                                                                        16246000
INTEGER SUBROUTINE EMITSPOOLED (POS);                                   16248000
   VALUE POS;                                                           16250000
   INTEGER POS;                                                         16252000
<< EMITS:  "SPOOLED" >>                                                 16254000
BEGIN                                                                   16256000
   MOVE BUFB (POS) := "SPOOLED";                                        16258000
   EMITSPOOLED := POS +7;                                               16260000
   END;    <<EMITSPOOLED>>                                              16262000
                                                                        16264000
                                                                        16266000
LOGICAL SUBROUTINE PROCESSREALDEV (DEVPARM);                            16268000
   VALUE DEVPARM;                                                       16270000
   INTEGER DEVPARM;                                                     16272000
<< PRINTS STATUS OF REAL DEVICE. >>                                     16274000
BEGIN                                                                   16276000
   ADEV := DEVPARM*LPDTSIZE;                                            16278000
   IF INTEGER(SYS'LPDTP(ADEV)) > 0 THEN                        <<04801>>16280000
      BEGIN    <<A REAL DEVICE: PRINT ITS STATUS>>                      16282000
      DEV := DEVPARM;  <<'CAUSE OF SUBR ADDRESSING>>                    16284000
      PROCESSREALDEV := TRUE;                                           16286000
      SAVESIR := GETSIR (LDTSIR);                                       16288000
      LPDT0 := SYS'LPDTP(ADEV);  <<MOVE LPDT ... >>                     16290000
      LPDT1 := SYS'LPDTP(ADEV+1);                                       16292000
      TOS := DEV *LDTSIZE;  << ... AND LDT >>                           16294000
      LDT0 := DPS0;                                                     16296000
      LDT2 := DPS0 (1);                                                 16298000
      LDT4 := PS0 (4);                                                  16300000
      DEL;                                                              16302000
      OWNER := 0;                                                       16304000
      IF (NOT IT'S'A'DISC ( LDT (LD'DEVTYPE) ) )               <<04801>>16306000
            AND LDT (LD'MAINPIN) <> 0 THEN                              16308000
         BEGIN    <<DEVICE HAS AN OWNER>>                               16310000
         IF ABS (ABS (PCBB) + LDT(LD'MAINPIN)*PCBSIZE          <<04801>>16312000
            + PC'PROCTYPE) <> SYSPROCESS THEN                  <<04801>>16314000
            BEGIN    <<OWNED BY A USER>>                                16316000
            EXCHANGEDB (JMATDST);  <<DETERMINE JOB NO.>>                16318000
            @JMATP := @JMAT'ENTRYP;                                     16320000
            WHILE (JMATP = 0)                                           16322000
                  OR (JMATP (JMAT'JSTATE) = JOBERR)            <<04801>>16324000
                  OR (JMATP(JMAT'PINNUM) <> LDT(LD'MAINPIN)) DO<<04801>>16326000
               BEGIN                                           <<04801>>16328000
               @JMATP := @JMATP +JMATENTRYSIZE;    <<ADVANCE>>          16330000
               IF @JMATP>=JMAT'CURSIZE&ASL(7) THEN             <<04801>>16332000
                   GO TO NOTOWNED;                             <<04801>>16334000
                    <<MUST BE STARTING OR TERMINATING>>        <<04801>>16336000
               END;                                            <<04801>>16338000
            OWNER := JMATP (JM'JOBNUM);                                 16340000
            END    <<USER JOB NO. DETERMINATION>>                       16342000
         << ELSE OWNER IS 0 >> ;                                        16344000
         END;                                                           16346000
    NOTOWNED:                                                  <<04801>>16348000
      RELSIR (LDTSIR, SAVESIR);                                         16350000
      EXCHANGEDB (0);                                                   16352000
                                                                        16354000
                                                                        16356000
   << PRINT DEVICE INFO: >>                                             16358000
                                                                        16360000
      BUF := "  ";                                             <<04801>>16362000
      MOVE BUF(1) := BUF,(MAXBUF);                             <<04801>>16364000
      IF NOT (HEADERPRINTED) THEN                                       16366000
         BEGIN                                                          16368000
         MOVE BUFB := HEADER;                                  <<04801>>16370000
         IF REQUESTSERVICE THEN GOTO LEAVE;                             16372000
         PRINT (BUF, HEADERLEN, %60);                                   16374000
         IF <> THEN GOTO LEAVE;                                         16376000
         HEADERPRINTED := TRUE;                                         16378000
         BUF := "  ";                                                   16380000
         MOVE BUF (1) := BUF, (MAXBUF);                                 16382000
         END;                                                           16384000
                                                                        16386000
      BUF := "  ";                                                      16388000
      ASCII (DEV, -10, BUFB (2));                                       16390000
      << JOB-ACC, DATA-ACC, BOTH, NEITHER >>                            16392000
      CASE * LPDT (LP'JA) OF                                            16394000
         BEGIN                                                          16396000
            TOS := " ";                                                 16398000
            TOS := "D";                                                 16400000
            TOS := "J";                                                 16402000
            TOS := "A"                                                  16404000
         END;                                                           16406000
      BUFB (4) := TOS;                                                  16408000
      IF NOT (LDTL (LD'F)) THEN                                         16410000
         BEGIN    <<DOWN>>                                              16412000
         IF LDTL (LD'SQ) THEN                                           16414000
            EMITSPOOLED (6)                                             16416000
         ELSE                                                           16418000
            MOVE BUF(3) := "UNAVAIL ";                                  16420000
         MOVE BUF (8) := "DOWN";                                        16422000
         LEN := 20;                                                     16424000
         IF LDTL (LD'M) THEN                                            16426000
            BEGIN    <<OWNED BY DIAG>>                                  16428000
            MOVE BUF (10) := ", DIAG";                                  16430000
            LEN := 27;                                                  16432000
            END;                                                        16434000
         END                                                            16436000
      ELSE                                                              16438000
         << UP >>                                                       16440000
         IF IT'S'A'DISC ( LDT (LD'DEVTYPE) ) THEN              <<04801>>16442000
            BEGIN    <<DISC>>                                           16444000
            MOVE BUF (3) := "DISC    ";                                 16446000
            LEN := EMITDP (EMITFILES (16));                             16448000
            END                                                         16450000
         ELSE                                                           16452000
            << OK ... NON-SHARABLE DEVICE >>                            16454000
            IF LPDT (LPDT'DRSTART) = DEVAVAIL THEN             <<04801>>16456000
               << UNOWNED >>                                            16458000
               IF LDTL (LD'SQ) THEN                                     16460000
                  LEN := EMITSPOOLED (6)                                16462000
               ELSE                                                     16464000
                  BEGIN    <<AVAILABLE REALEE>>                         16466000
                  MOVE BUF (3) := "AVAIL ";                             16468000
                  LEN := 11;                                            16470000
                  END                                                   16472000
            ELSE                                                        16474000
               BEGIN    <<UNAVAILABLE FOR SOME REASON>>                 16476000
               IF  (LDTL (LD'SQ))  OR  (LDT (LD'SP) = INPUTSPOOLER)     16478000
                     THEN                                               16480000
                  EMITSPOOLED (6)                                       16482000
               ELSE                                                     16484000
                  MOVE BUF (3) := "UNAVAIL ";                           16486000
               << PRINT OWNER >>                                        16488000
               IF (LPDT(LPDT'DRSTART) <> DEVOWNED)             <<04801>>16490000
                  OR (OWNER = 0) THEN                          <<04801>>16492000
                  << "SYSTEM'S" >>                                      16494000
                  IF LDT (LD'SP) = NOSPOOLER THEN                       16496000
                     BEGIN                                              16498000
                     MOVE BUF (8) := "SYS ";                            16500000
                     LEN := 19;                                         16502000
                     IF LDT (LD'MAINPIN) <> 0 THEN                      16504000
                        BEGIN                                           16506000
                        BUFB (20) := "#";                               16508000
                        LEN := 21                                       16510000
                              +ASCII (LDT (LD'MAINPIN), 10, BUFB(21));  16512000
                        END;                                            16514000
                     END                                                16516000
                  ELSE                                                  16518000
                     BEGIN    <<OWNED BY SPOOLER>>                      16520000
                     MOVE BUF (8) := "SPOOLER ";                        16522000
                     LEN := 27;                                         16524000
                     IF LDT (LD'SP) = OUTPUTSPOOLER THEN                16526000
                        MOVE BUF (12) := "OUT "                         16528000
                     ELSE                                               16530000
                        BEGIN                                           16532000
                        BUF (12) := "IN";                               16534000
                        LEN := LEN -1;                                  16536000
                        END;                                            16538000
                     END                                                16540000
               ELSE                                                     16542000
                  BEGIN    <<OWNED BY A JOB>>                           16544000
                  BUF (8) := IF OWNER.(0:2) = SESSIONTYPE THEN "#S"     16546000
                        ELSE "#J";                                      16548000
                  MOVE BUFB (18 +ASCII (OWNER.(2:14), 10, BUFB (18)))   16550000
                        := ": ";                                        16552000
                  LEN := EMITFILES (X + 2);                             16554000
                  END;                                                  16556000
               LEN := EMITDP (LEN);                                     16558000
               END;                                                     16560000
      IF (VOLLEN := PVOLID(DEVPARM,BUFB(34))) <> 0             <<04801>>16562000
         THEN LEN := VOLLEN;  << Tape - report VolID/Density >><<04801>>16564000
      SAVESIR := GETSIR( ASS'SIR );                            <<04801>>16566000
      TOS:=@JITDST;      <<ASSOCIATION TABLE ENTRY>>           <<04801>>16568000
      TOS := ASS'DST;                                          <<04801>>16570000
      TOS := DEV * ASS'ENTRYSIZE;                              <<04801>>16572000
      TOS := ASS'ENTRYSIZE;                                    <<04801>>16574000
      ASSEMBLE(MFDS 4);                                        <<04801>>16576000
      RELSIR( ASS'SIR, SAVESIR );                              <<04801>>16578000
      IF JITDST<>0 THEN <<DEVICE IS ASSOCIATED>>               <<04801>>16580000
      BEGIN                                                    <<04801>>16582000
         TOS:=@JITDST;                                         <<04801>>16584000
         TOS := JITDST( ASS'JIT );                             <<04801>>16586000
         TOS:=JITJOBNUM;                                       <<04801>>16588000
         TOS:=1;                                               <<04801>>16590000
         ASSEMBLE(MFDS 4);                                     <<04801>>16592000
         BUF(27):=IF JITDST.(0:1)=0 THEN "#S" ELSE "#J";       <<04801>>16594000
         LEN:=56+ASCII(JITDST.(2:14),10,BUFB(56));             <<04801>>16596000
         BUFB(LEN):="-";                                       <<04801>>16598000
         MOVE BUFB(LEN+1) := JITDST'(B'ASS'CLASS),(8);         <<04801>>16600000
         LEN:=LEN+9;                                           <<04801>>16602000
      END;                                                     <<04801>>16604000
                                                               <<04801>>16606000
      IF REQUESTSERVICE THEN GOTO LEAVE;                                16608000
      PRINT (BUF, -LEN, 0);                                             16610000
      IF <> THEN GOTO LEAVE;                                            16612000
      END                                                               16614000
   ELSE                                                                 16616000
      BEGIN                                                             16618000
      EXCHANGEDB (0);                                                   16620000
      PROCESSREALDEV := FALSE;                                          16622000
      END;                                                              16624000
   END;    <<PROCESSREALDEV>>                                           16626000
                                                                        16628000
                                                                        16630000
   SHOWDEV := 0;                                                        16632000
   SCAN PARMSTRING WHILE %6440, 1;                                      16634000
   IF CARRY THEN                                                        16636000
      BEGIN    <<REQUEST FOR ALL DEVICES>>                              16638000
      DEL;                                                              16640000
      MAXDEV := SYS'LPDTP(LPDT'MAXDEV);                                 16642000
      DO BEGIN                                                          16644000
         EXCHANGEDB (LDTDST);                                           16646000
         PROCESSREALDEV (DEVNUM);                                       16648000
         END                                                            16650000
      UNTIL  ((DEVNUM := DEVNUM +1) > MAXDEV);                          16652000
      END                                                               16654000
   ELSE                                                                 16656000
      BEGIN    <<PARM SPECIFIED>>                                       16658000
      @PP := S0;                                                        16660000
      MOVE BPS0 := BPS0 WHILE ANS,1;  <<SCAN TOKEN, UPSHIFT>>  <<04801>>16662000
      SCAN BPS0 WHILE %6440,1;  <<SKIP BLANKS>>                         16664000
      IF NOCARRY <<NOT CARRIAGE RETURN>> THEN  <<TOO MANY PARMS<<04801>>16666000
         IF CONSOLE THEN   <<MUST BE HANDLED CAREFULLY>>       <<04801>>16668000
            CONSERR(-SHOWDV2MP, BPS0(1), 0, 0)                 <<04801>>16670000
         ELSE   <<REGULAR USER, SEND ERROR MESSAGE>>           <<04801>>16672000
            CIERR(-SHOWDV2MP, BPS0(1));  <<WARN IGNORED>>      <<04801>>16674000
      DEL;  <<POP POINTER TO EXTRA PARM>>                      <<04801>>16676000
      PLEN := -(TOS -TOS);                                              16678000
      DEVNUM := BINARY (PP, PLEN);                                      16680000
      IF = THEN                                                         16682000
         BEGIN    <<LEGITIMATE NUMBER>>                                 16684000
         EXCHANGEDB (LDTDST);                                           16686000
         IF NOT (1 <= DEVNUM <= LDT'HIENTRY) THEN                       16688000
            BEGIN    <<OUT OF BOUNDS>>                                  16690000
            EXCHANGEDB (0);                                             16692000
            <<LOGICAL DEVICE NUMBER DOES NOT EXIST>>           <<04801>>16694000
            IF CONSOLE THEN                                    <<04801>>16696000
               CONSERR(SHOWDVNOSUCHLDN,PP,%10000,DEVNUM)       <<04801>>16698000
            ELSE                                               <<04801>>16700000
               BEGIN                                           <<04801>>16702000
               CIERR(SHOWDEV := SHOWDVNOSUCHLDN,PP,%10000,DEVNUM);      16704000
               PARMNUM := 1;                                   <<04801>>16706000
               END;                                            <<04801>>16708000
            END                                                <<04801>>16710000
         ELSE IF NOT (PROCESSREALDEV (DEVNUM)) THEN            <<04801>>16712000
            <<LOGICAL DEVICE NUMBER DOES NOT EXIST>>           <<04801>>16714000
            IF CONSOLE THEN                                    <<04801>>16716000
               CONSERR(SHOWDVNOSUCHLDN,PP,%10000,DEVNUM)       <<04801>>16718000
            ELSE                                               <<04801>>16720000
               BEGIN                                           <<04801>>16722000
               CIERR(SHOWDEV := SHOWDVNOSUCHLDN,PP,%10000,DEVNUM);      16724000
               PARMNUM := 1;                                   <<04801>>16726000
               END;                                            <<04801>>16728000
         END                                                   <<04801>>16730000
      ELSE IF > THEN   <<TOO LARGE FOR BINARY TO HANDLE>>      <<04801>>16732000
         BEGIN                                                 <<04801>>16734000
         TOS := PP(PLEN);                                      <<04801>>16736000
         PP(PLEN) := 0;  <<STOPPER FOR GENMSG>>                <<04801>>16738000
         IF CONSOLE THEN                                       <<04801>>16740000
            CONSERR(SHOWDVNOSUCHLDN, PP, 0, @PP)               <<04801>>16742000
         ELSE                                                  <<04801>>16744000
            BEGIN                                              <<04801>>16746000
            CIERR(SHOWDEV := SHOWDVNOSUCHLDN, PP, 0, @PP);     <<04801>>16748000
            PARMNUM := 1;                                      <<04801>>16750000
            END;                                               <<04801>>16752000
         PP(PLEN) := TOS;                                      <<04801>>16754000
         END                                                   <<04801>>16756000
      ELSE                                                     <<04801>>16758000
         BEGIN    <<NOT NUM: TRY CLASS>>                       <<04801>>16760000
         IF PLEN > 8 THEN                                      <<04801>>16762000
            BEGIN   <<INVALID CLASS NAME>>                     <<04801>>16764000
            TOS := PP(PLEN);  <<BYTE PAST LAST CHARACTER>>     <<04801>>16766000
            PP(PLEN) := 0;  <<INSERT GENMSG STOPPER>>          <<04801>>16768000
            IF CONSOLE THEN                                    <<04801>>16770000
               CONSERR(SHOWDVINVLDCLAS,PP,0,@PP)               <<04801>>16772000
            ELSE                                               <<04801>>16774000
               CIERR(SHOWDEV := SHOWDVINVLDCLAS, PP, 0, @PP);  <<04801>>16776000
            PP(PLEN) := TOS;  <<RESTORE DAMAGED CHARACTER>>    <<04801>>16778000
            PARMNUM := 1;                                      <<04801>>16780000
            RETURN;   <<BAIL OUT>>                             <<04801>>16782000
            END;                                               <<04801>>16784000
         MOVE CLASSNB := PP, (PLEN);                                    16786000
         EXCHANGEDB (LDTDST);                                           16788000
         @CLASSP := @LDT'DCTP;                                          16790000
         @LIMITP := @CLASSP +LDT'DCTSIZE;                               16792000
         DO                                                             16794000
         UNTIL  (CLASSPD = CLASSN0)  AND  (CLASSPD(1) = CLASSN1)        16796000
               OR  ((@CLASSP := @CLASSP                                 16798000
                  +(CLASSP (DC'NUMDEVS) &ASR(1)) +6) >= @LIMITP);       16800000
         IF @CLASSP >= @LIMITP THEN                                     16802000
            BEGIN    << DIDN'T FIND CLASS >>                            16804000
            EXCHANGEDB (0);                                             16806000
            TOS := PP(PLEN);  <<BYTE PAST LAST CHARACTER>>     <<04801>>16808000
            PP(PLEN) := 0;  <<INSERT GENMSG STOPPER>>          <<04801>>16810000
            IF CONSOLE THEN                                    <<04801>>16812000
               CONSERR(SHOWDVNOSUCHCLS,PP,0,@PP)               <<04801>>16814000
            ELSE                                               <<04801>>16816000
               CIERR(SHOWDEV := SHOWDVNOSUCHCLS, PP, 0, @PP);  <<04801>>16818000
            PP(PLEN) := TOS;  <<RESTORE DAMAGED CHARACTER>>    <<04801>>16820000
            PARMNUM := 1;                                      <<04801>>16822000
            END                                                         16824000
         ELSE                                                           16826000
            BEGIN    <<FOUND: SCAN THRU CLASS>>                         16828000
            @CLDEVP := (@CLASSP &LSL(1)) +DC'FIRSTDEV'B;                16830000
            @CLLIMP := @CLDEVP +CLASSP (DC'NUMDEVS);                    16832000
            DO BEGIN                                                    16834000
               IF EXCH THEN EXCHANGEDB (LDTDST);                        16836000
               EXCH := TRUE;                                            16838000
               PROCESSREALDEV (CLDEVP);                                 16840000
               END                                                      16842000
            UNTIL (@CLDEVP := @CLDEVP +1) = @CLLIMP;                    16844000
            END;    <<CLASS SCAN>>                                      16846000
         END;    <<CLASS REQUEST>>                                      16848000
      END;    <<PARM PROCESSING>>                                       16850000
                                                                        16852000
LEAVE:                                                                  16854000
   END;    <<SHOWDEV>>                                                  16856000
$PAGE "CONSSHOWDEV"                                            <<04801>>16858000
$CONTROL SEGMENT=OPLOW                                         <<04801>>16860000
                                                                        16862000
<< Note:  Procedure CONSSHOWDEV was  moved  unchanged  from >> <<04801>>16864000
<< SPOOLCOMS to OPCOMMAND as part of this enhancement.  Its >> <<04801>>16866000
<< fix number(s) were not changed.                          >> <<04801>>16868000
                                                                        16870000
LOGICAL PROCEDURE CONSSHOWDEV (PARMSTRING);                             16872000
   BYTE ARRAY PARMSTRING;                                               16874000
   OPTION PRIVILEGED, UNCALLABLE;                                       16876000
BEGIN                                                                   16878000
   INTEGER PN;                                                          16880000
                                                                        16882000
   CONSSHOWDEV := (SHOWDEV (PARMSTRING, PN, TRUE) = 0);                 16884000
   END;    <<CONSSHOWDEV>>                                              16886000
$PAGE "CXSHOWDEV"                                              <<04801>>16888000
$CONTROL SEGMENT=OPHI                                          <<04801>>16890000
                                                                        16892000
<< Note:  Procedure  CXSHOWDEV  was  moved  unchanged  from >> <<04801>>16894000
<< SPOOLCOMS to OPCOMMAND as part of this enhancement.  Its >> <<04801>>16896000
<< fix number(s) were not changed.                          >> <<04801>>16898000
                                                                        16900000
PROCEDURE CXSHOWDEV (PARMSP, ERRNUM, PARMNUM);                          16902000
   BYTE ARRAY PARMSP;                                                   16904000
   INTEGER ERRNUM, PARMNUM;                                             16906000
   OPTION PRIVILEGED, UNCALLABLE;                                       16908000
BEGIN                                                                   16910000
   ERRNUM := SHOWDEV (PARMSP, PARMNUM, FALSE);                          16912000
   END;    << CXSHOWDEV >>                                              16914000
$PAGE "   ***   =ABORTJOB   ***"                               <<04801>>16916000
$CONTROL SEGMENT=OPHI                                          <<04801>>16918000
                                                                        16920000
<< Note:  Procedure  DELETEJOB  was  moved  unchanged  from >> <<04801>>16922000
<< SPOOLCOMS to OPCOMMAND as part of this enhancement.  Its >> <<04801>>16924000
<< fix number(s) were not changed.                          >> <<04801>>16926000
                                                                        16928000
LOGICAL PROCEDURE DELETEJOB (JMATP);                                    16930000
   VALUE JMATP;                                                         16932000
   INTEGER POINTER JMATP;                                               16934000
   OPTION PRIVILEGED, UNCALLABLE;                                       16936000
BEGIN                                                                   16938000
   INTEGER           STATE;                                             16940000
                                                                        16942000
<< >>                                                                   16944000
   STATE := JMATP (JMAT'JSTATE);                                        16946000
   IF  (JMATP <> 0)  AND  (STATE <> JOBINTRO)  THEN                     16948000
      BEGIN    <<WAIT, INIT, EXEC OR DONE  (OR ERROR)  STATE>>          16950000
      IF  (STATE = JOBCIINIT)  OR  (STATE = JOBEXEC)                    16952000
                             OR  (STATE = JOBSUSP) THEN                 16954000
         BEGIN    <<ABORT RUNNING JOB>>                                 16956000
         ABORTJOB (JMATP (JMAT'PINNUM));                                16958000
         IF < THEN SUDDENDEATH (371);                                   16960000
         END                                                            16962000
      ELSE                                                              16964000
         IF (STATE = JOBWAIT) THEN                                      16966000
            BEGIN    <<REMOVE JMAT ENTRY & RELEASE $STDIN FILE>>        16968000
            DELINKENTRY (JMAT'SCHEDHEADP, JMATP);                       16970000
            TOS := JMATP (JM'JOBNUM);                                   16972000
            DEALLOCENTRY (JMATP);                                       16974000
            DELETEDEVFILE (S0, TRUE);                                   16976000
            DEL;                                                        16978000
            END                                                         16980000
         << ELSE DONE, WHICH IS FINISHING BY ITSELF >> ;                16982000
      TOS := TRUE;                                                      16984000
      END                                                               16986000
   ELSE                                                                 16988000
      TOS := FALSE;                                                     16990000
   DELETEJOB := TOS;                                                    16992000
   END;    <<DELETEJOB>>                                                16994000
$PAGE "CONSABORTJOB"                                           <<04801>>16996000
$CONTROL SEGMENT=OPLOW                                         <<04801>>16998000
                                                                        17000000
<< Note:  Procedure CONSABORTJOB was moved  unchanged  from >> <<04801>>17002000
<< SPOOLCOMS to OPCOMMAND as part of this enhancement.  Its >> <<04801>>17004000
<< fix number(s) were not changed.                          >> <<04801>>17006000
                                                                        17008000
LOGICAL PROCEDURE CONSABORTJOB (PARMSTRING);                            17010000
   BYTE ARRAY PARMSTRING;                                               17012000
   OPTION PRIVILEGED, UNCALLABLE;                                       17014000
BEGIN                                                                   17016000
   BYTE POINTER      PP;               <<PARM>>                         17018000
   INTEGER           PLEN;                                              17020000
   INTEGER           SAVESIR;                                           17022000
   INTEGER POINTER   JMATP,            <<ENTRY PNTR>>                   17024000
                     LIMITP;           <<TABLE END>>                    17026000
                                                                        17028000
<< >>                                                                   17030000
   CONSABORTJOB := FALSE;                                               17032000
   SCAN PARMSTRING WHILE %6440, 1;                                      17034000
   IF  NOCARRY  AND  (BPS0 = "#")  THEN                                 17036000
      BEGIN                                                             17038000
      @PP := S0;                                                        17040000
      SCAN * UNTIL %6440, 1;                                            17042000
      IF NOCARRY THEN                                                   17044000
         BEGIN                                                          17046000
         SCAN BPS0 WHILE %6440;                                         17048000
         IF NOCARRY THEN RETURN;                                        17050000
         END;                                                           17052000
      IF (PLEN := TOS -@PP) > 2 THEN                                    17054000
         BEGIN                                                          17056000
         TOS := BINARY (PP(2), PLEN-2);                                 17058000
         IF  =  AND  (S0.(0:2) = 0)  THEN                               17060000
            BEGIN                                                       17062000
            MOVE PP(1) := PP(1) WHILE AS;                      <<04801>>17064000
            IF PP(1) = "J" THEN TOS.(0:2) := 2                          17066000
            ELSE                                                        17068000
               IF PP(1) = "S" THEN TOS.(0:2) := 1                       17070000
               ELSE RETURN;                                             17072000
            EXCHANGEDB (JMATDST);                                       17074000
            SAVESIR := GETSIR (JMATSIR);                                17076000
            @JMATP := @JMAT'ENTRYP;                                     17078000
            @LIMITP := JMAT'CURSIZE *TBLQUANTUM -JMAT'ENTRYSIZE;        17080000
            DO                                                          17082000
            UNTIL (JMATP <> 0) AND (JMATP (JM'JOBNUM) = S0)             17084000
                  OR (@JMATP := @JMATP +JMAT'ENTRYSIZE) > @LIMITP;      17086000
            IF = THEN                                                   17088000
               CONSABORTJOB := DELETEJOB (JMATP);                       17090000
            RELSIR (JMATSIR, SAVESIR);                                  17092000
            EXCHANGEDB (0);                                             17094000
            END;                                                        17096000
         END;                                                           17098000
      END;                                                              17100000
   END;    <<CONSABORTJOB>>                                             17102000
$PAGE "   ***   DAYTIME   ***"                                 <<04801>>17104000
$CONTROL SEGMENT=OPHI                                          <<04801>>17106000
                                                                        17108000
<< Note:  Procedure DAYTIME was moved unchanged from SPOOL- >> <<04801>>17110000
<< COMS to OPCOMMAND as part of this enhancement.  Its  fix >> <<04801>>17112000
<< number(s) were not changed.                              >> <<04801>>17114000
                                                                        17116000
PROCEDURE DAYTIME (STRING, TIMESTAMP);                                  17118000
   VALUE TIMESTAMP;                                                     17120000
   BYTE ARRAY STRING;                                                   17122000
   DOUBLE TIMESTAMP;                                                    17124000
   OPTION UNCALLABLE;                                                   17126000
<< PRINTS DAY OF WEEK AND TIME.                                         17128000
   FORMAT:   "MON 11:53A"   (10 BYTES) >>                               17130000
BEGIN                                                                   17132000
   BYTE ARRAY DAYS (*) = PB :=                                          17134000
      "SUNMONTUEWEDTHUFRISAT";                                          17136000
   INTEGER                                                              17138000
      DATE  = Q+1,                                                      17140000
      TIME  = Q+2,                                                      17142000
      YEAR  = Q+3,                                                      17144000
      DAY   = Q+4,                                                      17146000
      X     = X;                                                        17148000
   EQUATE                                                               17150000
      NOON  = 12 *256;                                                  17152000
                                                                        17154000
SUBROUTINE CONVERT (N, POS);                                            17156000
   VALUE N, POS;                                                        17158000
   INTEGER N, POS;                                                      17160000
<< CONVERT N TO 2-DIGIT ASCII AT STRING (POS) >>                        17162000
BEGIN                                                                   17164000
   X := POS;                                                            17166000
   TOS := N;                                                            17168000
   TOS := 10;                                                           17170000
   ASSEMBLE (DIV, XCH);                                                 17172000
   STRING (X) := TOS +"0";                                              17174000
   X := X+1;                                                            17176000
   STRING (X) := TOS +"0";                                              17178000
   END;    <<CONVERT>>                                                  17180000
                                                                        17182000
   TOS := TIMESTAMP;                                                    17184000
   TOS := DATE.(0:7);                                                   17186000
   TOS := DATE.(7:9);                                                   17188000
   X := ((YEAR-1) &ASR(2) +YEAR +DAY) MOD 7 *3;                         17190000
   MOVE STRING := "      :  A";                                         17192000
   MOVE STRING := DAYS (X), (3);                                        17194000
   TOS := (TIME.(0:8) +11) MOD 12 +1;                                   17196000
   CONVERT (*, 4);                                                      17198000
   IF STRING (4) = "0" THEN STRING (4) := " ";                          17200000
   CONVERT (TIME.(8:8), 7);                                             17202000
   IF TIME >= NOON THEN STRING (9) := "P";                              17204000
   END;    <<DAYTIME>>                                                  17206000
$PAGE "   ***   SHOWJOB   ***"                                 <<04801>>17208000
$CONTROL SEGMENT=OPHI                                          <<04801>>17210000
                                                                        17212000
<< Note:  Procedure SHOWJOB was moved unchanged from SPOOL- >> <<04801>>17214000
<< COMS to OPCOMMAND as part of this enhancement.  Its  fix >> <<04801>>17216000
<< number(s) were not changed.                              >> <<04801>>17218000
                                                                        17220000
INTEGER PROCEDURE SHOWJOB (PARMSP, PARMNUM, CONSOLE);          <<04801>>17222000
   VALUE CONSOLE;                                              <<04801>>17224000
   LOGICAL CONSOLE;  <<TRUE => CALLED FROM CONSOLE>>           <<04801>>17226000
   BYTE ARRAY PARMSP;                                                   17228000
   INTEGER PARMNUM;                                                     17230000
   OPTION PRIVILEGED, UNCALLABLE;                                       17232000
<< PROCEDURE WHICH ACTUALLY PERFORMS :(=)SHOWJOB.  <PARMSP> CONTAINS    17234000
   PARAMETER IMAGE.  TYPE RETURN IS 0 (OKAY) OR CI ERROR NUMBER         17236000
   (IN WHICH CASE <PARMNUM> IS ERRING PARM NUMBER).  PRODUCES           17238000
   SHOWJOB LISTING ON $STDLIST, USING PRINT.  >>                        17240000
BEGIN                                                                   17242000
                                                                        17244000
<< INTERNAL REPRESENTATIONS OF JOB STATES >>                            17246000
<< These are used for indexes to STCOUNTS; JEXEC used to     >><<04801>>17248000
<< TALLY NUMBER OF JOBS IN JOBEXEC AND JOBINIT states        >><<04801>>17250000
   EQUATE            NOSTATE  = -1,    <<NO SPECIFICATION>>             17252000
                     JINTRO  = 0,      << INTRODUCED >>        <<04801>>17254000
                     JWAIT   = 1,      << WAIT       >>        <<04801>>17256000
                     JEXEC  = 2,       <<INCLUDES INIT.&TERM.>><<04801>>17258000
                  << JINIT NO LONGER USED.  COUNTED AS EXEC. >><<04801>>17260000
                     JSUSP  = 4;       <<SUSPENDED>>                    17262000
                                                                        17264000
<< FOR PARAMETER PARSE >>                                               17266000
   EQUATE            MAXPARMS  = 6;                                     17268000
                                                                        17270000
   INTEGER           NUMPARMS;                                          17272000
   DOUBLE ARRAY      PARMS (1:MAXPARMS);                                17274000
   BYTE POINTER      PP;                                                17276000
   BYTE              PLEN;                                              17278000
   INTEGER           PDELWD = PLEN;                                     17280000
   DOUBLE            PARM = PP;                                         17282000
   EQUATE            COMMA = 0,                                         17284000
                     EQUAL = 1,                                         17286000
                     SEMI = 2,                                          17288000
                     CR = 3;                                            17290000
   INTEGER           PNUM := 0;                                         17292000
   DEFINE                                                               17294000
      PSPECIAL          = LOGICAL (PDELWD.(10:1))  #,                   17296000
      PDEL              = PDELWD.(11:5)  #;                             17298000
                                                                        17300000
   DOUBLE            X1  := ",=;.";    <<DELIMITERS>>                   17302000
   INTEGER           X2  := %6400;     <<(MUST FOLLOW <X1>.>>           17304000
   BYTE ARRAY        DELS (*)  = X1;                                    17306000
   EQUATE            PERIOD  = CR,     <<PERIOD IS ADD'L DELIM, ...>>   17308000
                     CR'  = CR +1;     <<... REPLACING CR>>             17310000
   BYTE ARRAY        KEYWORDSP (*) = PB  :=                             17312000
   << ENTRIES CONTAIN NAME, PROCESSOR INDEX [,AND STATE VALUE] >>       17314000
                        6, 3, "JOB", 1,                                 17316000
                        9, 5, "INTRO", 2, JINTRO,                       17318000
                        8, 4, "WAIT", 2, JWAIT,                         17320000
                        8, 4, "EXEC", 2, JEXEC,                         17322000
                        8, 4, "SUSP", 2, JSUSP,                         17324000
                        9, 6, "STATUS", 3,                              17326000
                        0;                                              17328000
   EQUATE            KEYWORDSLEN  = (49 +1)/2;  <<IN WORDS>>            17330000
   ARRAY             KEYWORDSPW (*)  = KEYWORDSP,                       17332000
                     KEYWORDSW (0:KEYWORDSLEN-1) = Q;                   17334000
   BYTE ARRAY        KEYWORDS (*)  = KEYWORDSW;                         17336000
   BYTE POINTER      KEYDEFN;                                           17338000
                                                                        17340000
<< PARAMETERS CONTROLLING SCAN (PARSE PHASE "OUTPUT") >>                17342000
   << INITIALIZED FOR NULL PARAMETER CASE (ALL) >>                      17344000
   EQUATE            FORJOBNUM  = 0,   <<COMMAND OPTION>>               17346000
                     QUALIFIED  = 1,                                    17348000
                     STATUS  = 2;                                       17350000
   INTEGER           OPTIONTYPE  := QUALIFIED,                          17352000
                     JOBNUM  := 0,     <<SPECIFIED JOBNUM, OR 0>>       17354000
                     JTYPE  := 0,      <<"@J", OR "@S", OR 0>>          17356000
                     STATE  := NOSTATE;<<SPECIFIED STATE>>              17358000
   EQUATE            NODEFR  = 2;      <<,N/,D NOT SUPPLIED>>           17360000
   INTEGER           IDEFR  := NODEFR; <<DEFERREDNESS>>                 17362000
   LOGICAL           DEFR  = IDEFR;    <<TRUE => DEFERRED>>             17364000
   << NAMES SUPPLIED FOR QUALIFIED SCAN  (NLEN <> 0)  >>                17366000
   INTEGER ARRAY     INAMES (0:11) = Q;                                 17368000
   BYTE ARRAY        NAMES (*)  = INAMES,                               17370000
                     JN (*)  = NAMES (16),                              17372000
                     UN (*)  = NAMES (0),                               17374000
                     AN (*)  = NAMES (8);                               17376000
   INTEGER           NLEN  := 0,       <<COMPARE LEN (BYTES)>>          17378000
                     NSTART  := 0;     <<COMPARE START POS>>   <<04801>>17380000
                                                                        17382000
<< SCAN/PRINT PHASE -- EXTRA DATA SEG VARIABLES >>             <<04801>>17384000
   INTEGER           DSTNUM  := 0,     <<0 => NOT ACQUIRED>>   <<04801>>17386000
                     DSTLENGTH,                                <<04801>>17388000
                     ERRNUM := 0;      <<DST ERR?>>            <<04801>>17390000
                                                               <<04801>>17392000
<< MISC VARIABLES FOR SCAN PHASE >>                                     17394000
   INTEGER           SAVESIR,          <<GETSIR RESULT>>                17396000
                     RANK  := 0;       <<WAIT RANK ACCUMULATOR>>        17398000
   INTEGER ARRAY     ENTRYP(0:JMATENTRYSIZE-1); <<WORK BUF>>   <<04801>>17400000
   INTEGER POINTER   LIMITP,           <<TABLE END>>           <<04801>>17402000
                     FIRST'ENTRYP,     <<PTR TO 1ST ENTRY DST>><<04801>>17404000
                     SCHEDHEADP,       <<PTR TO SCHEDHEAD>>    <<04801>>17406000
                     JMAT'DSTP,        <<SCANNING PTR IN DST>> <<04801>>17408000
                     TEMPP;            <<TEMP PNTR 4 PARTICULAR RANK>>  17410000
   LOGICAL           STOP := FALSE;    <<STOPS PARSING>>       <<04801>>17412000
   INTEGER           ERRORMAX := 5;    <<ALSO STOPS PARSING>>  <<04801>>17414000
   INTEGER ERRORCOUNT := 0;                                    <<04801>>17416000
   LOGICAL JOBFLAG := FALSE;  <<JOB PARM SEEN>>                <<04801>>17418000
                                                                        17420000
<< MISC VARIABLES FOR ENTRY "VISIT"  (TEMP FILE WRITE) >>               17422000
   INTEGER           ENTRYSTATE,       <<CURRENT ENTRY'S STATE>>        17424000
                     SAVESTATE,        <<SAVE TRUE STATE VALUE>>        17426000
                     SAVERANK;         <<SAVE OVERWRITTEN WD>>          17428000
   DEFINE            JM'RANK  = JM'SCHEDLINKP  #;  <<RANK IN LINK>>     17430000
   BYTE ARRAY        JMAT'WORKAREA'B (*)  = JMAT'WORKAREA;              17432000
                                                                        17434000
<< ACCUMULATING SUMMARY VARIABLES >>                                    17436000
   INTEGER           TOTAL  := 0,      <<TOTAL VISITS>>                 17438000
                     SESCOUNT  := 0,   <<NUM EXEC SESSIONS>>            17440000
                     WAITDEFCOUNT  := 0; <<NUM WAIT DEFERRED>>          17442000
   INTEGER ARRAY     STCOUNTS (0:4) = Q; <<NUM PER STATE>>              17444000
   INTEGER           JOBFENCE,                                          17446000
                     JLIMIT,                                            17448000
                     SLIMIT;                                            17450000
                                                                        17452000
<< VARIABLES FOR PRINT PHASE >>                                         17454000
   EQUATE            OBUFMAX  = 35;    <<OUTPUT BUF LEN>>               17456000
   INTEGER ARRAY     OBUF (0:OBUFMAX); <<OUTPUT BUFFER>>                17458000
   BYTE ARRAY        OBUFB (*)  = OBUF;                                 17460000
   INTEGER ARRAY     EBUF (0:JMATENTRYSIZE-1); <<ENTRY BUF>>            17462000
   BYTE ARRAY        EBUFB(*) = EBUF;                                   17464000
   LOGICAL ARRAY     EBUFL (*)  = EBUF;                                 17466000
   LOGICAL           JLISTSPOOLED  := FALSE;  <<JLIST SPOOLED?>>        17468000
   DEFINE            HEADER =                                           17470000
"JOBNUM  STATE IPRI JIN  JLIST    INTRODUCED  JOB NAME "  #;            17472000
   EQUATE            HEADERLEN  = -53;                                  17474000
   EQUATE            POSJNUM  = 0,     <<FIELD POSITIONS>>              17476000
                     POSSTATE  = POSJNUM +8,                            17478000
                     POSRANK  = POSSTATE +4,                            17480000
                     POSINPRI  = POSSTATE +9,                           17482000
                     POSJIN  = POSINPRI +4,                             17484000
                     POSSR  = POSJIN +1,                                17486000
                     POSJLIST  = POSJIN +3,                             17488000
                     POSTIME  = POSJLIST +9,                            17490000
                     POSJNAME  = POSTIME +12;                           17492000
COMMENT                                                        <<04801>>17494000
   THIS DEFINE IS NO LONGER NEEDED.  IT WAS ORIGINALLY         <<04801>>17496000
INSTALLED TO PREVENT REQUESTSERVICE FROM BEING CALLED WHEN THE <<04801>>17498000
SHOWJOB COMMAND WAS ENTERED AT THE CONSOLE USING <CONTROL-A>.  <<04801>>17500000
(IF SHOWJOB IS EVER PUT BACK INTO THE CONSOLE INTERFACE, THE   <<04801>>17502000
DEFINE CAN BE REACTIVATED BY DELETING THESE LINES.)            <<04801>>17504000
<< TEMPORARY >>                                                         17506000
   DEFINE            REQUESTSERVICE  = FALSE #;                         17508000
                                                                        17510000
                                                                        17512000
                                                                        17514000
   INTEGER FNUM         := 2,                                  <<04801>>17516000
           CLOSEOPTIONS := 0,                                  <<04801>>17518000
           FOPTIONS;                                           <<04801>>17520000
   LOGICAL LISTFILE := FALSE;                                  <<04801>>17522000
   ARRAY DATEBUF(0:13);                                        <<04801>>17524000
   EQUATE TEMP     = 2,                                        <<04801>>17526000
          DELETE   = 4,                                        <<04801>>17528000
          ASBEFORE = 0,                                        <<04801>>17530000
          NEW      = 0;                                        <<04801>>17532000
   DEFINE DOMAIN    = (14:2)#,                                 <<04801>>17534000
          NOT'STDLIST = FOPTIONS.(10:3) <> 1 #;                <<04801>>17536000
<< SUBROUTINES FOR PARAMETER PARSING >>                                 17538000
                                                                        17540000
                                                                        17542000
SUBROUTINE ERROR (ERRN);                                                17544000
   VALUE ERRN;                                                          17546000
   INTEGER ERRN;                                                        17548000
BEGIN                                                          <<04801>>17550000
   CIERR(ERRN,PP);                                             <<04801>>17552000
   IF ERRN>0 THEN   <<SERIOUS ERROR>>                          <<04801>>17554000
      BEGIN  <<MUST KEEP TRACK OF NUMBER OF SERIOUS ERRORS>>   <<04801>>17556000
      SHOWJOB := ERRN;                                         <<04801>>17558000
      PARMNUM := PNUM + PARMNUM;                               <<04801>>17560000
      ERRORCOUNT := ERRORCOUNT+1;                              <<04801>>17562000
      IF ERRORCOUNT > ERRORMAX THEN   <<TOO MANY ERRORS,>>     <<04801>>17564000
         BEGIN   <<STOP PARSING>>                              <<04801>>17566000
         STOP := TRUE;                                         <<04801>>17568000
         CIERR(-SHOWJ2MERRORS,PP)                              <<04801>>17570000
         END;                                                  <<04801>>17572000
      END;   <<PROCESSING OF SERIOUS ERRORS>>                  <<04801>>17574000
END;  <<SUBROUTINE ERROR>>                                     <<04801>>17576000
SUBROUTINE FATALERROR;                                         <<04801>>17578000
BEGIN                                                          <<04801>>17580000
   CIERR(SHOWJOB := ERRNUM);                                   <<04801>>17582000
   ASSEMBLE( EXIT 3); << FATAL ERROR BAIL OUT >>               <<04801>>17584000
END;                                                           <<04801>>17586000
                                                               <<04801>>17588000
SUBROUTINE GETNEXT;                                            <<04801>>17590000
BEGIN   <<EXTRACTS NEXT PARAMETER>>                            <<04801>>17592000
IF PNUM+1 = MAXPARMS THEN  <<NEED A NEW SET OF PARMS>>         <<04801>>17594000
   BEGIN                                                       <<04801>>17596000
   MYCOMMAND(PP,DELS,MAXPARMS, NUMPARMS, PARMS(1));            <<04801>>17598000
   PNUM := 1;                                                  <<04801>>17600000
   PARMNUM := PARMNUM+MAXPARMS-1;                              <<04801>>17602000
   END;                                                        <<04801>>17604000
PARM := PARMS(PNUM := PNUM+1);                                 <<04801>>17606000
END;                                                           <<04801>>17608000
                                                               <<04801>>17610000
SUBROUTINE PARSESTATE;                                         <<04801>>17612000
BEGIN                                                          <<04801>>17614000
<<WAIT (,DEFERRED,NONDEFERRED), INTRO, SUSP, EXEC>>            <<04801>>17616000
IF (STATE <> NOSTATE) THEN                                     <<04801>>17618000
   IF INTEGER(KEYDEFN(1)) <> STATE THEN <<INCONSISTENT SPECIFIC<<04801>>17620000
      ERROR(-SHOWJREDNDSTATE);  <<OF STATES>>                  <<04801>>17622000
STATE := KEYDEFN(1);                                           <<04801>>17624000
DEFR := NODEFR;                                                <<04801>>17626000
IF PDEL = COMMA THEN   <<SUBPARAMETER SPECIFIED>>              <<04801>>17628000
   BEGIN   <<EXPECTING EITHER N (NOT DEFFERED) OR D (DEFFERED) <<04801>>17630000
   GETNEXT;   <<GET SUBPARAMETER>>                             <<04801>>17632000
   IF STATE<>JWAIT THEN  <<ONLY VALID FOR WAIT SPOOL FILES    <<U.RAO>> 17634000
      BEGIN                                                    <<04801>>17636000
      PNUM := PNUM-1;  <<BACK UP FOR REPARSE>>                 <<04801>>17638000
      ERROR(SHOWJNDINAP)                                       <<04801>>17640000
      END                                                      <<04801>>17642000
   ELSE IF PLEN=1 AND PP="N" THEN                              <<04801>>17644000
      DEFR := FALSE                                            <<04801>>17646000
   ELSE IF PLEN=1 AND PP="D" THEN                              <<04801>>17648000
      DEFR := TRUE                                             <<04801>>17650000
   ELSE   <<UNKNOWN TYPE, IGNORE>>                             <<04801>>17652000
      BEGIN                                                    <<04801>>17654000
      PNUM := PNUM-1;  <<BACK UP FOR REPARSE>>                 <<04801>>17656000
      ERROR(SHOWJUNKDEFR);                                     <<04801>>17658000
      END                                                      <<04801>>17660000
   END;                                                        <<04801>>17662000
OPTIONTYPE := QUALIFIED;                                       <<04801>>17664000
END;   <<SUBROUTINE PARSESTATE>>                               <<04801>>17666000
                                                               <<04801>>17668000
SUBROUTINE PARSEJOBID;                                         <<04801>>17670000
BEGIN                                                          <<04801>>17672000
<<ASSUMPTIONS:  JOB NAME, IF ANY, ALREADY PARSED.  JN=0=> "@">><<04801>>17674000
<<CURRENT PARM IS POINTING TO USER NAME>>                      <<04801>>17676000
IF PLEN = 0 THEN   <<NAME APPARENTLY MISSING>>                 <<04801>>17678000
   ERROR(USERNAMEMISSING)                                      <<04801>>17680000
ELSE IF PLEN > 8 THEN                                          <<04801>>17682000
   ERROR(USERNAMETOOLONG)                                      <<04801>>17684000
ELSE IF PSPECIAL AND NOT((PP="@") LAND (PLEN=1)) THEN          <<04801>>17686000
   ERROR(SHOWJXPCTUN)  <<EMBEDDED SPECIAL CHARACTERS>>         <<04801>>17688000
ELSE   <<VALID USER NAME>>                                     <<04801>>17690000
   BEGIN                                                       <<04801>>17692000
   IF PP="@" THEN  <<USER NAME IS ALL>>                        <<04801>>17694000
      BEGIN                                                    <<04801>>17696000
      UN := 0;                                                 <<04801>>17698000
      IF JN=ALPHA THEN   <<JNAME,@.ACCT CASE>>                 <<04801>>17700000
         BEGIN                                                 <<04801>>17702000
         JN := 0;  <<FORCE JOB NAME TO ALL>>                   <<04801>>17704000
         ERROR(USEREXPECTNAMENOTAT);  <<WARN OF PROBLEM>>      <<04801>>17706000
         END;                                                  <<04801>>17708000
      END                                                      <<04801>>17710000
   ELSE IF PP <> ALPHA THEN  <<EXPECTED LEADING ALPHA>>        <<04801>>17712000
      BEGIN                                                    <<04801>>17714000
      ERROR(USEREXPECTALPHA);                                  <<04801>>17716000
      JN := UN := 0;  <<FORCE TO ALL USERS IN ACCOUNT>>        <<04801>>17718000
      END                                                      <<04801>>17720000
   ELSE   <<JUST PLAIN OLD USER NAME>>                         <<04801>>17722000
      MOVE UN := PP, (PLEN);                                   <<04801>>17724000
   IF PDEL <> PERIOD THEN   <<MISSING DELIMITER>>              <<04801>>17726000
      ERROR(SHOWJXPCTPERIOD)                                   <<04801>>17728000
   ELSE   <<PARSE ACCOUNT NAME>>                               <<04801>>17730000
      BEGIN                                                    <<04801>>17732000
      GETNEXT;   <<GET ACCOUNT NAME>>                          <<04801>>17734000
      IF PLEN=0 THEN                                           <<04801>>17736000
         ERROR(ACCTNAMEMISSING)                                <<04801>>17738000
      ELSE IF PLEN > 8 THEN                                    <<04801>>17740000
         ERROR(ACCTNAMETOOLONG)                                <<04801>>17742000
      ELSE IF PP="@" THEN                                      <<04801>>17744000
         ERROR(ACCTEXPECTNAMENOTAT)                            <<04801>>17746000
      ELSE IF PP <> ALPHA THEN                                 <<04801>>17748000
         ERROR(ACCTEXPECTALPHA)                                <<04801>>17750000
      ELSE IF PSPECIAL THEN                                    <<04801>>17752000
         ERROR(SHOWJXPCTAN)                                    <<04801>>17754000
      ELSE   <<EVIDENTLY A VALID ACCOUNT NAME>>                <<04801>>17756000
         MOVE AN := PP, (PLEN);                                <<04801>>17758000
      END                                                      <<04801>>17760000
   END                                                         <<04801>>17762000
END;   <<SUBROUTINE PARSEJOBID>>                               <<04801>>17764000
SUBROUTINE PARSEJOB;                                           <<04801>>17766000
<<PARSE THE JOB= PARAMETER.  NOTHING UNUSUAL.>>                <<04801>>17768000
BEGIN                                                          <<04801>>17770000
IF JOBFLAG THEN  <<REDUNDANTLY SPECIFIED>>                     <<04801>>17772000
   ERROR (-SHOWJREDUNDJOB);                                    <<04801>>17774000
JOBFLAG := TRUE;  <<HAVE SEEN A JOB= PARAMETER>>               <<04801>>17776000
JTYPE := NLEN := 0;  <<INIT	ALIZE TO FORCE ALL JOBS/SESSIONS>> <<04801>>17778000
IF PDEL <> EQUAL THEN   <<MISSING "=" OF "JOB=">>              <<04801>>17780000
   BEGIN                                                       <<04801>>17782000
   @PP := @PP+INTEGER(PLEN); <<POINT PAST "JOB">>              <<04801>>17784000
   ERROR(SHOWJXPCTJOBEQ);                                      <<04801>>17786000
   END                                                         <<04801>>17788000
ELSE                                                           <<04801>>17790000
   BEGIN  <<AT LEAST HAVE EQUALS SIGN>>                        <<04801>>17792000
   GETNEXT;   <<FIND FIRST SUBPARAMETER>>                      <<04801>>17794000
   IF PLEN = 0 THEN   <<MISSING SUBPARAMETER>>                 <<04801>>17796000
      ERROR(SHOWJXPCTJOB)                                      <<04801>>17798000
   ELSE   <<PARAMETER EXIST, PARSE IT>>                        <<04801>>17800000
      BEGIN                                                    <<04801>>17802000
      INAMES := "  ";  <<INITIALIZE NAME BUFFERS>>             <<04801>>17804000
      MOVE INAMES(1) := INAMES,(11);                           <<04801>>17806000
      IF PP="@" THEN   <<MANY POSSIBILITIES>>                  <<04801>>17808000
         BEGIN                                                 <<04801>>17810000
         IF PLEN > 1 THEN   <<SUSPECT @J OR @S>>               <<04801>>17812000
            BEGIN                                              <<04801>>17814000
            IF PP(1) = "S" THEN  <<SESSIONS>>                  <<04801>>17816000
               BEGIN                                           <<04801>>17818000
               JTYPE := SESSIONTYPE;                           <<04801>>17820000
               IF PLEN > 2 THEN                                <<04801>>17822000
                  ERROR(SHOWJXPCTATS);  <<EXTRANEOUS>>         <<04801>>17824000
               END                                             <<04801>>17826000
            ELSE IF PP(1) = "J" THEN  <<JOBS>>                 <<04801>>17828000
               BEGIN                                           <<04801>>17830000
               JTYPE := BATCHTYPE;                             <<04801>>17832000
               IF PLEN > 2 THEN  <<EXTRANEOUS DATA>>           <<04801>>17834000
                  ERROR(SHOWJXPCTATJ);                         <<04801>>17836000
               END                                             <<04801>>17838000
            ELSE   <<GARBAGE OF SOME SORT>>                    <<04801>>17840000
               ERROR(SHOWJUNKATX);                             <<04801>>17842000
            END                                                <<04801>>17844000
         ELSE IF PDEL = COMMA THEN    <<ALL JOB NAMES>>        <<04801>>17846000
            BEGIN                                              <<04801>>17848000
            JN := 0;  <<FORCE TO ALL JOB NAMES>>               <<04801>>17850000
            GETNEXT;  <<GET FIRST PART OF JOBID>>              <<04801>>17852000
            PARSEJOBID;  <<PARSE REST OF JOB ID>>              <<04801>>17854000
            END                                                <<04801>>17856000
         ELSE IF PDEL = PERIOD THEN  <<JUST JOBID, NO NAME>>   <<04801>>17858000
            PARSEJOBID;                                        <<04801>>17860000
         END   <<"@" CASE>>                                    <<04801>>17862000
      ELSE   <<NOT AN "@" SIGN>>                               <<04801>>17864000
         BEGIN   <<GUESS IT IS [JOB NAME,] JOB ID>>            <<04801>>17866000
         IF PDEL = COMMA THEN                                  <<04801>>17868000
            BEGIN   <<JOB NAME PRESENT>>                       <<04801>>17870000
            IF PLEN <> 0 THEN                                  <<04801>>17872000
               IF PLEN > 8 THEN                                <<04801>>17874000
                  ERROR(SHOWJJNAME2LONG)                       <<04801>>17876000
               ELSE IF PP <> ALPHA THEN                        <<04801>>17878000
                  ERROR(SHOWJJNXPCTALPH)                       <<04801>>17880000
               ELSE IF PSPECIAL THEN   <<EMBEDDED SPECIALS>>   <<04801>>17882000
                  ERROR(SHOWJXPCTJN)                           <<04801>>17884000
               ELSE  <<PROBABLY OK>>                           <<04801>>17886000
                  BEGIN                                        <<04801>>17888000
                  MOVE JN := PP,(PLEN);                        <<04801>>17890000
                  GETNEXT;                                     <<04801>>17892000
                  PARSEJOBID;                                  <<04801>>17894000
                  END                                          <<04801>>17896000
            END                                                <<04801>>17898000
         ELSE   <<MUST BE PLAIN JOB ID>>                       <<04801>>17900000
            PARSEJOBID;                                        <<04801>>17902000
         END;                                                  <<04801>>17904000
      <<NOW SET JOB IDENTIFIER LENGTH AND COMPARE START>>      <<04801>>17906000
      IF AN=ALPHA THEN   <<ACCOUNT NAME PRESENT>>              <<04801>>17908000
         IF UN=ALPHA THEN  <<USER NAME PRESENT>>               <<04801>>17910000
            IF JN=ALPHA THEN   <<JOB NAME PRESENT>>            <<04801>>17912000
               NLEN := 24    <<24 BYTES>>                      <<04801>>17914000
            ELSE   <<NO JOB NAME, JUST JOB ID>>                <<04801>>17916000
               NLEN := 16                                      <<04801>>17918000
         ELSE   <<NO USER NAME>>                               <<04801>>17920000
            BEGIN                                              <<04801>>17922000
            NSTART := 8;                                       <<04801>>17924000
            NLEN := 8;                                         <<04801>>17926000
            END;                                               <<04801>>17928000
      END;  <<PARM EXISTS CASE>>                               <<04801>>17930000
   END   <<EQUALS SIGN CASE>>                                  <<04801>>17932000
END;   <<SUBROUTINE PARSEJOB>>                                 <<04801>>17934000
                                                               <<04801>>17936000
                                                                        17938000
SUBROUTINE INCRCOUNTS;                                                  17940000
<< INCREMENTS SUMMARY COUNTS >>                                         17942000
BEGIN                                                                   17944000
   TOTAL := TOTAL +1;                                                   17946000
   STCOUNTS (ENTRYSTATE) := STCOUNTS (ENTRYSTATE) +1;                   17948000
   IF (ENTRYSTATE = JWAIT)                                              17950000
      AND (ENTRYP(JMAT'INPRI) <= JOBFENCE) THEN                         17952000
      WAITDEFCOUNT := WAITDEFCOUNT +1;                                  17954000
   IF (ENTRYSTATE = JEXEC)                                              17956000
         AND (ENTRYP(JMAT'JOBTYPE) = SESSIONTYPE) THEN                  17958000
      SESCOUNT := SESCOUNT +1;                                          17960000
   END;    <<INCRCOUNTS>>                                               17962000
                                                                        17964000
                                                                        17966000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<04801>>17968000
                                                               <<04801>>17970000
SUBROUTINE DEF'MOVETODSEG;                                     <<04801>>17972000
<< SUBROUTINE FOR PRINT PHASE >>                               <<04801>>17974000
                                                               <<04801>>17976000
                                                               <<04801>>17978000
SUBROUTINE WRITE (LEN, CONTROL);                               <<04801>>17980000
   VALUE LEN, CONTROL;                                         <<04801>>17982000
   INTEGER LEN, CONTROL;                                       <<04801>>17984000
BEGIN                                                          <<04801>>17986000
   IF REQUESTSERVICE THEN GOTO LEAVE;                          <<04801>>17988000
   FWRITE(FNUM,OBUF,LEN,CONTROL);                              <<04801>>17990000
   IF <> THEN                                                  <<04801>>17992000
      BEGIN                                                    <<04801>>17994000
         FERROR'(FNUM,ERRNUM);                                 <<04801>>17996000
         GO TO LEAVE;                                          <<04801>>17998000
      END;                                                     <<04801>>18000000
   END;    <<WRITE>>                                           <<04801>>18002000
SUBROUTINE PRINTHEADER;                                        <<04801>>18004000
BEGIN                                                          <<04801>>18006000
   << PRINT HEADER FOR SHOWJOB -- DB MUST BE POINTING TO STK >><<04801>>18008000
   WRITE (0, 0);                                               <<04801>>18010000
   MOVE OBUF := HEADER;                                        <<04801>>18012000
   WRITE (HEADERLEN, %60);                                     <<04801>>18014000
END;    <<PRINTHEADER>>                                        <<04801>>18016000
                                                               <<04801>>18018000
                                                               <<04801>>18020000
SUBROUTINE PRINTENTRY;                                         <<04801>>18022000
BEGIN                                                          <<04801>>18024000
   COMMENT:                                                    <<04801>>18026000
      THIS ROUTINE FORMATS AND PRINTS THE ENTRY.               <<04801>>18028000
      ON ENTRY DB MUST BE POINTING TO STACK.                   <<04801>>18030000
   ;                                                           <<04801>>18032000
                                                               <<04801>>18034000
   OBUF := "  ";                                               <<04801>>18036000
   MOVE OBUF(1) := OBUF, (OBUFMAX);                            <<04801>>18038000
   JLISTSPOOLED := FALSE;                                      <<04801>>18040000
                                                               <<04801>>18042000
   << JOB NUMBER >>                                            <<04801>>18044000
   OBUFB (POSJNUM) := "#";                                     <<04801>>18046000
   OBUFB (POSJNUM+1) :=                                        <<04801>>18048000
         IF EBUF(JMAT'JOBTYPE) = BATCHTYPE THEN "J" ELSE "S";  <<04801>>18050000
   ASCII (EBUF(JMAT'JOBNUM), 10, OBUFB (POSJNUM+2));           <<04801>>18052000
                                                               <<04801>>18054000
   << SPOOLED ("S") >>                                         <<04801>>18056000
   IF EBUFL(JM'SPOOLED) THEN OBUFB(POSSR) := "S";              <<04801>>18058000
                                                               <<04801>>18060000
   << STATE [,RANK] [,INPRI] [,QUIET] [,RESTART/SPOOLED] >>    <<04801>>18062000
   IF EBUF(JMAT'JSTATE) = JOBEXEC OR                           <<04801>>18064000
      EBUF(JMAT'JSTATE) = JOBCIINIT OR                         <<04801>>18066000
      EBUF(JMAT'JSTATE) = JOBSUSP THEN                         <<04801>>18068000
      BEGIN    << EXECUTING >>                                 <<04801>>18070000
      IF EBUF(JMAT'JSTATE) = JOBSUSP THEN                      <<04801>>18072000
         MOVE OBUFB(POSSTATE) := "SUSP"                        <<04801>>18074000
      ELSE                                                     <<04801>>18076000
        IF EBUF(JMAT'JSTATE) = JOBCIINIT THEN                  <<04801>>18078000
               MOVE OBUFB(POSSTATE) :="EXEC*"                  <<04801>>18080000
            ELSE                                               <<04801>>18082000
         MOVE OBUFB (POSSTATE) := "EXEC";                      <<04801>>18084000
   << IF QUIET BIT SET AND TRUE STATE OF JOB IS NOT INIT. >>   <<04801>>18086000
   << (INCLUDES EXEC., SUSP., AND TERM.), THEN SAY SO.    >>   <<04801>>18088000
      IF EBUFL(JM'QUIET) AND (SAVESTATE <> JOBCIINIT) THEN     <<04801>>18090000
         MOVE OBUFB (POSINPRI -4) := "QUIET";                  <<04801>>18092000
      IF EBUFL (JM'RESTART) THEN OBUFB (POSSR) := "R";         <<04801>>18094000
      EBUF(JMAT'JIN) := EBUF(JM'ORIGJIN);    <<ORIG JIN>>      <<04801>>18096000
      X := SYS'LPDTP(EBUF(JMAT'JLIST) * 2);                    <<04801>>18098000
      IF X < 0 THEN  <<VIRTUAL>>                               <<04801>>18100000
         BEGIN                                                 <<04801>>18102000
         << VIRT. LIST: SHOW ORIGINAL DESTINATION >>           <<04801>>18104000
         JLISTSPOOLED := TRUE;                                 <<04801>>18106000
         EBUF(JMAT'JLIST) := EBUF (JM'ORIGJLIST)               <<04801>>18108000
         END                                                   <<04801>>18110000
      ELSE                                                     <<04801>>18112000
         << REAL LIST: SHOW ALLOC'D DEVICE >>                  <<04801>>18114000
         EBUFL(JMAT'C) := FALSE;                               <<04801>>18116000
      END                                                      <<04801>>18118000
   ELSE                                                        <<04801>>18120000
      BEGIN    << INTRO OR WAITING >>                          <<04801>>18122000
      << INPRI >>                                              <<04801>>18124000
      IF EBUF(JMAT'INPRI) = JOBHIPRI THEN                      <<04801>>18126000
         MOVE OBUFB (POSINPRI-1) := "HI"                       <<04801>>18128000
      ELSE                                                     <<04801>>18130000
         ASCII (EBUF(JMAT'INPRI), -10, OBUFB (POSINPRI));      <<04801>>18132000
      IF EBUF(JMAT'INPRI) <= JOBFENCE THEN                     <<04801>>18134000
         OBUFB (POSINPRI-2) := "D";                            <<04801>>18136000
      IF EBUF(JMAT'JSTATE) = JOBWAIT THEN                      <<04801>>18138000
         BEGIN    << WAIT: INDICATE RANK >>                    <<04801>>18140000
         MOVE OBUFB (POSSTATE) := "WAIT";                      <<04801>>18142000
         IF EBUF (JM'RANK) <> 0 THEN                           <<04801>>18144000
            BEGIN    << RANKED >>                              <<04801>>18146000
            OBUFB (POSRANK) := ":";                            <<04801>>18148000
            ASCII (EBUF (JM'RANK), 10, OBUFB (POSRANK+1));     <<04801>>18150000
            END;                                               <<04801>>18152000
         END                                                   <<04801>>18154000
      ELSE                                                     <<04801>>18156000
         MOVE OBUFB (POSSTATE) := "INTRO";                     <<04801>>18158000
      END;                                                     <<04801>>18160000
                                                               <<04801>>18162000
   << JIN >>                                                   <<04801>>18164000
   ASCII( EBUF(JMAT'JIN), -10, OBUFB(POSJIN) );                <<04801>>18166000
                                                               <<04801>>18168000
   << JLIST >>                                                 <<04801>>18170000
   TOS := 0;                                                   <<04801>>18172000
   TOS := EBUF(JMAT'JLIST);                                    <<04801>>18174000
   IF EBUFL(JMAT'C) THEN TOS := -TOS;                          <<04801>>18176000
   TOS := DEVSPEC (*, OBUFB (POSJLIST));                       <<04801>>18178000
   IF NOT (EBUFL(JMAT'C)) AND JLISTSPOOLED THEN                <<04801>>18180000
      << TELL USER THAT LDEV INDICATED IS SPOOLED >>           <<04801>>18182000
      OBUFB (S0 +POSJLIST) := "S";                             <<04801>>18184000
   DEL;                                                        <<04801>>18186000
                                                               <<04801>>18188000
   << DAY & TIME >>                                            <<04801>>18190000
   TOS := @EBUF (JM'STARTTIME);                                <<04801>>18192000
   DAYTIME (OBUFB (POSTIME), DPS0);                            <<04801>>18194000
   DEL;                                                        <<04801>>18196000
                                                               <<04801>>18198000
   << FULL JOB NAME & PRINT IT >>                              <<04801>>18200000
   WRITE(-45 -FORMNAME(2,OBUFB(POSJNAME),EBUFB(20),            <<04801>>18202000
      EBUFB(4),EBUFB(12),EBUFB),0);                            <<04801>>18204000
                                                               <<04801>>18206000
END;    << PRINTENTRY >>                                       <<04801>>18208000
                                                               <<04801>>18210000
                                                               <<04801>>18212000
  LOGICAL SUBROUTINE ALLOCATEDST (DSTNUM,DSTSIZE);             <<04801>>18214000
     INTEGER DSTNUM, DSTSIZE;                                  <<04801>>18216000
  BEGIN                                                        <<04801>>18218000
     COMMENT:                                                  <<04801>>18220000
        ALLOCATEDST= TRUE:  DATA-SEG ALLOCATED                 <<04801>>18222000
                     FALSE: COULD NOT ALLOCATE DATA-SEG,       <<04801>>18224000
                            ERRNUM SET TO APPRORIATE           <<04801>>18226000
                            VALUE.                             <<04801>>18228000
        WE USE (CALLABLE) 'GETDSEG' HERE SO THAT DATA-SEG      <<04801>>18230000
        WILL BE RELEASED AUTOMATICALLY IF PROCESS TERMINATES   <<04801>>18232000
        ABNORMALLY.;                                           <<04801>>18234000
                                                               <<04801>>18236000
     ALLOCATEDST := TRUE;                                      <<04801>>18238000
     GETDSEG (DSTNUM,DSTSIZE,0);                               <<04801>>18240000
     IF <> THEN                                                <<04801>>18242000
        BEGIN                                                  <<04801>>18244000
        ERRNUM := IF > OR DSTNUM=%2000 THEN SHOWSYSERR         <<04801>>18246000
                  ELSE IF DSTNUM=%2001 THEN SHOWNODST          <<04801>>18248000
                  ELSE SHOWNOVDS;                              <<04801>>18250000
        ALLOCATEDST:=DSTNUM:=0;                                <<04801>>18252000
        END;                                                   <<04801>>18254000
  END;    <<ALLOCATEDST>>                                      <<04801>>18256000
SUBROUTINE VISITENTRY;                                                  18258000
<< "VISITS" ENTRY, BY PRINTING THE ENTRY,           >>         <<04801>>18260000
<< AFTER SETTING STATE TO INTERNAL REPRESENTATION   >>         <<04801>>18262000
<< AND SETTING RANK (IN LINK WD). CALLS INCRCOUNTS. >>         <<04801>>18264000
BEGIN                                                                   18266000
   SAVESTATE := ENTRYP(JMAT'JSTATE);                                    18268000
   SAVERANK := ENTRYP (JM'RANK);                                        18270000
   IF ENTRYSTATE = JWAIT THEN                                           18272000
      ENTRYP (JM'RANK) := RANK;                                         18274000
   MOVE EBUF := ENTRYP,(JMATENTRYSIZE);                        <<04801>>18276000
   IF TOTAL = 0 THEN PRINTHEADER;                              <<04801>>18278000
   PRINTENTRY;                                                 <<04801>>18280000
   INCRCOUNTS;                                                 <<04801>>18282000
   ENTRYP (JM'RANK) := SAVERANK;    <<RESTORE "OFFICIAL" VALUES>>       18284000
   ENTRYP(JMAT'JSTATE) := SAVESTATE;                                    18286000
   END;    <<VISITENTRY>>                                               18288000
                                                                        18290000
                                                                        18292000
LOGICAL SUBROUTINE ENTRYQUALIFIES;                                      18294000
<< DETERMINE IF <ENTRY> QUALIFIES, IN QUALIFIED SCAN.                   18296000
   CALLED ONLY FOR QUALIFIED TYPE SCANS.                                18298000
   EXAMINES:                                                            18300000
      STATE, DEFERREDNESS, TYPE AND/OR NAMES. >>                        18302000
BEGIN                                                                   18304000
   ENTRYQUALIFIES := FALSE;  <<SIMPLY "RETURN" IF IT DOESN'T>>          18306000
   IF STATE <> NOSTATE THEN                                             18308000
      BEGIN    <<STATE SUPPLIED>>                                       18310000
      IF ENTRYSTATE <> STATE THEN RETURN;  <<IMPPROPER STATE>>          18312000
      IF IDEFR <> NODEFR THEN                                           18314000
         << "WAIT,N/D" SUPPLIED >>                                      18316000
         IF (ENTRYP(JMAT'INPRI) <= JOBFENCE) <> DEFR THEN               18318000
            RETURN;  << NOT CORRECT "DEFERREDNESS" >>                   18320000
      END;                                                              18322000
   IF JTYPE <> 0 THEN                                                   18324000
      BEGIN    << "@J/S" SUPPLIED >>                                    18326000
      IF ENTRYP(JMAT'JOBTYPE) <> JTYPE THEN RETURN;                     18328000
      END                                                               18330000
   ELSE                                                                 18332000
      IF NLEN <> 0 THEN                                                 18334000
         BEGIN    <<NAMED SEARCH REQUESTED>>                            18336000
         TOS := (@ENTRYP(JMAT'USERNAME) &LSL(1)) +NSTART;               18338000
         IF * <> NAMES (NSTART), (NLEN) THEN                   <<04801>>18340000
            RETURN;    <<NAME(S) DON'T MATCH>>                          18342000
         END;                                                           18344000
   ENTRYQUALIFIES := TRUE;    << PASSED ALL QUALIFICATIONS >>           18346000
   END;    <<ENTRYQUALIFIES>>                                           18348000
                                                                        18350000
                                                                        18352000
SUBROUTINE LINSCAN;                                                     18354000
<< PERFORMS A LINEAR SCAN THRU THE JMAT, HITTING APPROPRIATE ENTRIES >> 18356000
BEGIN                                                                   18358000
   @JMAT'DSTP := @FIRST'ENTRYP;                                <<04801>>18360000
   @LIMITP := DSTLENGTH-JMATENTRYSIZE;                         <<04801>>18362000
   DO BEGIN                                                             18364000
      MOVEFROMDSEG (@ENTRYP,DSTNUM,@JMAT'DSTP,JMATENTRYSIZE);  <<04801>>18366000
      IF ENTRYP <> 0                                                    18368000
         AND (ENTRYSTATE := ENTRYP(JMAT'JSTATE)) <> JOBERR THEN         18370000
         BEGIN    <<ACTUAL, NON-ERROR ENTRY>>                           18372000
         << MAP ACTUAL STATE INTO INTERNAL REPRESENTATION >>            18374000
         IF ENTRYSTATE = JOBINTRO THEN   TOS := JINTRO                  18376000
         ELSE                                                           18378000
            IF ENTRYSTATE = JOBSUSP THEN   TOS := JSUSP                 18380000
            ELSE                                                        18382000
            IF ENTRYSTATE=JOBWAIT THEN                         <<04801>>18384000
                 TOS := JWAIT                                  <<04801>>18386000
            ELSE   TOS := JEXEC;   << INCLUDES INIT. & TERM. >><<04801>>18388000
         ENTRYSTATE := TOS;                                             18390000
         CASE * OPTIONTYPE OF                                           18392000
            BEGIN                                                       18394000
                                                                        18396000
<<JOBNUM>>  IF ENTRYP (JM'JOBNUM) = JOBNUM THEN                         18398000
               BEGIN    <<GOT JOBNUM>>                                  18400000
               IF ENTRYSTATE = JWAIT                                    18402000
                     AND ENTRYP(JMAT'INPRI) > JOBFENCE THEN             18404000
                  BEGIN    <<NON-DEFERRED WAITING: CALC RANK>>          18406000
                  EXCHANGEDB (DSTNUM);                         <<04801>>18408000
                  @TEMPP := @JMAT'SCHEDHEADP;                           18410000
                  WHILE @TEMPP <> @JMAT'DSTP DO                <<04801>>18412000
                     BEGIN    <<NOT THIS 1: ADVANCE>>                   18414000
                     RANK := RANK +1;                                   18416000
                     @TEMPP := TEMPP (JM'SCHEDLINKP);                   18418000
                     END;                                               18420000
                  EXCHANGEDB (0);                              <<04801>>18422000
                  RANK := RANK +1;                                      18424000
                  END                                                   18426000
               << ELSE RANK := 0, BY INITIALIZATION >> ;                18428000
               VISITENTRY;                                              18430000
               @LIMITP := 0;    <<STOP SCAN>>                           18432000
               END;                                                     18434000
                                                                        18436000
<<QUALIFIED>>                                                           18438000
            IF ENTRYQUALIFIES THEN VISITENTRY;                          18440000
                                                                        18442000
<<STATUS>>  INCRCOUNTS  <<LAST CASE ST.>>  <<JUST ACCUMULATE>>          18444000
                                                                        18446000
            END;    <<CASE>>                                            18448000
         END;    <<ENTRY ANALYSIS>>                                     18450000
      END                                                               18452000
   UNTIL ((@JMAT'DSTP := @JMAT'DSTP +JMATENTRYSIZE) > @LIMITP);<<04801>>18454000
   END;    <<LINSCAN>>                                                  18456000
                                                                        18458000
                                                                        18460000
SUBROUTINE SCANWAIT;                                                    18462000
<< SCAN THRU SCHEDULE (WAITING) CHAIN, VISITING EVERY QUALIFIYING       18464000
   ENTRY.  >>                                                           18466000
BEGIN                                                                   18468000
   ENTRYSTATE := JWAIT;                                                 18470000
   @JMAT'DSTP := @SCHEDHEADP;                                  <<04801>>18472000
   WHILE <> DO                                                          18474000
      BEGIN                                                             18476000
      MOVEFROMDSEG (@ENTRYP,DSTNUM,@JMAT'DSTP,JMATENTRYSIZE);  <<04801>>18478000
      IF ENTRYP(JMAT'INPRI) > JOBFENCE THEN                             18480000
         << NON-DEFERRED, WAITING: AFFECTS SUCCEEDING RANKING >>        18482000
         RANK := RANK +1                                                18484000
      ELSE                                                              18486000
         << DEFERRED => RANK = 0 FOR THIS & ALL SUCCEEDING >>           18488000
         RANK := 0;                                                     18490000
      IF ENTRYQUALIFIES THEN VISITENTRY;                                18492000
      @JMAT'DSTP := ENTRYP (JM'SCHEDLINKP);                    <<04801>>18494000
      END;                                                              18496000
   END;    <<SCANWAIT>>                                                 18498000
                                                                        18500000
                                                                        18502000
<< PARSE PHASE >>                                                       18504000
COMMENT                                                        <<04801>>18506000
  THE FOLLOWING SUBROUTINE OPENS THE LIST FILE,                <<04801>>18508000
  AND IF IT'S NEW IT MAKES SURE THAT IT WILL BE CLOSED AS      <<04801>>18510000
  AS A TEMPORARY FILE. ANY ERRORS REGARDING THE LIST FILE      <<04801>>18512000
  ARE CONSIDERED FATAL AND WILL FLUSH FUTHER EXECUTION OF      <<04801>>18514000
  THE COMMAND.;                                                <<04801>>18516000
SUBROUTINE GETLISTFILE;                                        <<04801>>18518000
BEGIN                                                          <<04801>>18520000
   IF PDEL <> CR' THEN                                         <<04801>>18522000
      BEGIN                                                    <<04801>>18524000
         PARM := PARMS(PNUM := PNUM + 1);                      <<04801>>18526000
         ERROR( ERRNUM := SHJBEXPARMLST );                     <<04801>>18528000
                                                               <<04801>>18530000
         ASSEMBLE( EXIT 3 ); <<**** B A I L   O U T ****>>     <<04801>>18532000
                                                               <<04801>>18534000
      END;                                                     <<04801>>18536000
                                                               <<04801>>18538000
   FNUM := FOPEN(PP,%2404,%101);                               <<04801>>18540000
   IF <> THEN                                                  <<04801>>18542000
      BEGIN                                                    <<04801>>18544000
         FERROR'(FNUM,ERRNUM);                                 <<04801>>18546000
         ERRNUM := SHOWJOBOPNERR;                              <<04801>>18548000
         FATALERROR;                                           <<04801>>18550000
      END                                                      <<04801>>18552000
   ELSE                                                        <<04801>>18554000
      LISTFILE := TRUE;                                        <<04801>>18556000
                                                               <<04801>>18558000
END; << SUBROUTINE GETLISTFILE >>                              <<04801>>18560000
<<                                                           >><<04801>>18562000
<<                MAIN BODY OF SHOWJOB                       >><<04801>>18564000
<<                                                           >><<04801>>18566000
SHOWJOB := 0;                                                  <<04801>>18568000
MYCOMMAND(PARMSP,DELS,MAXPARMS,NUMPARMS,PARMS(1));             <<04801>>18570000
IF NUMPARMS > 0 THEN  <<SOME EXIST>>                           <<04801>>18572000
   BEGIN                                                       <<04801>>18574000
   PARM := PARMS(1);                                           <<04801>>18576000
   IF PP="#" OR (((PP="J") LOR (PP="S")) LAND (PP(1)=NUMERIC)) THEN     18578000
      BEGIN   <<SPECIFIC JOB NUMBER REQUESTED>>                <<04801>>18580000
      IF PP="#" THEN   <<DELETE # SIGN>>                       <<04801>>18582000
         BEGIN                                                 <<04801>>18584000
         @PP := @PP+1;                                         <<04801>>18586000
         PLEN := PLEN-1;                                       <<04801>>18588000
         END;                                                  <<04801>>18590000
      IF PP<> "J" AND PP<>"S" THEN  <<UNKNOWN REQUEST>>        <<04801>>18592000
         ERROR(SHOWJXPCTJSNUM)                                 <<04801>>18594000
      ELSE   <<J OR S FOUND>>                                  <<04801>>18596000
         BEGIN                                                 <<04801>>18598000
         OPTIONTYPE := FORJOBNUM;  <<=> EXPLICT JOB NUMBER>>   <<04801>>18600000
         IF PP="J" THEN                                        <<04801>>18602000
            JOBNUM .(0:2) := BATCHTYPE                         <<04801>>18604000
         ELSE   <<SESSION>>                                    <<04801>>18606000
            JOBNUM.(0:2) := SESSIONTYPE;                       <<04801>>18608000
         @PP := @PP+1;  <<MOVE PAST JOB TYPE>>                 <<04801>>18610000
         TOS := BINARY(PP, PLEN:=PLEN-1);  <<GET NUMBER>>      <<04801>>18612000
         IF <> OR NOT(1 <= S0 <= 16383) THEN                   <<04801>>18614000
            BEGIN   <<INVALID JOB NUMBER>>                     <<04801>>18616000
            IF JOBNUM.(0:2)=SESSIONTYPE THEN                   <<04801>>18618000
               ERROR(SHOWFXPCTSNUM)                            <<04801>>18620000
            ELSE                                               <<04801>>18622000
               ERROR(SHOWFXPCTJNUM);                           <<04801>>18624000
            OPTIONTYPE := QUALIFIED;                           <<04801>>18626000
            END;                                               <<04801>>18628000
         JOBNUM := LOGICAL(JOBNUM) LOR TOS;                    <<04801>>18630000
         END;                                                  <<04801>>18632000
      IF NUMPARMS > 1 THEN                                     <<04801>>18634000
            BEGIN                                              <<04801>>18636000
               PARM := PARMS(2);                               <<04801>>18638000
               IF PP <> "*" THEN                               <<04801>>18640000
                  ERROR(SHOWJXTRANPARMS)                       <<04801>>18642000
               ELSE                                            <<04801>>18644000
                  GETLISTFILE;                                 <<04801>>18646000
            END;                                               <<04801>>18648000
      END                                                      <<04801>>18650000
   ELSE   <<AT LEAST ONE KEYWORDED PARAMETER>>                 <<04801>>18652000
      BEGIN                                                    <<04801>>18654000
      MOVE KEYWORDSW := KEYWORDSPW, (KEYWORDSLEN);             <<04801>>18656000
      DO BEGIN   <<LOOP THROUGH KEYWORDS>>                     <<04801>>18658000
         GETNEXT;                                              <<04801>>18660000
         IF PLEN <> 0 THEN                                     <<04801>>18662000
            IF PP = "*" THEN                                   <<04801>>18664000
               STOP := TRUE                                    <<04801>>18666000
            ELSE                                               <<04801>>18668000
            BEGIN                                              <<04801>>18670000
            IF SEARCH(PP, PLEN, KEYWORDS, KEYDEFN) = 0 THEN    <<04801>>18672000
               ERROR(SHOWJUNKKEY)                              <<04801>>18674000
            ELSE   <<VALID KEYWORD>>                           <<04801>>18676000
               CASE  *INTEGER(KEYDEFN) OF                      <<04801>>18678000
                  BEGIN                                        <<04801>>18680000
                                                               <<04801>>18682000
                  ;   <<CAN'T HAPPEN>>                         <<04801>>18684000
                                                               <<04801>>18686000
                  PARSEJOB;   <<JOB= PARAMETER>>               <<04801>>18688000
                                                               <<04801>>18690000
                  PARSESTATE;  <<SUSP, INTRO, EXEC, WAIT>>     <<04801>>18692000
                                                               <<04801>>18694000
                  BEGIN                                        <<04801>>18696000
                     IF NUMPARMS <> 1 THEN                     <<04801>>18698000
                        BEGIN                                  <<04801>>18700000
                           IF PNUM > 1 THEN                    <<04801>>18702000
                              ERROR(SHOWJSTATSIGNRD)           <<04801>>18704000
                           ELSE                                <<04801>>18706000
                              BEGIN                            <<04801>>18708000
                                 PARM := PARMS(PNUM + 1);      <<04801>>18710000
                                 IF PP <> "*" THEN             <<04801>>18712000
                                    ERROR(SHOWJSTATSIGNRD)     <<04801>>18714000
                                 ELSE                          <<04801>>18716000
                                    OPTIONTYPE := STATUS;      <<04801>>18718000
                                 PARM := PARMS(PNUM);          <<04801>>18720000
                              END;                             <<04801>>18722000
                        END                                    <<04801>>18724000
                     ELSE                                      <<04801>>18726000
                        OPTIONTYPE := STATUS;                  <<04801>>18728000
                  END;                                         <<04801>>18730000
                  END;  <<OF CASE STATEMENT>>                  <<04801>>18732000
            END  <<OF CASE WHERE KEYWORD EXISTS>>              <<04801>>18734000
         END   <<OF KEYWORD LOOP>>                             <<04801>>18736000
      UNTIL  (PDEL <> SEMI) OR STOP;                           <<04801>>18738000
      IF (PDEL <> CR') AND NOT STOP THEN   <<UNKNOWN JUNK>>    <<04801>>18740000
         BEGIN                                                 <<04801>>18742000
         PARM := PARMS(PNUM := PNUM+1);                        <<04801>>18744000
         ERROR(SHOWJXTRANPARMS);                               <<04801>>18746000
         END                                                   <<04801>>18748000
      ELSE                                                     <<04801>>18750000
         IF PP = "*" AND STOP THEN                             <<04801>>18752000
            GETLISTFILE;                                       <<04801>>18754000
      END;                                                     <<04801>>18756000
   PARMNUM := PNUM := 0;                                       <<04801>>18758000
   STOP := FALSE;                                              <<04801>>18760000
   END;   <<OF PARSE>>                                         <<04801>>18762000
                                                               <<04801>>18764000
   << IF THE COMMAND OUTPUT IS NOT GOING TO $STDLIST, THEN  >> <<04801>>18766000
   << A DATELINE IS PRINTED AT THE BEGINNING OF THE FILE.   >> <<04801>>18768000
                                                               <<04801>>18770000
   FGETINFO( FNUM,, FOPTIONS );                                <<04801>>18772000
   IF FOPTIONS.DOMAIN = NEW THEN                               <<04801>>18774000
      CLOSEOPTIONS := TEMP;                                    <<04801>>18776000
                                                               <<04801>>18778000
                                                                        18780000
   IF NOT'STDLIST THEN                                         <<04801>>18782000
      BEGIN                                                    <<04801>>18784000
         DATE'LINE(DATEBUF);                                   <<04801>>18786000
         FWRITE(FNUM,DATEBUF,-27,%60);                         <<04801>>18788000
      END;                                                     <<04801>>18790000
   STCOUNTS(JINTRO) := 0;    <<INITIALIZE STATE COUNTS>>                18792000
   STCOUNTS(JWAIT) := 0;                                                18794000
   STCOUNTS(JEXEC) := 0;                                                18796000
   STCOUNTS(JSUSP) := 0;                                                18798000
   SAVESIR := GETSIR (JMATSIR);                                         18800000
   << GET EXTRA DATA SEG & COPY JMAT >>                        <<04801>>18802000
   MOVEFROMDSEG(@DSTLENGTH,JMATDST,0,1); <<1ST WORD JMAT>>     <<04801>>18804000
   DSTLENGTH := DSTLENGTH.(8:8)*TBLQUANTUM; <<CURSIZE OF JMAT>><<04801>>18806000
   IF NOT ALLOCATEDST (DSTNUM,DSTLENGTH) THEN                  <<04801>>18808000
      BEGIN                                                    <<04801>>18810000
      RELSIR (JMATSIR,SAVESIR);                                <<04801>>18812000
      FATALERROR;                                              <<04801>>18814000
      END;                                                     <<04801>>18816000
   EXCHANGEDB (DSTNUM);                                        <<04801>>18818000
   MOVEFROMDSEG(@ARRDB0,JMATDST,0,DSTLENGTH);                  <<04801>>18820000
   RELSIR(JMATSIR,SAVESIR);                                    <<04801>>18822000
   JOBFENCE := ARRDB0(JMAT'H'JOBFENCE);                                 18824000
   JLIMIT := ARRDB0(JMAT'H'JLIMIT);                                     18826000
   SLIMIT := ARRDB0(JMAT'H'SLIMIT);                                     18828000
   @FIRST'ENTRYP := @JMAT'ENTRYP; <<SAVE PTR TO 1ST ENTRY>>    <<04801>>18830000
   @SCHEDHEADP := @JMAT'SCHEDHEADP; <<SAVE PTR TO SCHEDHD>>    <<04801>>18832000
   EXCHANGEDB (0);                                             <<04801>>18834000
   CASE * OPTIONTYPE OF                                                 18836000
      BEGIN                                                             18838000
                                                                        18840000
<< JOBNUM SEARCH >>                                                     18842000
      LINSCAN;                                                          18844000
                                                                        18846000
<< QUALIFIED SEARCH >>                                                  18848000
      BEGIN                                                             18850000
         IF STATE = NOSTATE THEN                                        18852000
            BEGIN    << SCAN ALL: EXEC/WAIT/INTRO ORDER >>              18854000
            STATE := JSUSP;                                             18856000
            LINSCAN;                                                    18858000
            STATE := JEXEC;                                             18860000
            LINSCAN;                                                    18862000
            STATE := JWAIT;                                             18864000
            SCANWAIT;                                                   18866000
            RANK := 0;                                                  18868000
            STATE := JINTRO;                                            18870000
            LINSCAN;                                                    18872000
            STATE := NOSTATE;    <<FOR PROPER SUMMARY>>                 18874000
            END                                                         18876000
         ELSE                                                           18878000
            IF STATE = JWAIT THEN                                       18880000
               SCANWAIT                                                 18882000
            ELSE                                                        18884000
               << <STATE> APPROPRIATELY SET >>                          18886000
               LINSCAN;                                                 18888000
         END;                                                           18890000
                                                                        18892000
<< STATUS >>                                                            18894000
      LINSCAN    <<LAST CASE ST.>>                                      18896000
                                                                        18898000
      END;                                                              18900000
                                                                        18902000
<< SUMMARY >>                                                           18904000
   << PRINT BLANK LINE BETWEEN ENTRIES AND SUMMARY >>          <<04801>>18906000
   IF (TOTAL > 0) AND (OPTIONTYPE <> STATUS) THEN WRITE (0,0); <<04801>>18908000
                                                                        18910000
   IF (OPTIONTYPE = STATUS) OR (TOTAL > 1) THEN                         18912000
      BEGIN    << PRINT SUMMARY INFO >>                                 18914000
                                                                        18916000
      << TOT NUM JOBS >>                                                18918000
      MOVE OBUFB (ASCII (TOTAL, 10, OBUFB)) := " JOBS:", 2;             18920000
      IF (OPTIONTYPE = QUALIFIED) AND (NUMPARMS > 0) THEN               18922000
         BEGIN    << POSSIBLE SUBSET LISTED: TELL USER >>               18924000
         TOS := TOS -1;                                                 18926000
         MOVE * := " (DISPLAYED):", 2;                                  18928000
         END;                                                           18930000
      WRITE (-S0 +@OBUFB, 0);                                           18932000
      DEL;                                                              18934000
                                                                        18936000
      IF STATE = NOSTATE THEN                                           18938000
         BEGIN    << ALL STATES SHOWN (OR STATUS) >>                    18940000
                                                                        18942000
         << INTRO >>                                                    18944000
         MOVE OBUF := "      INTRO ";                                   18946000
         ASCII( STCOUNTS(JINTRO), -10, OBUFB(4) );             <<04801>>18948000
         WRITE (-11, 0);                                                18950000
                                                                        18952000
         << WAIT, INCL. DEFERRED >>                                     18954000
         MOVE OBUFB := "      WAIT; INCL ", 2;                          18956000
         ASCII (STCOUNTS (JWAIT), -10, OBUFB (4));                      18958000
         TOS := TOS +ASCII (WAITDEFCOUNT, 10, OBUFB (17));              18960000
         MOVE * := " DEFERRED", 2;                                      18962000
         WRITE (-S0 +@OBUFB, 0);                                        18964000
         DEL;                                                           18966000
                                                                        18968000
         << EXEC; INCL SESSIONS >>                                      18970000
         MOVE OBUFB := "      EXEC; INCL ", 2;                          18972000
         ASCII (STCOUNTS (JEXEC), -10, OBUFB (4));                      18974000
         TOS := TOS +ASCII (SESCOUNT, 10, OBUFB (17));                  18976000
         MOVE * := " SESSIONS", 2;                                      18978000
         WRITE (-S0 +@OBUFB, 0);                                        18980000
         DEL;                                                           18982000
                                                                        18984000
         << SUSPENDED >>                                                18986000
         MOVE OBUFB := "      SUSP ";                                   18988000
         ASCII (STCOUNTS(JSUSP),-10,OBUFB(4));                          18990000
         WRITE (-11,0);                                                 18992000
                                                                        18994000
         END                                                            18996000
      ELSE                                                              18998000
         IF STATE = JWAIT THEN                                          19000000
            BEGIN    << JUST WAIT: INDICATE NUM DEFERRED >>             19002000
            MOVE OBUF := "      DEFERRED";                              19004000
            ASCII (WAITDEFCOUNT, -10, OBUFB (4));                       19006000
            WRITE (-14, 0);                                             19008000
            END                                                         19010000
         ELSE                                                           19012000
            IF STATE = JEXEC THEN                                       19014000
               BEGIN    <<JUST EXEC: INDICATE SESSIONS>>                19016000
               MOVE OBUF := "      SESSIONS";                           19018000
               ASCII (SESCOUNT, -10, OBUFB (4));                        19020000
               WRITE (-14, 0);                                          19022000
               END;                                                     19024000
      END                                                               19026000
   ELSE                                                                 19028000
      IF TOTAL = 0 THEN                                                 19030000
         BEGIN    << INDICATE NONE >>                                   19032000
         MOVE OBUF := " NO SUCH JOB(S) ";                               19034000
         WRITE (-15, 0);                                                19036000
         END;                                                           19038000
                                                                        19040000
   << FENCE AND LIMITS >>                                               19042000
   MOVE OBUFB := "JOBFENCE= ", 2;                                       19044000
   TOS := TOS +ASCII (JOBFENCE, 10, OBUFB (10));                        19046000
   MOVE * := "; JLIMIT= ", 2;                                           19048000
   TOS := TOS +ASCII (JLIMIT, 10, BPS0);                                19050000
   MOVE * := "; SLIMIT= ", 2;                                           19052000
   TOS := TOS +ASCII (SLIMIT, 10, BPS0);                                19054000
   WRITE (-S0 +@OBUFB, %60);                                            19056000
   DEL;                                                                 19058000
                                                                        19060000
LEAVE:                                                                  19062000
   IF DSTNUM <> 0 THEN FREEDSEG(DSTNUM,0);                     <<04801>>19064000
   IF LISTFILE THEN                                            <<04801>>19066000
      BEGIN                                                    <<04801>>19068000
         FCLOSE(FNUM,CLOSEOPTIONS,0);                          <<04801>>19070000
         IF <> THEN                                            <<04801>>19072000
            BEGIN                                              <<04801>>19074000
               FERROR'(FNUM,ERRNUM);                           <<04801>>19076000
               ERROR(SHOWJOBCLSERR);                           <<04801>>19078000
            END;                                               <<04801>>19080000
      END;                                                     <<04801>>19082000
                                                               <<04801>>19084000
   END;    << SHOWJOB >>                                                19086000
$PAGE "CXSHOWJOB"                                              <<04801>>19088000
$CONTROL SEGMENT=OPHI                                          <<04801>>19090000
                                                                        19092000
<< Note:  Procedure  CXSHOWJOB  was  moved  unchanged  from >> <<04801>>19094000
<< SPOOLCOMS to OPCOMMAND as part of this enhancement.  Its >> <<04801>>19096000
<< fix number(s) were not changed.                          >> <<04801>>19098000
                                                                        19100000
PROCEDURE CXSHOWJOB (PARMSP, ERRNUM, PARMNUM);                          19102000
   BYTE ARRAY PARMSP;                                                   19104000
   INTEGER ERRNUM, PARMNUM;                                             19106000
   OPTION PRIVILEGED, UNCALLABLE;                                       19108000
BEGIN                                                                   19110000
   ERRNUM := SHOWJOB(PARMSP, PARMNUM, FALSE);                  <<04801>>19112000
   END;    << CXSHOWJOB >>                                              19114000
$PAGE "GLOBAL SYMBOL TABLE"                                    <<04801>>19116000
$PAGE                                                          <<04801>>19118000
$CONTROL SEGMENT = MAIN                                        <<04801>>19120000
END.   << OPCOMMAND - Module 85 >>                             <<04801>>19122000
