$CONTROL MAP,CODE,USLINIT                                               00010000
<<SPOOLCOMS - MODULE 80>>                                      <<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
$THIRTY                                                                 00028000
$CONTROL PRIVILEGED                                                     00030000
$CONTROL MAIN=SPOOLCOMS                                        <<04833>>00032000
$CONTROL SEGMENT=SPOOLCOMS1                                             00034000
<< MPE 3000/30 SPOOLING FACILITY >>                                     00036000
BEGIN                                                                   00038000
$PAGE "***  GENERAL/GLOBAL EQUIVALENCES   ***"                          00040000
DEFINE                                                                  00042000
           A                 = ABSOLUTE          #,                     00044000
           ENAPROC           = ASSEMBLE(PSEB)    #,                     00046000
           DISAPROC          = ASSEMBLE(PSDB)    #,                     00048000
           DISABLE           = ASSEMBLE(SED 0)   #,                     00050000
           ENABLE            = ASSEMBLE(SED 1)   #;                     00052000
INTEGER                                                                 00056000
           DB0               = DB+0  ,                                  00058000
           DB1               = DB+1  ,                                  00060000
           DB2               = DB+2  ,                                  00062000
           DB3               = DB+3  ,                                  00064000
           DB4               = DB+4  ,                                  00066000
           DB5               = DB+5  ,                                  00068000
           DB6               = DB+6  ,                                  00070000
           DB7               = DB+7  ,                                  00072000
           DB8               = DB+8  ,                                  00074000
           DB9               = DB+9  ,                                  00076000
           DB10              = DB+10 ,                                  00078000
           DB11              = DB+11 ,                                  00080000
           S0                = S-0   ,                                  00082000
           S1                = S-1    ,                        <<00170>>00084000
           S2                = S-2    ,                        <<00170>>00086000
           X                 = X     ,                                  00088000
           XREG              = X     ;                                  00090000
LOGICAL                                                                 00092000
           LDB3              = DB+3  ;                                  00094000
INTEGER POINTER                                                         00096000
           PDB0              = DB+0  ,                                  00098000
           PDB1              = DB+1  ,                                  00100000
           PDB2              = DB+2  ,                                  00102000
           PDB3              = DB+3  ,                                  00104000
           PDB4              = DB+4  ,                                  00106000
           PS0               = S-0   ,                                  00108000
           PS1               = S-1   ;                                  00110000
BYTE POINTER                                                            00112000
           BPS0              = S-0   ;                                  00114000
INTEGER ARRAY                                                           00116000
           ARRDB0(*)         = DB+0  ,                                  00120000
           ARRDB1(*)         = DB+1  ,                                  00122000
           ARRDB12(*)        = DB+12 ,                                  00124000
           ARRQ0(*)          = Q-0   ,                                  00126000
           ARRS0(*)          = S-0   ;                                  00128000
BYTE ARRAY                                                              00130000
           BARRS4(*)         = S-4   ;                                  00132000
DOUBLE POINTER                                                          00134000
           DPS0              = S-0   ;                                  00136000
$PAGE "***   SPOOLING CONSTANTS   ***"                                  00138000
EQUATE                                                                  00140000
<< SPOOLING SIRS >>                                                     00142000
           LDTSIR            = 10    ,                                  00144000
           LPDTSIR           = 9     ,                                  00146000
           IDDSIR            = 3     ,                                  00148000
           ODDSIR            = 4     ,                                  00150000
           JMATSIR           = 15    ,                                  00152000
<< DATA SEGMENT NUMBERS >>                                              00154000
           IDDDST            = 45    ,                                  00156000
           ODDDST            = 46    ,                                  00158000
           LDTDST            = 14    ,                                  00160000
           LPDTDST           = 13    ,                                  00162000
           JMATDST           = 25    ,                                  00164000
<< TABLE SIZE CONSTANTS >>                                              00168000
           LPDTSIZE          = 2     ,                                  00170000
           LDTSIZE           = 5     ,                                  00172000
           PCBSIZE           = 16    ,                                  00174000
           BSIZE             = 512   ,                                  00176000
           RSIZE             = 128   ,                                  00180000
           MAXRSIZE          = 255   ,                                  00182000
           XDDHSIZE          = 4     ,                                  00184000
           XDDSIZE           = 30    ,                                  00186000
           IDDHSIZE          = XDDHSIZE  ,                              00188000
           IDDSIZE           = XDDSIZE   ,                              00190000
           ODDHSIZE          = XDDHSIZE  ,                              00192000
           ODDSIZE           = XDDSIZE   ,                              00194000
           JMATSIZE          = 26    ,                                  00196000
           JMATERRSIZE       = JMATSIZE -3 ,                            00198000
<< LOW MAIN MEMORY >>                                                   00200000
           PCBB              = 3     ,                                  00204000
           CPCB              = 4     ,                                  00206000
<< MESSAGE CATALOG NUMBERS FOR SPOOLER/CI MESSAGES >>                   00208000
           NORMALSTOP        = 237   ,                                  00210000
           NONEXISTENTDEV    = 222   ,                                  00212000
           NOTACCEPTING      = 224   ,                                  00214000
           SPOOFLEIOERR      = 225   , <<80>>                           00216000
           NOSUCHSTACK       = 81    ,                                  00218000
           NOSTREAMING       = 82    ,                                  00220000
           FILENOTASCII      = 83    ,                                  00222000
           CANNOTSINIT       = SPOOFLEIOERR ;                           00226000
<< COMMAND INTERPRETER ERROR MESSAGE EQUATES>>                 <<U.RAO>>00228000
EQUATE                                                         <<U.RAO>>00230000
   ACCTEXPECTALPHA  =  550,   <<LEADING CHAR MUST BE ALPHA>>   <<U.RAO>>00232000
   ACCTNAMEMISSING  =  551,   <<EXPECTED ACCOUNT NAME>>        <<U.RAO>>00234000
   ACCTNAMETOOLONG  =  552,   <<ACCT NAME > 8 CHAR>>           <<U.RAO>>00236000
   ACCTEXPECTNAMENOTAT=553,   <<EXPECTED NAME, FOUND "@">>     <<U.RAO>>00238000
   USEREXPECTALPHA  =  590,                                    <<U.RAO>>00240000
   USERNAMEMISSING  =  591,                                    <<U.RAO>>00242000
   USERNAMETOOLONG  =  592,                                    <<U.RAO>>00244000
   USEREXPECTNAMENOTAT=593,                                    <<U.RAO>>00246000
   SHOWNODST        = 1127,   <<OUT OF DST'S>>                 <<00548>>00248000
   SHOWNOVDS        = 1128,   <<OUT OF VIRTUAL MEM FOR DST>>   <<00548>>00250000
   SHOWNOSPACE      = 1129,   <<OUT OF SPACE IN DST>>          <<00548>>00252000
   SHOWSYSERR       = 1130,   <<UNKNOW ERROR USING DST>>       <<00548>>00254000
   SHOWJOBOPNERR    =  1495,   <<CAN'T OPEN LISTFILE>>         <<01446>>00256000
   SHJBEXPARMLST    =  1496,   <<IGNRD PARMS PAST LISTFILE>>   <<01446>>00258000
   SHOWJOBCLSERR    =  1497,   <<CAN'T CLOSE LISTFILE>>        <<01446>>00260000
   SHOWJSTATSIGNRD  = 1500,   <<STATUS REQUEST IGNORED>>       <<U.RAO>>00262000
   SHOWJXTRANPARMS  = 1501,   <<EXTRA PARMS IGNORED>>          <<U.RAO>>00264000
   SHOWJXPCTJOB     = 1502,   <<EXPECTED JOB ID>>              <<U.RAO>>00266000
   SHOWJXPCTATS     = 1503,   <<EXPECTED "@S">>                <<U.RAO>>00268000
   SHOWJXPCTATJ     = 1504,   <<EXPECTED "@J">>                <<U.RAO>>00270000
   SHOWJUNKATX      = 1505,   <<EXPECTED EITHER "@S" OR "@J">> <<U.RAO>>00272000
   SHOWJJNAME2LONG  = 1506,   <<JOB NAME > 8 CHARACTERS LONG>> <<U.RAO>>00274000
   SHOWJJNXPCTALPH  = 1507,   <<EXPECTED ALPHA LEADING CHAR>>  <<U.RAO>>00276000
   SHOWJXPCTJN      = 1508,   <<SPECIALS EMBEDDED IN JOB NAME>><<U.RAO>>00278000
   SHOWJXPCTJSNUM   = 1509,   <<EXPECTED EITHER J OR S>>       <<U.RAO>>00280000
   SHOWJXPLCTJ2MP   = 1510,   <<EXTRA PARMS IGNORED>>          <<U.RAO>>00282000
   SHOWJUNKKEY      = 1511,   <<UNKNOWN KEYWORD>>              <<U.RAO>>00284000
   SHOWJ2MERRORS    = 1512,   <<TOO MANY ERRORS, PARSING STOPPE<<U.RAO>>00286000
   SHOWJFSERR       = 1513,   <<SCRATCH FILE ERROR>>           <<U.RAO>>00288000
   SHOWJREDNDSTATE  = 1514,   <<INCONSISTENT SPEC OF JOB STATE><<U.RAO>>00290000
   SHOWJNDINAP      = 1515,   <<ONLY WITH WAIT STATE>>         <<U.RAO>>00292000
   SHOWJUNKDEFR     = 1516,   <<UNKNOWN DEFER STATE>>          <<U.RAO>>00294000
   SHOWJXPCTUN      = 1517,   <<EMBEDDED SPECIALS NOT ALLOWED>><<U.RAO>>00296000
   SHOWJXPCTPERIOD  = 1518,   <<USER.ACCT>>                    <<U.RAO>>00298000
   SHOWJXPCTAN      = 1519,   <<EMBEDDED SPECIALS NOT ALLOWED>><<U.RAO>>00300000
   SHOWJREDUNDJOB   = 1520,   <<JOB PARM REDUNDANTLY SPECIFIED><<U.RAO>>00302000
   SHOWJXPCTJOBEQ   = 1521,   <<EXPECTED = SIGN AFTER "JOB">>  <<U.RAO>>00304000
   SHOWFXPCTODEVFL  = 1530,   <<ONLY OUTFILES WITH SHOWOUT>>   <<U.RAO>>00306000
   SHOWFXPCTIDEVFL  = 1531,   <<ONLY INFILES WITH SHOWIN>>     <<U.RAO>>00308000
   SHOWFINVLDDFID   = 1532,   <<INVALID DEVICEFILE ID>>        <<U.RAO>>00310000
   SHOWFXTRAIGNORD  = 1533,   <<EXTRA PARAMETERS INAPPROPRIATE><<U.RAO>>00312000
   SHOWFUNKKEY      = 1534,   <<UNKNOWN KEYWORD>>              <<U.RAO>>00314000
   SHOWFSTATSIGNRD  = 1535,   <<STATUS PARM IGNORED>>          <<U.RAO>>00316000
   SHOWFXTRANPARMS  = 1536,   <<UNIDENTIFIABLE PARAMETERS>>    <<U.RAO>>00318000
   SHOWFFSERR       = 1537,   <<SCRATCH FILE FILESYS ERROR>>   <<U.RAO>>00320000
   SHOWF2MERRORS    = 1538,   <<TOO MANY ERRORS IN PARSE>>     <<U.RAO>>00322000
   SHOWFREDNDSTATE  = 1539,   <<STATE INCONSISTENTLY SPECIFIED><<U.RAO>>00324000
   SHOWFINNDINAP    = 1540,   <<INPUT FILES CANNOT BE DEFERRED><<U.RAO>>00326000
   SHOWFOUTNDINAP   = 1541,   <<APPROPRIATE ONLY FOR "READY" FI<<U.RAO>>00328000
   SHOWFUNKDEFR     = 1542,   <<EXPECTED "N" OR "D">>          <<U.RAO>>00330000
   SHOWFXPCTJOBEQ   = 1543,   <<EXPECTED "JOB=">>              <<U.RAO>>00332000
   SHOWFXPCTJOB     = 1544,   <<INVALID JOB NAME SYNTAX>>      <<U.RAO>>00334000
   SHOWFXPCTATS     = 1545,   <<EXPECTED @S OR @S'>>           <<U.RAO>>00336000
   SHOWFXPCTATJ     = 1546,   <<EXPECTED @J OR @J'>>           <<U.RAO>>00338000
   SHOWFUNKATX      = 1547,   <<UNKNOWN JOB TYPE>>             <<U.RAO>>00340000
   SHOWFXPCTSNUM    = 1548,   <<INVALID SESSION NUMBER>>       <<U.RAO>>00342000
   SHOWFXPCTJNUM    = 1549,   <<INVALID JOB NUMBER>>           <<U.RAO>>00344000
   SHOWFXPCTJSNUM   = 1550,   <<INVALID JOB ID>>               <<U.RAO>>00346000
   SHOWFREDUNDJOB   = 1551,   <<REDUNDANTLY SPECIFIED>>        <<U.RAO>>00348000
   SHOWFXPCTDEV     = 1552,   <<EXPECTED DEVICE>>              <<U.RAO>>00350000
   SHOWFINVLDDEVSP  = 1553,   <<INVALID DEVICE SPECIFICATION>> <<U.RAO>>00352000
   SHOWFINPTDEVCLS  = 1554,   <<DEV CLASS INAPPROPRIATE FOR INP<<U.RAO>>00354000
   SHOWFDACCESSDEV  = 1555,   <<DIRECT ACCESS INAPPROPRIATE>>  <<U.RAO>>00356000
   SHOWFRDNTDEV     = 1556,   <<REDUNDANT>>                    <<U.RAO>>00358000
   SHOWDV2MP        = 1580,  <<TOO MANY PARAMETERS TO SHOWDEV>><<U.RAO>>00360000
   SHOWDVNOSUCHLDN  = 1581,  <<LDN CAN'T BE FOUND ON SYSTEM>>  <<U.RAO>>00362000
   SHOWDVINVLDCLAS  = 1582,  <<CLASS NAME > 8 CHARACTERS>>     <<U.RAO>>00364000
   SHOWDVNOSUCHCLS  = 1583,  <<CAN'T FIND DEVICE CLASS ON SYS>><<U.RAO>>00366000
   SHOWFDSDEVICE    = 1584,  <<DS DEVICE INAPPROPRIATE>>       <<01906>>00368000
   STRMNOTENABLED   =   82,  <<STREAM DISABLED>>               <<U.RAO>>00370000
   STRMNOSYSDEF     = 1590,  <<SYS DEF FILE NOT ALLOWED>>      <<U.RAO>>00372000
   STRMINVLDCOLON   = 1591,  <<BAD PSEUDOCOLON>>               <<U.RAO>>00374000
   STRMSYNTAX       = 1592,  <<BAD SYNTAX TO COMMAND>>         <<U.RAO>>00376000
   STRMFILEOPENERR  = 1596, <<CAN'T OPEN STREAM FILE>>         <<00534>>00378000
   <<GENERAL CI MESSAGES>>                                     <<U.RAO>>00380000
   CIGENERALMSGSET  =  7,                                      <<U.RAO>>00382000
                                                               <<U.RAO>>00384000
   SHOWFHEADER      =  14,                                     <<U.RAO>>00386000
   SHOWFFILECNTDSP  =  15,                                     <<U.RAO>>00388000
   SHOWFFILECNT     =  16,                                     <<U.RAO>>00390000
   SHOWFACTIVECNT   =  17,                                     <<U.RAO>>00392000
   SHOWFREADYCNT    =  18,                                     <<U.RAO>>00394000
   SHOWFOPENEDCNT   =  19,                                     <<U.RAO>>00396000
   SHOWFLOCKEDCNT   =  20,                                     <<U.RAO>>00398000
   SHOWFDEFCNT      =  21,                                     <<U.RAO>>00400000
   SHOWFSPOOFLECNT  =  22,                                     <<U.RAO>>00402000
   SHOWFNOSUCHFLS   =  23,                                     <<U.RAO>>00404000
   SHOWFOUTFENCE    =  24,                                     <<00874>>00406000
   SHOWFDEVFENCE    =  27;                                     <<00874>>00408000
$PAGE "CONSOLE ERROR MESSAGES"                                          00410000
<< Console error messages added as part of this fix.        >> <<04833>>00412000
                                                                        00414000
EQUATE                                                                  00416000
   OPCOMMNOTALLOW        = 3000, <<NO USER ACCESS TO OPRAT CMND>>       00418000
   EXPLDEVBAD            = 3001, <<EXPECTED LDEV # BAD>>                00420000
   LDEVNOTCONFIG         = 3002, <<LDEV NOT IN THIS CONFIG.>>           00422000
   HEADONREQ1P           = 3003, <<HEADON HAS EXACTLY 1 PARM>>          00424000
   HEADOFFREQ1P          = 3004, <<HEADOFF HAS EXACTLY ONE PARM>>       00426000
   LDEVNOTCRPRPNCH       = 3005, <<EXPCTD CARD RDR, PRNTR, PNCH>>       00428000
   USERNOACC2DEV         = 3006, <<USER HAS NO ACCESS TO DEVICE>>       00430000
   LDEVNOTREAL           = 3007, <<LOGICAL DEVICE IS NOT REAL>>         00432000
   GIVEREQ1P             = 3008, <<GIVE REQUIRES EXACTLY 1 PARM>>       00434000
   TAKEREQ1P             = 3009, <<TAKE REQUIRES EXACTLY 1 PARM>>       00436000
   LDEVINBYF             = 3010, <<DEVICE IN USE BY SYSTEM,>>           00438000
                                 <<  MUST BE DOWN              >>       00440000
   LDEVALINBYDIAG        = 3011, <<LDEV ALRDY IN USE BY DIAG>>          00442000
   UPREQ1P               = 3012, <<UP REQUIRES EXACTLY 1 PARM>>         00444000
   DOWNREQ1P             = 3013, <<DOWN REQUIRES EXACTLY 1 PARM>>       00446000
   LDEVINBYDIAG          = 3014, <<DEVICE IN USE BY DIAGNOSTICS>>       00448000
   LDEVALINBYF           = 3015, <<LDEV ALREADY IN USE BY SYS>>         00450000
   LDEVALDOWN            = 3016, <<DEVICE ALREADY DOWN>>                00452000
   LDEVALDOWNP           = 3017, <<LDEV ALRDY HAS DOWN PENDING>>        00454000
   LDEVINUSEDOWNP        = 3018, <<DEVICE IN USE, DOWN PENDING>>        00456000
   RECALLHEADER          = 3019, <<FOLLOWING REPLIES PENDING:>>         00458000
   WELCREADERR           =  901, <<CIERR-READ ERROR IN WELCM>> <<04833>>00460000
   NOREPLYPENDING        = 3020, <<NO REPLIES PENDING>>                 00462000
   ASSBYOTHERS           = 3021, <<LDEV ALRDY ASSOC BY OTHERS>>         00464000
   LDEVNOTINDIAG         = 3022, <<DEVICE NOT IN DIAGNOSTICS>>          00466000
   OUTFENCEREQ1P         = 3023, <<OUTFENCE REQUIRES 1 PARM>>           00468000
   EXPPRIOR1TO14         = 3024, <<OUTFENCE PRI EXPCT 1-14>>            00470000
   EXPPRIORGT14          = 3025, <<PRIORITY > 14, 14 USED>>             00472000
   EXPPRIORLT1           = 3026, <<PRIORITY <  1, 1  USED>>             00474000
   ABORTIOREQ1P          = 3027, <<ABORTIO REQUIRES 1 PARM>>            00476000
   NOIOQED4DEV           = 3028, <<NO I/O TO ABORT FOR DEVICE>>         00478000
   ACCEPTREQ2PARM        = 3029, <<ACCEPT HAS AT MOST TWO PARMS>>       00480000
   REFUSEREQ2PARM        = 3030, <<REFUSE HAS AT MOST TWO PARMS>>       00482000
   ACCEPTREQ1P           = 3031, <<ACCEPT MUST HAVE < =  1 PARM.>>      00484000
   REFUSEREQ1P           = 3032, <<ACCPET MUST HAVE < =  1 PARAM.>>     00486000
   COMMAAFTERDJ          = 3033, <<"," EXPCT AFTER DATA OR JOBS>>       00488000
   FIRSTMUSTBEDJ         = 3034, <<EXPECTED 'DATA' OR 'JOBS'>>          00490000
   LDEVNOTDJ             = 3035, <<LDEV NOT DATA/JOB ACCEPTING>>        00492000
   LDEVHASNODEFOUT       = 3036, <<LDEV HAS NO DEFLT OUTDEV>>           00494000
   WELMSGBUSY            = 3037, <<WELCOME DST'S BUSY>>                 00496000
   BREAKJOBREQ1P         = 3038, <<BREAKJOB HAS EXACTLY 1 PARM>>        00498000
   RESUMEJOBREQ1P        = 3039, <<RESUMEJOB HAS EXACTLY 1 PARM>>       00500000
   PARMNOTJOBID          = 3040, <<EXPECTED JOB ID (#JNNN)>>            00502000
   BADJOBNUM             = 3041, <<MUST BE POSITIVE INTEGER > 1>>       00504000
   NOSUCHJOB             = 3042, <<SPECIFIED JOB DOES NOT EXIST>>       00506000
   JOBNOTACTIVE          = 3043, <<BREAKJOB REQUIRES EXEC JOB>>         00508000
   JOBNOTSUSPENDED       = 3044, <<RESUMEJOB REQUIRES SUSP JOB>>        00510000
   SUSPENDJOBOWN         = 3045, <<SUSP JOB NNN OWNS LDEV MMM>>         00512000
   JOBINTERM             = 3046, <<RESUMING/SUSP JOB TERMNTNG>>         00514000
   NOTUSERSJOB           = 3047, <<USER RES/SUSP OTHER'S JOB>>          00516000
   REPLYREQ2P            = 3048, <<REPLY HAS AT LEAST 2 PARMS>>         00518000
   REPLYTOOMANYP         = 3049, <<REPLY HAS TOO MANY PARMS>>           00520000
   INVALIDPIN            = 3050, <<INVALID PIN GIVEN IN REPLY>>         00522000
   NOREQ4PIN             = 3051, <<NO REPLY OUTSTANDING FOR PIN>>       00524000
   REPLYEXPYN'NUM        = 3052, <<REPLY EXPECTED YES/NO OR #>>         00526000
   REPLYEXPYN            = 3053, <<REPLY EXPECTED Y/N>>                 00528000
   REPLYEXPNUMBER        = 3054, <<REPLY EXPECTED NUMBER>>              00530000
   ASSREQ1P              = 3055, <<ASSOCIATE HAS EXACTLY 1 PARM>>       00532000
   DISASSREQ1P           = 3056, <<DISASSOC HAS EXACTLY 1 PARM>>        00534000
   USERHASDEVASS         = 3057, <<USER ALREADY ASSOCIATED LDEV>>       00536000
   USERNOTASS2DEV        = 3058, <<USER CAN'T DISASSOC LDEV NOT>>       00538000
                                 <<  ASSOC WITH HIM            >>       00540000
   USERCANTASSDEV        = 3059, <<USER NOT ALLWD TO ASSOC LDEV>>       00542000
   REPLYEXP2PARM         = 3060, <<REPLY EXPECTED 2 PARMS ONLY>>        00544000
   STRINGTOOLONG         = 3061, <<REPLY STRING TOO LONG>>              00546000
   JOBFENCEREQ1P         = 3062, <<JOBFENCE REQ EXACTLY 1 PARM>>        00548000
   EXP0TO14              = 3063, <<JOBPRI MUST BE <0, >14>>             00550000
   EXPPRIORLT0           = 3064, <<JOBFENCE <0, ZERO USED>>             00552000
   EXPCOMMABREPLYP       = 3065, <<EXPCTD "," BETW REPLY PARMS>>        00554000
   STREAMSREQ1P          = 3066, <<STREAMS EXPCT EXACTLY 1 PARM>>       00556000
   CANTBETERM            = 3067, <<STREAMS DEV CAN'T BE TERM>>          00558000
   DEVNOTDJ              = 3068, <<STREAMS DEV NOT DATA/JOB ACC>>       00560000
   CONSOLEREQ1P          = 3069, <<CONSOLE REQ EXACTLY 1 PARM>>         00562000
   DEVNOTJOB             = 3070, <<CONSOLE DEV NOT JOB ACC>>            00564000
   EXP1OFSORJLIMIT       = 3071, <<EXPECTED JOB OR SESS LIMIT>>         00566000
   LIMITHAS2PARM         = 3072, <<LIMIT HAS AT MOST 2 PARMS>>          00568000
   EXPCOMMASJ            = 3073, <<LIMIT NEEDS "," BETW PARMS>>         00570000
   SLIMITBAD             = 3074, <<SESSION LIMIT BAD>>                  00572000
   JLIMITBAD             = 3075, <<JOB LIMIT BAD>>                      00574000
   EXPJNUMORJNAME        = 3076, <<EXPECTED JOBNUM OR JOBNAME>>         00576000
   DEVNOTOUTPUT          = 3077, <<ALTJOB OUTDEV MUST BE OUTDEV>>       00578000
   JOBNUMNOOTHERP        = 3078, <<JOBNUM HAS NO OTHER PARMS>>          00580000
   EXPJORSNUM            = 3079, <<EXPECTED #Jnnn OR #Snnn>>            00582000
   EXPUANDANAME          = 3080, <<EXPECTED USERNAME & ACCTNAME>>       00584000
   UORANAMEMAX8          = 3081, <<USER AND ACCT NAME > 8 CHARS>>       00586000
   PERIODEXP             = 3082, <<NO "." BETW USER/ACCT NAMES>>        00588000
   JOBBEINTRO            = 3083, <<CAN'T ABRT JOB BEING INTRO'D>>       00590000
   EXPACCTNAME           = 3084, <<EXPECTED [JOBNAME,]USER.NAME>>       00592000
   UORANAMEZERO          = 3085, <<USER/ACCT CAN'T BE 0 LENGTH>>        00594000
   EXP1OFINOUT           = 3086, <<ALTJOB KEYS NOT INPRI/OUTDEV>>       00596000
   EXPSEMICOLON          = 3087, <<NEED ";" BEFORE KEYS>>               00598000
   EXPEQUALS             = 3088, <<NEED " = " AFTER KEY>>               00600000
   EXPJAND1PARM          = 3089, <<ALTJOB REQ JOB + > =  1 KEY>>        00602000
   NOSUCHDEV             = 3090, <<NO SUCH DEVICE OR CLASS>>            00604000
   MUSTWAITORINTRO       = 3091, <<ALTJOB REQ WAIT/INTRO JOB>>          00606000
   CANTBESYSFILE         = 3092, <<(DIS)ALLOW FILE <> "$" FILE>>        00608000
   MUSTBEASNOCTL         = 3093, <<FILE = MUST BE ASCII/NOCCTL>>        00610000
   EXP1OFUSERFILE        = 3094, <<EXPECTED FILE =  OR>>                00612000
                                 <<  USER.ACCT;COMMANDS = >>            00614000
   EXPUSERNAME           = 3095, <<EXPECTED USERNAME>>                  00616000
   COMMANDSEPBYCOMMA     = 3096, <<COMMANDS ARE SEPRAT BY ",">>         00618000
   EXPCOMMANDS           = 3097, <<EXPECTED COMMANDS = >>               00620000
   NOSUCHCOMMAND         = 3098, <<UNKNOWN OPERATOR COMMAND>>           00622000
   TOOMANYPARM           = 3099, <<(DIS)ALLOW TOO MANY PARMS>>          00624000
   ALLDISALLIOERR        = 3100, <<I/O ON FILE =  FILE>>                00626000
   NOJOBINGOODSTATE      = 3101, <<NO JOBS IN EXECUTION STATE>>         00628000
   EXP1OFONOFF           = 3102, <<EXPECTED ON/OFF IN VMOUNT>>          00630000
   EXPALL                = 3103, <<EXPECTED ;ALL>>                      00632000
   REQSETGRPACCT         = 3104, <<EXPECTED SET.GROUP.ACCT>>            00634000
   LMHAS5PARMS           = 3105, <<LMOUNT HAS AT MOST 5 PARMS>>         00636000
   LDMEXP3PARMS          = 3106, <<LDISMOUNT HAS EXCTLY 3 PARMS>>       00638000
   BADSETNAME            = 3107, <<BAD VOLUME SET/CLASS NAME>>          00640000
   SETNAMEPERIOD         = 3108, <<EXPECTED "." AFTER SET NAME>>        00642000
   GROUPPERIOD           = 3109, <<EXPECTED "." AFTER GRP NAME>>        00644000
   EXPGENERATION         = 3110, <<EXPECTED ;GEN = >>                   00646000
   BADGENERATION         = 3111, <<INVALID GENERATION #>>               00648000
   MONMAXPARM            = 3112, <<TOO MANY PARMS FOR MON>>             00650000
   MONREQLDEV            = 3113, <<EXPECTED LDEV FOR MON>>              00652000
   NOSYSBUF              = 3114, <<NO SYSBUFS FOR MONITORING>>          00654000
   MONMUSTBETAPE         = 3115, <<MON LDEV MUST BE TAPE>>              00656000
   TAPEMUSTBEDOWN        = 3116, <<LDEV MUST BE DOWN FOR MON>>          00658000
   EXPSEMI'E'EQUALS      = 3117, <<EXPECTED ;E = >>                     00660000
   MASKCOMMA             = 3120, <<EXP "," AFTER MASK BIT #>>           00662000
   IGNOREDNULL           = 3121, <<IGNORED NULL MASK BIT #>>            00664000
   BADMASK               = 3122, <<INVALID MASK BIT SPECIFIED>>         00666000
   NODS                  = 3123, <<NO DS SUBSYSTEM>>                    00668000
   NOMP                  = 3124, <<NO MULTI-POINT SUBSYSTEM>>           00670000
   NOMRJE                = 3125, <<NO MRJE SUBSYSTEM>>                  00672000
   EXPAUTO               = 3126, <<EXPECTED "AUTO" AFTER "ON">>         00674000
   INVALIDNAME           = 3127, <<NAME MUST BE 1-8 CHARS,A/N>>         00676000
   JOBSECURITY1PARM      = 3128, <<JOBSECURITY HAS 1 PARM>>             00678000
   EXP1OFHIGHLOW         = 3129, <<EXPECTED EITHER HIGH OR LOW>>        00680000
   LDEVMUSTBETERM        = 3130, <<CONSOLE LDEV MUST BE TERM>>          00682000
   LDEVCANTBEDSTERM      = 3131, <<CONSOLE LDEV CANT BE DS TERM>>       00684000
   DEVNOTASS             = 3132, <<MASTEROP TRIED TO DISASSOC>>         00686000
                                 <<  NON-ASSOC DEVICE>>                 00688000
   LDEVWASASS            = 3133, <<CONFIRM ASSOC TO MASTEROP>>          00690000
   LDEVWASDISASS         = 3134, <<CONFIRM DISASSOC TO MASTEROP>>       00692000
   OTHERUSERHASDEV       = 3135, <<REQUIRE MASTEROP TO VERIFY>>         00694000
                                 <<  DEV COMMAND>>                      00696000
   OPNOTDONE             = 3136, <<OPERATOR DIDN'T VERIFY>>             00698000
   EXPFILESHOW           = 3137, <<EXPECTED FILE = FORMAL[;SHOW]>>      00700000
   EXPSHOW               = 3138, <<EXPECTED ;SHOW>>                     00702000
   LASTALLOW             = 3139, <<LAST CMPLT INP LINE WAS :>>          00704000
   MASTEROPDISASS        = 3140, <<MASTER OP DISASS. SOMEBODY>>         00706000
   NOSUCHDEVCLASS        = 3141, <<NO SUCH DEVICE CLASS>>               00708000
   ASSREQSESSION         = 3142, <<(DIS)ASSOC AVAIL ONLY TO SES>>       00710000
   OTHERUSERHASCLASS     = 3143, <<REQ MASTEROP TO VERIFY>>             00712000
                                 <<  CLASS COMMAND>>                    00714000
   CONSOLEBUSY           = 3144, <<CONSOLE IS BUSY>>           <<04833>>00716000
   CONSOLESWITCHED       = 3145, <<CONS SWCH FROM LDEV TO LDEV>>        00718000
   OUTFENCEXP3PARMS      = 3146, <<OUTFENCE EXPCT 3 PARMS>>    <<04833>>00720000
   EXPLDEVEQ             = 3147, <<EXPECTED "LDEV=">>          <<04833>>00722000
   LDEVNOTINODD          = 3148, <<LDEV NOT IN ODD>>           <<04833>>00724000
   CONSOLEDOWN           = 3149, <<CONS DOWN OR PENDING>>      <<04833>>00726000
   DOWNCONSOLE           = 3150, <<ATTEMPT TO DOWN CONSOLE>>   <<04833>>00728000
   CANT'DOWN'SYS'DISC    = 3151, << Attempt to down sysdisc.>> <<04833>>00730000
   CANTABORTIODISK       = 3160, <<Can't do ABORTIO on disc >> <<04833>>00732000
   CONSOLEIS             = 3190, <<Display current cons ldev>> <<04833>>00734000
   ABSLIMITEXCEEDED      = 3818, << Absolute J/S limit exc >>  <<04833>>00736000
   CONF'ERROR            = 3819; << CONFDATA.PUB.SYS error >>  <<04833>>00738000
$PAGE "SPOOLING ERROR MESSAGES"                                         00740000
<< Spooling error messages added as part of this fix.       >> <<04833>>00742000
                                                                        00744000
EQUATE                                                                  00746000
   EXPSPFNAME = 3200,     <<EXPECTED SPOOLFILE DFID>>                   00748000
   FILENUMNOOTHERP = 3201,<<EXPECTED ONE PARM DFID>>                    00750000
   EXPOORINUM = 3202,     <<EXPECTED #ONNN OR #INNN>>                   00752000
   BADFILENUM = 3203,     <<DFID MUST BE POSITIVE INTEGER>1>>           00754000
   NOSUCHFILE = 3204,     <<DFID DOES NOT EXIST>>                       00756000
   WRONGSTATE = 3205,     <<DFID NOT READY     >>                       00758000
   NOPOUNDSIGN = 3206,    <<DFID MUST START WITH # SIGN>>               00760000
   SPACTLDEV=3207,        <<SPOOLFILE IS ACTIVE ON LDEV \>>             00762000
   EXPONUM = 3208,         <<EXPECTED DFID OF #ONNN>>                   00764000
   EXP1OFKEY = 3209,       <<EXPECT 1 OF DEV,PRI,DEFER,COPIES>>         00766000
   EXP1TO127 = 3210,       <<EXPECT NUMBER 1<=COPIES<=127>>             00768000
   EXPOAND1PARM = 3211,    <<EXPECT DFID AND ONE PARM>>                 00770000
   EXPO0TO14 = 3212,        <<EXPECTS 0 <= PRI <= 14 >>                 00772000
   STARTSPREQ1P = 3213,     <<STARTSPOOL REQUIRES 1 PARM>>              00774000
   INVDEVCLASS  = 3214,     <<INVALID DEVICE CLASS >>                   00776000
   UNKNOWNDEVCL = 3215,     <<UNKNOWN DEVICE CLASS >>                   00778000
   EXPINOROUT   = 3216,     <<EXPECTED IN OR OUT IN REPLY>>             00780000
   DEVTYPENOTSPOOLEE=3217,  <<DEVICE NOT SPOOLEE TYPE>>                 00782000
   SPOOLEEOWNEDOUT=3218,    <<DEVICE ALREADY OUTPUT SPOOLEE>>           00784000
   SPOOLEEOWNEDIN =3219,    <<DEVICE ALREADY INPUT SPOOLEE>>            00786000
   DEVOWNEDOTHER = 3220,    <<DEVICE OWNED BY ANOTHER PROC>>            00788000
   DEVNOTJOBDATA = 3221,    <<DEVICE NOT JOB/DATA ACCEPTING>>           00790000
   DEVOWNEDDIAG = 3222,     <<DEVICE OWNED BY DIAGNOSTICS>>             00792000
   UNABLETOGETSTACK=3223,   <<UNABLE TO GET SPOOLER STACK>>             00794000
   UNABLETOPROCREATE=3224,  <<UNABLE TO CREATE SPOOLER PROC>>           00796000
   STOPSPREQ1P = 3225,      <<STOPSPOOL REQUIRES 1 PARM>>               00798000
   SPOOLERBUSY = 3226,      <<SPOOLER PROCESS BUSY>>                    00800000
   CANT'DELETE'STDIN = 3227,                                   <<04833>>00802000
   SPOOLINOROUT = 3227,     <<IS SPOOLER INPUT OR OUTPUT?>>             00804000
                            <<  (in $SET 7)              >>             00806000
   DEVICENOTSPOOLED = 3228, <<DEVICE IS NOT SPOOLED>>                   00808000
   EXP1OFLDEVORFIN = 3229,  <<EXPECTED 1 OF LDEV OR FINISH>>            00810000
   SUSPENDSP2PARM  = 3230,  <<SUSPENDSPOOL EXP MAX 2 PARMS>>            00812000
   EXPFINISH = 3231,        <<EXPECTED "FINISH" PARAMETER>>             00814000
   RESUMESPREQ1P = 3232,    <<RESUMESP REQUIRES 1 PARM >>               00816000
   DEFEROVERPRI = 3233,      <<DEFER OVERRIDES PRI>>                    00818000
   PRIOVERDEFER = 3234,      <<PRI OVERRIDES DEFER>>                    00820000
   PRIOVERPRI = 3235,        <<PRI OVERRIDES PRI>>                      00822000
   SPACTLDEVNODEL = 3236,    <<SPFLE ACTIVE ON LDEV,NOT DELETE>>        00824000
   DEVICENOTOUTSPOOL = 3237, <<DEVICE NOT SPOOLED FOR OUTPUT>>          00826000
   EXPBACKORFORWARD = 3238,   <<EXPECTED "BACK" OR "FORWARD">> <<04833>>00828000
   EXPNUM1TO256 = 3239,       <<EXPECTED RANGE 1 TO 256>>      <<04833>>00830000
   EXPPAGESORFILES = 3240,    <<EXPECTED "PAGES" OR "FILES">>  <<04833>>00832000
   EXP4PARMS = 3241,          <<EXPECTED AT MOST 4 PARMS>>     <<04833>>00834000
   EXPDEVCLASSLONG = 3242,  <<DEVCLASS NAME > 8 CHARS>>        <<04833>>00836000
   BADCLASSNAME  = 3243,    <<CLASS NOT CONFIGURED>>           <<04833>>00838000
   CLASSALREADYSPOOLED = 3244, <<CLASS ALREADY SPOOLED>>       <<04833>>00840000
   CLASSNOTSPOOLED = 3245,  <<CLASS NOT SPOOLED>>              <<04833>>00842000
   CLTYPENOTSPOOLEE = 3246, <<DEVCLASSTYPE NOT SPOOLEE>>       <<04833>>00844000
   USERNOACC2CLASS = 3247, <<USER HAS NO ACCESS TO CLASS>>     <<04833>>00846000
   LDEVNOTACTIVE = 3248,      <<LDEV IS NOT ACTIVE >>          <<04833>>00848000
   RESUMESPBEGINX = 3249,   <<EXTRA PARMS AFTER "BEGINNING">>  <<04833>>00850000
   EXPBLANK       = 3250,    <<EXPECTED BLANK DELIMITER>>      <<04833>>00852000
   EXP1OFLDEVORSHUTQ = 3251, <<EXPECTED LDEV;[SHUTQ]>>         <<04833>>00854000
   EXP1OFLDEVOROPENQ = 3252, <<EXPECTED LDEV;[OPENQ]>>         <<04833>>00856000
   STARTSP2PARM      = 3253, <<STARTSPOOL EXP 2 PARMS>>        <<04833>>00858000
   STOPSP2PARM       = 3254, <<STOPSPOOL EXP 2 PARMS>>         <<04833>>00860000
   EXPSHUTQ          = 3255, <<STARTSPOOL EXP SHUTQ>>          <<04833>>00862000
   EXPOPENQ          = 3256, <<STOPSPOOL EXP OPENQ>>           <<04833>>00864000
   CLASSXPARMS       = 3257, <<EXTRA PARMS AFTER CLASS>>       <<04833>>00866000
   DEVICEACTIVE   = 3258,    <<DEVICE IS ACTIVE>>              <<04833>>00868000
   SHUTQINPUT     = 3259, <<SHUTQ INVALID INPUT SPOOLEE>>      <<04833>>00870000
   OPENQINPUT     = 3260, <<OPENQ INVALID INPUT SPOOLEE>>      <<04833>>00872000
   DEVISDOWN      = 3261; <<DEV DOWNED ON START SPOOLER>>      <<04833>>00874000
$PAGE "ALLOW MASK EQUATES"                                              00876000
<< Allow Mask equates added as part of this fix.            >> <<04833>>00878000
                                                                        00880000
<< THE FOLLOWING EQUATES DEFINE THE MASK BIT FOR EACH OPERATOR COMMAND>>00882000
<< THE FIRST "M'DEVICE" COMMANDS DEFINE THE OPERATOR COMMANDS>>         00884000
<< DEALING WITH DEVICES                                      >>         00886000
                                                               <<04833>>00888000
<< WHEN ADDING A NEW COMMAND TO THIS SET OF EQUATES, >>        <<04833>>00890000
<< BE SURE TO ADD A CORRESPONDING MOVE STATEMENT IN  >>        <<04833>>00892000
<< LOGIMAGE EVEN IF THE COMMAND WILL NOT BE LOGGED.  >>        <<04833>>00894000
                                                                        00896000
EQUATE M'ABORTIO=0,              <<ABORTIO ALLOW MASK BIT>>             00898000
       M'ACCEPT=M'ABORTIO+1,     <<ACCEPT ALLOW MASK BIT>>              00900000
       M'DOWN=M'ACCEPT+1,        <<DOWN ALLOW MASK BIT>>                00902000
       M'GIVE=M'DOWN+1,          <<GIVE ALLOW MASK BIT>>                00904000
       M'HEADOFF=M'GIVE+1,       <<HEADOFF ALLOW MASK BIT>>             00906000
       M'HEADON=M'HEADOFF+1,     <<HEADON ALLOW MASK BIT>>              00908000
       M'REFUSE=M'HEADON+1,      <<REFUSE ALLOW MASK BIT>>              00910000
       M'REPLY=M'REFUSE+1,       <<REPLY ALLOW MASK BIT>>               00912000
       M'STARTSPOOL=M'REPLY+1,        <<STARTSPOOL ALLOW MASK>>         00914000
       M'TAKE=M'STARTSPOOL+1,         <<TAKE ALLOW MASK BIT>>           00916000
       M'UP=M'TAKE+1,            <<UP ALLOW MASK BIT>>                  00918000
       M'MPLINE=M'UP+1,          <<MPLINE ALLOW MASK BIT>>              00920000
       M'DSCONTROL=M'MPLINE+1,   <<DSCONTROL ALLOW MASK BIT>>           00922000
                                                                        00924000
       M'DEVICE=M'DSCONTROL,     <<UPPER LIMIT OF DEVICE COMMANDS>>     00926000
                                                                        00928000
       M'ABORTJOB=M'DEVICE+1,    <<ABORTJOB ALLOW MASK BIT>>            00930000
       M'ALLOW=M'ABORTJOB+1,     <<ALLOW ALLOW MASK BIT>>               00932000
       M'ALTSPOOLFILE=M'ALLOW+1,     <<ALTFILE ALLOW MASK BIT>>         00934000
       M'ALTJOB=M'ALTSPOOLFILE+1,    <<ALTJOB ALLOW MASK BIT>>          00936000
       M'BREAKJOB=M'ALTJOB+1,    <<BREAKJOB ALLOW MASK BIT>>            00938000
       M'DELETESPOOLFILE=M'BREAKJOB+1,<<DELETE ALLOW MASK BIT>>         00940000
       M'DISALLOW=M'DELETESPOOLFILE+1,<<DISALLOW ALLOW MASK>>           00942000
       M'JOBFENCE=M'DISALLOW+1,  <<JOBFENCE ALLOW MASK BIT>>            00944000
       M'LIMIT=M'JOBFENCE+1,     <<LIMIT ALLOW MASK BIT>>               00946000
       M'STOPSPOOL=M'LIMIT+1,         <<STOPSPOOL ALLOW MASK>>          00948000
       M'SUSPENDSPOOL=M'STOPSPOOL+1,  <<SUSPENDSPOOL ALLOW >>           00950000
       M'OUTFENCE=M'SUSPENDSPOOL+1,   <<OUTFENCE ALLOW MASK>>           00952000
       M'RECALL=M'OUTFENCE+1,    <<RECALL ALLOW MASK BIT>>              00954000
       M'RESUMEJOB=M'RECALL+1,   <<RESUMEJOB ALLOW MASK BIT>>           00956000
       M'RESUMESPOOL=M'RESUMEJOB+1,   <<RESUMESPOOL ALLOW MASK>>        00958000
       M'STREAMS=M'RESUMESPOOL+1,     <<STREAMS ALLOW MASK BIT>>        00960000
       M'CONSOLE=M'STREAMS+1,    <<CONSOLE ALLOW MASK BIT>>             00962000
       M'WARN=M'CONSOLE+1,       <<WARN ALLOW MASK BIT>>                00964000
       M'WELCOME=M'WARN+1,       <<WELCOME ALLOW MASK BIT>>             00966000
       M'MON=M'WELCOME+1,        <<MON ALLOW MASK BIT>>                 00968000
       M'MOFF=M'MON+1,           <<MOFF ALLOW MASK BIT>>                00970000
       M'VMOUNT=M'MOFF+1,        <<VMOUNT ALLOW MASK BIT>>              00972000
       M'LMOUNT=M'VMOUNT+1,      <<LMOUNT ALLOW MASK BIT>>              00974000
       M'LDISMOUNT=M'LMOUNT+1,   <<LDISMOUNT ALLOW MASK BIT>>           00976000
       M'MRJECONTROL=M'LDISMOUNT+1,<<MRJECONTROL ALLOW MASK BIT>>       00978000
       M'JOBSCRTY=M'MRJECONTROL+1,<<JOB SECURITY ALLOW MASK BIT>>       00980000
       M'DOWNLOAD=M'JOBSCRTY+1,<<DOWNLOAD ALLOW MASK BIT>>  <<00575>>   00982000
       M'MIOENABLE=M'DOWNLOAD+1,<<MIOENABLE ALLOW MASK BIT>>   <<04833>>00984000
       M'MIODISABLE=M'MIOENABLE+1, <<MIODISABLE ALLOW MASK>>   <<04833>>00986000
       M'LOG=M'MIODISABLE+1,       <<LOG ALLOW MASK>>          <<04833>>00988000
       M'FOREIGN=M'LOG+1,      <<FOREIGN ALLOW MASK>>          <<04833>>00990000
       M'IMLCONTROL=M'FOREIGN+1,                               <<04833>>00992000
       M'SHOWCOM=M'IMLCONTROL+1,  <<SHOWCOM ALLOW MASK BIT>>            00994000
       NO'OF'OPCOMMANDS=M'SHOWCOM+1;                           <<04833>>00996000
$PAGE "***   SYSTEM GLOBAL TABLE - SYSDB   ***"                         00998000
<< SYSTEM GLOBAL TABLE - SYSDB >>                                       01000000
EQUATE                                                                  01002000
           PCBTBASE          = 3     ,                                  01004000
           LPDTBASE          = 8     ,                                  01006000
           EXTSSECT          = %104  ,                                  01008000
           SPOOLINDEX        = %132  ,                                  01010000
           JOBSYNC           = %121  ,                                  01012000
           SINPLABEL         = %161  ,                                  01014000
           SINDELTAP         = %164  ,                                  01016000
           SOUTPLABEL        = %165  ,                                  01018000
           SOUTDELTAP        = %166  ;                                  01020000
DEFINE                                                                  01022000
           ABSYS             = %1000              #,                    01024000
           ABSYS'LPDTBASE    = A(ABSYS+LPDTBASE)  #,                    01026000
           ABSYS'EXTSSECT    = A(ABSYS+EXTSSECT)  #,                    01028000
           ABSYS'SPOOLINDEX  = A(ABSYS+SPOOLINDEX)#,                    01030000
           JOBSYNCADDR       = ABSYS +JOBSYNC     #,                    01032000
           ABSYS'JOBSYNC     = A (JOBSYNCADDR)    #,                    01034000
             JOBREADY'F      = 13:1               #,                    01036000
             DEVFREED'F      = 14:1               #,                    01038000
             JOBWAITING'F    = 15:1               #,                    01040000
           ABSYS'UCOPPCBT    = A(ABSYS+PCBT+UCOPPCBT)#,                 01042000
           ABSYS'SINPLABEL   = A(ABSYS+SINPLABEL) #,                    01044000
           ABSYS'SINDELTAP   = A(ABSYS+SINDELTAP) #,                    01046000
           ABSYS'SOUTPLABEL  = A(ABSYS+SOUTPLABEL)#,                    01048000
           ABSYS'SOUTDELTAP  = A(ABSYS+SOUTDELTAP)#;                    01050000
POINTER                                                                 01052000
           SYS'PCBTP         = PCBTBASE  ,                              01054000
           SYS'LPDTP         = LPDTBASE  ;                              01056000
$PAGE "***   PROCESS CONTROL BLOCK - PCB   ***"                         01058000
<< PROCESS CONTROL BLOCK - PCB >>                                       01060000
DEFINE                                                                  01062000
           ABPCB             = A(PCBB)   #,                             01064000
           ABCPCB            = A(CPCB)   #;                             01066000
EQUATE                                                                  01068000
           DADWAIT           = 1        ,                               01070000
           SONWAIT           = 2        ,                               01072000
           JUNKWAIT          = %20      ;                               01074000
EQUATE                                                                  01076000
           UCOPLPIN          = 2        ;                               01078000
DEFINE                                                                  01080000
           PCB'PTYPE         = A(A(CPCB)+9).(6:3) #,           <<00534>>01082000
           PROGRAMMATIC      = (PCB'PTYPE < 2)#,               <<00751>>01084000
           PCB'STACKDST      = 3).(1:10     #;                          01086000
$PAGE "***   LOGICAL - PHYSICAL DEVICE TABLE - LPDT   ***"              01088000
INTEGER POINTER LPDT=8;                                        <<04833>>01090000
DEFINE LPDT'VIRTUAL=0).(0:1#,      <<0=>REAL DEVICE>>          <<04833>>01092000
       LPDT'JOB=1).(2:1#,          <<JOB ACCEPTING>>           <<04833>>01094000
       LPDT'DATA=1).(3:1#,         <<DATA ACCEPTING>>          <<04833>>01096000
       LPDT'DRSTART=1).(0:2#,      <<DR START>>                <<04833>>01098000
       LPDT'SUBTYPE=1).(12:4#,     <<DEVICE SUBTYPE>>          <<04833>>01100000
       LPDT'DITP=0).(1:15#,        <<DIT POINTER>>             <<04833>>01102000
       LPDT'PV = 1).(4:1#,                                     <<04833>>01104000
       LPDT'SD = 1).(10:1#,                                    <<04833>>01106000
       LPDT'MAXDEV=0).(0:8#;        <<MAXIMUM LOGICAL DEVICE>> <<04833>>01108000
DEFINE                                                                  01110000
   << PREFIX >>                                                         01112000
           LPDT'HIENTRY      = DB0.(0:8)         #,                     01114000
           LPDT'ENTRYSIZE    = DB0.(8:8)         #,                     01116000
           LPDT'SERVREQS     = DB1               #,                     01118000
   << ENTRY >>                                                          01120000
           LP'DITP           = 0                 #,                     01122000
           LP'VIRTUALF       = 0:1               #,                     01124000
           LP'IDD'ODDF       = 1:1               #,                     01126000
           LP'XDDPF          = 2:14              #,                     01128000
           LP'VIRTDEV        = 1                 #,                     01130000
           LP'SS             = 1).(0:2           #,                     01132000
              DEVAVAIL       = 0                 #,                     01134000
              DEVOWNED       = 1                 #,                     01136000
              DEVSERVICE     = 2                 #,                     01138000
              DEVRESERVED    = 3                 #,                     01140000
           LP'J              = 1).(2:1           #,                     01142000
           LP'A              = 1).(3:1           #,                     01144000
           LP'CTLY           = 1).(4:1           #,                     01146000
           LP'D              = 1).(5:1           #,                     01148000
           LP'I              = 1).(6:1           #,                     01150000
           LP'EOFBITS        = 8:2               #,                     01152000
           LP'EOFFIELD       = 1).(LP'EOFBITS    #,                     01154000
           LP'B              = 1).(10:1          #,                     01156000
           LP'L              = 1).(11:1          #,                     01158000
           LP'SUBTYPE        = 1).(12:4          #;                     01160000
$PAGE "***   LOGICAL DEVICE TABLE - LDT / DCT   ***"                    01162000
<< LOGICAL DEVICE TABLE - LDT / DCT >>                                  01164000
DEFINE                                                                  01166000
   << PREFIX >>                                                         01168000
           LDT'HIENTRY       = DB0.(0:8)         #,                     01170000
           LDT'ENTRYSIZE     = DB0.(8:8)         #,                     01172000
           LDT'DCTP          = PDB1              #,                     01174000
           LDT'NUMCLASS      = DB2               #,                     01176000
           LDT'DCTSIZE       = DB3               #,                     01178000
           LDT'STREAMDEV     = DB4.(8:8)         #,                     01180000
   << ENTRY >>                                                          01182000
           LD'USECOUNT       = 0                 #,                     01184000
           LD'MAINPIN        = 1).(0:8           #,                     01186000
           LD'VTABX          = 1).(0:8           #,                     01188000
           LD'CTLYPIN        = 1).(8:8           #,                     01190000
           LD'RWIDTH         = 2).(0:8           #,                     01192000
           LD'FO             = 2).(9:1           #,                     01194000
           LD'DEVTYPE        = 2).(10:6          #,                     01196000
              READERPUNCH    = 20                #,            <<04833>>01200000
           LD'BASICTYPE      = 2).(10:3          #,                     01202000
              DEVIN          = 1                 #,                     01206000
              DEVCONIO       = 2                 #,                     01208000
              DEVSERIO       = 3                 #,                     01210000
              DEVOUT         = 4                 #,                     01212000
           LD'SP             = 3).(0:2           #,                     01214000
             NOSPOOLER       = 0                 #,                     01216000
             INPUTSPOOLER    = 1                 #,                     01218000
             INPUTSPOOFLE    = 1                 #,                     01220000
             OUTPUTSPOOLER   = 2                 #,                     01222000
             OUTPUTSPOOFLE   = 2                 #,                     01224000
           LD'F              = 3).(2:1           #,                     01226000
           LD'M              = 3).(3:1           #,                     01228000
           LD'R              = 3).(4:1           #,                     01230000
           LD'C              = 3).(7:1           #,                     01232000
           LD'OUTDEV         = 3).(8:8           #,                     01234000
           LD'SQ             = 4).(7:1           #,                     01236000
           LD'XDDHEADX       = 4).(8:8           #,                     01238000
<< DEVICE CLASS TABLE - DCT >>                                          01240000
   << ENTRY >>                                                          01242000
           DC'SQ             = 4).(8:1           #,            <<04833>>01246000
           DC'NUMDEVS        = 5).(0:8           #,                     01248000
           DC'FIRSTDEV       = 5).(8:8           #,                     01250000
           DC'FIRSTDEV'B     = 11                #;                     01252000
                                                               <<04833>>01254000
                                                               <<04833>>01256000
                                                               <<04833>>01258000
<< GETCLASS image of Device Class Table entry. >>              <<04833>>01260000
                                                               <<04833>>01262000
DEFINE                                                         <<04833>>01264000
           C'SQ              = GETCLASSBUF(2).( 8:1)#,         <<04833>>01266000
           C'DEVTYPE         = GETCLASSBUF(2).(10:6)#;         <<04833>>01268000
$PAGE "***   COMMON FIELDS OF JMAT, IDD, ODD   ***"                     01270000
DEFINE                                                                  01272000
   << PREFIX >>                                                         01274000
           TBL'MAXSIZE       = DB0.(0:8)         #,                     01276000
           TBL'CURSIZE       = DB0.(8:8)         #,                     01278000
              TBLQUANTUM     = 128               #,                     01280000
           TBL'ENTRYSIZE     = DB1.(8:8)         #,                     01282000
           TBL'ENTRYAREAP    = PDB2              #,                     01284000
           << CHAINS DEFINED BY "HEAD" POINTER,                         01286000
              IMMEDIATELY FOLLOWED BY "TAIL" POINTER.                   01288000
              EACH POINTS TO WD 0 OF ENTRY.                             01290000
              NULL CHAIN:  HEAD = 0;  TAIL = @HEAD.                     01292000
              CHAIN TERMINATED BY 0 LINK.                               01294000
           >>                                                           01296000
           TTCHAINEND        = 0                 #,                     01298000
           TT'INUSEWORD      = 0                 #,                     01300000
              FREEENTRY      = 0                 #,                     01302000
           TT'JTYPE          = 1).(0:2           #,                     01304000
              SESSIONTYPE    = 1                 #,                     01306000
              BATCHTYPE      = 2                 #,                     01308000
           TT'JNUM           = 1).(2:14          #,                     01310000
           TT'JOBNUM         = 1                 #,                     01312000
           TT'UNAME          = 2                 #,                     01314000
           TT'ANAME          = 6                 #,                     01316000
           TT'JNAME          = 10                #,                     01318000
           TT'LINKP'W        = 25                #,                     01320000
           TT'LINKP          = TT'LINKP'W        #;                     01322000
$PAGE "***   DEVICE DIRECTORIES: GENERAL - XDD   ***"                   01324000
<< DEVICE DIRECTORIES: GENERAL - XDD >>                                 01326000
DEFINE                                                                  01328000
   << PREFIX >>                                                         01330000
           XDD'MAXSIZE       = TBL'MAXSIZE       #,                     01332000
           XDD'CURSIZE       = TBL'CURSIZE       #,                     01334000
           XDD'HEADSIZE      = DB1.(0:8)         #,                     01336000
           XDD'SUBSIZE       = TBL'ENTRYSIZE     #,                     01338000
           XDD'SUBAREAP      = TBL'ENTRYAREAP    #,                     01340000
           XDD'ODD           = LDB3.(0:1)        #,                     01342000
           XDD'NEXTDFID      = DB3               #,                     01344000
           XDD'OUTFENCE      = DB4.(12:4)        #,                     01346000
   << HEAD ENTRY >>                                                     01348000
            XD'HOUTFENCE      = 0).(0:8           #,           <<00874>>01350000
           XD'HLDEV          = 0).(8:8           #,                     01352000
           XD'HHEADP         = 1                 #,                     01354000
              DEVCHAINEND    = TTCHAINEND        #,                     01356000
           XD'HTAILP         = 2                 #,                     01358000
           XD'HREALP         = 3                 #,                     01360000
   << SUBENTRY >>                                                       01362000
           XD'STATE          = 0).(1:2           #,                     01364000
              DFACTIVE       = 0                 #,                     01366000
              DFREADY        = 1                 #,                     01368000
              DFOPENED       = 2                 #,                     01370000
              DFRESERVED     = 3                 #,                     01372000
              DFLOCKED       = 3                 #,                     01374000
           XD'OUTPRI         = 0).(3:4           #,                     01376000
           XD'C              = 0).(7:1           #,                     01378000
           XD'DEVICE         = 0).(8:8           #,                     01380000
           XD'JTYPE          = TT'JTYPE          #,                     01382000
           XD'JNUM           = TT'JNUM           #,                     01384000
           XD'JOBNUM         = TT'JOBNUM         #,                     01386000
           XD'UNAME          = TT'UNAME          #,                     01388000
           XD'ANAME          = TT'ANAME          #,                     01390000
           XD'JNAME          = TT'JNAME          #,                     01392000
           XD'FNAME          = 14                #,                     01394000
           XD'DEVFILEID      = 18                #,                     01396000
           XD'TEF            = 19).(0:1          #,                     01398000
           XD'DATA           = 19).(1:1              #,        <<U.RAO>>01400000
           XD'XDDHEADX       = 19).(8:8          #,                     01402000
   << SPOOFLE EXTENSION >>                                              01404000
           XD'SPOOLFILE      = 20                #,                     01406000
           XD'LOGDEV         = 20).(0:8          #,                     01408000
           XD'HIGHADDR       = 20).(8:8          #,                     01410000
           XD'LOWADDR        = 21                #,                     01412000
           XD'NUMEXT         = 22).(0:8          #,                     01414000
           XD'VDEV           = 22).(8:8          #,                     01416000
           XD'LASTEXT        = 23                #,                     01418000
           XD'RECOVERY       = 24                #,                     01420000
           XD'RESTART        = 24).(2:1          #,                     01422000
           XD'FOD            = 24).(3:1          #,                     01424000
           XD'NOSPACE        = 24).(4:1          #,                     01426000
            XD'ABORT          = 24).(5:1          #,           <<B0.SZ>>01428000
           XD'NUMCOPIES      = 24).(8:8          #,                     01430000
           XD'LINKP'W        = TT'LINKP'W        #,                     01432000
           XD'LINKP          = TT'LINKP          #,                     01434000
           XD'NUMLINES0      = 26                #,                     01436000
           XD'NUMLINES1      = 27                #,                     01438000
           XD'TIMEREADY0     = 28                #,                     01440000
           XD'TIMEREADY1     = 29                #;                     01442000
$PAGE "***   INPUT DEVICE DIRECTORY - IDD   ***"                        01444000
<<INPUT DEVICE DIRECTORY - IDD >>                                       01446000
DEFINE                                                                  01448000
   << PREFIX >>                                                         01450000
           IDD'MAXSIZE       = XDD'MAXSIZE       #,                     01452000
           IDD'CURSIZE       = XDD'CURSIZE       #,                     01454000
           IDD'HEADSIZE      = XDD'HEADSIZE      #,                     01456000
           IDD'SUBSIZE       = XDD'SUBSIZE       #,                     01458000
           IDD'SUBAREAP      = XDD'SUBAREAP      #,                     01460000
           IDD'NEXTDFID      = XDD'NEXTDFID      #,                     01462000
   << HEAD ENTRY >>                                                     01464000
           ID'HLDEV          = XD'HLDEV          #,                     01466000
           ID'HHEADP         = XD'HHEADP         #,                     01468000
           ID'HTAILP         = XD'HTAILP         #,                     01470000
           ID'HREALP         = XD'HREALP         #,                     01472000
   << SUBENTRY >>                                                       01474000
           ID'STATE          = XD'STATE          #,                     01476000
           ID'DEVICE         = XD'DEVICE         #,                     01478000
           ID'JTYPE          = XD'JTYPE          #,                     01480000
           ID'JNUM           = XD'JNUM           #,                     01482000
           ID'JOBNUM         = XD'JOBNUM         #,                     01484000
           ID'UNAME          = XD'UNAME          #,                     01486000
           ID'ANAME          = XD'ANAME          #,                     01488000
           ID'JNAME          = XD'JNAME          #,                     01490000
           ID'FNAME          = XD'FNAME          #,                     01492000
           ID'DEVFILEID      = XD'DEVFILEID      #,                     01494000
           ID'XDDHEADX       = XD'XDDHEADX       #,                     01496000
   << SPOOFLE EXTENSION >>                                              01498000
           ID'SPOOLFILE      = XD'SPOOLFILE      #,                     01500000
           ID'LOGDEV         = XD'LOGDEV         #,                     01502000
           ID'HIGHADDR       = XD'HIGHADDR       #,                     01504000
           ID'LOWADDR        = XD'LOWADDR        #,                     01506000
           ID'NUMEXT         = XD'NUMEXT         #,                     01508000
           ID'VDEV           = XD'VDEV           #,                     01510000
           ID'LASTEXT        = XD'LASTEXT        #,                     01512000
           ID'RESTART        = XD'RESTART        #,                     01514000
           ID'LINKP          = XD'LINKP          #,                     01516000
           ID'NUMLINES0      = XD'NUMLINES0      #,                     01518000
           ID'NUMLINES1      = XD'NUMLINES1      #,                     01520000
           ID'TIMEREADY0     = XD'TIMEREADY0     #,                     01522000
           ID'TIMEREADY1     = XD'TIMEREADY1     #;                     01524000
$PAGE "***   OUTPUT DEVICE DIRECTORY - ODD   ***"                       01526000
<< OUTPUT DEVICE DIRECTORY - ODD >>                                     01528000
DEFINE                                                                  01530000
   << PREFIX >>                                                         01532000
           ODD'MAXSIZE       = XDD'MAXSIZE       #,                     01534000
           ODD'CURSIZE       = XDD'CURSIZE       #,                     01536000
           ODD'HEADSIZE      = XDD'HEADSIZE      #,                     01538000
           ODD'SUBSIZE       = XDD'SUBSIZE       #,                     01540000
           ODD'SUBAREAP      = XDD'SUBAREAP      #,                     01542000
           ODD'ODD           = XDD'ODD           #,                     01544000
           ODD'NEXTDFID      = XDD'NEXTDFID      #,                     01546000
           ODD'OUTFENCE      = XDD'OUTFENCE      #,                     01548000
   << HEAD ENTRY >>                                                     01550000
              ODDCLASSHEADX  = 2                 #,                     01552000
            OD'HOUTFENCE      = XD'HOUTFENCE      #,           <<00874>>01554000
           OD'HLDEV          = XD'HLDEV          #,                     01556000
              DEVCLASSCHAIN  = 0                 #,                     01558000
           OD'HHEADP         = XD'HHEADP         #,                     01560000
           OD'HTAILP         = XD'HTAILP         #,                     01562000
           OD'HREALP         = XD'HREALP         #,                     01564000
   << SUBENTRY >>                                                       01566000
           OD'STATE          = XD'STATE          #,                     01568000
           OD'OUTPRI         = XD'OUTPRI         #,                     01570000
           OD'C              = XD'C              #,                     01572000
           OD'DEVICE         = XD'DEVICE         #,                     01574000
           OD'JTYPE          = XD'JTYPE          #,                     01576000
           OD'JNUM           = XD'JNUM           #,                     01578000
           OD'JOBNUM         = XD'JOBNUM         #,                     01580000
           OD'UNAME          = XD'UNAME          #,                     01582000
           OD'ANAME          = XD'ANAME          #,                     01584000
           OD'JNAME          = XD'JNAME          #,                     01586000
           OD'FNAME          = XD'FNAME          #,                     01588000
           OD'DEVFILEID      = XD'DEVFILEID      #,                     01590000
           OD'TEF            = XD'TEF            #,                     01592000
           OD'XDDHEADX       = XD'XDDHEADX       #,                     01594000
   << SPOOFLE EXTENSION >>                                              01596000
           OD'SPOOLFILE      = XD'SPOOLFILE      #,                     01598000
           OD'LOGDEV         = XD'LOGDEV         #,                     01600000
           OD'HIGHADDR       = XD'HIGHADDR       #,                     01602000
           OD'LOWADDR        = XD'LOWADDR        #,                     01604000
           OD'NUMEXT         = XD'NUMEXT         #,                     01606000
           OD'VDEV           = XD'VDEV           #,                     01608000
           OD'LASTEXT        = XD'LASTEXT        #,                     01610000
           OD'RECOVERY       = XD'RECOVERY       #,                     01612000
           OD'FOD            = XD'FOD            #,                     01614000
           OD'NOSPACE        = XD'NOSPACE        #,                     01616000
           OD'NUMCOPIES      = XD'NUMCOPIES      #,                     01618000
           OD'LINKP          = XD'LINKP          #,                     01620000
           OD'NUMLINES0      = XD'NUMLINES0      #,                     01622000
           OD'NUMLINES1      = XD'NUMLINES1      #,                     01624000
           OD'TIMEREADY0     = XD'TIMEREADY0     #,                     01626000
           OD'TIMEREADY1     = XD'TIMEREADY1     #;                     01628000
$PAGE "***   JOB MASTER TABLE - JMAT   ***"                             01630000
<< JOB MASTER TABLE - JMAT >>                                           01632000
EQUATE                                                         <<04859>>01634000
   JMATENTRYSIZE     = 26,                                     <<04859>>01636000
   JMATHEADERSIZE    = 12;                                     <<04859>>01638000
                                                               <<04859>>01640000
DEFINE                                                                  01642000
   << PREFIX >>                                                         01644000
           JMAT'MAXSIZE      = TBL'MAXSIZE       #,                     01646000
           JMAT'CURSIZE      = TBL'CURSIZE       #,                     01648000
           JMAT'ENTRYSIZE    = TBL'ENTRYSIZE     #,                     01650000
           JMAT'ENTRYP       = TBL'ENTRYAREAP    #,                     01652000
           JMAT'SCHEDHEADP   = PDB3              #,                     01654000
              JOBCHAINEND    = 0                 #,                     01656000
           JMAT'SCHEDTAILP   = PDB4              #,                     01658000
           JMAT'NEXTNUMS     = ARRDB5            #,                     01660000
           JMAT'NEXTJOBNUM   = DB5               #,                     01662000
           JMAT'NEXTSNUM     = DB5.(2:14)        #,                     01664000
           JMAT'NEXTSESNUM   = DB6               #,                     01666000
           JMAT'NEXTJNUM     = DB6.(2:14)        #,                     01668000
           JMAT'JOBFENCE     = DB7.(12:4)        #,                     01670000
           JMAT'JLIMITS      = ARRDB8            #,                     01672000
           JMAT'SLIMIT       = DB8               #,                     01674000
           JMAT'JCOUNTS      = ARRDB9            #,                     01676000
           JMAT'SCOUNT       = DB9               #,                     01678000
           JMAT'JLIMIT       = DB10              #,                     01680000
           JMAT'JCOUNT       = DB11              #,                     01682000
           JMAT'WORKAREA     = ARRDB12           #,                     01684000
   << ENTRY >>                                                          01686000
           JMAT'STATE = 0).(0:5#,                              <<04859>>01688000
           JM'JSTATE         = 0).(0:6           #,                     01690000
              JOBINTRO       = 1                 #,                     01692000
              JOBWAIT        = %40               #,                     01694000
              JOBINIT        = %60               #,                     01696000
              JOBEXEC        = 2                 #,                     01698000
              JOBDONE        = 3                 #,                     01700000
              JOBSUSP        = 4                 #,                     01702000
              JOBERR         = %50               #,                     01704000
           JM'D              = 0).(6:1           #,                     01706000
           JM'ERRH           = 0).(6:1           #,                     01708000
           JM'I              = 0).(7:1           #,                     01710000
           JM'ERRC           = 0).(7:1           #,                     01712000
           JM'G              = 0).(8:1           #,                     01714000
           JM'QUIET          = 0).(8:1           #,                     01716000
           JM'A              = 0).(9:1           #,                     01718000
           JM'U              = 0).(10:1          #,                     01720000
           JM'C              = 0).(11:1          #,                     01722000
           JM'INPRI          = 0).(12:4          #,                     01724000
              JOBHIPRI       = 15                #,                     01726000
           JM'ERRLIST        = 0).(8:8           #,                     01728000
           JM'JTYPE          = TT'JTYPE          #,                     01730000
           JM'JNUM           = TT'JNUM           #,                     01732000
           JM'JOBNUM         = TT'JOBNUM         #,                     01734000
           JM'ERRPARM        = 1).(0:6           #,                     01736000
           JM'ERRNUM         = 1).(6:10          #,                     01738000
           JM'UNAME          = TT'UNAME          #,                     01740000
           JM'ANAME          = TT'ANAME          #,                     01742000
           JM'JNAME          = TT'JNAME          #,                     01744000
           JM'LGNAME         = 14                #,                     01746000
           JM'JIN            = 18).(0:8          #,                     01748000
           JM'JLIST          = 18).(8:8          #,                     01750000
           JM'STARTTIME      = 19                #,                     01752000
           JM'MAINPIN        = 22).(0:8          #,                     01754000
           JM'XPRI           = 22).(8:8          #,                     01756000
           JM'TIMELIMIT      = 23                #,                     01758000
           JM'SPOOLED        = 24).(0:1          #,                     01760000
           JM'RESTART        = 24).(1:1          #,                     01762000
           JM'PRIWARN        = 24).(2:1          #,                     01764000
           JM'OUTPRI         = 24).(5:4          #,                     01766000
           JM'NUMCOPIES      = 24).(9:7          #,                     01768000
           JM'ORIGJIN        = 25).(0:8          #,                     01770000
           JM'ORIGJLIST      = 25).(8:8          #,                     01772000
           JM'SCHEDLINKP'W   = TT'LINKP'W        #,                     01774000
           JMAT'ORIGLIST = 25).(8:8#,  << Job's origlist >>    <<04859>>01776000
           JM'SCHEDLINKP     = TT'LINKP          #;                     01778000
$PAGE "ASSOCIATION TABLE DEFINITIONS AND DECLARATIONS"         <<01651>>01780000
                                                               <<01651>>01782000
EQUATE ASS'DST = 34,        << ASSOCIATION TABLE DST.      >>  <<01651>>01784000
       ASS'SIR = 24,        << ASSOCIATION TABLE SIR.      >>  <<01651>>01786000
                                                               <<01651>>01788000
   ASS'ENTRYSIZE       = 7,  << WORD COUNT OF ONE ENTRY.   >>  <<01651>>01790000
   ASS'CLASS           = 3,  << INDEX OF CLASS NAME.       >>  <<01651>>01792000
   B'ASS'CLASS         = ASS'CLASS * 2;                        <<01651>>01794000
                                                               <<01651>>01796000
DEFINE            << ASSOCIATION TABLE JIT POINTER.        >>  <<01651>>01798000
   ASS'JIT             = 1).(6:10 #;                           <<01651>>01800000
                                                               <<01651>>01802000
$PAGE "***   SPOOLER STACK   ***"                                       01804000
COMMENT  <<P>> MEANS PROGEN INITIALIZES VARIABLE;                       01806000
                                                                        01808000
<< PROGEN -> SPOOLER COMMUNICATION >>                                   01810000
   EQUATE  DIRECTIV          = 0                 ;                      01814000
   EQUATE  PRIORDIRECTIVE    = 0                 ,                      01818000
           QUITSPOOLING      = 1                 ,                      01820000
           WAITSPOOLING      = 2                 ,                      01822000
           RESUMESPOOLING    = 3                 ,                      01824000
           KEEPSPOOLING      = RESUMESPOOLING    ,                      01826000
           FINISHFILE        = 0                 ,                      01828000
           DELETEFILE        = 1                 ,                      01830000
           DEFERFILE         = 2                 ,                      01832000
           RELINKFILE        = 3                 ;                      01834000
   LOGICAL SPOOLREQUEST      = DB+1              ,                      01836000
           FILEREQUEST       = DB+2              ;                      01838000
                                                                        01840000
<< SPOOLER CONTROL >>                                                   01842000
   INTEGER SPOOLEE           = DB+3              ,<<P>>                 01844000
           DEVICE            = SPOOLEE           ;                      01846000
   EQUATE  SPOOLE            = 3                 ;                      01848000
   INTEGER DEVICEFILE        = DB+7              ,                      01852000
           SPOOLFILE         = DB+8              ;                      01854000
   LOGICAL SPOOLER           = DB+9              ;                      01856000
   INTEGER DEVICETYPE        = DB+10             ;                      01858000
<< DEVICE RECOGNITION >>                                                01860000
   LOGICAL DEVRECFLAGS       = DB+12             ,                      01862000
           OUTFLAGS          = DEVRECFLAGS       ;                      01864000
   DEFINE  PROMPTING         = DEVRECFLAGS.(0:1) #;            <<02548>>01866000
    EQUATE  BLOCKS              = 8 <<# OF 512 WORD BLOCKS>>,  <<01549>>01870000
                                    << IN BUFFER          >>   <<01549>>01872000
            EPOC'SUBTYPE        = 8                  ;         <<01549>>01874000
                                                                        01878000
<< BUFFER/RECORD CONTROL >>                                             01880000
   BYTE PSEUDOCOLON          = DB+15             ;                      01882000
   EQUATE  INBUFS            = 2                 ,                      01886000
           OUTBUFS           = 8                 ;             <<02548>>01888000
   INTEGER DEVICERECL        = DB+18             ,                      01892000
           RECL              = DB+19             ;                      01894000
   INTEGER POINTER DEVICERECP= DB+20             ,                      01896000
                   RECP      = DB+21             ;                      01898000
                                                                        01902000
<< REAL WORLD >>                                                        01904000
INTEGER CIERRNUM  = DB+28             ,                        <<00534>>01906000
        CIPARMNUM = DB+29             ;                        <<00534>>01908000
   INTEGER POINTER JMATP     = DB+30             ,                      01910000
                   OUTCLASSES= JMATP             ,                      01912000
                   XDDEP     = DB+31             ,                      01914000
                   IDDEP     = XDDEP             ,                      01916000
                   ODDEP     = XDDEP             ,                      01918000
                   ODDXP     = DB+32             ,                      01920000
                   LDTP      = DB+33             ,                      01922000
                   DEVHP     = DB+34             ,                      01924000
                   CLASSHP   = DB+35             ;                      01926000
   INTEGER DEVFILEID         = DB+36             ,                      01928000
           JOBNUMBER         = DB+37             ,                      01930000
           STREAMDEV         = DB+38             ,                      01932000
           LISTTYPE          = DB+39             ,                      01934000
           LISTSIZE          = DB+40             ,                      01936000
           STACKDST          = DB+41             ,                      01938000
           JLISTED           = DB+42             ,                      01940000
           ORIGDEST          = DB+43             ;                      01942000
   DOUBLE   LINES'PRINTED     = DB+44              ;           <<B0.SZ>>01944000
$PAGE "   ***   SPOOLER INFO FOR PROGEN   ***"                          01948000
    INTEGER DEVICE'SUBTYPE      = DB+65;                       <<01549>>01950000
    LOGICAL BLOCKMODE           = DB+66;                       <<01549>>01952000
    DEFINE  PAGEPRINTER         = DEVICETYPE = PRINTER AND     <<01549>>01954000
                             DEVICE'SUBTYPE = EPOC'SUBTYPE #;  <<01549>>01956000
<< SPOOLER INITIATION PARAMETERS >>                                     01958000
   EQUATE                                                               01960000
           INITDIRECTIVE = [ 1/1 ,                                      01962000
                             7/0 ,                                      01964000
                             4/KEEPSPOOLING ,                           01966000
                             4/FINISHFILE ],                            01968000
           SPOOLPRI = 140;                                              01970000
                                                                        01972000
<< SPOOLER STACK DATA SEGMENT SIZES >>                                  01974000
   INTEGER POINTER   DBP  = DB+1;      <<PNTR 2 DB FROM PCBX>>          01976000
   EQUATE                                                               01978000
           PCBXSIZE = 512,  <<AT MOST!>>                                01980000
           GLOBSIZE = 80,                                      <<04382>>01982000
           LOCSIZE = 768+BSIZE+RSIZE+INBUFS*RSIZE,                      01984000
           INITSTACKSIZE = PCBXSIZE + 30 + GLOBSIZE +LOCSIZE; <<<01549>>01986000
                                                               <<04833>>01988000
DEFINE EXECUTORHEAD= (PARMSP,ERRNUM,PARMNUM);                  <<04833>>01990000
                     BYTE ARRAY PARMSP;                        <<04833>>01992000
                     INTEGER ERRNUM, PARMNUM;                  <<04833>>01994000
                     OPTION PRIVILEGED,UNCALLABLE #;           <<04833>>01996000
                                                                        01998000
<< DECLARATIONS FOR PARAMETER PARSING >>                                02000000
   DEFINE            P'DECLARATIONS =                                   02002000
      INTEGER           NUMPARMS;                                       02004000
      DOUBLE ARRAY      PARMS (1:MAXPARMS);                             02006000
      BYTE POINTER      PP;                                             02008000
      BYTE              PLEN;                                           02010000
      INTEGER           PDELWD = PLEN;                                  02012000
      DOUBLE            PARM = PP;                                      02014000
      EQUATE            COMMA = 0,                                      02016000
                        EQUAL = 1,                                      02018000
                        SEMI = 2,                                       02020000
                        CR = 3;                                         02022000
      INTEGER           PNUM := 0    #,                                 02024000
      PSPECIAL          = LOGICAL (PDELWD.(10:1))  #,                   02026000
      PDEL              = PDELWD.(11:5)  #;                             02028000
                                                                        02030000
                                                               <<04833>>02034000
<< MYCOMMAND PARAMETER DESCRIPTION AREA LAYOUT>>               <<04833>>02036000
                                                               <<04833>>02038000
DEFINE DELIMITER=(11:5)#, SPECIAL'CHAR=(10:1)#,                <<04833>>02040000
       ALPHA'CHAR=(8:1)#, NUMERICAL'CHAR=(9:1)#;               <<04833>>02042000
<<        DEF'MOVEFROMDSEG          >>                         <<00548>>02044000
<< To use, declare SUBROUTINE DEF'MOVEFROMDSEG >>              <<00548>>02046000
   DEFINE                                                      <<00548>>02048000
   DEF'MOVEFROMDSEG =                                          <<00548>>02050000
      MOVEFROMDSEG(DBTARGET,DSTN,DSTOFFSET,COUNT);             <<00548>>02052000
         VALUE DBTARGET,DSTN,DSTOFFSET,COUNT;                  <<00548>>02054000
         LOGICAL POINTER DBTARGET;                             <<00548>>02056000
         LOGICAL DSTN,DSTOFFSET,COUNT;                         <<00548>>02058000
      BEGIN                                                    <<00548>>02060000
         X := TOS; << SAVE RETURN ADDRESS >>                   <<00548>>02062000
         ASSEMBLE(MFDS 0);                                     <<00548>>02064000
         TOS := X; << RESTORE RETURN ADDRESS >>                <<00548>>02066000
      END #,                                                   <<00548>>02068000
                                                               <<00548>>02070000
<<        DEF'MOVETODSEG            >>                         <<00548>>02072000
<< To use, declare SUBROUTINE DEF'MOVETODSEG >>                <<00548>>02074000
   DEF'MOVETODSEG =                                            <<00548>>02076000
      MOVETODSEG(DSTN,DSTOFFSET,DBSOURCE,COUNT);               <<00548>>02078000
         VALUE DSTN,DSTOFFSET,DBSOURCE,COUNT;                  <<00548>>02080000
         LOGICAL POINTER DBSOURCE;                             <<00548>>02082000
         LOGICAL DSTN,DSTOFFSET,COUNT;                         <<00548>>02084000
      BEGIN                                                    <<00548>>02086000
         X := TOS;                                             <<00548>>02088000
         ASSEMBLE(MTDS 0);                                     <<00548>>02090000
         TOS := X;                                             <<00548>>02092000
      END #;                                                   <<00548>>02094000
                                                               <<00548>>02096000
$PAGE "***   EXTERNAL PROCEDURES   ***"                                 02098000
                                                                        02100000
PROCEDURE SPOOLINTO;                                                    02102000
   OPTION EXTERNAL;                                                     02104000
                                                                        02106000
LOGICAL PROCEDURE REQUESTSERVICE;                                       02108000
   OPTION EXTERNAL;                                                     02110000
                                                                        02112000
PROCEDURE SLINKXDD (XDDHEADX, XDDENTRYP);                               02114000
   VALUE XDDHEADX, XDDENTRYP;                                           02116000
   INTEGER XDDHEADX;                                                    02118000
   INTEGER POINTER XDDENTRYP;                                           02120000
   OPTION EXTERNAL;                                                     02122000
                                                               <<04833>>02124000
LOGICAL PROCEDURE CHECKALLOW (MASK);                           <<04833>>02126000
   VALUE MASK;                                                 <<04833>>02128000
   LOGICAL MASK;                                               <<04833>>02130000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04833>>02132000
COMMENT -- CHECKALLOW returns TRUE if the user has been ALLOW- <<04833>>02134000
ed to use the command specified in MASK, or  if  s/he  is  the <<04833>>02136000
master operator. If neither condition is satisfied, CHECKALLOW <<04833>>02138000
returns FALSE.  DB must be at the stack.                       <<04833>>02140000
;                                                              <<04833>>02142000
                                                               <<04833>>02144000
LOGICAL PROCEDURE VERIFY'MASTEROP (LDEV);                      <<04833>>02146000
   VALUE LDEV;                                                 <<04833>>02148000
   INTEGER LDEV;                                               <<04833>>02150000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04833>>02152000
COMMENT -- When a device has been ASSOCIATEd to  a  user,  the <<04833>>02154000
user  normally enters all commands (such as :REPLY) which per- <<04833>>02156000
tain to that device.  The master operator may also enter these <<04833>>02158000
commands, but since this is unusual,  VERIFY'MASTEROP  prompts <<04833>>02160000
the  operator  to  make  sure  s/he intends to use the command <<04833>>02162000
while the device is ASSOCIATEd.  The routine returns TRUE only <<04833>>02164000
if the user is the MASTEROP and s/he fails to  verify  his/her <<04833>>02166000
action.                                                        <<04833>>02168000
;                                                              <<04833>>02170000
                                                               <<04833>>02172000
LOGICAL PROCEDURE VERIFY'MASTOP'C (CLASSNAME);                 <<04833>>02174000
   INTEGER ARRAY CLASSNAME;                                    <<04833>>02176000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04833>>02178000
COMMENT -- When a device class has been ASSOCIATEd to a  user, <<04833>>02180000
the  user  normally  enters  all commands (such as :STOPSPOOL) <<04833>>02182000
which pertain to that class.  The master operator may also en- <<04833>>02184000
ter these commands, but since this is unusual, VERIFY'MASTOP'C <<04833>>02186000
prompts the operator to make sure s/he intends to use the com- <<04833>>02188000
mand while the class is ASSOCIATEd.  The routine returns  TRUE <<04833>>02190000
only if the user is the MASTEROP and s/he fails to verify his/ <<04833>>02192000
her action.                                                    <<04833>>02194000
  The LDT SIR must be locked before calling VERIFY'MASTOP'C.   <<04833>>02196000
;                                                              <<04833>>02198000
                                                               <<04833>>02200000
INTEGER PROCEDURE VERIFY'RLDEV (PARM, LEN, ERRNUM, PARMNUM,    <<04833>>02202000
                                PARAMETERNUM);                 <<04833>>02204000
   VALUE LEN, PARAMETERNUM;                                    <<04833>>02206000
   INTEGER LEN, ERRNUM, PARMNUM, PARAMETERNUM;                 <<04833>>02208000
   BYTE ARRAY PARM;                                            <<04833>>02210000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04833>>02212000
COMMENT -- VERIFY'RLDEV verifies that  the  ASCII  string  (of <<04833>>02214000
length  LEN) contained in PARM identifies a "real" (as opposed <<04833>>02216000
to virtual) device in this configuration of the operating sys- <<04833>>02218000
tem.  If so, the binary equivalent is returned in the  result, <<04833>>02220000
and the condition code is set to CCE.  If an error is detected <<04833>>02222000
ERRNUM is set to the CI error number, PARMNUM is set to PARAM- <<04833>>02224000
ETERNUM and the condition code is set to CCL.                  <<04833>>02226000
  DB must be at the stack.                                     <<04833>>02228000
;                                                              <<04833>>02230000
                                                               <<04833>>02232000
INTEGER PROCEDURE ASSOC'CLASS (CLASSNAME);                     <<04833>>02234000
   INTEGER ARRAY CLASSNAME;                                    <<04833>>02236000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<04833>>02238000
COMMENT -- ASSOC'CLASS returns the LDEV# of  $STDLIST  of  the <<04833>>02240000
user ASSOCIATEd to CLASSNAME.  If CLASSNAME does not exist the <<04833>>02242000
result is -1.  If no user is ASSOCIATEd to CLASSNAME, the  re- <<04833>>02244000
sult is 0.                                                     <<04833>>02246000
  DB must be at the stack.                                     <<04833>>02248000
;                                                              <<04833>>02250000
                                                                        02252000
PROCEDURE DELINKENTRY (CHAINP, ENTRYP);                                 02254000
   VALUE ENTRYP;                                                        02256000
   INTEGER POINTER CHAINP, ENTRYP;                                      02258000
   OPTION EXTERNAL;                                                     02260000
                                                                        02262000
PROCEDURE SROOSTER (DEVICE);                                            02264000
   VALUE DEVICE;                                                        02266000
   INTEGER DEVICE;                                                      02268000
   OPTION EXTERNAL;                                                     02270000
                                                                        02272000
INTEGER PROCEDURE FORMNAME(TYPE,TARGET,BA1,BA2,BA3,BA4);       <<02.EB>>02274000
   VALUE TYPE;INTEGER TYPE;                                    <<02.EB>>02276000
   BYTE ARRAY TARGET,BA1,BA2,BA3,BA4;                          <<02.EB>>02278000
   OPTION EXTERNAL;                                            <<02.EB>>02280000
                                                                        02282000
LOGICAL PROCEDURE SPOOLEDDEV (DEV);                                     02284000
   VALUE DEV;                                                           02286000
   INTEGER DEV;                                                         02288000
   OPTION EXTERNAL;                                                     02290000
                                                                        02292000
PROCEDURE SCHEDULEJOB' (JMATP);                                         02294000
   VALUE JMATP;                                                         02296000
   INTEGER POINTER JMATP;                                               02298000
   OPTION EXTERNAL;                                                     02300000
                                                                        02302000
PROCEDURE ABORTJOB (MAIN);                                              02304000
   VALUE MAIN;                                                          02306000
   INTEGER MAIN;                                                        02308000
   OPTION EXTERNAL;                                                     02310000
                                                                        02312000
PROCEDURE DEALLOCENTRY (ENTRYP);                                        02314000
   VALUE ENTRYP;                                                        02316000
   INTEGER POINTER ENTRYP;                                              02318000
   OPTION EXTERNAL;                                                     02320000
                                                                        02322000
PROCEDURE FREEDEVICE(DEV,WAIT,NOREW);                          <<TAPEL>>02324000
   VALUE DEV, WAIT;                                                     02326000
   INTEGER DEV;                                                         02328000
   LOGICAL WAIT,NOREW;                                         <<TAPEL>>02330000
   OPTION EXTERNAL,VARIABLE;                                   <<TAPEL>>02332000
                                                                        02334000
PROCEDURE SREMOVEXDD (XDDSUBP);                                         02336000
   VALUE XDDSUBP;                                                       02338000
   INTEGER POINTER XDDSUBP;                                             02340000
   OPTION EXTERNAL;                                                     02342000
                                                                        02344000
PROCEDURE AWAKE(PCBPT,N,WAITF);                                         02346000
   VALUE PCBPT,N,WAITF;                                                 02348000
   INTEGER PCBPT,N,WAITF;                                               02350000
   OPTION EXTERNAL;                                                     02352000
                                                                        02354000
INTEGER PROCEDURE SYSPROC (LPIN);                                       02356000
   VALUE   LPIN;                                                        02358000
   LOGICAL LPIN;                                                        02360000
   OPTION EXTERNAL;                                                     02362000
                                                                        02364000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);                                     02366000
   VALUE DSTX;                                                          02368000
   LOGICAL DSTX;                                                        02370000
   OPTION EXTERNAL;                                                     02372000
                                                                        02374000
LOGICAL PROCEDURE GETSTACK (N,MP);                                      02376000
   VALUE N,MP;                                                          02378000
   LOGICAL N,MP;                                                        02380000
   OPTION EXTERNAL;                                                     02382000
                                                                        02384000
INTEGER PROCEDURE GETDEVINFO(DEVICE,DEVINFO);                           02386000
   BYTE ARRAY DEVICE;                                                   02388000
   INTEGER ARRAY DEVINFO;                                               02390000
   OPTION EXTERNAL;                                                     02392000
                                                                        02394000
LOGICAL PROCEDURE GETSIR(SIRNUM);                                       02396000
   VALUE SIRNUM;                                                        02398000
   INTEGER SIRNUM;                                                      02400000
   OPTION EXTERNAL;                                                     02402000
                                                                        02404000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,B,C,D,E,F,           <<0U.EB>>02406000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>02408000
   VALUE SETNO,MSGNO,MASK,B,C,D,E,F,DEST,REPLY,BUFF,           <<0U.EB>>02410000
      DST,IOTYPE;                                              <<0U.EB>>02412000
   LOGICAL SETNO,MSGNO,MASK,B,C,D,E,F,DEST,REPLY,BUFF,         <<0U.EB>>02414000
      DST,IOTYPE;                                              <<0U.EB>>02416000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>02418000
                                                                        02420000
PROCEDURE RELSIR(SIRNUM,ALREADY);                                       02422000
   VALUE SIRNUM,ALREADY;                                                02424000
   INTEGER SIRNUM;                                                      02426000
   LOGICAL ALREADY;                                                     02428000
   OPTION EXTERNAL;                                                     02430000
                                                                        02432000
PROCEDURE SUDDENDEATH(ERRNUM);                                          02434000
   VALUE ERRNUM;                                                        02436000
   INTEGER ERRNUM;                                                      02438000
   OPTION EXTERNAL;                                                     02440000
                                                                        02442000
PROCEDURE WAIT(WF,JPCNTX);                                              02444000
   VALUE WF,JPCNTX;                                                     02446000
   INTEGER WF,JPCNTX;                                                   02448000
   OPTION EXTERNAL;                                                     02450000
                                                                        02452000
PROCEDURE PROCREATE (PIN, PLABEL, DELTAP, STACKDST, GLOBSIZE,  <<01200>>02454000
                     DLSIZE, LOCSIZE, PRI, STRING, STRINGLNTH, <<01200>>02456000
                     PARM, FLAGS, MAXSTACK, STDIN, STDLIST);   <<01200>>02458000
  VALUE PLABEL, DELTAP, STACKDST, GLOBSIZE, DLSIZE, LOCSIZE,   <<01200>>02460000
        PRI, STRING, STRINGLNTH, PARM, FLAGS, MAXSTACK;        <<01200>>02462000
  INTEGER PLABEL, DELTAP, STACKDST, GLOBSIZE, DLSIZE, LOCSIZE, <<01200>>02464000
          PRI, STRING, STRINGLNTH, PARM, PIN, MAXSTACK;        <<01200>>02466000
  LOGICAL FLAGS;                                               <<01200>>02468000
  LOGICAL ARRAY STDIN, STDLIST;                                <<01200>>02470000
  OPTION EXTERNAL;                                             <<01200>>02472000
                                                                        02474000
LOGICAL PROCEDURE SETCRITICAL;                                          02476000
OPTION EXTERNAL;                                                        02478000
                                                                        02480000
PROCEDURE RESETCRITICAL(CRSTATE);                                       02482000
VALUE CRSTATE;                                                          02484000
LOGICAL CRSTATE;                                                        02486000
OPTION EXTERNAL;                                                        02488000
                                                                        02490000
LOGICAL PROCEDURE SENDSPOOLERMSG(LDEV,DIRECTIVE,SPOOFLING,     <<00552>>02494000
        SPOOLINFO,                                             <<01549>>02496000
        ERRNUM,PARMNUM);                                       <<00552>>02498000
   VALUE LDEV,DIRECTIVE,SPOOFLING;                             <<00552>>02500000
   INTEGER DIRECTIVE,ERRNUM,PARMNUM;                           <<00552>>02502000
   LOGICAL LDEV,SPOOFLING;                                     <<00552>>02504000
   LOGICAL ARRAY SPOOLINFO;                                    <<01549>>02506000
   OPTION FORWARD;                                             <<04833>>02508000
                                                               <<00552>>02510000
INTEGER PROCEDURE ADOPT(ADOPTEE,ADOPTOR);                      <<00552>>02512000
   VALUE ADOPTEE,ADOPTOR;                                      <<00552>>02514000
   INTEGER ADOPTEE,ADOPTOR;                                    <<00552>>02516000
   OPTION EXTERNAL;                                            <<00552>>02518000
                                                               <<00552>>02520000
LOGICAL PROCEDURE SFINDIDD(DFID,XDDEP);                        <<04833>>02522000
   VALUE DFID;                                                 <<04833>>02524000
   INTEGER XDDEP;                                              <<04833>>02526000
   INTEGER DFID;                                               <<04833>>02528000
   OPTION EXTERNAL;                                            <<04833>>02530000
                                                               <<04833>>02532000
LOGICAL PROCEDURE SFINDACTIVE(LDEV,DFID);                      <<04833>>02534000
   VALUE LDEV;                                                 <<04833>>02536000
   INTEGER LDEV,DFID;                                          <<04833>>02538000
   OPTION EXTERNAL;                                            <<04833>>02540000
                                                                        02542000
PROCEDURE CIERR(ERRNUM, ERRADR, PARMMASK, PARM);               <<U.RAO>>02546000
   VALUE ERRNUM, PARMMASK, PARM;                               <<U.RAO>>02548000
   INTEGER ERRNUM, PARMMASK, PARM;                             <<U.RAO>>02550000
   BYTE ARRAY ERRADR;                                          <<U.RAO>>02552000
   OPTION PRIVILEGED, UNCALLABLE, VARIABLE, EXTERNAL;          <<U.RAO>>02554000
                                                               <<U.RAO>>02556000
PROCEDURE FERROR'(FNUM, PARMNUM);                              <<U.RAO>>02558000
   VALUE FNUM;                                                 <<U.RAO>>02560000
   INTEGER FNUM, PARMNUM;                                      <<U.RAO>>02562000
   OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                    <<U.RAO>>02564000
                                                               <<U.RAO>>02566000
INTEGER PROCEDURE CHECKFILENAME'(PDEF,GPTR,APTR,ERRPTR);       <<U.RAO>>02568000
VALUE PDEF;                                                    <<U.RAO>>02570000
DOUBLE PDEF;                                                   <<U.RAO>>02572000
LOGICAL APTR, <<POINTER TO ACCOUNT PART OF NAME>>              <<U.RAO>>02574000
        GPTR, <<POINTER TO GROUP PART OF NAME>>                <<U.RAO>>02576000
        ERRPTR;  <<POINTER TO PLACE IN NAME OF ERROR>>         <<U.RAO>>02578000
OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                       <<U.RAO>>02580000
                                                               <<U.RAO>>02582000
INTEGER PROCEDURE FSOPEN(FDESG,FOPT,AOPT,XDDX,DEV,FMSG,                 02584000
      ULAB,BF,NB,FS,NE,IA,FC);                                          02586000
   VALUE FOPT,AOPT,XDDX,ULAB,BF,NB,FS,NE,IA,FC;                         02588000
   INTEGER XDDX,ULAB,BF,NB,NE,IA,FC;                                    02590000
   LOGICAL FOPT,AOPT;                                                   02592000
   DOUBLE FS;                                                           02594000
   BYTE ARRAY FDESG,DEV,FMSG;                                           02596000
   OPTION EXTERNAL,VARIABLE;  <<FOPEN SEC ENTRY POINT>>                 02598000
INTEGER PROCEDURE GET'DSDEVICE(DEV);                           <<01906>>02600000
VALUE DEV;                                                     <<01906>>02602000
INTEGER DEV;                                                   <<01906>>02604000
OPTION EXTERNAL;                                               <<01906>>02606000
LOGICAL PROCEDURE GETCLASS(BUF,FLAG,CLADR,CLINX,CLNAME);       <<01906>>02608000
VALUE FLAG,CLADR,CLINX;                                        <<01906>>02610000
LOGICAL FLAG;                                                  <<01906>>02612000
INTEGER CLADR,CLINX;                                           <<01906>>02614000
INTEGER ARRAY CLNAME,BUF;                                      <<01906>>02616000
OPTION VARIABLE,EXTERNAL;                                      <<01906>>02618000
                                                                        02620000
PROCEDURE FSCLOSE(FN,DISP,SEC);                                         02622000
   VALUE   FN,DISP,SEC;                                                 02624000
   INTEGER FN,DISP,SEC;                                                 02626000
   OPTION  EXTERNAL;  <<FCLOSE SEC ENTRY POINT>>                        02628000
                                                               <<00534>>02630000
PROCEDURE FRESETEOF;                                           <<00534>>02632000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<00534>>02634000
                                                               <<00534>>02636000
LOGICAL PROCEDURE MASTEROP; OPTION EXTERNAL;                   <<00552>>02638000
                                                               <<00552>>02640000
LOGICAL PROCEDURE SRELINKODD(O,D);                             <<00610>>02642000
   VALUE O,D;                                                  <<00610>>02644000
   INTEGER D;                                                  <<00610>>02646000
   INTEGER POINTER O;                                          <<00610>>02648000
   OPTION EXTERNAL;                                            <<00610>>02650000
                                                               <<00610>>02652000
LOGICAL PROCEDURE SFINDODD(DFID,XDDEP);                        <<00858>>02654000
   VALUE DFID;                                                 <<00858>>02656000
   INTEGER XDDEP;                                              <<00858>>02658000
   INTEGER DFID;                                               <<00858>>02660000
   OPTION EXTERNAL;                                            <<00858>>02662000
                                                               <<00858>>02664000
                                                                        02666000
PROCEDURE HELP;                                                <<00170>>02668000
   OPTION EXTERNAL;                                            <<00170>>02670000
PROCEDURE DATE'LINE(STRING);                                   <<01446>>02672000
   BYTE ARRAY STRING;OPTION EXTERNAL;                          <<01446>>02674000
INTEGER PROCEDURE XRETJTENTRY (N1,N2,N3,SIZE,INFO);            <<01884>>02676000
   INTEGER SIZE;                                               <<01884>>02678000
   INTEGER ARRAY INFO;                                         <<01884>>02680000
   BYTE ARRAY N1,N2,N3;                                        <<01884>>02682000
   OPTION EXTERNAL;                                            <<01884>>02684000
INTEGER PROCEDURE PARSE'DEV'PARMS(BYTE'STRING,DEVPARMS);       <<01884>>02686000
   BYTE ARRAY BYTE'STRING;                                     <<01884>>02688000
   LOGICAL ARRAY DEVPARMS;                                     <<01884>>02690000
   OPTION EXTERNAL;                                            <<01884>>02692000
                                                               <<04859>>02694000
LOGICAL PROCEDURE FINDJOB( JMENT, ENTP, JNUM, JOB, JNAME,      <<04859>>02696000
                           UNAME, ANAME, SIR );                <<04859>>02698000
   VALUE JNUM, JOB;                                            <<04859>>02700000
   INTEGER ARRAY JMENT, JNAME, UNAME, ANAME;                   <<04859>>02702000
   INTEGER JNUM, SIR, ENTP;                                    <<04859>>02704000
   LOGICAL JOB;                                                <<04859>>02706000
OPTION VARIABLE, EXTERNAL;                                     <<04859>>02708000
                                                               <<04859>>02710000
                                                               <<01884>>02712000
   LOGICAL PROCEDURE GET'DEV'PARM(TOKEN, DEVPARMS, INDEX);     <<01884>>02714000
      VALUE TOKEN;                                             <<01884>>02716000
      LOGICAL TOKEN;                                           <<01884>>02718000
      LOGICAL ARRAY DEVPARMS;                                  <<01884>>02720000
      INTEGER INDEX;                                           <<01884>>02722000
      OPTION EXTERNAL;                                         <<01884>>02724000
                                                               <<02548>>02726000
INTEGER PROCEDURE PVOLID(LDEV,BUF);                            <<02548>>02728000
   VALUE LDEV; INTEGER LDEV;                                   <<02548>>02730000
   BYTE ARRAY BUF;                                             <<02548>>02732000
   OPTION EXTERNAL;                                            <<02548>>02734000
                                                               <<04833>>02736000
LOGICAL PROCEDURE CHECKASS (LDEV, ASSENT);                     <<04833>>02738000
  VALUE LDEV;                                                  <<04833>>02740000
  LOGICAL LDEV;                                                <<04833>>02742000
  INTEGER ARRAY ASSENT;                                        <<04833>>02744000
  OPTION PRIVILEGED, UNCALLABLE, VARIABLE, EXTERNAL;           <<04833>>02746000
COMMENT -- CHECKASS checks if the user has  ASSOCIATEd  device <<04833>>02748000
LDEV.  If  so, it returns TRUE, else it returns FALSE.  If AS- <<04833>>02750000
SENT is specified, the Associate Table assent is returned, re- <<04833>>02752000
gardless of whether CHECKASS returns TRUE or FALSE.            <<04833>>02754000
;                                                              <<04833>>02756000
                                                               <<04833>>02758000
PROCEDURE LOGIMAGE (TYPE, PARMSP);                             <<04833>>02760000
  VALUE TYPE;                                                  <<04833>>02762000
  INTEGER TYPE;                                                <<04833>>02764000
  BYTE ARRAY PARMSP;                                           <<04833>>02766000
  OPTION PRIVILEGED, UNCALLABLE, EXTERNAL;                     <<04833>>02768000
COMMENT -- Logs operator commands in the system log file.      <<04833>>02770000
;                                                              <<04833>>02772000
                                                               <<02548>>02774000
INTRINSIC FOPEN,FREAD,FWRITE,FCONTROL,FCLOSE;                           02776000
INTRINSIC FGETINFO,FCHECK,FPOINT;                                       02778000
INTRINSIC ASCII,BINARY,DASCII,ZSIZE,DLSIZE,PRINT;                       02780000
INTRINSIC SEARCH,MYCOMMAND;                                             02782000
INTRINSIC READX;                                               <<04833>>02784000
INTRINSIC GETDSEG,FREEDSEG;                                    <<00548>>02786000
INTRINSIC FREADDIR;                                            <<01549>>02788000
$PAGE "   ***   =SPOOL STUFF   ***"                                     02790000
                                                                        02792000
                                                                        02794000
LOGICAL PROCEDURE VALIDSPOOLEE (DEVTYPE, OUT);                          02796000
   VALUE DEVTYPE, OUT;                                                  02798000
   INTEGER DEVTYPE;                                                     02800000
   LOGICAL OUT;                                                         02802000
   OPTION PRIVILEGED, UNCALLABLE;                                       02804000
BEGIN                                                                   02806000
<< PERMISSABLE SPOOLEES.  CORRESPONDING DEVTYPE BITS.  ON => SPOOLEE >> 02808000
   LOGICAL ARRAY     OUTMASK (*) = PB :=                                02810000
                        [8/0, 8/0],                                     02812000
                      [8/%(2) 00001010, 8/0], <<     PRP,MRJE>><<00763>>02814000
                        [8/%(2) 11011110, 8/0];<<LP,CDPN,PLTS>><<00.06>>02816000
   LOGICAL ARRAY     INMASK (*) = PB :=                                 02818000
                        [8/0, 8/%(2) 10000000],  <<CD RDR>>             02820000
                        [8/%(2) 00001000, 8/%(2) 10000000],             02822000
                        <<PRNTR/RDR/PUN, MAG TAPE>>                     02824000
                        [8/0, 8/0];                                     02826000
                                                                        02828000
<< >>                                                                   02830000
   XREG := DEVTYPE &LSR(4);                                             02832000
   TOS := IF OUT THEN OUTMASK (XREG) ELSE INMASK (XREG);                02834000
   XREG := DEVTYPE.(12:4);                                              02836000
   ASSEMBLE (CSL 1, X);                                                 02838000
   VALIDSPOOLEE := TOS;                                                 02840000
   END;    <<VALIDSPOOLEE>>                                             02842000
$PAGE "IT'S'A'DISC"                                            <<04833>>02844000
LOGICAL PROCEDURE IT'S'A'DISC (TYPE);                          <<04833>>02846000
                                                               <<03531>>02848000
VALUE TYPE;                                                    <<03531>>02850000
INTEGER TYPE;   << Input is a device type. >>                  <<03531>>02852000
                                                               <<03531>>02854000
BEGIN                                                          <<03531>>02856000
                                                               <<03531>>02858000
   << This logical procedure determines whether a   >>         <<03531>>02860000
   << given device type is a valid disc device type >>         <<03531>>02862000
                                                               <<03531>>02864000
EQUATE                                                         <<03531>>02866000
   MIN'DISC'TYPE = 0,                                          <<03531>>02868000
   MAX'DISC'TYPE = 6;                                          <<03531>>02870000
                                                               <<03531>>02872000
IT'S'A'DISC := MIN'DISC'TYPE <= TYPE <= MAX'DISC'TYPE;         <<04833>>02874000
                                                               <<03531>>02876000
END; << IT'S'A'DISC >>                                         <<04833>>02878000
                                                               <<03531>>02880000
                                                                        02882000
$PAGE "INITIATESPOOLER"                                        <<04833>>02884000
INTEGER PROCEDURE INITIATESPOOLER (DEVICE, OUT);                        02886000
   VALUE DEVICE, OUT;                                                   02888000
   INTEGER DEVICE;                                                      02890000
   LOGICAL OUT;                                                         02892000
   OPTION PRIVILEGED, UNCALLABLE;                                       02894000
BEGIN                                                                   02896000
   DEFINE            SPOOFLING = OUT.(14:1) #;                          02898000
   EQUATE                              <<RETURNS>>                      02900000
                     XOKAY  = 0,                                        02902000
                     XOWNEDOUT  = -2,                                   02904000
                     XOWNEDIN  = -1,                                    02906000
                     XOWNED  = 1,                                       02908000
                     XNOTREALDEV  = 2,                                  02910000
                     XNOTSPOOLEE  = 3,                                  02912000
                     XNOTJD  = 4,                                       02914000
                     XDIAG  = 5,                                        02916000
                     XNOSEG  = 6,                                       02918000
                     XCANTPROC = 7,                            <<00552>>02920000
                     XBUSY = 8,                                <<01200>>02922000
                     XDEV'DOWN = 9,                            <<02611>>02924000
                     NOSTRING = 0,         << FOR PROCREATE >> <<01200>>02926000
                     NOSTLEN = 0,                              <<01200>>02928000
                     PRIVAL = [5/4,3/0,8/SPOOLPRI];            <<01200>>02930000
<< LOCALS >>                                                            02932000
   INTEGER POINTER   DEVP;                                              02934000
   LOGICAL POINTER   DEVPL = DEVP;                                      02936000
   INTEGER           LPDTDEV,                                           02938000
                     INCOMINGDST,                                       02940000
                     CURSEG,                                            02942000
                     SAVELPDTSIR,                                       02944000
                     SAVELDTSIR,                                        02946000
                     MAXSTACKSIZE,                                      02948000
                     SPSTACK,                                           02950000
                     SPPIN  := 0;                                       02952000
LOGICAL                                                        <<02611>>02954000
                     SQREVERSED  := FALSE,                              02956000
                     UNWIND := FALSE,                          <<01200>>02958000
                     NOSTDIN := 0,         << FOR PROCREATE >> <<01200>>02960000
                     NOSTDLIST := 0;                           <<01200>>02962000
   INTEGER POINTER PCB = 3; <<SYSDB RELATIVE PCB INDIRECT POINTER>>     02964000
                                                                        02966000
                                                                        02968000
<< >>                                                                   02970000
   @DEVP := DEVICE *LDTSIZE;                                            02972000
   LPDTDEV := ABSYS +ABSYS'LPDTBASE +(DEVICE &ASL(1));                  02974000
   INCOMINGDST := EXCHANGEDB (CURSEG := LDTDST);                        02976000
   SAVELDTSIR := GETSIR (LDTSIR);                                       02978000
   SAVELPDTSIR := GETSIR (LPDTSIR);                                     02980000
   IF (1 <= DEVICE <= LDT'HIENTRY)  AND  (ABSOLUTE (LPDTDEV) >= 0)      02982000
         THEN                                                           02984000
      BEGIN    <<VALID REAL DEVICE>>                                    02986000
      IF VALIDSPOOLEE (DEVP (LD'DEVTYPE), OUT) THEN                     02988000
         << LEGITIMATE SPOOLEE >>                                       02990000
         IF NOT (DEVPL (LD'M)) THEN                                     02992000
            << NOT OWNED BY DIAGNOSTICS >>                              02994000
         IF (DEVPL (LD'F)) THEN                                <<02611>>02996000
            BEGIN                                              <<02611>>02998000
            IF OUT  OR  ABSOLUTE (LPDTDEV +1).(2:2) <> 0  THEN          03000000
               BEGIN    <<JOB AND/OR DATA ACCEPTING, IF INPUT>>         03002000
               XREG := LPDTDEV +1;                                      03004000
               DISABLE;                                                 03006000
               TOS := ABSOLUTE (XREG);                                  03008000
               IF S0.(0:2) = 0 THEN                                     03010000
                  BEGIN    <<UNOWNED: RESERVE>>                         03012000
                  TOS.(0:2) := 3;                                       03014000
                  ABSOLUTE (XREG) := TOS;                               03016000
                  ENABLE;                                               03018000
                  IF OUT THEN                                           03022000
                     BEGIN    <<SET SPOOFLING ALSO>>                    03024000
                     IF DEVPL (LD'SQ) <> SPOOFLING THEN                 03026000
                        BEGIN                                           03028000
                        DEVPL (LD'SQ) := SPOOFLING;                     03030000
                        SQREVERSED := TRUE;                             03032000
                        END;                                            03034000
                     TOS := OUTPUTSPOOLER;                              03036000
                     END                                                03038000
                  ELSE                                                  03040000
                     TOS := INPUTSPOOLER;                               03042000
                  DEVP (LD'SP) := TOS;                                  03044000
                  UNWIND := TRUE;                                       03046000
                  TOS := INITSTACKSIZE;                                 03048000
   MAXSTACKSIZE := ((TOS+127)&ASR(7))&ASL(7)+512*(BLOCKS + 2); <<01884>>03050000
                                                               <<01549>>03052000
                  IF (SPSTACK := GETSTACK (INITSTACKSIZE,               03054000
                        MAXSTACKSIZE)) <> 0 THEN                        03056000
                     BEGIN    << GOT SPOOLER STACK >>                   03058000
                     EXCHANGEDB (CURSEG := 0);                          03060000
                     <<PROCREATE>>                                      03062000
                     TOS := @SPPIN;                                     03064000
                     IF OUT THEN                                        03066000
                        BEGIN                                           03068000
                        TOS := ABSYS'SOUTPLABEL.(8:8);                  03070000
                        TOS.(0:1) := 1;                                 03072000
                        TOS := ABSYS'SOUTDELTAP;                        03074000
                        END                                             03076000
                     ELSE                                               03078000
                        BEGIN                                           03080000
                        TOS := ABSYS'SINPLABEL.(8:8);                   03082000
                        TOS.(0:1) := 1;                                 03084000
                        TOS := ABSYS'SINDELTAP;                         03086000
                        END;                                            03088000
            PROCREATE(*, *, *, SPSTACK, GLOBSIZE + 30, 0,     <<<01549>>03090000
                                LOCSIZE, PRIVAL, NOSTRING,     <<01200>>03092000
                                NOSTLEN, 0, %713, MAXSTACKSIZE,<<01200>>03094000
                                NOSTDIN, NOSTDLIST);           <<01200>>03096000
                     IF = THEN                                          03098000
                        BEGIN    <<ALL SET: AWAKE>>                     03100000
                           ADOPT(SPPIN,3); <<ADOPT TO PROGEN>> <<00552>>03102000
                        EXCHANGEDB (CURSEG := SPSTACK);                 03104000
                 << DBP USES THE DB POINTER IN >>             <<<01549>>03106000
                 <<  PCB GLOBAL  >>                           <<<01549>>03108000
                        DBP := 0;  <<ZERO GLOBALS>>                     03110000
                        MOVE DBP(1) := DBP,(GLOBSIZE -1);               03112000
                        DBP (DIRECTIV) := INITDIRECTIVE;                03114000
                        DBP (SPOOLE) := DEVICE;                         03116000
                        AWAKE (SPPIN *PCBSIZE, DADWAIT, 0);             03118000
                        TOS := XOKAY;                                   03120000
                        END                                             03122000
                     ELSE   TOS := XCANTPROC;                           03124000
                     END                                                03126000
                  ELSE   TOS := XNOSEG;                                 03128000
                  END                                                   03130000
               ELSE                                                     03132000
                  BEGIN    <<OWNED>>                                    03134000
                  ENABLE;                                               03136000
                  DEL;                                                  03138000
                  IF DEVP (LD'SP) = NOSPOOLER THEN                      03140000
                     TOS := XOWNED                                      03142000
                  ELSE                                                  03144000
                     IF DEVP (LD'SP) = OUTPUTSPOOLER THEN               03146000
                           TOS := XOWNEDOUT                    <<00552>>03148000
                     ELSE                                               03150000
                           TOS := XOWNEDIN;                    <<00552>>03152000
                  END                                                   03154000
               END                                                      03156000
            ELSE   TOS := XNOTJD                                        03158000
            END  ELSE TOS:=XDEV'DOWN                           <<02611>>03160000
         ELSE   TOS := XDIAG                                            03162000
      ELSE   TOS := XNOTSPOOLEE;                                        03164000
      END                                                               03166000
   ELSE   TOS := XNOTREALDEV;                                           03168000
                                                                        03170000
   IF ((INITIATESPOOLER := TOS) <> XOKAY)  AND  UNWIND  THEN            03172000
      BEGIN                                                             03174000
      IF CURSEG <> LDTDST THEN EXCHANGEDB (CURSEG := LDTDST);           03176000
      DEVP (LD'SP) := NOSPOOLER;                                        03178000
      IF SQREVERSED THEN DEVPL (LD'SQ) := NOT (SPOOFLING);              03180000
      ABSOLUTE (LPDTDEV +LP'SS) := 0;                                   03184000
      END;                                                              03186000
                                                                        03188000
   RELSIR (LPDTSIR, SAVELPDTSIR);                                       03190000
   RELSIR (LDTSIR, SAVELDTSIR);                                         03192000
   IF CURSEG <> INCOMINGDST THEN EXCHANGEDB (INCOMINGDST);              03194000
                                                                        03196000
RETURN;                                                                 03198000
HELP;                                                                   03200000
   END;    <<INITIATESPOOLER>>                                          03202000
                                                                        03204000
                                                                        03206000
LOGICAL PROCEDURE CONSSPOOL (PARMSTRING);                               03208000
   BYTE ARRAY PARMSTRING;                                               03210000
   OPTION PRIVILEGED, UNCALLABLE;                                       03212000
BEGIN                                                                   03214000
                                                                        03216000
   LOGICAL RESULT = CONSSPOOL;                                          03218000
                                                                        03220000
<< MYCOMMAND AND PARSING VARIABLES >>                                   03222000
   INTEGER           X1 := %26015,     <<COMMA, CR>>                    03224000
                     NUMPARMS;                                          03226000
   BYTE ARRAY        DELIM (*) = X1;                                    03228000
   DOUBLE ARRAY      PARMS (0:3) = Q;                                   03230000
   INTEGER           PNUM := 1;        <<POSITIONED FOR 1ST KEYWORD>>   03232000
                                                                        03234000
<< KEYWORD DEFINITIONS >>                                               03236000
   EQUATE            DICTLEN = 38,                                      03238000
                     X2 = DICTLEN -1;                                   03240000
   BYTE ARRAY        KEYWORDSP (*) = PB :=                              03242000
                        10, 8, "STARTOUT",                              03244000
                        9, 7, "STARTIN",                                03246000
                        6, 4, "STOP",                                   03248000
                        8, 6, "RESUME",                                 03250000
                        6, 4, "WAIT",                                   03252000
                        8, 6, "DELETE",                                 03254000
                        7, 5, "DEFER",                                  03256000
                        7, 5, "OPENQ",                                  03258000
                        7, 5, "SHUTQ",                                  03260000
                        7, 5, "RESET",                                  03262000
                        0;                                              03264000
   INTEGER ARRAY     KEYWORDSPW (*) = KEYWORDSP,                        03266000
                     KEYWORDSW (0:X2) = Q;                              03268000
   BYTE ARRAY        KEYWORDS (*) = KEYWORDSW;                          03270000
<< BITS CORRESPONDING TO PERMISSABLE KEYWORDS>>                         03272000
   LOGICAL           CONTEXTFLAG := -1;                                 03274000
   INTEGER           KEYNUM;                                            03276000
                                                                        03278000
<< =SPOOL CONTROLLING VARIABLES >>                                      03280000
   INTEGER           DEVICE;                                            03282000
   INTEGER POINTER   DEVP;                                              03284000
   EQUATE         << DIRECTION >>                                       03286000
                     IN = 0,                                            03288000
                     OUT = 1,                                           03290000
                     EITHER = -1;                                       03292000
   INTEGER           DIRECTION := EITHER;                               03294000
   EQUATE         << SPOOFLING >>                                       03296000
                     SHUT = 0,                                          03298000
                     OPEN = 1,                                          03300000
                     LEAVE = -1;                                        03302000
   INTEGER           SPOOFLING := LEAVE;                                03304000
                  << PROGEN/SPOOLER DIRECTIVE>>                         03306000
   EQUATE            NODIRECTIVE  = %100000;                            03308000
   INTEGER           NEWDIRECTIVE  := NODIRECTIVE;                      03310000
   DEFINE            PROCDIRECTIVE = NEWDIRECTIVE.(8:4) #,              03312000
                     FILEDIRECTIVE = NEWDIRECTIVE.(12:4) #;             03314000
   LOGICAL           STARTFLAG := FALSE;  <<PROCREATE FLAG>>            03316000
                                                                        03318000
<< MISC >>                                                              03320000
   INTEGER           SPOOLERPCB,                                        03322000
                     SAVESIR;                                           03324000
                                                                        03326000
                                                                        03328000
<< >>                                                                   03330000
   CONSSPOOL := FALSE;                                                  03332000
   MYCOMMAND (PARMSTRING, DELIM, 4, NUMPARMS, PARMS);                   03334000
   IF = AND (NUMPARMS >= 2) THEN                                        03336000
      BEGIN    <<VALID NUMBER OF PARMS>>                                03338000
      TOS := 0;                                                         03340000
      TOS := PARMS;                                                     03342000
      TOS := TOS &LSR(8);                                               03344000
      DEVICE := BINARY (*, *);                                          03346000
      IF = THEN                                                         03348000
         BEGIN    <<VALID NUMBER>>                                      03350000
         MOVE KEYWORDSW := KEYWORDSPW, (DICTLEN);                       03352000
         DO BEGIN    <<PROCESS KEYWORDS>>                               03354000
            TOS := 0;                                                   03356000
            TOS := PARMS (PNUM);                                        03358000
            TOS := TOS &LSR(8);                                         03360000
            IF = THEN                                                   03362000
               BEGIN    <<OMITTED PARM>>                                03364000
               ASSEMBLE (DEL, DDEL);                                    03366000
               RETURN;                                                  03368000
               END;                                                     03370000
            << NOT OMITTED >>                                           03372000
            KEYNUM := SEARCH (*, *, KEYWORDS) -1;                       03374000
            IF < THEN RETURN;    <<UNRECOGNIZED KEYWORD>>               03376000
            << RECOGNIZABLE KEYWORD >>                                  03378000
            TOS := CONTEXTFLAG;    <<C IF LEGITIMATE IN CONTEXT>>       03380000
            XREG := KEYNUM;                                             03382000
            ASSEMBLE (TBC 0,X; DEL);                                    03384000
            IF = THEN RETURN;                                           03386000
            << CONTEXTUALLY LEGITIMATE >>                               03388000
                                                                        03390000
            << KEYWORD PROCESSORS                                       03392000
               EACH PROCESSOR LEAVES:                                   03394000
                  S-1 = NEW CONTEXTFLAG,                                03396000
                  S-0 = IMPLIED DIRECTION.  >>                          03398000
            CASE KEYNUM OF                                              03400000
               BEGIN                                                    03402000
<< STARTOUT >>    BEGIN                                                 03404000
                  STARTFLAG := TRUE;                                    03406000
                  PROCDIRECTIVE := RESUMESPOOLING;                      03408000
                  TOS := %600;                                          03410000
                  TOS := OUT;                                           03412000
                  END;                                                  03414000
<< STARTIN >>     BEGIN                                                 03416000
                  STARTFLAG := TRUE;                                    03418000
                  PROCDIRECTIVE := RESUMESPOOLING;                      03420000
                  TOS := 0;                                             03422000
                  TOS := IN;                                            03424000
                  END;                                                  03426000
<< STOP >>        BEGIN                                                 03428000
                  PROCDIRECTIVE := QUITSPOOLING;                        03430000
                  TOS := %3700;                                         03432000
                  TOS := DIRECTION;    <<LEAVE DIRECTION>>              03434000
                  END;                                                  03436000
<< RESUME >>      BEGIN                                                 03438000
                  PROCDIRECTIVE := RESUMESPOOLING;                      03440000
                  TOS := %600;                                          03442000
                  TOS := OUT;                                           03444000
                  END;                                                  03446000
<< WAIT >>        BEGIN                                                 03448000
                  PROCDIRECTIVE := WAITSPOOLING;                        03450000
                  TOS := %3700;                                         03452000
                  TOS := OUT;                                           03454000
                  END;                                                  03456000
<< DELETE >>      BEGIN                                                 03458000
                  FILEDIRECTIVE := DELETEFILE;                          03460000
                  TOS := %24600;                                        03462000
                  TOS := DIRECTION;    <<LEAVE DIRECTION>>              03464000
                  END;                                                  03466000
<< DEFER >>       BEGIN                                                 03468000
                  FILEDIRECTIVE := DEFERFILE;                           03470000
                  TOS := %24600;                                        03472000
                  TOS := OUT;                                           03474000
                  END;                                                  03476000
<< OPENQ >>       BEGIN                                                 03478000
                  SPOOFLING := OPEN;                                    03480000
                  TOS := %137700;                                       03482000
                  TOS := OUT;                                           03484000
                  END;                                                  03486000
<< SHUTQ >>       BEGIN                                                 03488000
                  SPOOFLING := SHUT;                                    03490000
                  TOS := %137700;                                       03492000
                  TOS := OUT;                                           03494000
                  END;                                                  03496000
<< RESET >>       BEGIN                                                 03498000
                  FILEDIRECTIVE := RELINKFILE;                          03500000
                  TOS := %24600;                                        03502000
                  TOS := OUT;                                           03504000
                  END  <<LAST CASE STATEMENT>>                          03506000
               END;    <<CASE>>                                         03508000
            DIRECTION := TOS;                                           03510000
            CONTEXTFLAG := TOS LAND CONTEXTFLAG;                        03512000
            END                                                         03514000
         UNTIL (PNUM := PNUM +1) = NUMPARMS;                            03516000
                                                                        03518000
         IF STARTFLAG THEN                                              03520000
            BEGIN                                                       03522000
            IF (DIRECTION = OUT) AND (SPOOFLING <> SHUT) THEN           03524000
               DIRECTION := 3;                                          03526000
            IF INITIATESPOOLER (DEVICE, DIRECTION) = 0 THEN             03528000
               CONSSPOOL := TRUE;                                       03530000
            END                                                         03532000
         ELSE                                                           03534000
            BEGIN    <<[OPEN/SHUT Q] AND SEND DIRECTIVE>>               03536000
            @DEVP := DEVICE *LDTSIZE;                                   03538000
            EXCHANGEDB (LDTDST);                                        03540000
            SAVESIR := GETSIR (LDTSIR);                                 03542000
            IF  (1 <= DEVICE <= LDT'HIENTRY)                            03544000
               AND  (ABSOLUTE (ABSYS +ABSYS'LPDTBASE                    03546000
                  +(DEVICE &ASL(1))).(LP'VIRTUALF) = 0) THEN            03548000
               IF NEWDIRECTIVE = NODIRECTIVE THEN                       03550000
                  BEGIN    <<JUST CHANGING OPENQ/SHUTQ>>                03552000
                  IF VALIDSPOOLEE (DEVP (LD'DEVTYPE), TRUE) THEN        03554000
                     BEGIN    <<VALID OUTPUT SPOOLEE: CHANGE>>          03556000
                     DEVP (LD'SQ) := SPOOFLING;                         03558000
                     CONSSPOOL := TRUE;                                 03560000
                     END;                                               03562000
                  END                                                   03564000
               ELSE                                                     03566000
                  IF DEVP (LD'SP) <> NOSPOOLER THEN                     03568000
                     << A SPOOLER >>                                    03570000
                     IF (DIRECTION = EITHER)                            03572000
                     OR (DIRECTION +1 = DEVP (LD'SP))  THEN             03574000
                        BEGIN    <<CORRECT DIRECTION>>                  03576000
                        IF PROCDIRECTIVE = QUITSPOOLING THEN            03578000
                           BEGIN                                        03580000
                           IF SPOOFLING = LEAVE THEN                    03582000
                              SPOOFLING := SHUT;                        03584000
                           END;                                         03586000
                        IF SPOOFLING <> LEAVE THEN                      03588000
                           DEVP (LD'SQ) := SPOOFLING;                   03590000
                        << SEND DIRECTIVE >>                            03592000
                        SPOOLERPCB := DEVP(LD'MAINPIN)*                 03594000
                              PCBSIZE;                                  03596000
                        EXCHANGEDB(SYS'PCBTP(SPOOLERPCB                 03598000
                              +PCB'STACKDST));                          03600000
                        DBP (DIRECTIV) := NEWDIRECTIVE;                 03602000
                        AWAKE (SPOOLERPCB, DADWAIT, 0);                 03604000
                        CONSSPOOL := TRUE;                              03606000
                        END;                                            03608000
            IF RESULT AND SPOOFLING=OPEN THEN                           03610000
               BEGIN                                                    03612000
               DISABLE;                                                 03614000
               ABSYS'JOBSYNC.(DEVFREED'F) := 1;                         03616000
               ENABLE;                                                  03618000
               AWAKE(SYSPROC(UCOPLPIN),%20,0);                          03620000
               END;                                                     03622000
            RELSIR (LDTSIR, SAVESIR);                                   03624000
            EXCHANGEDB (0);                                             03626000
            END;                                                        03628000
         END;                                                           03630000
      END;                                                              03632000
   END;    <<CONSSPOOL>>                                                03634000
                                                                        03636000
                                                                        03638000
                                                                        03640000
                                                                        03642000
PROCEDURE INITSPOOLING;                                                 03644000
   OPTION PRIVILEGED, UNCALLABLE;                                       03646000
BEGIN                                                                   03648000
   INTEGER           DEVICE;                                            03650000
   INTEGER POINTER   DEVP;                                              03652000
   INTEGER           ACTION;           <<INITIATESPOOLER ACTION>>       03654000
   EQUATE            OKAY = 0,                                          03656000
                     NOTSPOOLEE = 3,                                    03658000
                     NOTJD = 4;                                         03660000
   DOUBLE            X1  := "SPOO";    << "SPOOL" CLASS NAME >>         03662000
   INTEGER           X2  := %46015;                                     03664000
   BYTE ARRAY        SPOOL (*) = X1;                                    03666000
   INTEGER ARRAY     DEVINFO (0:8);                                     03668000
                                                                        03670000
                                                                        03672000
<< >>                                                                   03674000
   IF GETDEVINFO (SPOOL, DEVINFO) = 0                                   03676000
         AND IT'S'A'DISC (DEVINFO(1)) THEN                     <<04833>>03678000
      TOS := DEVINFO                                                    03680000
   ELSE                                                                 03682000
      TOS := 0;                                                         03684000
   ABSYS'SPOOLINDEX := TOS;    << "SPOOL" CLASS INDEX (NEG) >>          03686000
   EXCHANGEDB (LDTDST);                                                 03688000
   @DEVP := LDT'ENTRYSIZE;                                              03690000
   DEVICE := 1;                                                         03692000
   DO BEGIN                                                             03694000
      IF DEVP (LD'SP) <> NOSPOOLER THEN                                 03696000
         BEGIN                                                          03698000
         ACTION := INITIATESPOOLER (DEVICE, DEVP (LD'SP) &LSR(1)        03700000
               + DEVP (LD'SQ) &LSL(1));                                 03702000
         IF ACTION <> OKAY THEN                                         03704000
            IF (ACTION = NOTSPOOLEE)  OR  (ACTION = NOTJD)  THEN        03706000
               BEGIN                                                    03708000
               EXCHANGEDB (0);                                          03710000
               GENMSG(1,241,%10000,DEVICE,,,,,0);              <<00.EB>>03712000
               EXCHANGEDB (LDTDST);                                     03714000
               DEVP(LD'SP) := NOSPOOLER;                       <<00.06>>03716000
               DEVP(LD'SQ) := 0;                               <<00.06>>03718000
               END                                                      03720000
            ELSE                                                        03722000
               SUDDENDEATH (370);                                       03724000
         END;                                                           03726000
      @DEVP := @DEVP +LDT'ENTRYSIZE;                                    03728000
      END                                                               03730000
   UNTIL (DEVICE := DEVICE +1) > LDT'HIENTRY;                           03732000
   EXCHANGEDB (0);                                                      03734000
   END;    <<INITSPOOLING>>                                             03736000
$PAGE "   ***   DEVICE/CLASS DISPLAY (UTILITY)   ***"                   03738000
$CONTROL SEGMENT= SPOOLCOMS2                                            03740000
                                                                        03742000
                                                                        03744000
INTEGER PROCEDURE DEVSPEC (DEVICE, BUFB);                               03746000
   VALUE DEVICE;                                                        03748000
   INTEGER DEVICE;                                                      03750000
   BYTE ARRAY BUFB;                                                     03752000
   OPTION PRIVILEGED, UNCALLABLE;                                       03754000
BEGIN                                                                   03756000
   INTEGER POINTER   CLASSP;                                            03758000
   DOUBLE POINTER    CLASSPD = CLASSP;                                  03760000
<< >>                                                                   03762000
   IF DEVICE >= 0 THEN                                                  03764000
      TOS := ASCII (DEVICE, 10, BUFB)                                   03766000
   ELSE                                                                 03768000
      BEGIN    <<FIND CLASS>>                                           03770000
      EXCHANGEDB (LDTDST);                                              03772000
      @CLASSP := @LDT'DCTP;                                             03774000
      WHILE (DEVICE := DEVICE +1) < 0 DO                                03776000
         @CLASSP := @CLASSP +(CLASSP (DC'NUMDEVS) &ASR(1)) +6;          03778000
      TOS := CLASSPD;                                                   03780000
      TOS := CLASSPD (1);                                               03782000
      TOS := 0;    <<DELIMITER FOR SCAN>>                               03784000
      EXCHANGEDB (0);                                                   03786000
      MOVE BUFB := BARRS4 WHILE AN, 1;                         <<04833>>03788000
      TOS := TOS -@BUFB;                                                03790000
      END;                                                              03792000
   DEVSPEC := TOS;                                                      03794000
   END;    <<DEVSPEC>>                                                  03796000
$PAGE "   ***   SHOWFILES   ***"                                        03798000
INTEGER PROCEDURE SHOWFILES (PARMSTRING, PARMNUM, INJOBNUM, OUT);       03800000
   VALUE INJOBNUM, OUT;                                                 03802000
   BYTE ARRAY PARMSTRING;                                               03804000
   INTEGER PARMNUM, INJOBNUM;                                           03806000
   LOGICAL OUT;                                                         03808000
   OPTION PRIVILEGED, UNCALLABLE;                                       03810000
BEGIN                                                                   03812000
                                                                        03814000
<< DECLARATIONS >>                                                      03816000
                                                                        03818000
<< PARSE >>                                                             03820000
   EQUATE             MAXPARMS = 12;                           <<U.RAO>>03822000
   P'DECLARATIONS;                                                      03824000
   EQUATE            STATESTART  = 66,                                  03826000
                     KEYLEN  = ((STATESTART +1) /2) +12;                03828000
   BYTE ARRAY        KEYWORDSP (*) = PB :=                              03830000
                        6, 3, "DEV", 1,                                 03832000
                        6, 3, "JOB", 2,                                 03834000
                        10, 6, "ACTIVE", 3, DFACTIVE,                   03836000
                        9, 5, "READY", 3, DFREADY,                      03838000
                        10, 6, "OPENED", 3, DFOPENED,                   03840000
                        10, 6, "LOCKED", 3, DFLOCKED,                   03842000
                        9, 6, "STATUS", 4,                              03844000
                        5, 2, "SP", 5,                                  03846000
                        0,                                              03848000
                        << STATES >>                                    03850000
                        "ACTIVE",                                       03852000
                        "READY ",                                       03854000
                        "OPENED",                                       03856000
                        "LOCKED";                                       03858000
   ARRAY             KEYWORDSPW (*) = KEYWORDSP;                        03860000
   ARRAY             KEYWORDSW (0:KEYLEN-1);                            03862000
   BYTE ARRAY        KEYWORDS (*) = KEYWORDSW;                          03864000
   BYTE POINTER      KEYDEFN;                                           03866000
                                                                        03868000
<< VARIABLES CONTROLLING SCANNING: RESULTING FROM PARSE >>              03870000
   INTEGER           DFID := 0,        <<DEV FILE ID; OR 0 (ALL)>>      03872000
                     DEV := 0;      <<+DEV/-CLASS INDEX; IF SPECIFIED>> 03874000
   INTEGER ARRAY     DEVINFO (0:8) = Q;<<GETDEVINFO RETURN>>            03876000
   INTEGER           JOBNUM := 0;      <<JOB NUM QUALIFIER>>            03878000
   EQUATE            NOSTATE = 4;      <<NO STATE SPEC SIGNAL>>         03880000
   INTEGER           STATE := NOSTATE; <<STATE QUALIFIER>>              03882000
   EQUATE            NODEF = 0,        <<DEFERRED SPECIFICATION>>       03884000
                     NONDEFR = 2,                                       03886000
                     DEFR = 1;                                          03888000
   INTEGER           DEF := NODEF;                                      03890000
   INTEGER ARRAY     BUF(0:130); << RETURN FOR GETCLASS >>     <<01906>>03892000
INTEGER JPRIME := 0;                                           <<U.RAO>>03894000
   LOGICAL           SP := FALSE,      <<JUST SPOOFLES REQUEST>>        03896000
                     STATUS := FALSE;  <<JUST "STATUS" REQUEST>>        03898000
   EQUATE ERRORMAX = 3;                                        <<U.RAO>>03900000
   INTEGER ERRORCOUNT := 0;                                    <<U.RAO>>03902000
   LOGICAL FLAGS := 0;                                         <<U.RAO>>03904000
   DEFINE DEVFLAG = FLAGS.(15:1)#,                             <<U.RAO>>03906000
          JOBFLAG = FLAGS.(14:1)#,                             <<U.RAO>>03908000
          STATEFLAG = FLAGS.(13:1)#,                           <<U.RAO>>03910000
          STATUSFLAG = FLAGS.(12:1)#,                          <<U.RAO>>03912000
          SPOOFLESFLAG = FLAGS.(11:1)#,                        <<U.RAO>>03914000
          ALLFLAG = FLAGS.(0:1)#;                              <<U.RAO>>03916000
                                                                        03918000
<< VARIABLES FOR SCAN >>                                                03920000
   INTEGER POINTER   HEADP,            <<SCANNING HEAD PNTR>>           03922000
                     LASTHEADP,        <<LAST HEAD TO EXAMINE>>         03924000
                     ENTRYP,           <<SCANNING ENTRY PNTR>>          03926000
                     LIMITP,           <<TABLE LIMIT>>                  03928000
                     TEMPP,            <<TEMPORARY PNTR>>               03930000
                     CLASSP  = TEMPP,  <<DCT CLASS PNTR>>               03932000
                     CURCLP;           <<CURRENT CLASS POINTER>>        03934000
   LOGICAL POINTER   ENTRYPL = ENTRYP, <<LOGICAL EQUIVALENCES>>         03936000
                     CURCLPL = CURCLP;                                  03938000
   BYTE POINTER      CLASSPB  = CLASSP; <<DCT CLASS B PNTR>>            03940000
   INTEGER           CLX,              <<CLASS INDEX>>                  03942000
                     NUMDEVS  = CLX,   <<NUM DEVS IN CLASS>>            03944000
                     HEADPX = NUMDEVS; <<Q-REL ARRAY INDEX>>            03946000
   DEFINE            OD'HIT = 0).(0:1 #,  <<FOR CLASS SCAN>>            03948000
                     OD'RANK = OD'LINKP  #;  <<TEMP FOR RANK>>          03950000
   INTEGER           RANK := 0;        <<ODD RANK ACCUMULATOR>>         03952000
   INTEGER           XDDSIR,           <<APPROPRIATE SIR>>              03954000
                     SAVESIR;          <<GETSIR RESULT>>                03956000
                                                                        03958000
<< VARIABLES FOR SUMMARY ACCUMULATION >>                                03960000
   INTEGER           ST;               <<TEMPORARY>>                    03962000
   << FOLLOWING DECLARATIONS MUST REMAIN DIRECT (=Q) AND CONTIG 4 INIT>>03964000
   INTEGER ARRAY     STCOUNTS (0:3) =Q, <<(TOTAL) STATE COUNTS>>        03966000
                     DEFCOUNTS (0:3) =Q,<<DEFERRED COUNTS (/STATE)>>    03968000
                     SPCOUNTS (0:3) =Q; <<SPOOFLE COUNTS (/STATE)>>     03970000
   DOUBLE            SPSPACE := 0D;    <<SPOOFLE SPACE>>                03972000
   INTEGER           TOTAL;                                             03974000
   INTEGER           OUTFENCE;         <<OUTPUT FENCE>>                 03976000
   INTEGER         DEVFENCE;   <<OUTFENCE FOR AN LDEV>>        <<00874>>03978000
   INTEGER DEVINHEAD; << LDEV IN HEAD OF ODD>>                 <<00874>>03980000
                                                                        03982000
<< FOR VISIT OF EACH ENTRY >>                                           03984000
   INTEGER           FNUM  := 0;       <<TEMPORARY FILE NUM.>>          03986000
   INTEGER           SAVELINK;         <<SAVED LINK WD ('CAUSE <RANK>)>>03988000
                                                               <<00548>>03990000
<< VARIABLES FOR EXTRA DATA SEG -- SEQUENTIAL READ/WR ACCESS>> <<00548>>03992000
   INTEGER           DSTNUM := 0,      <<0 => NOT ACQUIRED>>   <<00548>>03994000
                     ERRNUM := 0;      <<DST ERR?>>            <<00548>>03996000
   LOGICAL           NEXTLOC,                                  <<00548>>03998000
                     ENDOFDATA ,       <<# OF WORDS USED>>     <<00548>>04000000
                     DSTLENGTH;                                <<00548>>04002000
                                                                        04004000
<< PRINT VARIABLES >>                                          <<00548>>04006000
   EQUATE            OBUFMAX = 32;                             <<00548>>04008000
   ARRAY             OBUF (0:OBUFMAX); <<OUTPUT BUFFER>>       <<00548>>04010000
   BYTE ARRAY        OBUFB (*) = OBUF;                                  04012000
   INTEGER ARRAY     EBUF (0:XDDSIZE -1);  <<FILE BUF (FOR ENTRY)>>     04014000
   BYTE ARRAY        EBUFB(*) = EBUF;                          <<02.EB>>04016000
   LOGICAL ARRAY     EBUFL (*)  = EBUF;                                 04018000
   BYTE ARRAY        STATES (*)  = KEYWORDS (STATESTART);               04020000
   BYTE ARRAY        SPACEBUF (0:11);  <<2 GET RT. JUSTIFICATION>>      04022000
   LOGICAL           STOP  := FALSE;   <<FSYS ERROR INDICATOR>>         04024000
   INTEGER           LEN;              <<PRINT LEN (IN BYTES)>>         04026000
   EQUATE            HEADERLEN = -61;                                   04028000
   EQUATE            POSDEVCL = 0,                                      04030000
                     POSDFID = POSDEVCL +9,                             04032000
                     POSJNUM = POSDFID +8,                              04034000
                     POSJNAME = POSJNUM,                                04036000
                     POSFNAME = POSJNUM +8,                             04038000
                     POSSTATE = POSFNAME +9,                            04040000
                     POSFORMS = POSSTATE +7,                            04042000
                     POSSPACE = POSFORMS +8,                            04044000
                     POSRANK = POSSPACE +4,                             04046000
                     POSDEFPRI = POSRANK +1,                            04048000
                     POSNUMC = POSDEFPRI +6;                            04050000
                                                                        04052000
                                                                        04054000
SUBROUTINE ERROR (ERRN);                                                04056000
   VALUE ERRN;                                                          04058000
   INTEGER ERRN;                                                        04060000
<< CALLED WHEN ERROR <ERRN> DETECTED.  SETS RETURN PARAMETERS:          04062000
   SHOWFILES (TO <ERRN>), AND <PARMNUM> (TO <PNUM>); AND                04064000
   DECIDES WHETHER TO CALL CIERR OR EXIT.>>                    <<U.RAO>>04066000
BEGIN                                                          <<U.RAO>>04068000
   CIERR(ERRN,PP);                                             <<U.RAO>>04070000
   IF ERRN>0 THEN   <<SERIOUS ERROR>>                          <<U.RAO>>04072000
      BEGIN  <<MUST KEEP TRACK OF NUMBER OF SERIOUS ERRORS>>   <<U.RAO>>04074000
      SHOWFILES := ERRN;                                       <<U.RAO>>04076000
      PARMNUM := PNUM + PARMNUM;                               <<U.RAO>>04078000
      ERRORCOUNT := ERRORCOUNT+1;                              <<U.RAO>>04080000
      IF ERRORCOUNT > ERRORMAX THEN   <<TOO MANY ERRORS,>>     <<U.RAO>>04082000
         BEGIN   <<STOP PARSING>>                              <<U.RAO>>04084000
         STOP := TRUE;                                         <<U.RAO>>04086000
         CIERR(-SHOWF2MERRORS,PP)                              <<U.RAO>>04088000
         END;                                                  <<U.RAO>>04090000
      END;   <<PROCESSING OF SERIOUS ERRORS>>                  <<U.RAO>>04092000
END;  <<SUBROUTINE ERROR>>                                     <<U.RAO>>04094000
SUBROUTINE FATALERROR;  <<FATAL ERROR, INCIDENTALLY>>          <<00548>>04096000
BEGIN                                                          <<01152>>04098000
CIERR(SHOWFILES := ERRNUM);                                    <<01152>>04100000
ASSEMBLE(EXIT 4);  << FATAL ERROR, BAIL OUT >>                 <<01152>>04102000
END;                                                           <<U.RAO>>04104000
                                                               <<U.RAO>>04106000
SUBROUTINE GETNEXT;                                            <<U.RAO>>04108000
BEGIN   <<EXTRACTS NEXT PARAMETER>>                            <<U.RAO>>04110000
IF PNUM+1 = MAXPARMS THEN  <<NEED A NEW SET OF PARMS>>         <<U.RAO>>04112000
   BEGIN                                                       <<U.RAO>>04114000
   MYCOMMAND(PP,,MAXPARMS, NUMPARMS, PARMS(1));                <<U.RAO>>04116000
   PNUM := 1;                                                  <<U.RAO>>04118000
   PARMNUM := PARMNUM+MAXPARMS-1;                              <<U.RAO>>04120000
   END;                                                        <<U.RAO>>04122000
PARM := PARMS(PNUM := PNUM+1);                                 <<U.RAO>>04124000
END;                                                           <<U.RAO>>04126000
LOGICAL SUBROUTINE DSDEVICE(LDEV);                             <<01906>>04128000
VALUE LDEV;                                                    <<01906>>04130000
INTEGER LDEV;                                                  <<01906>>04132000
BEGIN                                                          <<01906>>04134000
   SAVESIR := GETSIR(LDTSIR);                                  <<01906>>04136000
   DSDEVICE := TRUE;                                           <<01906>>04138000
   IF LDEV > 0 THEN                                            <<01906>>04140000
      BEGIN                                                    <<01906>>04142000
         IF GET'DSDEVICE(LDEV) <> 2 THEN                       <<01906>>04144000
            DSDEVICE := FALSE;                                 <<01906>>04146000
      END                                                      <<01906>>04148000
   ELSE                                                        <<01906>>04150000
      BEGIN                                                    <<01906>>04152000
         GETCLASS(BUF,TRUE,,-LDEV);                            <<01906>>04154000
         NUMDEVS := BUF(3).(0:8);                              <<01906>>04156000
         @CLASSPB := @BUF(3)&LSL(1) + 1;                       <<01906>>04158000
         WHILE (NUMDEVS := NUMDEVS - 1) >= 0 DO                <<01906>>04160000
         IF GET'DSDEVICE(INTEGER(CLASSPB(NUMDEVS))) <> 2 THEN  <<01906>>04162000
            DSDEVICE := FALSE;                                 <<01906>>04164000
      END;                                                     <<01906>>04166000
   RELSIR(LDTSIR,SAVESIR);                                     <<01906>>04168000
END;  << SUBROUTINE DSDEVICE >>                                <<01906>>04170000
SUBROUTINE PARSEDEV;                                           <<U.RAO>>04172000
BEGIN   <<PARSES DEV PARAMETER, OF FORM   >>                   <<U.RAO>>04174000
<<                                        >>                   <<U.RAO>>04176000
<<   DEV={device/device class}            >>                   <<U.RAO>>04178000
<<                                        >>                   <<U.RAO>>04180000
IF PDEL <> EQUAL THEN                                          <<U.RAO>>04182000
   ERROR(SHOWFXPCTDEV)                                         <<U.RAO>>04184000
ELSE                                                           <<U.RAO>>04186000
   BEGIN  <<HAVE = SIGN>>                                      <<U.RAO>>04188000
   GETNEXT;    <<GET SUBPARAMETER>>                            <<U.RAO>>04190000
   IF PLEN=0 THEN                                              <<U.RAO>>04192000
      ERROR(SHOWFXPCTDEV)                                      <<U.RAO>>04194000
   ELSE IF GETDEVINFO(PP, DEVINFO) <> 0 THEN                   <<U.RAO>>04196000
      ERROR (-SHOWFINVLDDEVSP) << Error in device spec.     >> <<04833>>04198000
   ELSE IF NOT OUT AND (DEVINFO<0) THEN                        <<U.RAO>>04200000
      ERROR(SHOWFINPTDEVCLS)   <<DEVICE CLASS NOT ALLOWED ON IN<<U.RAO>>04202000
   ELSE IF DEVINFO(1)<=7 THEN                                  <<U.RAO>>04204000
      ERROR(SHOWFDACCESSDEV)   <<DIRECT ACCESS DEVICE NOT ALLOW<<U.RAO>>04206000
   ELSE IF DSDEVICE(DEVINFO) THEN                              <<01906>>04208000
      ERROR(SHOWFDSDEVICE)      <<DS DEVICE NOT ALLOWED >>     <<01906>>04210000
   ELSE   <<LOOKS FAIRLY GOOD>>                                <<U.RAO>>04212000
      BEGIN                                                    <<U.RAO>>04214000
      DEVFLAG := TRUE;                                         <<U.RAO>>04216000
      IF <> THEN   <<REDUNDANTLY SPECIFIED>>                   <<U.RAO>>04218000
         BEGIN                                                 <<U.RAO>>04220000
         PARM := PARMS(PNUM-1);  <<BACK UP TO "DEV">>          <<U.RAO>>04222000
         ERROR(-SHOWFRDNTDEV);                                 <<U.RAO>>04224000
         PARM := PARMS(PNUM);                                  <<U.RAO>>04226000
         END;                                                  <<U.RAO>>04228000
      DEV := DEVINFO;                                          <<U.RAO>>04230000
      END;                                                     <<U.RAO>>04232000
   END;                                                        <<U.RAO>>04234000
END;   <<SUBROUTINE PARSEDEV>>                                 <<U.RAO>>04236000
                                                               <<U.RAO>>04238000
                                                               <<U.RAO>>04240000
                                                               <<U.RAO>>04242000
SUBROUTINE PARSEJOB;                                           <<U.RAO>>04244000
BEGIN   <<PARSES JOB PARAMETER, SYNTAX IS>>                    <<U.RAO>>04246000
<<                                                             <<U.RAO>>04248000
<<        @                                                    <<U.RAO>>04250000
<<  JOB = @J, @S, @J', @S'                                     <<U.RAO>>04252000
<<        #Jnnn, #Snnn, #J'nnn, #S'nnn, Jnnn, Snnn, J'nnn, S'nn<<U.RAO>>04254000
<<                                                             <<U.RAO>>04256000
<<Note that if an error is detected, the parser does its best t<<U.RAO>>04258000
<<figure out what the user wanted, and give him that or a super<<U.RAO>>04260000
<<of what he wanted.  For example, @J3 would result in an error<<U.RAO>>04262000
<<but we would still give the user @J.                         <<U.RAO>>04264000
                                                               <<U.RAO>>04266000
JOBFLAG := TRUE;                                               <<U.RAO>>04268000
IF <> THEN    <<REDUNDANTLY SPECIFIED>>                        <<U.RAO>>04270000
   ERROR (-SHOWFREDUNDJOB);                                    <<04833>>04272000
IF PDEL <> EQUAL THEN   <<MISSING EQUALS SIGN>>                <<U.RAO>>04274000
   BEGIN                                                       <<U.RAO>>04276000
   @PP := @PP+INTEGER(PLEN);                                   <<U.RAO>>04278000
   ERROR(SHOWFXPCTJOBEQ);                                      <<U.RAO>>04280000
   ALLFLAG := TRUE;                                            <<U.RAO>>04282000
   END                                                         <<U.RAO>>04284000
ELSE                                                           <<U.RAO>>04286000
   BEGIN   <<HAVE EQUAL SIGN, CHECK OUT SUBPARAMETER>>         <<U.RAO>>04288000
   GETNEXT;   <<GET SUBPARAMETER>>                             <<U.RAO>>04290000
   IF PLEN=0 THEN   <<MISSING SUBPARAMETER>>                   <<U.RAO>>04292000
      BEGIN                                                    <<U.RAO>>04294000
      ERROR(SHOWFXPCTJOB);                                     <<U.RAO>>04296000
      ALLFLAG := TRUE;                                         <<U.RAO>>04298000
      END                                                      <<U.RAO>>04300000
   ELSE   <<PARAMETER EXISTS, PARSE IT>>                       <<U.RAO>>04302000
      BEGIN                                                    <<U.RAO>>04304000
      ALLFLAG := FALSE;  <<INITIALIZE ALLFLAG>>                <<U.RAO>>04306000
      IF PP="@" THEN                                           <<U.RAO>>04308000
         BEGIN                                                 <<U.RAO>>04310000
         IF PP(1)="S" THEN                                     <<U.RAO>>04312000
            BEGIN                                              <<U.RAO>>04314000
            IF PLEN=3 AND PP(2)="'" THEN <<REINTRODUCED SPOOFLE<<U.RAO>>04316000
               JOBNUM := [2/0, 14/0]                           <<U.RAO>>04318000
            ELSE   <<REGULAR SESSIONS>>                        <<U.RAO>>04320000
               BEGIN                                           <<U.RAO>>04322000
               JOBNUM := [2/1, 14/0];   <<ALSO DEFAULT IF ERROR<<U.RAO>>04324000
               IF PLEN>2 THEN   <<EXTRA STUFF TACKED ON>>      <<U.RAO>>04326000
                  ERROR(SHOWFXPCTATS);                         <<U.RAO>>04328000
               END                                             <<U.RAO>>04330000
            END                                                <<U.RAO>>04332000
         ELSE IF PP(1)="J" THEN                                <<U.RAO>>04334000
            BEGIN                                              <<U.RAO>>04336000
            IF PLEN=3 AND PP(2)="'" THEN <<REINTRODUCED JOB SPO<<U.RAO>>04338000
               JOBNUM := [2/3, 14/0]                           <<U.RAO>>04340000
            ELSE   <<REGULAR JOB>>                             <<U.RAO>>04342000
               BEGIN                                           <<U.RAO>>04344000
               JOBNUM := [2/2, 14/0];                          <<U.RAO>>04346000
               IF PLEN>2 THEN   <<EXTRA STUFF, WARN AND IGNORE><<U.RAO>>04348000
                  ERROR(SHOWFXPCTATJ);                         <<U.RAO>>04350000
               END                                             <<U.RAO>>04352000
            END                                                <<U.RAO>>04354000
         ELSE   <<MUST BE @ OR @junk>>                         <<U.RAO>>04356000
            BEGIN                                              <<U.RAO>>04358000
            ALLFLAG := TRUE;                                   <<U.RAO>>04360000
            IF PLEN>1 THEN                                     <<U.RAO>>04362000
               BEGIN   <<EXTRA STUFF>>                         <<U.RAO>>04364000
               @PP := @PP+1;                                   <<U.RAO>>04366000
               ERROR(SHOWFUNKATX)                              <<U.RAO>>04368000
               END                                             <<U.RAO>>04370000
            END   <<PLAIN @ CASE>>                             <<U.RAO>>04372000
         END  <<ALL @ CASES>>                                  <<U.RAO>>04374000
      ELSE   <<A PARTICULAR JOB OR SESSION, EVIDENTLY>>        <<U.RAO>>04376000
         BEGIN                                                 <<U.RAO>>04378000
         IF PP="#" OR PP="J" OR PP="S" THEN                    <<U.RAO>>04380000
            BEGIN  <<LOOKS LIKE A SPECIFIC JOB #>>             <<U.RAO>>04382000
            JPRIME := 0;  <<REINITIALIZE IT>>                  <<U.RAO>>04384000
            IF PP="#" THEN                                     <<U.RAO>>04386000
               BEGIN                                           <<U.RAO>>04388000
               @PP := @PP+1;   <<MOVE PAST "#">>               <<U.RAO>>04390000
               PLEN := PLEN-1;                                 <<U.RAO>>04392000
               END;                                            <<U.RAO>>04394000
            IF PP="S" THEN   <<SESSIONS>>                      <<U.RAO>>04396000
               BEGIN                                           <<U.RAO>>04398000
               IF PP(1)="'" THEN   <<REINTRODUCED SESSION SPOOF<<U.RAO>>04400000
                  BEGIN                                        <<U.RAO>>04402000
                  JOBNUM.(0:2) := 0;                           <<U.RAO>>04404000
                  JPRIME := 1;                                 <<U.RAO>>04406000
                  END                                          <<U.RAO>>04408000
               ELSE   <<REGULAR SESSIONS>>                     <<U.RAO>>04410000
                  JOBNUM.(0:2) := 1;                           <<U.RAO>>04412000
              TOS:=BINARY(PP(1+JPRIME),INTEGER(PLEN)-1-JPRIME);<<U.RAO>>04414000
               IF <> OR NOT(1<=S0<=16383) THEN  <<PROBLEM>>    <<U.RAO>>04416000
                  BEGIN                                        <<U.RAO>>04418000
                  @PP := @PP+1+JPRIME;                         <<U.RAO>>04420000
                  ERROR(SHOWFXPCTSNUM);                        <<U.RAO>>04422000
                  DEL;  <<POP INVALID FILE NUMBER, >>          <<U.RAO>>04424000
                  TOS := 0;   <<DEFAULT TO ALL SESSIONS>>      <<U.RAO>>04426000
                  END;                                         <<U.RAO>>04428000
               JOBNUM.(2:14) := TOS;                           <<U.RAO>>04430000
               END <<PROCESSING OF SESSIONS>>                  <<U.RAO>>04432000
            ELSE IF PP="J" THEN  <<JOBS>>                      <<U.RAO>>04434000
               BEGIN                                           <<U.RAO>>04436000
               IF PP(1)="'" THEN   << REINTRODUCED JOB SPOOFLE><<U.RAO>>04438000
                  BEGIN                                        <<U.RAO>>04440000
                  JOBNUM.(0:2) := 3;                           <<U.RAO>>04442000
                  JPRIME := 1;                                 <<U.RAO>>04444000
                  END                                          <<U.RAO>>04446000
               ELSE   <<REGULAR JOBS>>                         <<U.RAO>>04448000
                  JOBNUM.(0:2) := 2;                           <<U.RAO>>04450000
              TOS:=BINARY(PP(1+JPRIME),INTEGER(PLEN)-1-JPRIME);<<U.RAO>>04452000
               IF <> OR NOT(1<=S0<=16383) THEN                 <<U.RAO>>04454000
                  BEGIN  <<INVALID FILE NUMBER>>               <<U.RAO>>04456000
                  @PP := @PP+1+JPRIME;                         <<U.RAO>>04458000
                  ERROR(SHOWFXPCTJNUM);                        <<U.RAO>>04460000
                  DEL;                                         <<U.RAO>>04462000
                  TOS := 0;                                    <<U.RAO>>04464000
                  END;                                         <<U.RAO>>04466000
               JOBNUM.(2:14) := TOS;                           <<U.RAO>>04468000
               END  <<JOB CASE>>                               <<U.RAO>>04470000
            ELSE  <<NOT JOB OR SESSION, ???>>                  <<U.RAO>>04472000
               BEGIN                                           <<U.RAO>>04474000
               ERROR(SHOWFXPCTJSNUM);                          <<U.RAO>>04476000
               ALLFLAG := TRUE;   <<DO ALL JOBS AND SESSIONS>> <<U.RAO>>04478000
               END                                             <<U.RAO>>04480000
            END                                                <<U.RAO>>04482000
         ELSE   <<NOT #, J, OR S>>                             <<U.RAO>>04484000
            BEGIN                                              <<U.RAO>>04486000
            ERROR(SHOWFXPCTJSNUM);                             <<U.RAO>>04488000
            ALLFLAG := TRUE;                                   <<U.RAO>>04490000
            END                                                <<U.RAO>>04492000
         END  <<PARTICULAR JOB CASE>>                          <<U.RAO>>04494000
      END  <<NON-NULL SUBPARAMETER CASE>>                      <<U.RAO>>04496000
   END;                                                        <<U.RAO>>04498000
END;  <<SUBROUTINE PARSEJOB>>                                  <<U.RAO>>04500000
                                                               <<U.RAO>>04502000
SUBROUTINE PARSESTATE;                                         <<U.RAO>>04504000
BEGIN                                                          <<U.RAO>>04506000
<<READY(,DEFERRED,NONDEFERRED), ACTIVE, LOCKED, OPENED>>       <<U.RAO>>04508000
IF (STATE <> NOSTATE) THEN                                     <<U.RAO>>04510000
   IF INTEGER(KEYDEFN(1)) <> STATE THEN <<INCONSISTENT SPECIFIC<<U.RAO>>04512000
      ERROR(-SHOWFREDNDSTATE);  <<OF STATES>>                  <<U.RAO>>04514000
STATE := KEYDEFN(1);                                           <<U.RAO>>04516000
DEF := NODEF;                                                  <<U.RAO>>04518000
IF PDEL = COMMA THEN   <<SUBPARAMETER SPECIFIED>>              <<U.RAO>>04520000
   BEGIN   <<EXPECTING EITHER N (NOT DEFFERED) OR D (DEFFERED) <<U.RAO>>04522000
   GETNEXT;   <<GET SUBPARAMETER>>                             <<U.RAO>>04524000
   IF NOT OUT THEN                                             <<U.RAO>>04526000
      ERROR(SHOWFINNDINAP)  <<INAPPROPRIATE FOR INPUT FILES>>  <<U.RAO>>04528000
   ELSE IF STATE<>DFREADY THEN  <<ONLY VALID FOR READY OUTFILES<<U.RAO>>04530000
      ERROR(SHOWFOUTNDINAP)                                    <<U.RAO>>04532000
   ELSE IF PLEN=1 AND PP="N" THEN                              <<U.RAO>>04534000
      DEF := NONDEFR                                           <<U.RAO>>04536000
   ELSE IF PLEN=1 AND PP="D" THEN                              <<U.RAO>>04538000
      DEF := DEFR                                              <<U.RAO>>04540000
   ELSE   <<UNKNOWN TYPE, IGNORE>>                             <<U.RAO>>04542000
      ERROR(SHOWFUNKDEFR)                                      <<U.RAO>>04544000
   END;                                                        <<U.RAO>>04546000
END;   <<SUBROUTINE PARSESTATE>>                               <<U.RAO>>04548000
                                                                        04550000
INTEGER SUBROUTINE DEMAND (ENTRYP);                                     04552000
   VALUE ENTRYP;                                                        04554000
   INTEGER POINTER ENTRYP;                                              04556000
<< DETERMINES "LOAD" THAT ODD SUBENTRY <ENTRYP> IMPOSES ON ITS          04558000
   ODD DEVICE/CLASS QUEUE.  I.E. HOW MUCH DOES/WILL THIS SUBENTRY       04560000
   DELAY FOLLOWING SUBENTRIES.  F (STATE, #COPIES, DEFERREDNESS,        04562000
   DEV/CL).  >>                                                         04564000
BEGIN                                                                   04566000
   DEMAND := 0;                                                         04568000
   COMMENT                                                     <<04176>>04570000
      A specific entry will not affect the "load" if it        <<04176>>04572000
      pertains to a file which is opened,active or deferred.   <<04176>>04574000
   ;                                                           <<04176>>04576000
   IF (ENTRYP(OD'STATE) <> DFOPENED) AND                       <<04176>>04578000
      (ENTRYP(OD'STATE) <> DFACTIVE) AND                       <<04176>>04580000
      (ENTRYP(OD'OUTPRI) > ODD'OUTFENCE) THEN                  <<04176>>04582000
      DEMAND := ENTRYP (OD'NUMCOPIES);                                  04584000
   END;    <<DEMAND>>                                                   04586000
                                                                        04588000
                                                                        04590000
INTEGER SUBROUTINE NEXTENTRY (ENTRYP);                                  04592000
   VALUE ENTRYP;                                                        04594000
   INTEGER POINTER ENTRYP;                                              04596000
<< RETURNS POINTER TO SUBENTRY FOLLOWING <ENTRYP> IN DEV/CL CHAIN.      04598000
   THIS IS NON-TRIVIAL WHEN SCANNING ALL ENTRIES AND ON THE CLASS       04600000
   CHAIN, BECAUSE IT'S NECESSARY TO RETURN THE NEXT ENTRY IN            04602000
   <ENTRYP>'S CLASS; AND VISIT ALL REPRESENTED CLASSES IN THIS          04604000
   WAY BEFORE FINALLY RETURNING 0.                                      04606000
   THIS SUBROUTINE ALSO MAINTAINS <RANK>, AS IT GOES DOWN CHAIN.        04608000
   RELIES ON <DEV>, <HEADP> AND <CURCLP>.  >>                           04610000
BEGIN                                                                   04612000
   IF  (DEV = 0)  AND  (HEADP (XD'HLDEV) = 0)  THEN                     04616000
      BEGIN    <<SCANNING ALL DEVS; AND ON CL CHAIN>>                   04618000
      IF OUT THEN RANK := RANK + DEMAND(ENTRYP);               <<04176>>04620000
      DO    <<GET NEXT ENTRY WITH SAME INDEX AS <CURCLP>'S >>           04622000
         @ENTRYP := ENTRYP (OD'LINKP)                                   04624000
      UNTIL  (@ENTRYP = 0)                                              04626000
            OR  (ENTRYP (OD'DEVICE) = CURCLP (OD'DEVICE));              04628000
      IF @ENTRYP = 0 THEN                                               04630000
         BEGIN    <<NO MORE ENTRIES OF SAME INDEX AS <CURCLP>.>>        04632000
         << BEGIN SCAN OF NEXT UNVISITED CLASS FF. <CURCLP>. >>         04634000
         DO BEGIN    <<ADVANCE <CURCLP> TO NEXT UNVISITED ENTRY>>       04636000
            CURCLPL (OD'HIT) := FALSE;    <<TURN OFF VISIT FLAG>>       04638000
            @CURCLP := CURCLP (OD'LINKP);                               04640000
            END                                                         04642000
         UNTIL  (@CURCLP = 0)  OR  (NOT (CURCLPL (OD'HIT)));            04644000
         << <CURCLP> AT NEXT UNVISITED CLASS, OR AT END. >>             04646000
         @ENTRYP := @CURCLP;                                            04648000
         RANK := 0;    <<NEW LOGICAL CHAIN FOR RANKING>>                04650000
         END;                                                           04652000
      IF (NEXTENTRY := @ENTRYP) <> 0 THEN ENTRYP (OD'HIT) := TRUE;      04654000
      END                                                               04656000
   ELSE                                                                 04658000
      BEGIN                                                    <<04176>>04660000
      IF OUT THEN                                              <<04176>>04662000
         COMMENT                                               <<04176>>04664000
            If we are scanning down a device chain or if       <<04176>>04666000
            we are scanning a class chain and class index      <<04176>>04668000
            corrresponds to the class index ( device ) of      <<04176>>04670000
            the current entry and the current entry is a       <<04176>>04672000
            class spoolfile, or if we scan device chain        <<04176>>04674000
            currently then compute rank.                       <<04176>>04676000
         ;                                                     <<04176>>04678000
         IF DEV > 0 OR                                         <<04176>>04680000
            ((DEV < 0) LAND                                    <<04176>>04682000
             (ENTRYP(OD'DEVICE) = -DEV) LAND                   <<04176>>04684000
             LOGICAL(ENTRYP(XD'C))) OR                         <<04176>>04686000
            HEADP(XD'HLDEV) <> 0 THEN                          <<04176>>04688000
            RANK := RANK + DEMAND(ENTRYP);                     <<04176>>04690000
      NEXTENTRY := ENTRYP (XD'LINKP);                                   04692000
      END;                                                     <<04176>>04694000
   END;    <<NEXTENTRY>>                                                04696000
                                                                        04698000
                                                                        04700000
INTEGER SUBROUTINE NEXTHEAD (HEADP);                                    04702000
   VALUE HEADP;                                                         04704000
   INTEGER POINTER HEADP;                                               04706000
<< RETURNS PNTR TO NEXT CHAIN (HEAD) TO SCAN.  DETERMINED BY            04708000
   VALUE OF <DEV>.  >>                                                  04710000
<< >>                                                                   04712000
   IF DEV > 0 THEN                                                      04714000
      << SPECIFIC DEVICE: SCAN NO OTHER CHAINS >>                       04716000
      NEXTHEAD := 0                                                     04718000
   ELSE                                                                 04720000
      IF DEV = 0 THEN                                                   04722000
         BEGIN  << ALL DEVICES: RETURN FOLLOWING CHAIN >>               04724000
         IF (NEXTHEAD := @HEADP +XDD'HEADSIZE) > @LASTHEADP THEN        04726000
            NEXTHEAD := 0;                                              04728000
         END                                                            04730000
      ELSE                                                              04732000
         BEGIN  << CLASS: RETURN CHAIN OF NEXT DEV IN CLASS >>          04734000
         NEXTHEAD := ARRQ0 (HEADPX) *XDD'HEADSIZE;                      04736000
         HEADPX := HEADPX -1;                                           04738000
         END;                                                           04740000
SUBROUTINE DEF'MOVEFROMDSEG;                                   <<00548>>04742000
SUBROUTINE DEF'MOVETODSEG;                                     <<00548>>04744000
LOGICAL SUBROUTINE PUTENTRY (DSTNUM,SOURCE,COUNT);             <<00548>>04746000
   VALUE DSTNUM,SOURCE,COUNT;                                  <<00548>>04748000
   LOGICAL DSTNUM,COUNT;                                       <<00548>>04750000
   LOGICAL POINTER SOURCE;                                     <<00548>>04752000
                                                               <<00548>>04754000
BEGIN                                                          <<00548>>04756000
   COMMENT:                                                    <<00548>>04758000
      MOVE 'COUNT' WORDS FROM 'SOURCE' TO THE NEXT             <<00548>>04760000
      LOCATION IN DST 'DSTNUM'.;                               <<00548>>04762000
   IF (ENDOFDATA+COUNT) <= DSTLENGTH THEN                      <<00548>>04764000
      BEGIN                                                    <<00548>>04766000
      PUTENTRY := TRUE;                                        <<00548>>04768000
      MOVETODSEG (DSTNUM,ENDOFDATA,SOURCE,COUNT);              <<00548>>04770000
      ENDOFDATA := ENDOFDATA +COUNT;                           <<00548>>04772000
      END                                                      <<00548>>04774000
   ELSE                                                        <<00548>>04776000
      BEGIN << OUT OF SPACE >>                                 <<00548>>04778000
      ERRNUM := SHOWSYSERR;                                    <<00548>>04780000
      PUTENTRY := FALSE;                                       <<00548>>04782000
      END;                                                     <<00548>>04784000
END;    <<PUTENTRY>>                                           <<00548>>04786000
LOGICAL SUBROUTINE GETENTRY (TARGET,DSTNUM,COUNT);             <<00548>>04788000
   VALUE TARGET,DSTNUM,COUNT;                                  <<00548>>04790000
   LOGICAL DSTNUM,COUNT;                                       <<00548>>04792000
   LOGICAL POINTER TARGET;                                     <<00548>>04794000
BEGIN                                                          <<00548>>04796000
   COMMENT:                                                    <<00548>>04798000
      MOVE THE NEXT 'COUNT' WORDS FROM DST 'DSTNUM'            <<00548>>04800000
      INTO 'SOURCE'.;                                          <<00548>>04802000
   IF NEXTLOC >= ENDOFDATA THEN GETENTRY := FALSE              <<00548>>04804000
   ELSE                                                        <<00548>>04806000
      BEGIN                                                    <<00548>>04808000
      GETENTRY := TRUE;                                        <<00548>>04810000
      MOVEFROMDSEG (TARGET,DSTNUM,NEXTLOC,COUNT);              <<00548>>04812000
      NEXTLOC := NEXTLOC + COUNT;                              <<00548>>04814000
      END;                                                     <<00548>>04816000
END;    <<GETENTRY>>                                           <<00548>>04818000
                                                                        04820000
                                                                        04822000
SUBROUTINE INCRCOUNTS;                                                  04824000
<< UPDATES COUNTS FOR FINAL/"STATUS" REPORT >>                          04826000
BEGIN                                                                   04828000
   ST := ENTRYP (XD'STATE);                                             04830000
   << UPDATE STATE COUNT >>                                             04832000
   STCOUNTS (ST) := STCOUNTS (ST) +1;                                   04834000
   IF  OUT  AND  (ENTRYP (OD'OUTPRI) <= ODD'OUTFENCE)  THEN             04836000
      << UPDATE DEFERRED COUNT >>                                       04838000
      DEFCOUNTS (ST) := DEFCOUNTS (ST) +1;                              04840000
 IF ENTRYP (XD'SPOOLFILE) <> 0 THEN                                     04842000
    BEGIN    <<UPDATE SPOOFLE COUNTS>>                                  04844000
    SPCOUNTS (ST) := SPCOUNTS (ST) +1;                                  04846000
    TOS := ENTRYP(XD'NUMEXT);                                           04848000
    IF = THEN TOS := TOS+2;                                             04850000
    TOS := LOGICAL(TOS-1) ** ABSYS'EXTSSECT;                            04852000
    TOS := TOS+DOUBLE(ENTRYP(XD'LASTEXT));                              04854000
    SPSPACE := TOS +SPSPACE;                                            04856000
    END;                                                                04858000
   END;    <<INCRCOUNTS>>                                               04860000
                                                                        04862000
                                                                        04864000
SUBROUTINE VISITENTRY;                                                  04866000
<< WRITES <ENTRYP> OUT TO TEMPORARY FILE.  REPLACES LINK WITH           04868000
   ENTRY'S RANK (FROM <RANK>) FOR OUTPUT SUBENTRIES. >>                 04870000
BEGIN                                                                   04872000
   SAVELINK := ENTRYP (OD'RANK);                                        04874000
   IF OUT THEN                                                          04876000
      BEGIN                                                             04878000
      IF DEMAND (ENTRYP) > 0 THEN TOS := RANK +1                        04880000
      ELSE TOS := 0;                                                    04882000
      ENTRYP (OD'RANK) := TOS;                                          04884000
      END;                                                              04886000
   IF NOT PUTENTRY (DSTNUM,ENTRYP,XDD'SUBSIZE) THEN            <<00548>>04888000
      STOP := TRUE;                                            <<00548>>04890000
   INCRCOUNTS;                                                 <<00548>>04892000
   ENTRYP (OD'RANK) :=  SAVELINK;                                       04894000
   END;    <<VISITENTRY>>                                               04896000
                                                                        04898000
                                                                        04900000
SUBROUTINE WRITE (LEN, CONTROL);                                        04902000
   VALUE LEN, CONTROL;                                                  04904000
   INTEGER LEN, CONTROL;                                                04906000
<< PRINTS (OBUF, <LEN>, <CONTROL>); TAKING INTO ACCOUNT BREAK           04908000
   REQUEST AND ERROR (IN WHICH CASES IT GOES TO LEAVE).  >>             04910000
BEGIN                                                                   04912000
   IF REQUESTSERVICE THEN GOTO LEAVE;                                   04914000
   PRINT (OBUF, LEN, CONTROL);                                          04916000
   IF <> THEN GOTO LEAVE;                                               04918000
   END;    <<WRITE>>                                                    04920000
                                                               <<00548>>04922000
LOGICAL SUBROUTINE ALLOCATEDST (DSTNUM,DSTSIZE);               <<00548>>04924000
   INTEGER DSTNUM, DSTSIZE;                                    <<00548>>04926000
BEGIN                                                          <<00548>>04928000
   COMMENT:                                                    <<00548>>04930000
      ALLOCATEDST= TRUE:  DATA-SEG ALLOCATED                   <<00548>>04932000
                   FALSE: COULD NOT ALLOCATE DATA-SEG,         <<00548>>04934000
                          ERRNUM SET TO APPRORIATE             <<00548>>04936000
                          VALUE.                               <<00548>>04938000
      WE USE (CALLABLE) 'GETDSEG' HERE SO THAT DATA-SEG        <<00548>>04940000
      WILL BE RELEASED AUTOMATICALLY IF PROCESS TERMINATES     <<00548>>04942000
      ABNORMALLY.;                                             <<00548>>04944000
                                                               <<00548>>04946000
   ALLOCATEDST := TRUE;                                        <<00548>>04948000
   GETDSEG (DSTNUM,DSTSIZE,0);                                 <<00548>>04950000
   IF <> THEN                                                  <<00548>>04952000
      BEGIN                                                    <<00548>>04954000
      ERRNUM := IF > OR DSTNUM=%2000 THEN SHOWSYSERR           <<00548>>04956000
                ELSE IF DSTNUM=%2001 THEN SHOWNODST            <<00548>>04958000
                ELSE SHOWNOVDS;                                <<00548>>04960000
      ALLOCATEDST:=DSTNUM:=0;                                  <<00548>>04962000
      END;                                                     <<00548>>04964000
END;    <<ALLOCATEDST>>                                        <<00548>>04966000
<< PARSE COMMAND >>                                                     04968000
                                                                        04970000
SHOWFILES := 0;  <<NO ERROR NUMBER SO FAR>>                    <<U.RAO>>04972000
JOBNUM := INJOBNUM;  <<INIT FOR INDIVIDUAL USERS>>             <<U.RAO>>04974000
IF INJOBNUM=0 THEN   <<CONSOLE COMMAND>>                       <<U.RAO>>04976000
   ALLFLAG := TRUE;  <<INITIALIZE TO ALL FILES>>               <<U.RAO>>04978000
MOVE KEYWORDSW := KEYWORDSPW, (KEYLEN);                        <<U.RAO>>04980000
MYCOMMAND(PARMSTRING,,MAXPARMS,NUMPARMS,PARMS(1));             <<U.RAO>>04982000
IF NUMPARMS>0 THEN   <<SOMETHING THERE, PARSE IT>>             <<U.RAO>>04984000
   BEGIN                                                       <<U.RAO>>04986000
   PARM := PARMS(PNUM:=1);  <<GET FIRST PARM>>                 <<U.RAO>>04988000
   IF PP="#" THEN  <<PROBABLY A PARTICULAR DEVICEFILE>>        <<U.RAO>>04990000
      BEGIN                                                    <<U.RAO>>04992000
      ALLFLAG := TRUE;  <<INITIALIZE IN CASE OF ERROR>>        <<U.RAO>>04994000
      IF (PP(1) <> "I") AND NOT OUT THEN                       <<01651>>04996000
         ERROR(SHOWFXPCTIDEVFL)                                <<U.RAO>>04998000
      ELSE IF (PP(1) <> "O") AND OUT THEN                      <<01651>>05000000
         ERROR(SHOWFXPCTODEVFL)                                <<U.RAO>>05002000
      ELSE  <<APPROPRIATE REQUEST>>                            <<U.RAO>>05004000
         BEGIN  <<CHECK FOR ID NUMBER>>                        <<U.RAO>>05006000
         ALLFLAG := FALSE;                                     <<U.RAO>>05008000
         DFID := BINARY(PP(2), PLEN-2);                        <<U.RAO>>05010000
         IF <> OR DFID<0 THEN                                  <<U.RAO>>05012000
            BEGIN                                              <<U.RAO>>05014000
            ERROR(SHOWFINVLDDFID);                             <<U.RAO>>05016000
            DFID := 0;  <<REINITIALIZE>>                       <<U.RAO>>05018000
            END                                                <<U.RAO>>05020000
         END;                                                  <<U.RAO>>05022000
      IF NUMPARMS>1 THEN                                       <<U.RAO>>05024000
         BEGIN  <<TOO MANY PARMS>>                             <<U.RAO>>05026000
         PARM := PARMS(PNUM:=2);                               <<U.RAO>>05028000
         ERROR(SHOWFXTRAIGNORD);                               <<U.RAO>>05030000
         END;                                                  <<U.RAO>>05032000
      END                                                      <<U.RAO>>05034000
   ELSE  <<REGULAR PARMS, TO BE REGULARLY PARSED>>             <<U.RAO>>05036000
      BEGIN                                                    <<U.RAO>>05038000
      PNUM := 0;                                               <<U.RAO>>05040000
      PARMNUM := 0;                                            <<U.RAO>>05042000
      DO BEGIN  <<UNTIL NO MORE KEYWORDS>>                     <<U.RAO>>05044000
         GETNEXT;                                              <<U.RAO>>05046000
         IF PLEN <> 0 THEN   <<NOT AN EXTRANEOUS DELIMITER>>   <<U.RAO>>05048000
            BEGIN                                              <<U.RAO>>05050000
            IF SEARCH(PP,PLEN,KEYWORDS,KEYDEFN)=0 THEN         <<U.RAO>>05052000
               ERROR(SHOWFUNKKEY)                              <<U.RAO>>05054000
            ELSE  <<VALID KEYWORD>>                            <<U.RAO>>05056000
               CASE *INTEGER(KEYDEFN) OF                       <<U.RAO>>05058000
               BEGIN   <<LOOK AT INDIVIDUAL PARAMETERS>>       <<U.RAO>>05060000
                                                               <<U.RAO>>05062000
                  ;  <<CAN'T HAPPEN>>                          <<U.RAO>>05064000
                                                               <<U.RAO>>05066000
                  PARSEDEV;    <<DEV PARAMETER>>               <<U.RAO>>05068000
                                                               <<U.RAO>>05070000
                  PARSEJOB;    <<JOB PARAMETER>>               <<U.RAO>>05072000
                                                               <<U.RAO>>05074000
                  PARSESTATE;  <<READY, ACTIVE, OPENED, LOCKED><<U.RAO>>05076000
                                                               <<U.RAO>>05078000
                  BEGIN        <<STATUS PARAMETER>>            <<U.RAO>>05080000
                  IF NUMPARMS <> 1 THEN  <<OTHER PARMS INAPPROP<<U.RAO>>05082000
                     ERROR(SHOWFSTATSIGNRD)                    <<U.RAO>>05084000
                  ELSE                                         <<U.RAO>>05086000
                     STATUS := TRUE;                           <<U.RAO>>05088000
                  END;                                         <<U.RAO>>05090000
                                                               <<U.RAO>>05092000
                  SP := TRUE;  <<ALL SPOOLED FILES, SP>>       <<U.RAO>>05094000
                                                               <<U.RAO>>05096000
               END;                                            <<U.RAO>>05098000
            END                                                <<U.RAO>>05100000
         END                                                   <<U.RAO>>05102000
      UNTIL (PDEL<>SEMI) OR STOP;                              <<U.RAO>>05104000
      IF (PDEL<>CR) AND NOT STOP THEN  <<UNKNOWN JUNK IN STRING<<U.RAO>>05106000
         BEGIN                                                 <<U.RAO>>05108000
         PARM := PARMS(PNUM:=PNUM+1);                          <<U.RAO>>05110000
         ERROR(SHOWFXTRANPARMS);                               <<U.RAO>>05112000
         END;                                                  <<U.RAO>>05114000
      END;                                                     <<U.RAO>>05116000
   PARMNUM := PNUM := 0;  <<SUCCESSFUL PARSE>>                 <<U.RAO>>05118000
   STOP := FALSE;                                              <<U.RAO>>05120000
   END;   <<PARSER>>                                           <<U.RAO>>05122000
                                                                        05124000
   STCOUNTS := 0;                                                       05126000
   STCOUNTS (1) := 0;                                                   05128000
   STCOUNTS (2) := 0;                                                   05130000
   STCOUNTS (3) := 0;                                                   05132000
   MOVE DEFCOUNTS := STCOUNTS, (4);                                     05134000
   MOVE SPCOUNTS := STCOUNTS, (4);                                      05136000
   IF OUT THEN                                                          05138000
      BEGIN                                                             05140000
      DFID.(0:1) := 1;                                                  05142000
      TOS := ODDDST;                                                    05144000
      TOS := ODDSIR;                                                    05146000
      END                                                               05148000
   ELSE                                                                 05150000
      BEGIN                                                             05152000
      TOS := IDDDST;                                                    05154000
      TOS := IDDSIR;                                                    05156000
      END;                                                              05158000
   XDDSIR := TOS;                                                       05160000
   SAVESIR := GETSIR (XDDSIR);                                 <<00548>>05162000
      TOS := @DSTLENGTH;              <<DB REL ADDRESS>>       <<00548>>05164000
      TOS := S1;                      <<XDDDST>>               <<00170>>05166000
      TOS := 0;                       <<XDD OFFSET>>           <<00170>>05168000
      TOS := 1;                       << 1 WORD >>             <<00170>>05170000
      ASSEMBLE(MFDS);   <<GET LENGTH OF XDD TBL FOR FOPEN>>    <<00170>>05172000
      DSTLENGTH := DSTLENGTH.(8:8)*TBLQUANTUM; <<CUR TAB SIZE>><<00548>>05174000
      IF NOT ALLOCATEDST (DSTNUM,DSTLENGTH) THEN               <<00548>>05176000
         BEGIN                                                 <<00548>>05178000
         DEL;                                                  <<00548>>05180000
         RELSIR (XDDSIR,SAVESIR);                              <<00548>>05182000
         FATALERROR;                                           <<00548>>05184000
         END                                                   <<00548>>05186000
      ELSE ENDOFDATA := 0; <<NEXT AVAIL WORD IN DST>>          <<00548>>05188000
   EXCHANGEDB (S0);                                                     05190000
   DEL;                                                                 05192000
   OUTFENCE := ODD'OUTFENCE;                                            05194000
   IF DFID.(1:15) <> 0 THEN                                             05196000
      BEGIN    <<DEVICEFILEID SEARCH>>                                  05198000
      @ENTRYP := @XDD'SUBAREAP;                                         05200000
      @LIMITP := XDD'CURSIZE *TBLQUANTUM -XDD'SUBSIZE;                  05202000
      DO                                                                05204000
      UNTIL  (ENTRYP <> 0)  AND  (ENTRYP (XD'DEVFILEID) = DFID)         05206000
            OR  ((@ENTRYP := @ENTRYP +XDD'SUBSIZE) > @LIMITP);          05208000
      IF = THEN                                                         05210000
         BEGIN    <<FOUND ENTRY>>                                       05212000
         IF  OUT  AND  (DEMAND (ENTRYP) > 0)  THEN                      05214000
            BEGIN    <<RANKED FILE: CALCULATE RANK>>                    05216000
            @HEADP := ENTRYP (OD'XDDHEADX) *ODDHSIZE;                   05218000
            @TEMPP := HEADP (XD'HHEADP);                                05220000
            << SCAN DOWN CHAIN LOOKING FOR THIS SUBENTRY >>             05222000
            WHILE @TEMPP <> @ENTRYP DO                                  05224000
               BEGIN                                                    05226000
               COMMENT                                         <<04176>>05228000
                  If scan occurs along the class chain         <<04176>>05230000
                  rank is counted only within the same class.  <<04176>>05232000
                  The "device" field in the ODD, can be a      <<04176>>05234000
                  class index or a device, depending on        <<04176>>05236000
                  the class bit being on.                      <<04176>>05238000
               ;                                               <<04176>>05240000
               IF TEMPP(OD'DEVICE) = ENTRYP(OD'DEVICE) THEN    <<04176>>05242000
                  RANK := RANK + DEMAND(TEMPP);                <<04176>>05244000
               @TEMPP := TEMPP (XD'LINKP);                              05246000
               END;                                                     05248000
            END;                                                        05250000
         VISITENTRY;                                                    05252000
         END;                                                           05254000
      END                                                               05256000
   ELSE                                                                 05258000
      BEGIN    <<VISIT EVERY ENTRY SATISFYING <DEV>, <JOB>, <STATE>>    05260000
      << SET UP FOR SCAN OF ENTRIES IN SET OF CHAINS >>                 05262000
      @HEADP := ODDCLASSHEADX *XDD'HEADSIZE;                            05264000
      IF DEV = 0 THEN                                                   05266000
         BEGIN    <<SCAN ALL DEV CHAINS>>                               05268000
         IF NOT (OUT) THEN @HEADP := @HEADP +IDD'HEADSIZE               05270000
         ELSE @CURCLP := HEADP (OD'HHEADP);  <<FOR CLASS SCAN>>         05272000
         END                                                            05274000
      ELSE                                                              05276000
         << SPECIFIC DEVICE/CLASS >>                                    05278000
         IF DEV > 0 THEN                                                05280000
            <<PARTICULAR DEVICE; GET HEADX FORM LDT ENTRY>>             05282000
            @HEADP := DEVINFO (4 +LD'XDDHEADX) *XDD'HEADSIZE            05284000
         ELSE                                                           05286000
            BEGIN  << CLASS: FORM Q-REL, STACK ARRAY OF ITS DEVS >>     05288000
            EXCHANGEDB (LDTDST);                                        05290000
            @CLASSP := @LDT'DCTP;                                       05292000
            << FIND CLASS ENTRY >>                                      05294000
            CLX := DEV;                                                 05296000
            WHILE (CLX := CLX +1) < 0 DO                                05298000
               @CLASSP := @CLASSP +(CLASSP (DC'NUMDEVS) &ASR(1)) +6;    05300000
            << LOAD CLASS' DEVS' HEADPS ON TOS. TERMINATED BY 0. >>     05302000
            TOS := 0;                                                   05304000
            NUMDEVS := CLASSP (DC'NUMDEVS);                             05306000
            @CLASSPB := @CLASSP &LSL(1) +DC'FIRSTDEV'B;                 05308000
            WHILE (NUMDEVS := NUMDEVS -1) >= 0 DO                       05310000
               TOS := ARRDB0                                            05312000
                     (CLASSPB (NUMDEVS) *LDTSIZE +LD'XDDHEADX);         05314000
            EXCHANGEDB (IF OUT THEN ODDDST ELSE IDDDST);                05316000
            << CALC Q-REL INDEX OF LAST ELEMENT >>                      05318000
            PUSH (S, Q);                                                05320000
            HEADPX := TOS -TOS;                                         05322000
            << HEADP ALREADY SET (TO CLASS CHAIN) >>                    05324000
            END;                                                        05326000
      << <HEADP> NOW SET PROPERLY FOR SCAN >>                           05328000
      @LASTHEADP := @XDD'SUBAREAP -XDD'HEADSIZE;                        05330000
      IF STATUS THEN                                                    05332000
         BEGIN                                                          05334000
         DO BEGIN                                                       05336000
            @ENTRYP := HEADP (XD'HHEADP);                               05338000
            WHILE (@ENTRYP <> 0) DO                                     05340000
               BEGIN                                                    05342000
                  INCRCOUNTS;                                  <<U.RAO>>05344000
               @ENTRYP := ENTRYP (XD'LINKP);                            05346000
               END;                                                     05348000
            END                                                         05350000
         UNTIL (@HEADP := @HEADP +XDD'HEADSIZE) > @LASTHEADP;           05352000
         END                                                            05354000
      ELSE                                                              05356000
         << DO QUALIFIED VISITING >>                                    05358000
         DO BEGIN                                                       05360000
            @ENTRYP := HEADP (XD'HHEADP);                               05362000
            WHILE  (@ENTRYP <> 0)  AND  (NOT (STOP)) DO                 05364000
               BEGIN    <<CHECK 2 C IF THIS SUBE SATISFIES>>            05366000
               IF  (DEV = 0)    << ALL >>                               05368000
               OR  (HEADP (XD'HLDEV) <> 0)    << SPECIFIC DEV >>        05370000
               OR  (-DEV = ENTRYP (OD'DEVICE))  THEN                    05372000
                  << SATSIFIES CLASS >>                                 05374000
                  IF ALLFLAG    <<ALL FILES>>                  <<U.RAO>>05376000
                  OR  (ENTRYP (XD'JOBNUM) = 0)    << READY/INTRO :DATA>>05378000
                  OR  (JOBNUM.(2:14) = 0)                               05380000
                        AND  (JOBNUM.(0:2) = ENTRYP (XD'JTYPE))         05382000
                  OR  (JOBNUM = ENTRYP (XD'JOBNUM))  THEN               05384000
                     << SATISIFIES JOB >>                               05386000
                     IF  (STATE = NOSTATE)                              05388000
                     OR  (STATE = ENTRYP (XD'STATE))  THEN              05390000
                        << SATISFIES STATE >>                           05392000
                        IF  (DEF = NODEF)                               05394000
                        OR  (DEF = DEFR)                                05396000
                              AND  (ENTRYP (OD'OUTPRI) <= ODD'OUTFENCE) 05398000
                        OR  (DEF = NONDEFR)                             05400000
                              AND  (ENTRYP (OD'OUTPRI) > ODD'OUTFENCE)  05402000
                        THEN                                            05404000
                           IF  (NOT (SP))                               05406000
                           OR  (ENTRYP (XD'SPOOLFILE)  <> 0) THEN       05408000
                              << SATISFIED ALL QUALIFICATIONS >>        05410000
                              VISITENTRY;                               05412000
               @ENTRYP := NEXTENTRY (ENTRYP);                           05414000
               END;    <<ENTRY PROCESSING>>                             05416000
            << DONE SCAN OF CHAIN >>                                    05418000
            RANK := 0;                                                  05420000
            END                                                         05422000
         UNTIL ((@HEADP := NEXTHEAD (HEADP)) = 0) OR STOP;              05424000
      END;    <<QUALIFIED VISITING>>                                    05426000
                                                                        05428000
   RELSIR (XDDSIR, SAVESIR);                                            05430000
   EXCHANGEDB (0);                                                      05432000
   IF STOP THEN FATALERROR;                                    <<00548>>05434000
                                                                        05436000
<< PRINT PHASE >>                                                       05438000
                                                                        05440000
   IF ((TOTAL := STCOUNTS +STCOUNTS(1) +STCOUNTS(2)) <> 0)              05442000
         AND  (NOT (STATUS))  THEN                                      05444000
      BEGIN    <<PRINT FILE INFO>>                                      05446000
      WRITE (0, 0);                                                     05448000
      GENMSG(CIGENERALMSGSET, SHOWFHEADER);  <<PUT OUT HEADING><<U.RAO>>05450000
      NEXTLOC := 0;  <<LOC OF NEXTENTRY IN DST>>               <<00548>>05452000
      WHILE GETENTRY(EBUF,DSTNUM,XDDSIZE) DO                   <<00548>>05454000
         BEGIN                                                          05456000
         OBUF := "  ";                                                  05458000
         MOVE OBUF (1) := OBUF, (OBUFMAX);                              05460000
                                                                        05462000
         << DEV/CL>>                                                    05464000
         DEVSPEC ((IF EBUFL (XD'C) THEN -EBUF (OD'DEVICE)               05466000
               ELSE EBUF (XD'DEVICE)), OBUFB (POSDEVCL));               05468000
                                                                        05470000
         << DEVICE FILE ID >>                                           05472000
         OBUFB (POSDFID) := "#";                                        05474000
         OBUFB (POSDFID +1) := IF OUT THEN "O" ELSE "I";                05476000
         ASCII (EBUF (XD'DEVFILEID).(1:15), 10, OBUFB (POSDFID +2));    05478000
                                                                        05480000
         << JOB NUM >>                                                  05482000
         IF EBUF (XD'JOBNUM) <> 0 THEN                                  05484000
            BEGIN    <<NOT INTRO/READY :DATA>>                          05486000
            OBUFB (POSJNUM) := "#";                                     05488000
            OBUFB (POSJNUM +1) :=                                       05490000
                  IF EBUF (XD'JTYPE) <= SESSIONTYPE THEN "S" ELSE "J";  05492000
            JPRIME := 0;                                                05494000
            IF NOT (SESSIONTYPE<=EBUF(XD'JTYPE)<=BATCHTYPE) THEN        05496000
               BEGIN                                                    05498000
               JPRIME := 1;                                             05500000
               OBUFB(POSJNUM+2) := "'";                                 05502000
               END;                                                     05504000
            ASCII (EBUF (XD'JNUM), 10, OBUFB (POSJNUM +2 +JPRIME));     05506000
            END;                                                        05508000
                                                                        05510000
         << FILE NAME >>                                                05512000
         TOS := @OBUFB (POSFNAME);                                      05514000
         TOS := @EBUF (XD'FNAME) &LSL(1);                               05516000
         MOVE * := *, (8);                                              05518000
                                                                        05520000
         << STATE >>                                                    05522000
         MOVE OBUFB (POSSTATE) := STATES (EBUF (XD'STATE) *6), (6);     05524000
                                                                        05526000
         << FORMS >>                                                    05528000
         IF EBUFL (XD'TEF) THEN OBUFB (POSFORMS) := "F";                05530000
                                                                        05532000
         << SPOOFLE EXTENSION >>                                        05534000
         IF EBUF (XD'SPOOLFILE)  <> 0 THEN                              05536000
            BEGIN    <<SPOOFLE>>                                        05538000
            TOS := 0;                                                   05540000
            TOS := EBUF(XD'NUMEXT);                                     05542000
            IF = THEN TOS := TOS+2;                                     05544000
            TOS := LOGICAL(TOS-1) ** ABSYS'EXTSSECT;                    05546000
            TOS := TOS+DOUBLE(EBUF(XD'LASTEXT));                        05548000
            LEN := DASCII (*, 10, SPACEBUF);                            05550000
            MOVE OBUFB (POSSPACE) := SPACEBUF (LEN-1), (-LEN);          05552000
                                                                        05554000
            << OUTPUT SPOOFLE EXTENSION >>                              05556000
            IF OUT THEN                                                 05558000
               BEGIN                                                    05560000
                                                                        05562000
               << RANK >>                                               05564000
               IF (EBUF(OD'RANK) <> 0) AND                     <<04176>>05566000
                  (EBUF(OD'STATE) <> DFACTIVE) THEN            <<04176>>05568000
                  ASCII (EBUF (OD'RANK), -10, OBUFB (POSRANK));         05570000
                                                                        05572000
               << DEFERRED AND OUTPRI >>                                05574000
               IF EBUF (OD'OUTPRI) <= OUTFENCE THEN                     05576000
                  OBUFB (POSDEFPRI) := "D";                             05578000
               ASCII (EBUF (OD'OUTPRI), -10, OBUFB (POSDEFPRI +2));     05580000
                                                                        05582000
               << NUM COPIES >>                                         05584000
               ASCII (EBUF (OD'NUMCOPIES), -10, OBUFB (POSNUMC));       05586000
                                                                        05588000
               LEN := POSNUMC +1;                                       05590000
               END    <<OUTPUT SPOOFLE EXTENSION>>                      05592000
            ELSE                                                        05594000
               LEN := POSSPACE +1;                                      05596000
            END    <<SPOOFLE EXTENSION>>                                05598000
         ELSE                                                           05600000
            BEGIN    <<CALC PRINT LENGTH: NO EXTENSION>>                05602000
            SCAN OBUFB (POSSTATE) UNTIL " ", 1;                         05604000
            LEN := TOS -@OBUFB;                                         05606000
            END;                                                        05608000
                                                                        05610000
         WRITE (-LEN, 0);                                               05612000
         IF EBUF (XD'JOBNUM) = 0 THEN                                   05614000
            BEGIN    <<ACTIVE/READY :DATA>>                             05616000
            OBUF := "  ";                                               05618000
            MOVE OBUF (1) := OBUF, ((POSJNAME +1) &ASR(1));             05620000
            TOS := @OBUFB(POSJNAME) +FORMNAME(2,OBUFB          <<02.EB>>05622000
               (POSJNAME),EBUFB(20),EBUFB(4),EBUFB(12),        <<02.EB>>05624000
               EBUFB);<<JOBN,USERN,ACCTN>>                     <<02.EB>>05626000
            MOVE BPS0 := "; ", 2;                                       05628000
            TOS := (@EBUF (ID'FNAME)) &LSL(1);                          05630000
            MOVE * := *, (8);                                           05632000
            WRITE (-S0 +@OBUFB, 0);                                     05634000
            DEL;                                                        05636000
            END;                                                        05638000
         END;                                                           05640000
                                                                        05642000
      WRITE (0, 0);                                                     05644000
      END;                                                              05646000
                                                                        05648000
                                                                        05650000
<< SUMMARY >>                                                           05652000
   IF  STATUS  OR  (TOTAL > 1)  THEN                                    05654000
      BEGIN    <<PRINT SUMMARY INFO>>                                   05656000
      IF NOT STATUS AND (NUMPARMS>0) THEN  <<SUBSET>>          <<U.RAO>>05658000
         GENMSG(CIGENERALMSGSET,SHOWFFILECNTDSP,%10000,TOTAL)  <<U.RAO>>05660000
      ELSE   <<ALL>>                                           <<U.RAO>>05662000
         GENMSG(CIGENERALMSGSET,SHOWFFILECNT,%10000,TOTAL);    <<U.RAO>>05664000
      IF STATE = NOSTATE THEN                                           05666000
         BEGIN    <<ALL STATES DISPLAYED>>                              05668000
                                                                        05670000
         << ACTIVE >>                                                   05672000
         GENMSG(CIGENERALMSGSET,SHOWFACTIVECNT,%10000,         <<U.RAO>>05674000
            STCOUNTS(DFACTIVE));                               <<U.RAO>>05676000
                                                                        05678000
         << READY >>                                                    05680000
         GENMSG(CIGENERALMSGSET, SHOWFREADYCNT, %11100,        <<U.RAO>>05682000
            STCOUNTS(DFREADY), SPCOUNTS(DFREADY), DEFCOUNTS(DFREADY));  05684000
                                                                        05686000
         << OPENED >>                                                   05688000
         GENMSG(CIGENERALMSGSET, SHOWFOPENEDCNT, %11000,       <<U.RAO>>05690000
            STCOUNTS(DFOPENED), SPCOUNTS(DFOPENED));           <<U.RAO>>05692000
                                                                        05694000
         << LOCKED>>                                                    05696000
         GENMSG(CIGENERALMSGSET, SHOWFLOCKEDCNT, %11000,       <<U.RAO>>05698000
            STCOUNTS(DFLOCKED), SPCOUNTS(DFLOCKED));           <<U.RAO>>05700000
                                                                        05702000
         END                                                            05704000
      ELSE                                                              05706000
         IF STATE=DFREADY THEN  <<JUST PRINT NUMBER READY>>    <<U.RAO>>05708000
            GENMSG(CIGENERALMSGSET, SHOWFDEFCNT, %10000,       <<U.RAO>>05710000
               DEFCOUNTS(DFREADY));                            <<U.RAO>>05712000
                                                                        05714000
      << NUM SPOOFLES >>                                                05716000
      GENMSG(CIGENERALMSGSET, SHOWFSPOOFLECNT, %12000,         <<U.RAO>>05718000
        SPCOUNTS+SPCOUNTS(1)+SPCOUNTS(2)+SPCOUNTS(3),@SPSPACE);<<U.RAO>>05720000
      END                                                               05722000
   ELSE                                                                 05724000
      IF TOTAL = 0 THEN                                                 05726000
         GENMSG(CIGENERALMSGSET, SHOWFNOSUCHFLS);  <<NO SUCH FI<<U.RAO>>05728000
   IF OUT THEN                                                          05730000
    BEGIN                                                      <<00874>>05732000
      GENMSG(CIGENERALMSGSET, SHOWFOUTFENCE, %10000, OUTFENCE);<<U.RAO>>05734000
       DEV := 0;                                               <<00874>>05736000
       @HEADP := 8;  <<INITIALIZE XDD HEAD POINTER>>           <<00874>>05738000
       <<COPY THE HEAD PART OF ODD TO EXTRA DST>>              <<00874>>05740000
       SAVESIR := GETSIR(ODDSIR);                              <<00874>>05742000
       MOVEFROMDSEG( DSTLENGTH,ODDDST,2,1); <<SUBAREAP>>       <<00874>>05744000
       TOS := DSTNUM;                                          <<00874>>05746000
       TOS := 0;                                               <<00874>>05748000
       TOS := ODDDST;                                          <<00874>>05750000
       TOS := 0;                                               <<00874>>05752000
       TOS := DSTLENGTH;                                       <<00874>>05754000
       ASSEMBLE(MDS 5);                                        <<00874>>05756000
       RELSIR(ODDSIR,SAVESIR);                                 <<00874>>05758000
       EXCHANGEDB(DSTNUM);                                     <<00874>>05760000
       << WE ARE NOW POINTING DB AT OUR XTRA DST>>             <<00874>>05762000
       @LASTHEADP := @XDD'SUBAREAP -XDD'HEADSIZE;              <<00914>>05764000
       DO                                                      <<00874>>05766000
       BEGIN                                                   <<00874>>05768000
          DEVFENCE := HEADP(XD'HOUTFENCE);                     <<00874>>05770000
          DEVINHEAD := HEADP(XD'HLDEV);                        <<00874>>05772000
          IF DEVFENCE <> 0 THEN                                <<00874>>05774000
          BEGIN                                                <<00874>>05776000
             EXCHANGEDB(0);                                    <<00874>>05778000
             GENMSG(CIGENERALMSGSET,SHOWFDEVFENCE,%11000,      <<00874>>05780000
                DEVFENCE,DEVINHEAD);                           <<00874>>05782000
             EXCHANGEDB(DSTNUM);                               <<00874>>05784000
          END;                                                 <<00874>>05786000
       END                                                     <<00874>>05788000
       UNTIL ((@HEADP := NEXTHEAD(HEADP))=0);                  <<00874>>05790000
       EXCHANGEDB(0);                                          <<00874>>05792000
    END;                                                       <<00874>>05794000
                                                                        05796000
LEAVE:                                                                  05798000
   IF DSTNUM <> 0 THEN FREEDSEG (DSTNUM,0);;                   <<00548>>05800000
   END;    <<SHOWFILES>>                                                05802000
                                                                        05804000
                                                                        05806000
LOGICAL PROCEDURE CONSSHOWIN  <<& CONSSHOWOUT>>  (PARMSTRING);          05808000
   BYTE ARRAY PARMSTRING;                                               05810000
   OPTION PRIVILEGED,UNCALLABLE;                               <<00179>>05812000
BEGIN                                                                   05814000
   ENTRY CONSSHOWOUT;                                                   05816000
   LOGICAL OUT := TRUE;                                                 05818000
   INTEGER PN;                                                          05820000
                                                                        05822000
   OUT := FALSE;                                                        05824000
CONSSHOWOUT:                                                            05826000
   CONSSHOWIN := (SHOWFILES (PARMSTRING, PN, 0, OUT) = 0);              05828000
   END;    <<CONSSHOWIN/ CONSSHOWOUT>>                                  05830000
                                                                        05832000
                                                                        05834000
PROCEDURE CXSHOWIN  <<AND CXSHOWOUT>>  (PARMSP, ERRNUM, PARMNUM);       05836000
   BYTE ARRAY PARMSP;                                                   05838000
   INTEGER ERRNUM, PARMNUM;                                             05840000
   OPTION PRIVILEGED, UNCALLABLE;                                       05842000
BEGIN                                                                   05844000
   ENTRY CXSHOWOUT;                                                     05846000
                                                                        05848000
   LOGICAL OUT := TRUE;                                                 05850000
   INTEGER JITJNUM  = DB+9;                                             05852000
   EQUATE PXGWJIT  = 6;                                                 05854000
                                                                        05856000
   OUT := FALSE;                                                        05858000
CXSHOWOUT:                                                              05860000
   PUSH (DL);                                                           05862000
   EXCHANGEDB (PS0 (-PS0(-1) +PXGWJIT).(6:10));                         05864000
   TOS := JITJNUM;                                                      05866000
   EXCHANGEDB (0);                                                      05868000
   ERRNUM:=SHOWFILES(PARMSP,PARMNUM,IF MASTEROP THEN 0 ELSE S0,<<00552>>05870000
                     OUT);                                     <<00552>>05872000
   END;    <<CXSHOWIN/CXSHOWOUT>>                                       05874000
$PAGE "   ***   CONSALTFILE / CONSALTJOB   ***"                         05878000
$CONTROL SEGMENT= SPOOLCOMS1                                            05880000
                                                                        05882000
                                                                        05884000
LOGICAL PROCEDURE CONSALTFILE <<AND CONSALTJOB>> (PARMSTRING);          05886000
   BYTE ARRAY PARMSTRING;                                               05888000
   OPTION PRIVILEGED, UNCALLABLE;                                       05890000
BEGIN                                                                   05892000
   ENTRY CONSALTJOB;                                                    05894000
   LOGICAL           FILEFLAG := FALSE;<<COMMAND INDICATOR>>            05896000
                                                                        05898000
<< DECLARATIONS >>                                                      05900000
                                                                        05902000
<< PARSE >>                                                             05904000
   EQUATE            MAXPARMS = 7;                                      05906000
   P'DECLARATIONS;                                                      05908000
   EQUATE            KEYLEN = 20;                                       05910000
   BYTE ARRAY        KEYWORDSP (*) = PB :=                              05912000
                        9, 5, "INPRI", 1, 0,                            05914000
                        10, 6, "OUTPRI", 1, 1,                          05916000
                        10, 6, "COPIES", 2, 1,                          05918000
                        10, 6, "OUTDEV", 3, 3,                          05920000
                        0;                                              05922000
   ARRAY             KEYWORDSPW (*) = KEYWORDSP;                        05924000
   ARRAY             KEYWORDSW (0:KEYLEN -1);                           05926000
   BYTE ARRAY        KEYWORDS (*) = KEYWORDSW;                          05928000
   BYTE POINTER      KEYDEFN;                                           05930000
                                                                        05932000
<< PARSE RESULT >>                                                      05934000
   INTEGER           TARGET,           <<DEV FILE ID /OR/ JOB NUM>>     05936000
                     DFID = TARGET,                                     05938000
                     JOBNUM = TARGET;                                   05940000
   INTEGER           PRI  := -1,       <<NEW INPRI/OUTPRI>>             05942000
                     INPRI = PRI,                                       05944000
                     OUTPRI = PRI,                                      05946000
                     NUMCOPIES := 0,   <<NEW COPIES>>                   05948000
                     DEV := 0;         <<NEW OUTDEV>>                   05950000
   INTEGER ARRAY     DEVINFO (0:8) = Q;<<GETDEVINFO RESULT>>            05952000
   EQUATE            OUTTYPE = 4;      <<DEV MUST B OUTPUT>>            05954000
   LOGICAL           RELINK := FALSE;  <<ODD RELINK NECESSARY?>>        05956000
                                                                        05958000
<< SEARCH PARAMETERS >>                                                 05960000
   INTEGER           SAVESIR;          <<GETSIR RESULT>>                05962000
   INTEGER           VDEV;                                              05964000
   INTEGER POINTER   LDTP;                                              05966000
   INTEGER           SAVSIR;                                            05968000
   INTEGER           HEADX;                                             05970000
   INTEGER POINTER   ENTRYP,           <<RUNNING PNTR>>                 05972000
                     LIMITP,           <<TABLE END PNTR>>               05974000
                     HEADP = LIMITP;   <<ODD HEAD PNTR>>                05976000
   LOGICAL POINTER   ENTRYPL  = ENTRYP;                                 05978000
   DEFINE            OD'DEVSPEC = 0).(7:9  #;  <<TO INCL CL BIT>>       05980000
                                                                        05982000
<< >>                                                                   05984000
   FILEFLAG := TRUE;                                                    05986000
CONSALTJOB:                                                             05988000
                                                                        05990000
   CONSALTFILE := FALSE;    <<INITIALIZE>>                              05992000
   MYCOMMAND (PARMSTRING, , MAXPARMS, NUMPARMS, PARMS(1));              05994000
   IF  <>  OR  (NUMPARMS < 3)  THEN RETURN;                             05996000
   PARM := PARMS (PNUM := 1);                                           05998000
   IF  (PLEN < 3)  OR  (PP <> "#")  THEN RETURN;                        06000000
   TOS := BINARY (PP(2), PLEN -2);                                      06002000
   IF  <>  OR  ((TARGET := TOS) < 0)  THEN RETURN;                      06004000
   IF FILEFLAG THEN                                                     06006000
      BEGIN                                                             06008000
      IF PP(1) <> "O" THEN RETURN;                                      06010000
      TARGET.(0:1) := 1;                                                06012000
      END                                                               06014000
   ELSE                                                                 06016000
      BEGIN                                                             06018000
      IF  (PP(1) <> "J")  OR  (LOGICAL (TARGET).(1:1))  THEN RETURN;    06020000
      TARGET.(0:2) := 2;                                                06022000
      END;                                                              06024000
                                                                        06026000
   << GOT TARGET (DFID OR JNUM); PROCESS KEYWORDS >>                    06028000
   MOVE KEYWORDSW := KEYWORDSPW, (KEYLEN);                              06030000
   WHILE PDEL = SEMI DO                                                 06032000
      BEGIN                                                             06034000
      PARM := PARMS (PNUM :=  PNUM +1);                                 06036000
      IF  (PLEN = 0)  OR  (PDEL <> EQUAL)  THEN RETURN;                 06038000
      IF SEARCH (PP, PLEN, KEYWORDS, KEYDEFN) = 0 THEN RETURN;          06040000
      PARM := PARMS (PNUM := PNUM +1);                                  06042000
      IF PLEN = 0 THEN RETURN;                                          06044000
      << CHECK IF ALLOWED 4 THIS COMMAND >>                             06046000
      IF  (KEYDEFN (1) <> 3)                                            06048000
            AND  (INTEGER (KEYDEFN(1)) <> INTEGER (FILEFLAG.(15:1)))    06050000
               THEN RETURN;                                             06052000
      XREG := KEYDEFN;                                                  06054000
      KEYDEFN := 0;    <<SIGNAL FOR DUPLICATE>>                         06056000
      CASE * XREG OF                                                    06058000
         BEGIN                                                          06060000
                                                                        06062000
<< DUPLICATE >>                                                         06064000
            RETURN;                                                     06066000
                                                                        06068000
<< INPRI/OUTPRI >>                                                      06070000
            BEGIN                                                       06072000
            PRI := BINARY (PP, PLEN);                                   06074000
            IF <> THEN RETURN;                                          06076000
            IF NOT (0 <= PRI <= 14) THEN RETURN;                        06078000
            RELINK := TRUE;    <<ENTRY MUST BE RELINKED>>               06080000
            END;                                                        06082000
                                                                        06084000
<< NUM COPIES >>                                                        06086000
            BEGIN                                                       06088000
            NUMCOPIES := BINARY (PP, PLEN);                             06090000
            IF <> THEN RETURN;                                          06092000
            IF NOT (1 <= NUMCOPIES <= 127) THEN RETURN;                 06094000
            END;                                                        06096000
                                                                        06098000
<< OUTDEV >>                                                            06100000
            BEGIN                                                       06102000
            IF (GETDEVINFO (PP, DEVINFO) <> 0) THEN                     06104000
               RETURN;                                                  06106000
            IF FILEFLAG THEN                                            06108000
               BEGIN                                                    06110000
               IF SPOOLEDDEV (DEVINFO).(14:2) = 0 THEN RETURN;          06112000
               END                                                      06114000
            ELSE                                                        06116000
               IF DEVINFO (4 +LD'BASICTYPE) <> OUTTYPE THEN RETURN;     06118000
            TOS := DEVINFO;                                             06120000
            IF < THEN                                                   06122000
               BEGIN                                                    06124000
               TOS := -TOS;                                             06126000
               TOS.(7:1) := 1;                                          06128000
               END;                                                     06130000
            DEV := TOS;                                                 06132000
            RELINK := TRUE;    <<MUST B RELINKED (ODD)>>                06134000
            END    <<LAST CASE STATEMENT>>                              06136000
                                                                        06138000
         END;                                                           06140000
      END;                                                              06142000
   IF PDEL <> CR THEN RETURN;                                           06144000
                                                                        06146000
   << DONE PARSE >>                                                     06148000
                                                                        06150000
   IF FILEFLAG THEN                                                     06152000
      BEGIN                                                             06154000
      SAVSIR := GETSIR(LDTSIR);                                         06156000
      EXCHANGEDB (ODDDST);                                              06158000
      SAVESIR := GETSIR (ODDSIR);                                       06160000
      @ENTRYP := @XDD'SUBAREAP;                                         06162000
      @LIMITP := XDD'CURSIZE *TBLQUANTUM -XDD'SUBSIZE;                  06164000
      DO    <<FIND SUBENTRY>>                                           06166000
      UNTIL  (ENTRYP <> 0)  AND  (ENTRYP (OD'DEVFILEID) = DFID)         06168000
            OR  ((@ENTRYP := @ENTRYP +XDD'SUBSIZE) > @LIMITP);          06170000
      IF  =  <<GOT REQUESTED ENTRY. RIGHT TYPE/STATE?>>                 06172000
            AND  (ENTRYP (OD'SPOOLFILE)  <> 0)    <<SPOOFLE>>           06174000
               AND  (ENTRYP (OD'STATE) <> DFACTIVE)    <<OPN OR RDY>>   06176000
                  THEN                                                  06178000
         BEGIN    <<EXISTENT OPENED/READY SPOOFLE>>                     06180000
         IF NUMCOPIES > 0 THEN ENTRYP (OD'NUMCOPIES) := NUMCOPIES;      06182000
         IF RELINK THEN                                                 06184000
            BEGIN    <<OUTPRI AND/OR DEVICE => DELINK & RELINK>>        06186000
            TOS := (@HEADP := ENTRYP (OD'XDDHEADX) *ODD'HEADSIZE)       06188000
                  +OD'HHEADP;                                           06190000
            DELINKENTRY (*, ENTRYP);                                    06192000
            IF DEV <> 0 THEN                                            06194000
               BEGIN    <<NEW DEVICE>>                                  06196000
               ENTRYP (OD'DEVSPEC) := DEV;                              06198000
               @HEADP := ODDCLASSHEADX *ODD'HEADSIZE;                   06200000
               IF NOT (ENTRYPL (OD'C)) THEN                             06202000
                  << DEVICE: FIND HEAD >>                               06204000
                  DO @HEADP := @HEADP +ODD'HEADSIZE                     06206000
                  UNTIL HEADP (OD'HLDEV) = DEV;                         06208000
               ENTRYP (OD'XDDHEADX) := @HEADP /ODD'HEADSIZE;            06210000
               HEADX := @HEADP / ODD'HEADSIZE;                          06212000
               VDEV := ENTRYP (OD'VDEV);                                06214000
               IF ENTRYP(OD'STATE)=DFOPENED AND VDEV<>0 THEN            06216000
                  BEGIN                                                 06218000
                  EXCHANGEDB(LDTDST);                                   06220000
                  @LDTP := VDEV*LDTSIZE;                                06222000
                  LDTP(LD'XDDHEADX) := HEADX;                           06224000
                  EXCHANGEDB(ODDDST);                                   06226000
                  END;                                                  06228000
               END;                                                     06230000
            IF PRI >= 0 THEN ENTRYP (OD'OUTPRI) := PRI;                 06232000
            SLINKXDD (ENTRYP (OD'XDDHEADX), ENTRYP);                    06234000
            END;                                                        06236000
         RELSIR (ODDSIR, SAVESIR);                                      06238000
         IF RELINK THEN                                                 06240000
            <<AWAKE APPROPRIATE SPOOLER(S)>>                            06242000
            SROOSTER (IF ENTRYPL (OD'C) THEN -ENTRYP (OD'DEVICE)        06244000
                  ELSE ENTRYP (OD'DEVICE));                             06246000
         CONSALTFILE := TRUE;                                           06248000
         END                                                            06250000
      ELSE                                                              06252000
         RELSIR (ODDSIR, SAVESIR);                                      06254000
      RELSIR(LDTSIR,SAVSIR);                                            06256000
      END    <<CONSALTFILE>>                                            06258000
   ELSE                                                                 06260000
      BEGIN    <<ALTER JMAT ENTRY>>                                     06262000
      EXCHANGEDB (JMATDST);                                             06264000
      SAVESIR := GETSIR (JMATSIR);                                      06266000
      @ENTRYP := @JMAT'ENTRYP;                                          06268000
      @LIMITP := JMAT'CURSIZE *TBLQUANTUM -JMAT'ENTRYSIZE;              06270000
      DO                                                                06272000
      UNTIL  (ENTRYP <> 0)                                              06274000
            AND  (ENTRYP (JM'JSTATE) <> JOBERR)                         06276000
               AND  (ENTRYP (JM'JOBNUM) = JOBNUM)                       06278000
         OR  ((@ENTRYP := @ENTRYP +JMAT'ENTRYSIZE) > @LIMITP);          06280000
      IF = THEN                                                         06282000
         << FOUND ENTRY: MUST BE INTRO OR WAIT >>                       06284000
         IF  (ENTRYP (JM'JSTATE) = JOBINTRO)                            06286000
               OR  (ENTRYP (JM'JSTATE) = JOBWAIT)  THEN                 06288000
            BEGIN    <<EXISTENT AND IN PERMISSABLE STATE>>              06290000
            IF DEV <> 0 THEN                                            06292000
               BEGIN                                                    06294000
               ENTRYP (JM'C) := DEV.(7:1);                              06296000
               ENTRYP (JM'JLIST) := DEV;                                06298000
               IF (ENTRYP (JM'JSTATE) = JOBWAIT) AND (PRI < 0) THEN     06300000
                  << NEW DEV => MAYBE CAN START;                        06302000
                     PRI NOT SUPPLIED, SO AWAKE UCOP HERE. >>           06304000
                  BEGIN                                                 06306000
                  XREG := JOBSYNCADDR;                                  06308000
                  DISABLE;                                              06310000
                  ABSOLUTE (XREG).(JOBREADY'F) := TRUE;                 06312000
                  ENABLE;                                               06314000
                  AWAKE(SYSPROC(UCOPLPIN),JUNKWAIT,0);                  06316000
                  END;                                                  06318000
               END;                                                     06320000
            IF PRI >= 0 THEN                                            06322000
               BEGIN    <<CHANGE INPRI>>                                06324000
               ENTRYP (JM'INPRI) := PRI;                                06326000
               IF ENTRYP (JM'JSTATE) = JOBWAIT THEN                     06328000
                  BEGIN    <<CHANGED WAITING'S INPRI: RESCHEDULE>>      06330000
                  DELINKENTRY (JMAT'SCHEDHEADP, ENTRYP);                06332000
                  ENTRYP (JM'JSTATE) := JOBINTRO;                       06334000
                  SCHEDULEJOB' (ENTRYP);                                06336000
                  END;                                                  06338000
               END;                                                     06340000
            CONSALTFILE := TRUE;                                        06342000
            END;                                                        06344000
      RELSIR (JMATSIR, SAVESIR);                                        06346000
      END;    <<CONSALTJOB>>                                            06348000
                                                                        06350000
   EXCHANGEDB (0);                                                      06352000
   END;    <<CONSALTFILE/CONSALTJOB>>                                   06354000
$PAGE "   ***   =DELETE   ***"                                          06356000
INTEGER PROCEDURE DELETEDEVFILE (PARM, FLAGS);                          06358000
   VALUE PARM, FLAGS;                                                   06360000
   INTEGER PARM;                                                        06362000
   LOGICAL FLAGS;                                                       06364000
   OPTION PRIVILEGED, UNCALLABLE;                                       06366000
BEGIN                                                                   06368000
   DEFINE            BYJOB  = FLAGS #; <<PARM IS JOB NUM>>              06370000
   EQUATE            ERRSTD  = 4,      << CANT DELETE $STDIN >><<04694>>06372000
                     ERRSTATE  = 3,    <<WRONG STATE>>                  06374000
                     ERRNOTFOUND  = 2; <<NO SUCH DEV FILE>>             06376000
   INTEGER           JOBNUM  := 0,     <<0  => DFID SEARCH>>            06378000
                     DFID  := 0,       <<0 => JOBNUM SEARCH>>           06380000
                     XDDSIR,                                            06382000
                     XDDDST,                                            06384000
                     SAVESIR,                                           06386000
                     INDST,                                             06388000
                     DEV;                                               06390000
   INTEGER POINTER   ENTRYP,            <<SUB ENTRY PNTR>>              06392000
                     LIMITP;            <<TABLE END>>                   06394000
   LOGICAL           RELSIRED  := FALSE;                                06396000
   INTEGER         ERRNUM := 0,                                <<00552>>06398000
                   PARMNUM := 0;                               <<00552>>06400000
   LOGICAL SPOOLER'RESULT,                                     <<00610>>06402000
           DELETE'RESULT;                                      <<00610>>06404000
   EQUATE SPOOLERBUSY = %6232; <<CI SPOOLER BUSY MESSAGE>>     <<00610>>06406000
                                                               <<00610>>06408000
   EQUATE   SHUT=0,                                            <<01324>>06410000
            OPEN=1,                                            <<01324>>06412000
            UNCHANGED=2;                                       <<01324>>06414000
                                                                        06416000
                                                                        06418000
   BYTE ARRAY PARMSTRING(0:12);                                <<00552>>06420000
   INTEGER PARMLEN;                                            <<00552>>06422000
   LOGICAL ARRAY SPOOLINFO(0:3);                               <<01549>>06424000
   LOGICAL SUBROUTINE S'FINDENTRY;                             <<01324>>06426000
                                                               <<00610>>06428000
   BEGIN                                                       <<00610>>06430000
                                                               <<00610>>06432000
   S'FINDENTRY := FALSE;                                       <<01324>>06434000
   @ENTRYP := @XDD'SUBAREAP;                                   <<00610>>06436000
   @LIMITP := XDD'CURSIZE *TBLQUANTUM -XDD'SUBSIZE;            <<00610>>06438000
   DO                                                          <<00610>>06440000
   UNTIL (ENTRYP <> 0)                                         <<00610>>06442000
         AND ((ENTRYP (XD'DEVFILEID) = DFID)                   <<00610>>06444000
         OR (BYJOB LAND (ENTRYP (XD'JOBNUM) = JOBNUM)))        <<00610>>06446000
         OR (@ENTRYP := @ENTRYP +XDD'SUBSIZE) > @LIMITP;       <<00610>>06448000
   IF @ENTRYP <= @LIMITP THEN S'FINDENTRY := TRUE;             <<01324>>06450000
   END; <<SUBROUTINE S'FINDENTRY>>                             <<00610>>06452000
                                                               <<00610>>06454000
<< >>                                                                   06456000
   IF BYJOB THEN                                                        06458000
      JOBNUM := PARM                                                    06460000
   ELSE                                                                 06462000
      DFID := PARM;                                                     06464000
   IF DFID >= 0 THEN                                                    06466000
      BEGIN                                                             06468000
      TOS := IDDDST;                                                    06470000
      TOS := IDDSIR;                                                    06472000
      END                                                               06474000
   ELSE                                                                 06476000
      BEGIN                                                             06478000
      TOS := ODDDST;                                                    06480000
      TOS := ODDSIR;                                                    06482000
      END;                                                              06484000
   XDDSIR := TOS;                                                       06486000
   XDDDST := TOS;                                                       06488000
   INDST := EXCHANGEDB (XDDDST);                                        06490000
   SAVESIR := GETSIR (XDDSIR);                                          06492000
                                                                        06494000
S'FINDENTRY;      <<FIND XDD ENTRY FOR PARM VALUE>>            <<00610>>06496000
   IF <= THEN                                                           06498000
      IF BYJOB    <<=ABORTJOB REQUEST>>                                 06500000
      OR ENTRYP (XD'STATE) = DFREADY                                    06502000
            AND ((DFID < 0) OR (ENTRYP (XD'FNAME) <> "$S")) THEN        06504000
            << (ANY READY OUT) OR (READY, NON-$STDIN IN) >>             06506000
         BEGIN    <<ALL OK>>                                            06508000
         ENTRYP (XD'STATE) := DFRESERVED;                               06510000
         RELSIR (XDDSIR, SAVESIR);                                      06512000
         RELSIRED := TRUE;                                              06514000
         DEV := ENTRYP (XD'DEVICE);                                     06516000
         TOS := ENTRYP (XD'SPOOLFILE);   <<FOR SPOOFLE CHECK>>          06518000
         IF XDD'ODD THEN @ENTRYP.(0:1) := 1;                            06520000
         IF TOS <> 0 THEN                                               06522000
            BEGIN                                                       06524000
            TOS := 0;                                                   06526000
            TOS := EXCHANGEDB(0);                                       06528000
            TOS := FSOPEN(,%305,%500,@ENTRYP);                          06530000
            FSCLOSE(*,4,0);                                             06532000
            EXCHANGEDB(*);                                              06534000
            END                                                         06536000
         ELSE                                                           06538000
            BEGIN    <<REAL: REMOVE ENTRY & RELEASE DEVICE>>            06540000
            SREMOVEXDD (ENTRYP);                                        06542000
            FREEDEVICE (DEV, TRUE);                                     06544000
            END;                                                        06546000
         TOS := 0;                                                      06548000
         END                                                            06550000
      ELSE                                                     <<00552>>06552000
      BEGIN                                                    <<00552>>06554000
         IF ENTRYP(XD'STATE) = DFACTIVE THEN                   <<00552>>06556000
         BEGIN                                                 <<00552>>06558000
            DEV := ENTRYP(XD'DEVICE);                          <<00552>>06560000
           EXCHANGEDB(0); <<RETURN TO STACK>>                  <<00610>>06562000
           RELSIR(XDDSIR,SAVESIR);                             <<00610>>06564000
           RELSIRED := TRUE;                                   <<00610>>06566000
           SAVESIR := GETSIR(LDTSIR); <<FOR SENDSPOOLERMSG>>   <<00610>>06568000
           SPOOLER'RESULT :=                                   <<00610>>06570000
     SENDSPOOLERMSG(DEV,DELETEFILE LOR %100000,UNCHANGED,      <<01324>>06572000
                      SPOOLINFO,                               <<01549>>06574000
                  ERRNUM,PARMNUM);                             <<00610>>06576000
           RELSIR(LDTSIR,SAVESIR);                             <<00610>>06578000
           IF NOT SPOOLER'RESULT THEN                          <<00610>>06580000
           BEGIN                                               <<00610>>06582000
              IF ERRNUM = SPOOLERBUSY THEN                     <<00610>>06584000
            BEGIN                                              <<00552>>06586000
               CIERR(-ERRNUM);                                 <<02709>>06588000
               TOS := ERRSTATE;                                <<00552>>06590000
            END                                                <<00552>>06592000
            ELSE                                               <<00552>>06594000
              BEGIN     <<SPOOLER NOT ACTIVE BUT ENTRY IS>>    <<00610>>06596000
              EXCHANGEDB(XDDDST);                              <<00610>>06598000
           SAVESIR := GETSIR(XDDSIR); RELSIRED := FALSE;       <<00610>>06600000
IF NOT S'FINDENTRY THEN GO TO EXIT1; ENTRYP(XD'OUTPRI):=0;     <<01324>>06602000
       ENTRYP(XD'STATE) := DFREADY;                            <<00610>>06604000
              RELSIR(XDDSIR,SAVESIR); RELSIRED:= TRUE;         <<00610>>06606000
              EXCHANGEDB(0);  <<BACK TO STACK>>                <<00610>>06608000
              TOS := DELETE'RESULT:=                           <<00610>>06610000
                 DELETEDEVFILE(PARM,FLAGS);                    <<00610>>06612000
              IF S0 <> 0 THEN                                  <<00610>>06614000
                 CIERR(-ERRNUM);                               <<00610>>06616000
           END                                                 <<00610>>06618000
      END  ELSE                                                <<00610>>06620000
           BEGIN  << SPOOLER DELETE OK>>                       <<00610>>06622000
              TOS := 0;                                        <<00610>>06624000
           END;                                                <<00610>>06626000
       END                                                     <<00610>>06628000
         ELSE IF (ENTRYP(XD'FNAME)="$S") AND                   <<04694>>06630000
                 (ENTRYP(XD'FNAME+2) = "IN")                   <<04694>>06632000
                 THEN TOS := ERRSTD                            <<04694>>06634000
                 ELSE TOS := ERRSTATE;                         <<04694>>06636000
      END                                                      <<00552>>06638000
   ELSE                                                        <<01324>>06640000
EXIT1:    TOS  := ERRNOTFOUND;                                 <<01324>>06642000
   DELETEDEVFILE := TOS;                                                06644000
   IF NOT (RELSIRED) THEN                                               06646000
      RELSIR (XDDSIR, SAVESIR);                                         06648000
   IF INDST <> XDDDST THEN EXCHANGEDB (INDST);                          06650000
                                                                        06652000
   END;    << DELETEDEVFILE >>                                          06654000
                                                                        06656000
                                                                        06658000
LOGICAL PROCEDURE CONSDELETE (PARMSTRING);                              06660000
   BYTE ARRAY PARMSTRING;                                               06662000
   OPTION PRIVILEGED,UNCALLABLE;                               <<00179>>06664000
BEGIN                                                                   06666000
   BYTE POINTER      PP;                                                06668000
   INTEGER           PLEN;                                              06670000
                                                                        06672000
<< >>                                                                   06674000
   CONSDELETE := FALSE;                                                 06676000
   SCAN PARMSTRING WHILE %6440, 1;                                      06678000
   IF  NOCARRY  AND  (BPS0 = "#")  THEN                                 06680000
      BEGIN                                                             06682000
      @PP := S0;                                                        06684000
      SCAN * UNTIL %6440, 1;                                            06686000
      IF NOCARRY THEN                                                   06688000
         BEGIN                                                          06690000
         SCAN BPS0 WHILE %6440;                                         06692000
         IF NOCARRY THEN RETURN;                                        06694000
         END;                                                           06696000
      IF (PLEN := TOS -@PP) > 2 THEN                                    06698000
         BEGIN                                                          06700000
         TOS := BINARY (PP(2), PLEN-2);                                 06702000
         IF = AND (S0 > 0) THEN                                         06704000
            BEGIN                                                       06706000
            MOVE PP(1) := PP(1) WHILE AS;                      <<00.06>>06708000
            IF PP(1) <> "I" THEN                                        06710000
               IF PP(1) = "O" THEN TOS.(0:1) := 1                       06712000
               ELSE RETURN;                                             06714000
            CONSDELETE := (DELETEDEVFILE (S0, FALSE) = 0);              06716000
            END;                                                        06718000
         END;                                                           06720000
      END;                                                              06722000
   END;    <<CONSDELETE>>                                               06724000
                                                               <<01.02>>06726000
$PAGE "MRJE ROUTINES"                                          <<00858>>06728000
COMMENT This procdure is called to alter the attributes of a   <<01894>>06730000
        ready or opened output spool file. Changes may only    <<01894>>06732000
        be made to:   a) Priority,  b) Device, or  c) Copies.  <<01894>>06734000
        Supplying the approriate parameter dictates a change.  <<01894>>06736000
        Possible returns are:                                  <<01894>>06738000
                                                               <<01894>>06740000
         0  No errors  (also cce).                             <<01894>>06742000
        -1  Device file doesn't exist  (ccl).                  <<01894>>06744000
        -2  Device file ID not specified or invalid (ccl).     <<01894>>06746000
        >0  File active.   (0:8)=pri   (8:8)=dev    (ccg).     <<01894>>06748000
                                                               <<01894>>06750000
        It is assumed that all parameters passed have been     <<01894>>06752000
        tested and are valid. No attemp is made to change the  <<01894>>06754000
        state of the spool file. If 'device' is specified, it  <<01894>>06756000
        should be supplied in the same format as the DEVINFO   <<01894>>06758000
        return from 'getdevinfo' ie. negative class;           <<01894>>06760000
                                                               <<01894>>06762000
INTEGER PROCEDURE alteroutputfile ( dfid, pri, dev, copies );  <<01894>>06764000
  VALUE dfid, pri, dev, copies;                                <<01894>>06766000
  INTEGER dfid, pri, dev, copies;                              <<01894>>06768000
  OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                     <<01894>>06770000
  BEGIN                                                        <<01894>>06772000
                                                               <<01894>>06774000
   EQUATE xdd'entry'size = 30,                                 <<01894>>06776000
          odd'entrysize  = xdd'entry'size,                     <<01894>>06778000
          ccg            = 0,                                  <<01894>>06780000
          ccl            = 1,                                  <<01894>>06782000
          cce            = 2;                                  <<01894>>06784000
                                                               <<01894>>06786000
DEFINE cc = status.(6:2)#;                                     <<01894>>06788000
                                                               <<01894>>06790000
     LOGICAL bit'mask = q-4,     << Option variable mask >>    <<01894>>06792000
             status   = q-1;     << Status register >>         <<01894>>06794000
                                                               <<01894>>06796000
     INTEGER saveldt,            << for getsir call >>         <<01894>>06798000
             savelpdt,                                         <<01894>>06800000
             savexdd,                                          <<01894>>06802000
             roosterparm,                                      <<01894>>06804000
             xddep;              << entry pointer in odd >>    <<01894>>06806000
                                                               <<01894>>06808000
     LOGICAL relink;                                           <<01894>>06810000
                                                               <<01894>>06812000
     INTEGER ARRAY xdd(0:odd'entrysize);                       <<01894>>06814000
                                                               <<01894>>06816000
     SUBROUTINE def'movefromdseg;                              <<01894>>06818000
                                                               <<01894>>06820000
     SUBROUTINE def'movetodseg;                                <<01894>>06822000
                                                               <<01894>>06824000
                                                               <<01894>>06826000
                                                               <<01894>>06828000
                                                               <<01894>>06830000
     alteroutputfile := 0;        << Assume successful >>      <<01894>>06832000
     cc := cce;                                                <<01894>>06834000
     roosterparm := 0;                                         <<01894>>06836000
     relink := FALSE;                                          <<01894>>06838000
                                                               <<01894>>06840000
     IF (NOT bit'mask.(12:1)) OR  << File not supplied >>      <<01894>>06842000
        (dfid >= 0) THEN          << Invalid fileid >>         <<01894>>06844000
     BEGIN                                                     <<01894>>06846000
        alteroutputfile := -2;    << dfid not supplied >>      <<01894>>06848000
        cc := ccl;                                             <<01894>>06850000
        RETURN;                                                <<01894>>06852000
     END;                                                      <<01894>>06854000
                                                               <<01894>>06856000
     saveldt  := getsir ( ldtsir );                            <<01894>>06858000
     savelpdt := getsir ( lpdtsir );                           <<01894>>06860000
     savexdd  := getsir ( oddsir );                            <<01894>>06862000
                                                               <<01894>>06864000
     IF NOT sfindodd ( dfid, xddep ) THEN                      <<01894>>06866000
     BEGIN                                                     <<01894>>06868000
        alteroutputfile := -1;    << No such file >>           <<01894>>06870000
        cc := ccl;                                             <<01894>>06872000
     END ELSE                                                  <<01894>>06874000
     BEGIN                                                     <<01894>>06876000
        xddep.(0:1) := 0;        << Reset high bit >>          <<01894>>06878000
        movefromdseg ( xdd, odddst, xddep, xdd'entry'size );   <<01894>>06880000
        IF xdd(xd'state) = dfactive THEN                       <<01894>>06882000
        BEGIN                                                  <<01894>>06884000
           alteroutputfile := (xdd(xd'outpri) & lsl(8)) +      <<01894>>06886000
                              xdd(xd'device);                  <<01894>>06888000
           cc := ccg;                                          <<01894>>06890000
        END ELSE                                               <<01894>>06892000
        BEGIN                                                  <<01894>>06894000
           IF xdd(xd'spoolfile) = 0 THEN                       <<01894>>06896000
           BEGIN                                               <<01894>>06898000
              alteroutputfile := -1;  << No file >>            <<01894>>06900000
              cc := ccl;                                       <<01894>>06902000
           END ELSE                                            <<01894>>06904000
           BEGIN            << All tests passed >>             <<01894>>06906000
                                                               <<01894>>06908000
              IF bit'mask.(13:1) THEN                          <<01894>>06910000
              BEGIN                                            <<01894>>06912000
                 xdd(xd'outpri) := pri;                        <<01894>>06914000
                 relink := TRUE;                               <<01894>>06916000
              END;                                             <<01894>>06918000
                                                               <<01894>>06920000
              IF bit'mask.(14:1) THEN                          <<01894>>06922000
              BEGIN                                            <<01894>>06924000
                 IF dev < 0 THEN   << class >>                 <<01894>>06926000
                 BEGIN                                         <<01894>>06928000
                    xdd(xd'device) := -dev;                    <<01894>>06930000
                    xdd(xd'c) := 1;                            <<01894>>06932000
                 END ELSE                                      <<01894>>06934000
                 BEGIN                                         <<01894>>06936000
                    xdd(xd'device) := dev;                     <<01894>>06938000
                    xdd(xd'c) := 0;                            <<01894>>06940000
                 END;                                          <<01894>>06942000
                 relink := TRUE;                               <<01894>>06944000
              END;                                             <<01894>>06946000
                                                               <<01894>>06948000
              IF bit'mask.(15:1) THEN                          <<01894>>06950000
                 xdd(xd'numcopies) := copies;                  <<01894>>06952000
                                                               <<01894>>06954000
              movetodseg (odddst, xddep, xdd, xdd'entry'size); <<01894>>06956000
              IF relink THEN                                   <<01894>>06958000
              BEGIN                                            <<01894>>06960000
                 TOS := xdd(xd'device);                        <<01894>>06962000
                 IF LOGICAL(xdd(xd'c)) THEN TOS := -TOS;       <<01894>>06964000
                 ASSEMBLE ( dup );                             <<01894>>06966000
                 TOS := xddep;                                 <<01894>>06968000
                 ASSEMBLE ( cab );                             <<01894>>06970000
                 exchangedb ( odddst );                        <<01894>>06972000
                 srelinkodd ( *, * );                          <<01894>>06974000
                 exchangedb ( 0 );     << Back to stack >>     <<01894>>06976000
                 roosterparm := TOS;                           <<01894>>06978000
              END;   << of relink >>                           <<01894>>06980000
              IF roosterparm <> 0 THEN srooster(roosterparm);  <<01894>>06982000
           END;                                                <<01894>>06984000
        END;                                                   <<01894>>06986000
     END;                                                      <<01894>>06988000
                                                               <<01894>>06990000
     relsir ( oddsir, savexdd );                               <<01894>>06992000
     relsir ( lpdtsir, savelpdt );                             <<01894>>06994000
     relsir ( ldtsir, saveldt );                               <<01894>>06996000
                                                               <<01894>>06998000
  END;      << Of alteroutputfile >>                           <<01894>>07000000
                                                               <<01.02>>07002000
<<   SPECIAL INTERFACE FOR MRJE TO ALLOW PROGRAMMATIC   >>     <<01.02>>07004000
<<   DELETE OF DEVICEFILES                              >>     <<01.02>>07006000
INTEGER PROCEDURE MRJEDELETE (DFID);                           <<01.02>>07008000
   VALUE   DFID;                                               <<01.02>>07010000
   INTEGER DFID;                                               <<01.02>>07012000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01.02>>07014000
   BEGIN                                                       <<01.02>>07016000
   INTEGER ERROR;                                              <<01.02>>07018000
   << >>                                                       <<01.02>>07020000
   ERROR := DELETEDEVFILE(DFID,FALSE);                         <<01.02>>07022000
   IF ERROR <> 0 THEN                                          <<01.02>>07024000
      IF (ERROR = 3) OR (ERROR = 4) THEN ERROR := 2            <<04694>>07026000
                   ELSE ERROR := 1;                            <<01.02>>07028000
   MRJEDELETE := ERROR;                                        <<01.02>>07030000
   END;    << MRJEDELETE >>                                    <<01.02>>07032000
$CONTROL SEGMENT=SPOOLCOMS1                                    <<00858>>07034000
<< SPECIAL INTERFACE FOR MRJE TO ALLOW>>                       <<00858>>07036000
<< PROGRAMMATIC CHANGING OF USERNAME AND>>                     <<00858>>07038000
<< ACCOUNT NAME IN OUTPUT DEVICE DIRECTORY>>                   <<00858>>07040000
                                                               <<00858>>07042000
INTEGER PROCEDURE CHANGEODD(DFID,NEWUSER,NEWACCT);             <<00858>>07044000
   VALUE DFID;                                                 <<00858>>07046000
   INTEGER DFID;                                               <<00858>>07048000
   BYTE ARRAY NEWUSER,NEWACCT;                                 <<00858>>07050000
   OPTION UNCALLABLE,PRIVILEGED;                               <<00858>>07052000
                                                               <<00858>>07054000
   BEGIN                                                       <<00858>>07056000
                                                               <<00858>>07058000
   INTEGER ERROR, XDDEP, DFILEID, OLDSIR;                      <<00858>>07060000
   INTEGER ARRAY XDDENTRY(0:30);                               <<00858>>07062000
   BYTE ARRAY USER(*) = XDDENTRY(2);                           <<00858>>07064000
   BYTE ARRAY ACCT(*) = XDDENTRY(6);                           <<00858>>07066000
                                                               <<00858>>07068000
   SUBROUTINE DEF'MOVEFROMDSEG;                                <<00858>>07070000
                                                               <<00858>>07072000
   SUBROUTINE DEF'MOVETODSEG;                                  <<00858>>07074000
                                                               <<00858>>07076000
   DFILEID := LOGICAL(DFID) LOR %100000;                       <<00858>>07078000
   OLDSIR := GETSIR(ODDSIR);                                   <<00858>>07080000
   IF NOT SFINDODD(DFILEID,XDDEP) THEN                         <<00858>>07082000
      ERROR := 1                                               <<00858>>07084000
   ELSE                                                        <<00858>>07086000
   BEGIN                                                       <<00858>>07088000
      XDDEP := XDDEP.(1:15); <<TURN OFF HIGH BIT>>             <<00858>>07090000
      MOVEFROMDSEG(XDDENTRY,ODDDST,XDDEP,30);                  <<00858>>07092000
      USER := " ";                                             <<00858>>07094000
      MOVE USER(1) := USER, (15);                              <<00858>>07096000
      MOVE USER := NEWUSER WHILE AN;                           <<00858>>07098000
      MOVE ACCT := NEWACCT WHILE AN;                           <<00858>>07100000
      MOVETODSEG(ODDDST,XDDEP,XDDENTRY,30);                    <<00858>>07102000
      ERROR := 0;                                              <<00858>>07104000
   END;                                                        <<00858>>07106000
   RELSIR(ODDSIR,OLDSIR);                                      <<00858>>07108000
   CHANGEODD := ERROR;                                         <<00858>>07110000
END; << CHANGEODD>>                                            <<00858>>07112000
$PAGE "***   INPUT STREAMER   ***"                                      07116000
$CONTROL SEGMENT= SPOOLCOMS1                                            07118000
PROCEDURE STREAMJNUM;                                                   07120000
OPTION UNCALLABLE;                                                      07122000
   BEGIN <<STREAMJNUM>>                                                 07124000
   INTEGER CONTROL           := %320  ;                                 07126000
   ARRAY   LINE(0:4) ;                                                  07128000
   BYTE ARRAY BLINE(*)       = LINE  ;                                  07130000
      << >>                                                             07132000
   IF PROMPTING OR                                                      07134000
      LISTSIZE - 5 < (JLISTED := JLISTED + 5) THEN                      07136000
      BEGIN <<END OF THE LINE>>                                         07138000
      CONTROL := JLISTED := 0;                                          07140000
      END <<END OF THE LINE>>;                                          07142000
   LINE := "  ";                                                        07144000
   MOVE LINE(1) := LINE,(4);                                            07146000
   BLINE(1) := "#";                                                     07148000
   TOS := %112;                                                         07150000
   TOS := 0;                                                            07152000
   IF @JMATP > 0 THEN                                                   07154000
      BEGIN <<JOB>>                                                     07156000
      TOS := JOBNUMBER.(2:14);                                          07158000
      END <<JOB>>                                                       07160000
   ELSE                                                                 07162000
      BEGIN <<DATA>>                                                    07164000
      ASSEMBLE(DECB);                                                   07166000
      TOS := DEVFILEID;                                                 07168000
      END <<DATA>>;                                                     07170000
   ASCII(*,10,BLINE(3));                                                07172000
   BLINE(2) := TOS;                                                     07174000
   PRINT(LINE,5,CONTROL);                                               07176000
   END <<STREAMJNUM>>;                                                  07178000
PROCEDURE CXSTREAM(PARMSP,ERRNUM,PARMNUM);                     <<U.RAO>>07180000
BYTE ARRAY PARMSP;                                             <<U.RAO>>07182000
INTEGER ERRNUM,PARMNUM;                                        <<U.RAO>>07184000
OPTION PRIVILEGED,UNCALLABLE;                                  <<U.RAO>>07186000
   BEGIN <<CXSTREAM>>                                          <<U.RAO>>07188000
   EQUATE  MAXPARMS          = 4         ,                     <<U.RAO>>07190000
           SEMI'EX           = 2         ,                     <<01514>>07194000
           DFLT'ACC          = 0         ,                     <<01514>>07196000
           EX'ACC            = 6         ,                     <<01514>>07198000
           FOPOMITTED        = %2047     ,                     <<U.RAO>>07200000
           FOPSUPPLIED       = %2007     ;                     <<U.RAO>>07202000
   DEFINE  ACCESS'BITS       = (12:4)#   ,                     <<01514>>07204000
           EXCLU'BITS        = (8:2) #   ;                     <<01514>>07206000
   LOGICAL FOPTIONS     := FOPOMITTED ,                        <<U.RAO>>07208000
           AOPTIONS,                                           <<01514>>07210000
           OPENOK            := FALSE,                         <<01514>>07212000
           PROMPT            := FALSE ,                        <<U.RAO>>07214000
           DUMMY                      ,                        <<U.RAO>>07216000
           LERRPTR           := 0     ,                        <<U.RAO>>07218000
           INLISTDEVS                 ,                        <<U.RAO>>07220000
           WASCRITICAL                ;                        <<U.RAO>>07222000
   INTEGER FILENUMBER        := 0     ,                        <<U.RAO>>07224000
           NUMPARMS                   ,                        <<U.RAO>>07226000
           OLDZ'DB                    ;                        <<U.RAO>>07228000
   ARRAY   LOCALGLOBALS(0:GLOBSIZE)   ;                        <<04382>>07230000
   << PARSE DECLARATIONS >>                                    <<U.RAO>>07232000
   DOUBLE ARRAY PARMS(0:MAXPARMS-1) = Q  ;                     <<U.RAO>>07234000
   INTEGER COMMACR           := %26015 ;                       <<U.RAO>>07236000
   BYTE ARRAY   DXL(*)       = COMMACR   ;                     <<U.RAO>>07238000
   BYTE POINTER FILENAME     = PARMS     ,                     <<U.RAO>>07240000
                PSEUDOCOLONPARM  = PARMS + 2 ,                 <<U.RAO>>07242000
                EXTRAPARM    = PARMS + 4 ;                     <<U.RAO>>07244000
   BYTE    FILENAMELEN       = PARMS + 1 ,                     <<U.RAO>>07246000
           PSEUDOCOLONLEN    = PARMS + 3 ,                     <<U.RAO>>07248000
           EXTRAPARMLEN      = PARMS + 5 ;                     <<U.RAO>>07250000
   << FILE SPECIFICATIONS >>                                   <<U.RAO>>07252000
   BYTE    COLON             := "!"      ;                     <<U.RAO>>07254000
   BYTE POINTER ERRPTR = LERRPTR;  <<RTN VALUE FROM CHECKFILENA<<U.RAO>>07256000
   BYTE POINTER FORMALDES    := @DXL(1)  <<CR>>  ;             <<U.RAO>>07258000
                                                               <<00534>>07260000
   SUBROUTINE CLEANUP;                                         <<00534>>07262000
      << RESETS THINGS TO THE WAY THEY WERE >>                 <<00534>>07264000
      BEGIN                                                    <<00534>>07266000
      MOVE ARRDB0 := LOCALGLOBALS,(GLOBSIZE);                  <<00534>>07268000
      RESETCRITICAL(WASCRITICAL);                              <<00534>>07270000
      FCLOSE(FILENUMBER,-1,0);                                 <<00534>>07272000
      END;                                                     <<00534>>07274000
                                                               <<00534>>07276000
   << >>                                                       <<U.RAO>>07278000
   PUSH(STATUS);                                               <<U.RAO>>07280000
   TOS.(2:1) := 0;                                             <<U.RAO>>07282000
   SET(STATUS);                                                <<U.RAO>>07284000
   ERRNUM := 0;                                                <<U.RAO>>07286000
   PARMNUM := 0;                                               <<U.RAO>>07288000
   EXCHANGEDB(LDTDST);                                         <<U.RAO>>07290000
   PUSH(Q,DL);                                                 <<U.RAO>>07292000
   ASSEMBLE(XCH);                                              <<U.RAO>>07294000
   XREG := TOS - TOS - 1;  <<Q REL OFFSET TO DL-1>>            <<U.RAO>>07296000
   TOS := - ARRQ0(XREG);  <<GET OFFSET TO PXGLOB>>             <<U.RAO>>07298000
   XREG := TOS + 4 + XREG; <<GET OFFSET TO 4TH WORD IN PXGLOB>><<U.RAO>>07300000
   TOS := LOGICAL(ARRQ0(XREG));  <<GET PXGLOB(3)  (JINPUT LDN)><<U.RAO>>07302000
   TOS := TOS&LSL(8);    <<INPUT LDN IN UPPER BYTE>>           <<U.RAO>>07304000
   TOS := LOGICAL(ARRQ0(XREG+1)) LAND %377;  <<JOB OUTPUT LDN>><<U.RAO>>07306000
   TOS := S0 * LDTSIZE;  <<LDT OFFSET TO JOB OUTPUT LD ENTRY>> <<U.RAO>>07308000
   TOS := PS0(LD'RWIDTH);  <<REC LENGTH OF JOB OUTPUT LDEV>>   <<U.RAO>>07310000
   TOS := PS1(LD'DEVTYPE);  <<DEVICE TYPE OF JOB OUTPUT LDEV>> <<U.RAO>>07312000
   ASSEMBLE(CAB,DEL);   <<POP OFFSET TO LDT ENTRY>>            <<U.RAO>>07314000
   TOS := LDT'STREAMDEV;                                       <<U.RAO>>07316000
   EXCHANGEDB(0);                                              <<U.RAO>>07318000
   IF S0 = 0 THEN    <<NO STREAM DEVICE>>                      <<U.RAO>>07320000
      CIERR(ERRNUM := STRMNOTENABLED)    <<FACILITY OFF>>      <<U.RAO>>07322000
   ELSE                                                        <<U.RAO>>07324000
      BEGIN <<STREAMING>>                                      <<U.RAO>>07326000
      MYCOMMAND(PARMSP,DXL,MAXPARMS,NUMPARMS,PARMS);           <<U.RAO>>07328000
      IF NUMPARMS > 0 THEN                                     <<U.RAO>>07330000
         BEGIN <<SOME PARM(S)>>                                <<U.RAO>>07332000
         IF FILENAMELEN<>0 THEN  <<FILE NAME PRESENT>>         <<U.RAO>>07334000
            BEGIN   <<CHECK NAME VALIDITY>>                    <<U.RAO>>07336000
            PARMNUM := 1;                                      <<U.RAO>>07338000
            ERRNUM := CHECKFILENAME'(PARMS&LSR(8),DUMMY,       <<U.RAO>>07340000
                         DUMMY, LERRPTR);                      <<U.RAO>>07342000
            IF < THEN   <<SYNTAX ERROR IN FILE NAME>>          <<U.RAO>>07344000
               CIERR(ERRNUM, ERRPTR)                           <<U.RAO>>07346000
            ELSE IF > AND ERRNUM <> 0 THEN  <<SYS DEF FILE>>   <<U.RAO>>07348000
               IF ERRNUM <> 3 THEN  <<NOT $OLDPASS>>           <<U.RAO>>07350000
                  CIERR(ERRNUM := STRMNOSYSDEF, FILENAME)      <<U.RAO>>07352000
               ELSE   <<IS $OLDPASS, LEGAL>>                   <<U.RAO>>07354000
                  ERRNUM := 0;  <<CLEANUP>>                    <<U.RAO>>07356000
            @FORMALDES := @FILENAME;                           <<U.RAO>>07358000
            FOPTIONS := FOPSUPPLIED;  <<FILE SUPPLIED>>        <<U.RAO>>07360000
            IF ERRNUM <> 0 THEN RETURN;                        <<U.RAO>>07362000
            END;                                               <<U.RAO>>07364000
         IF NUMPARMS = 2 THEN                                  <<U.RAO>>07366000
            BEGIN   <<GET PSEUDOCOLON>>                        <<U.RAO>>07368000
            IF PSEUDOCOLONLEN = 1 THEN   <<ALL'S WELL>>        <<U.RAO>>07370000
               COLON := PSEUDOCOLONPARM                        <<U.RAO>>07372000
            ELSE IF PSEUDOCOLONLEN > 1 THEN  <<BAD NEWS>>      <<U.RAO>>07374000
               BEGIN  <<MULTIPLE CHAR AS PSEUDOCOLON>>         <<U.RAO>>07376000
               TOS := PSEUDOCOLONPARM(PSEUDOCOLONLEN);         <<U.RAO>>07378000
               PSEUDOCOLONPARM(PSEUDOCOLONLEN) := 0;  <<STOPPER<<U.RAO>>07380000
               CIERR(ERRNUM := STRMINVLDCOLON, PSEUDOCOLONPARM,<<U.RAO>>07382000
                  0, @PSEUDOCOLONPARM);                        <<U.RAO>>07384000
               PSEUDOCOLONPARM(PSEUDOCOLONLEN) := TOS;         <<U.RAO>>07386000
               PARMNUM := 2;                                   <<U.RAO>>07388000
               END;                                            <<U.RAO>>07390000
            END                                                <<U.RAO>>07392000
         ELSE IF NUMPARMS >= 3 THEN   <<ONLY ONE GOOD CASE>>   <<U.RAO>>07394000
            BEGIN  <<ASSUME PSEUDOCOLON IS COMMA>>             <<U.RAO>>07396000
            IF PSEUDOCOLONLEN <> 0 OR NUMPARMS > 3 THEN        <<U.RAO>>07398000
               BEGIN  <<SYNTAX PROBLEM>>                       <<U.RAO>>07400000
               CIERR(ERRNUM := STRMSYNTAX, PSEUDOCOLONPARM);   <<U.RAO>>07402000
               PARMNUM := 2;                                   <<U.RAO>>07404000
               END                                             <<U.RAO>>07406000
            ELSE  <<OK, WAS SPECIAL CASE>>                     <<U.RAO>>07408000
               COLON := ",";                                   <<U.RAO>>07410000
            END;                                               <<U.RAO>>07412000
         IF ERRNUM <> 0 THEN RETURN;  <<BAIL OUT>>             <<U.RAO>>07414000
         END <<SOME PARM(S)>>;                                 <<U.RAO>>07416000
                                                               <<01514>>07418000
   << THERE ARE TWO CHANCES TO OPEN THE STREAM FILE.       >>  <<01514>>07420000
   << FIRST:  THE OLD WAY--WITH READ ACCESS ONLY.  IF THAT >>  <<01514>>07422000
   << FAILS, THEN THE SECOND WAY--WITH EXECUTE ACCESS, IS  >>  <<01514>>07424000
   << TRIED.  BOTH ATTEMPTS ALLOW SEMI-EXCLUSIVE ACCESS BY >>  <<01514>>07426000
   << OTHERS.                                              >>  <<01514>>07428000
      AOPTIONS := 0;                                           <<01514>>07430000
      AOPTIONS.EXCLU'BITS := SEMI'EX;                          <<01514>>07432000
      AOPTIONS.ACCESS'BITS := DFLT'ACC;                        <<01514>>07434000
      FILENUMBER := FOPEN( FORMALDES, FOPTIONS, AOPTIONS );    <<01514>>07436000
      IF = THEN OPENOK := TRUE                                 <<01514>>07438000
      ELSE                                                     <<01514>>07440000
      BEGIN                                                    <<01514>>07442000
         AOPTIONS.ACCESS'BITS := EX'ACC;                       <<01514>>07444000
         FILENUMBER :=                                         <<01514>>07446000
            FOPEN( FORMALDES, FOPTIONS, AOPTIONS );            <<01514>>07448000
         IF = THEN OPENOK := TRUE;                             <<01514>>07450000
      END;                                                     <<01514>>07452000
      IF NOT OPENOK THEN                                       <<01514>>07454000
         BEGIN <<CAN'T OPEN STREAM FILE>>                      <<00534>>07456000
         FERROR'(FILENUMBER,PARMNUM);                          <<00534>>07458000
         CIERR(ERRNUM:=STRMFILEOPENERR);                       <<00534>>07460000
         END                                                   <<00534>>07462000
      ELSE                                                     <<U.RAO>>07464000
         BEGIN <<SUCCESSFUL FOPEN>>                            <<U.RAO>>07466000
                                                               <<03505>>07468000
         << Make sure there will be enough stack space >>      <<03505>>07470000
                                                               <<03505>>07472000
         TOS := %3600;                                         <<03505>>07474000
         ASSEMBLE (ADDS 0);                                    <<03505>>07476000
         TOS := %3600;                                         <<03505>>07478000
         ASSEMBLE (SUBS 0);                                    <<03505>>07480000
                                                               <<03505>>07482000
         WASCRITICAL := SETCRITICAL;                           <<U.RAO>>07484000
         MOVE LOCALGLOBALS := ARRDB0,(GLOBSIZE);               <<U.RAO>>07486000
         DB0 := 0;                                             <<U.RAO>>07488000
         MOVE ARRDB1 := ARRDB0,(GLOBSIZE-1);                   <<U.RAO>>07490000
         SPOOLER := FALSE;                                     <<U.RAO>>07492000
         STREAMDEV := TOS;                                     <<U.RAO>>07494000
         LISTTYPE := TOS;                                      <<U.RAO>>07496000
         LISTSIZE := TOS;                                      <<U.RAO>>07498000
         INLISTDEVS := TOS LOR TOS;                            <<U.RAO>>07500000
         PSEUDOCOLON := COLON;                                 <<U.RAO>>07502000
         DEVICEFILE := FILENUMBER;                             <<U.RAO>>07504000
         JLISTED := 0;                                         <<U.RAO>>07506000
         FGETINFO(DEVICEFILE,,FOPTIONS,,RECL,,DEVICE);         <<U.RAO>>07508000
         IF NOT FOPTIONS&LSR(2) THEN                           <<U.RAO>>07510000
            BEGIN <<FILE ISN'T ASCII>>                         <<U.RAO>>07512000
            CLEANUP;                                           <<00534>>07514000
            CIERR(ERRNUM:=FILENOTASCII);                       <<00534>>07516000
            END <<FILE ISN'T ASCII>>                           <<U.RAO>>07518000
         ELSE                                                  <<U.RAO>>07522000
            BEGIN <<ASCII file>>                               <<04912>>07524000
            TOS := SYS'LPDTP(DEVICE*LPDTSIZE+1);               <<U.RAO>>07526000
            ASSEMBLE(TBC 6); <<INTERACTIVE ?>>                 <<U.RAO>>07528000
            DEL;                                               <<U.RAO>>07530000
            IF <> THEN                                         <<U.RAO>>07532000
               BEGIN <<INTERACTIVE>>                           <<U.RAO>>07534000
               TOS := DEVICE * LDTSIZE;                        <<U.RAO>>07536000
               EXCHANGEDB(LDTDST);                             <<U.RAO>>07538000
               IF NOT LOGICAL(PS0(LD'C)) AND                   <<U.RAO>>07540000
                 PS0(LD'OUTDEV) = INTEGER(INLISTDEVS LAND %377)<<U.RAO>>07542000
                  THEN PROMPT := TRUE;                         <<U.RAO>>07544000
               EXCHANGEDB(0);                                  <<U.RAO>>07546000
               DEL;                                            <<U.RAO>>07548000
               END <<INTERACTIVE>>;                            <<U.RAO>>07550000
            PROMPTING := PROMPT;                               <<U.RAO>>07552000
            RECL := ((-RECL)+1)&LSR(1);                        <<U.RAO>>07554000
            DEVICERECL := RECL;                                <<U.RAO>>07556000
            PUSH(Z);                                           <<U.RAO>>07558000
            OLDZ'DB := TOS;                                    <<U.RAO>>07560000
            TOS := 0;                                          <<U.RAO>>07562000
            PUSH(S);                                           <<U.RAO>>07564000
            TOS := TOS + LOCSIZE;                              <<U.RAO>>07566000
            ZSIZE(*);                                          <<U.RAO>>07568000
            IF <> THEN                                         <<00534>>07570000
               BEGIN                                           <<00534>>07572000
               ZSIZE(OLDZ'DB);                                 <<00534>>07574000
               CLEANUP;                                        <<00534>>07576000
               CIERR(ERRNUM:=NOSUCHSTACK);                     <<00534>>07578000
               END                                             <<00534>>07580000
            ELSE                                               <<U.RAO>>07582000
               BEGIN <<ROOM ENUF>>                             <<U.RAO>>07584000
               SPOOLREQUEST := KEEPSPOOLING;                   <<U.RAO>>07586000
               FILEREQUEST := FINISHFILE;                      <<U.RAO>>07588000
            << NOW PROCESS THE STREAM FILE. ALL ERRORS WILL>>  <<00534>>07590000
            << BE PRINTED IN SPOOLINTO. ERRNUM AND PARMNUM >>  <<00534>>07592000
            << ARE FOR THE COMMAND INTRINSIC AND REFLECT   >>  <<00534>>07594000
            << THE LAST ERROR TO OCCUR IN PROCESSING.      >>  <<00534>>07596000
                                                               <<00534>>07598000
               SPOOLINTO;                                      <<00534>>07600000
                                                               <<00534>>07602000
               TOS := CIERRNUM;  << SAVE ERR # AND PARM # >>   <<00534>>07604000
               TOS := CIPARMNUM; << FROM GLOBAL AREA.     >>   <<00534>>07606000
               ZSIZE(OLDZ'DB);                                 <<00534>>07608000
               CLEANUP;                                        <<00534>>07610000
               PARMNUM := TOS;  << SET COMMAND INTRINSIC  >>   <<00534>>07612000
               ERRNUM := TOS;   << RETURN PARAMETERS.     >>   <<00534>>07614000
                                                               <<00751>>07616000
            << No longer critical. If an error occured in >>   <<00751>>07618000
            << SPOOLINTO then call CIERR to TERMINATE if  >>   <<00751>>07620000
            << this is a job with no previous :CONTINUE.  >>   <<00751>>07622000
               IF ERRNUM > 0 THEN CIERR;                       <<00751>>07624000
                                                               <<00534>>07626000
            << IF PROGRAMMATIC STREAM THEN RESET EOF ON   >>   <<00534>>07628000
            << $STDIN TO ALLOW FUTURE READS.              >>   <<00534>>07630000
                                                               <<00534>>07632000
               IF PROGRAMMATIC THEN FRESETEOF;                 <<00751>>07634000
               PRINT(LOCALGLOBALS,0,0);   << CR,LF >>          <<00534>>07636000
               END <<ROOM ENUF>>;                              <<00534>>07638000
            END <<ASCII FILE>>;                                <<00534>>07640000
         END <<SUCCESSFULL FOPEN>>;                            <<00534>>07642000
      END <<STREAMING>>;                                       <<00534>>07644000
   END <<CXSTREAM>>;                                           <<00534>>07646000
$CONTROL SEGMENT=SPOOLCOMS1                                    <<01549>>07648000
$PAGE "                     POPENENV"                          <<01549>>07650000
procedure POPENENV( EnvFileName,EnvFileNum,NextRnum,           <<01549>>07652000
                    EnvRecord,Status,ErrNum );                 <<01549>>07654000
  byte array EnvFileName;                                      <<01549>>07656000
  integer EnvFileNum,NextRnum,Status,ErrNum;                   <<01549>>07658000
  logical array EnvRecord;                                     <<01549>>07660000
                                                               <<01549>>07662000
comment                                                        <<01549>>07664000
  This procedure is used to open an environment file, before   <<01549>>07666000
calls to PREADENV can be made.  POPENENV checks to make sure   <<01549>>07668000
that the file supplied is actually an environment file, by     <<01549>>07670000
looking at the file code (which should be 1112) and the record <<01549>>07672000
size (which should be 512 words).                              <<01549>>07674000
  The file number is returned in EnvFileNum if the file        <<01549>>07676000
is opened successfully and is actually an environment file.    <<01549>>07678000
Otherwise, Status is set to explain the error in general       <<01549>>07680000
terms, and ErrNum is set to explain exactly what happened.     <<01549>>07682000
                                                               <<01549>>07684000
                BA            I          I         LA          <<01549>>07686000
  POPENENV( EnvFileName, EnvFileNum, NextRnum, EnvRecord,      <<01549>>07688000
              I        I                                       <<01549>>07690000
            Status, ErrNum )                                   <<01549>>07692000
                                                               <<01549>>07694000
_Parameters_                                                   <<01549>>07696000
                                                               <<01549>>07698000
  EnvFileName      byte array (required)                       <<01549>>07700000
                                                               <<01549>>07702000
                   This is the name of an environment file     <<01549>>07704000
                   (produced by PS2680) which is to be opened  <<01549>>07706000
                   for reading.  The name must be terminated   <<01549>>07708000
                   in a manner suitable for passing to FOPEN,  <<01549>>07710000
                   e.g. terminated by a blank.                 <<01549>>07712000
                                                               <<01549>>07714000
  EnvFileNum       integer (required)                          <<01549>>07716000
                                                               <<01549>>07718000
                   This parameter is the file number of the    <<01549>>07720000
                   environment file as returned by FOPEN.      <<01549>>07722000
                   It should subsequently be passed to PREADENV<<01549>>07724000
                                                               <<01549>>07726000
  NextRnum         integer (required)                          <<01549>>07728000
                                                               <<01549>>07730000
                   This parameter is set to the record number  <<01549>>07732000
                   or the first downloadable record in the     <<01549>>07734000
                   environment file.  It should be passed      <<01549>>07736000
                   untouched to PREADENV, which will subsequent<<01549>>07738000
                   use it to keep track of where it is in the  <<01549>>07740000
                   file.                                       <<01549>>07742000
                                                               <<01549>>07744000
  EnvRecord        logical array (required)                    <<01549>>07746000
                                                               <<01549>>07748000
                   This array is used by POPENENV when it reads<<01549>>07750000
                   in the environment file's first record.  The<<01549>>07752000
                   only reason that this is a parameter rather <<01549>>07754000
                   than a local variable is to conserve stack  <<01549>>07756000
                   space.  The calling program will have had to<<01549>>07758000
                   declare this array anyway to use PREADENV, s<<01549>>07760000
                   we are just re-using it here.  The array mus<<01549>>07762000
                   have room for at least 512 words.           <<01549>>07764000
                                                               <<01549>>07766000
  Status           integer (required)                          <<01549>>07768000
                                                               <<01549>>07770000
                   On return, this parameter is set to indicate<<01549>>07772000
                   in general terms what happened when POPENENV<<01549>>07774000
                   attempted to open the environment file.     <<01549>>07776000
                   The values taken on by Status here are the  <<01549>>07778000
                   same as the corresponding values for Status <<01549>>07780000
                   returned by PLOADENV.  They are:            <<01549>>07782000
                                                               <<01549>>07784000
                        value                meaning           <<01549>>07786000
                                                               <<01549>>07788000
                          0        Successful.  The environ-   <<01549>>07790000
                                   ment file is open.          <<01549>>07792000
                                                               <<01549>>07794000
                          1        Couldn't open the environ-  <<01549>>07796000
                                   ment file.  ErrNum contains <<01549>>07798000
                                   the MPE error message num-  <<01549>>07800000
                                   ber as returned by FCHECK.  <<01549>>07802000
                                                               <<01549>>07804000
                          2        File supplied exists, but   <<01549>>07806000
                                   isn't an environment file.  <<01549>>07808000
                                   ErrNum contains what was    <<01549>>07810000
                                   wrong.                      <<01549>>07812000
                                                               <<01549>>07814000
                          3        Couldn't read the environ-  <<01549>>07816000
                                   ment file's header. (The    <<01549>>07818000
                                   first record of the file.)  <<01549>>07820000
                                   ErrNum contains FCHECK num. <<01549>>07822000
                                   The file is closed.         <<01549>>07824000
                                                               <<01549>>07826000
                          4        Nothing in compiled part.   <<01549>>07828000
                                   This environment file must  <<01549>>07830000
                                   be compiled by PS2680       <<01549>>07832000
                                   before it can be used.      <<01549>>07834000
                                   The file is closed.         <<01549>>07836000
                                                               <<01549>>07838000
                          5        Warning: environment file   <<01549>>07840000
                                   has been changed since last <<01549>>07842000
                                   compiled.  The file is open,<<01549>>07844000
                                   however.                    <<01549>>07846000
                                                               <<01549>>07848000
                          6        Bad environment file. There <<01549>>07850000
                                   was something wrong with    <<01549>>07852000
                                   the environment file's      <<01549>>07854000
                                   internal format.  ErrNum    <<01549>>07856000
                                   says exactly what.          <<01549>>07858000
                                   The file is closed.         <<01549>>07860000
                                                               <<01549>>07862000
                          8        Couldn't close the environ- <<01549>>07864000
                                   ment file after an error was<<01549>>07866000
                                   detected.  ErrNum contains t<<01549>>07868000
                                   FCHECK number.              <<01549>>07870000
                                                               <<01549>>07872000
                          9        FGETINFO failed.  ErrNum    <<01549>>07874000
                                   contains the FCHECK number. <<01549>>07876000
                                   The file is closed.         <<01549>>07878000
$PAGE                                                          <<01549>>07880000
  ErrNum          integer (required)                           <<01549>>07882000
                                                               <<01549>>07884000
                  If an error occurred (as indicated by        <<01549>>07886000
                  a non-zero Status, above) ErrNum will        <<01549>>07888000
                  contain in detail the actual error.  For     <<01549>>07890000
                  errors resulting from MPE intrinsics,        <<01549>>07892000
                  ErrNum containst the error number            <<01549>>07894000
                  returned by FCHECK.  For errors specific     <<01549>>07896000
                  to environment files, ErrNum contains        <<01549>>07898000
                  one of the following values:                 <<01549>>07900000
                                                               <<01549>>07902000
                     (The associated Status value is shown     <<01549>>07904000
                      in parentheses.)                         <<01549>>07906000
                                                               <<01549>>07908000
                        value                meaning           <<01549>>07910000
                                                               <<01549>>07912000
                          1 (2)    File had wrong file code.   <<01549>>07914000
                                                               <<01549>>07916000
                          2 (2)    File had wrong record size. <<01549>>07918000
                                                               <<01549>>07920000
                          3 (6)    The file header was bad.    <<01549>>07922000
                                   This means either that it   <<01549>>07924000
                                   had the wrong record type   <<01549>>07926000
                                   or that the pointer to the  <<01549>>07928000
                                   downloadable stuff was      <<01549>>07930000
                                   invalid.                    <<01549>>07932000
;                                                              <<01549>>07934000
begin                                                          <<01549>>07936000
  << Equates used with environment files. >>                   <<01549>>07938000
  equate                                                       <<01549>>07940000
    cEnvFileCode    = 1112,    << File code for env. files >>  <<01549>>07942000
    cEnvFileRecSize = 512,                                     <<01549>>07944000
    cNil            = %177777, << End-of-list. >>              <<01549>>07946000
    cHeaderRnum     = 0,       << Record # of file header. >>  <<01549>>07948000
    cHeaderRecType  = 10000,   << Rec type of file header. >>  <<01549>>07950000
                                                               <<01549>>07952000
    cRecordTypeWord = 2,       << Offset at which can be   >>  <<01549>>07954000
                               << found the record type of >>  <<01549>>07956000
                               << an env. file record.     >>  <<01549>>07958000
                                                               <<01549>>07960000
    cChangedWord    = 4,       << Offset to the logical    >>  <<01549>>07962000
                               << value indicating whether >>  <<01549>>07964000
                               << this file was changed    >>  <<01549>>07966000
                               << since last compiled.     >>  <<01549>>07968000
                                                               <<01549>>07970000
    cDownloadPtr    = 5;       << Offset in file header at >>  <<01549>>07972000
                               << which the pointer to the >>  <<01549>>07974000
                               << downloadable stuff can   >>  <<01549>>07976000
                               << be found.                >>  <<01549>>07978000
                                                               <<01549>>07980000
  << These are the values which Status can have on return. >>  <<01549>>07982000
                                                               <<01549>>07984000
  equate                                                       <<01549>>07986000
    cSuccessfulOpen   = 0,                                     <<01549>>07988000
    cCouldn'tOpenEnvFile  = 1,                                 <<01549>>07990000
    cNotAnEnvFile         = 2,                                 <<01549>>07992000
    cCouldn'tReadHeader   = 3,                                 <<01549>>07994000
    cEmptyCompiledPart    = 4,                                 <<01549>>07996000
    cChangedSinceCompiled = 5,                                 <<01549>>07998000
    cBadEnvFile           = 6,                                 <<01549>>08000000
    cCouldn'tCloseEnvFile = 8,                                 <<01549>>08002000
    cFGETINFOfailed       = 9;                                 <<01549>>08004000
                                                               <<01549>>08006000
  << These are the values which ErrNum can have on return. >>  <<01549>>08008000
  <<                                                       >>  <<01549>>08010000
  << ErrNum is undefined if Status is cSuccessfulOpen,     >>  <<01549>>08012000
  << cEmptyCompiledPart, or cChangedSinceCompiled.         >>  <<01549>>08014000
  <<                                                       >>  <<01549>>08016000
  << ErrNum is listed below if Status is cNotAnEnvFile or  >>  <<01549>>08018000
  << cBadEnvFile.                                          >>  <<01549>>08020000
  <<                                                       >>  <<01549>>08022000
  << ErrNum is the value returned by FCHECK if Status is   >>  <<01549>>08024000
  << any other error number. (See above)                   >>  <<01549>>08026000
                                                               <<01549>>08028000
  equate                                                       <<01549>>08030000
    << Status = cNotAnEnvFile >>                               <<01549>>08032000
    cWrongFileCode = 1,                                        <<01549>>08034000
    cWrongRecSize  = 2,                                        <<01549>>08036000
                                                               <<01549>>08038000
    << Status = cBadEnvFile >>                                 <<01549>>08040000
    cBadFileHeader  = 3;                                       <<01549>>08042000
                                                               <<01549>>08044000
  integer                                                      <<01549>>08046000
    FileCode,                                                  <<01549>>08048000
    RecordSize;                                                <<01549>>08050000
                                                               <<01549>>08052000
  define dERROR'RETURN =                                       <<01549>>08054000
    begin                                                      <<01549>>08056000
      CLOSE'ENV'FILE;                                          <<01549>>08058000
      return;                                                  <<01549>>08060000
    end #;                                                     <<01549>>08062000
$PAGE "                 POPENENV -- SUBROUTINES"               <<01549>>08064000
logical subroutine OKAY'PTR(Ptr);                              <<01549>>08066000
  value Ptr;                                                   <<01549>>08068000
  integer Ptr;                                                 <<01549>>08070000
begin                                                          <<01549>>08072000
  if Ptr > 1 and  << first 2 records are headers >>            <<01549>>08074000
     Ptr < 32767  << largest legal ptr is 32766  >>            <<01549>>08076000
     or Ptr=cNil                                               <<01549>>08078000
  then OKAY'PTR := true                                        <<01549>>08080000
  else OKAY'PTR := false;                                      <<01549>>08082000
end;                                                           <<01549>>08084000
                                                               <<01549>>08086000
logical subroutine OPEN'ENV'FILE;                              <<01549>>08088000
begin                                                          <<01549>>08090000
  OPEN'ENV'FILE := false;  << Assume failure >>                <<01549>>08092000
                                                               <<01549>>08094000
  EnvFileNum := FOPEN(EnvFileName,                             <<01549>>08096000
                      [5/0,   << reserved for MPE >>           <<01549>>08098000
                       1/1,   << disallow file eqns  >>        <<01884>>08100000
                       1/0,                                    <<01549>>08102000
                       1/0,                                    <<01549>>08104000
                       2/0,   << fixed length records >>       <<01549>>08106000
                       3/0,   << actual = formal      >>       <<01549>>08108000
                       1/0,   << binary               >>       <<01549>>08110000
                       2/1],  << old permanent file   >>       <<01549>>08112000
                                                               <<01549>>08114000
                           0); << Read only.                >> <<04448>>08116000
  if <> then                                                   <<01549>>08118000
  begin                                                        <<01549>>08120000
    Status := cCouldn'tOpenEnvFile;                            <<01549>>08122000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>08124000
    return;                                                    <<01549>>08126000
  end;                                                         <<01549>>08128000
                                                               <<01549>>08130000
  OPEN'ENV'FILE := true;                                       <<01549>>08132000
end;                                                           <<01549>>08134000
$PAGE                                                          <<01549>>08136000
logical subroutine CHECK'VALID'ENV'FILE;                       <<01549>>08138000
begin                                                          <<01549>>08140000
  CHECK'VALID'ENV'FILE := false;                               <<01549>>08142000
                                                               <<01549>>08144000
  FGETINFO(EnvFileNum, <<filename>>, <<foptions>>,             <<01549>>08146000
                       <<aoptions>>,                           <<01549>>08148000
           RecordSize, <<devtype>>,  <<ldnum>>,                <<01549>>08150000
                       <<hdaddr>>,                             <<01549>>08152000
           FileCode);                                          <<01549>>08154000
  if <> then                                                   <<01549>>08156000
  begin                                                        <<01549>>08158000
    Status := cFGETINFOfailed;                                 <<01549>>08160000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>08162000
    return;                                                    <<01549>>08164000
  end;                                                         <<01549>>08166000
                                                               <<01549>>08168000
  if FileCode <> cEnvFileCode then                             <<01549>>08170000
  begin                                                        <<01549>>08172000
    Status := cNotAnEnvFile;                                   <<01549>>08174000
    ErrNum := cWrongFileCode;                                  <<01549>>08176000
    return;                                                    <<01549>>08178000
  end                                                          <<01549>>08180000
  else if RecordSize <> cEnvFileRecSize then                   <<01549>>08182000
  begin                                                        <<01549>>08184000
    Status := cNotAnEnvFile;                                   <<01549>>08186000
    ErrNum := cWrongRecSize;                                   <<01549>>08188000
    return;                                                    <<01549>>08190000
  end;                                                         <<01549>>08192000
                                                               <<01549>>08194000
  CHECK'VALID'ENV'FILE := true;                                <<01549>>08196000
end;                                                           <<01549>>08198000
                                                               <<01549>>08200000
logical subroutine GET'FILE'HEADER;                            <<01549>>08202000
begin                                                          <<01549>>08204000
  GET'FILE'HEADER := false;                                    <<01549>>08206000
                                                               <<01549>>08208000
  FREADDIR(EnvFileNum,EnvRecord,cEnvFileRecSize,               <<01549>>08210000
           double(cHeaderRnum));                               <<01549>>08212000
  if <> then                                                   <<01549>>08214000
  begin                                                        <<01549>>08216000
    Status := cCouldn'tReadHeader;                             <<01549>>08218000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>08220000
    return;                                                    <<01549>>08222000
  end;                                                         <<01549>>08224000
                                                               <<01549>>08226000
  << See if the file header is okay. >>                        <<01549>>08228000
                                                               <<01549>>08230000
  if EnvRecord(cRecordTypeWord) <> cHeaderRecType              <<01549>>08232000
     or not OKAY'PTR(EnvRecord(cDownloadPtr))                  <<01549>>08234000
  then begin                                                   <<01549>>08236000
    Status := cBadEnvFile;                                     <<01549>>08238000
    ErrNum := cBadFileHeader;                                  <<01549>>08240000
    return;                                                    <<01549>>08242000
  end;                                                         <<01549>>08244000
                                                               <<01549>>08246000
  GET'FILE'HEADER := true;                                     <<01549>>08248000
end;                                                           <<01549>>08250000
                                                               <<01549>>08252000
subroutine CLOSE'ENV'FILE;                                     <<01549>>08254000
begin                                                          <<01549>>08256000
  FCLOSE(EnvFileNum,0,0); << Take all defaults >>              <<01549>>08258000
  if <> then                                                   <<01549>>08260000
  begin                                                        <<01549>>08262000
    Status := cCouldn'tCloseEnvFile;                           <<01549>>08264000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>08266000
  end;                                                         <<01549>>08268000
end;                                                           <<01549>>08270000
$PAGE "                POPENENV -- MAIN CODE"                  <<01549>>08272000
  Status := cSuccessfulOpen; << Assume success at first >>     <<01549>>08274000
                                                               <<01549>>08276000
  if not OPEN'ENV'FILE then return;                            <<01549>>08278000
                                                               <<01549>>08280000
  if not CHECK'VALID'ENV'FILE then                             <<01549>>08282000
    dERROR'RETURN;                                             <<01549>>08284000
                                                               <<01549>>08286000
  if not GET'FILE'HEADER      then                             <<01549>>08288000
    dERROR'RETURN;                                             <<01549>>08290000
                                                               <<01549>>08292000
  << If this file has changed since it was last compiled, >>   <<01549>>08294000
  << we will set Status to indicate that.  This is only a >>   <<01549>>08296000
  << warning, however, so we do not do an ERROR'RETURN.   >>   <<01549>>08298000
                                                               <<01549>>08300000
  if EnvRecord(cChangedWord) then                              <<01549>>08302000
    Status := cChangedSinceCompiled;                           <<01549>>08304000
                                                               <<01549>>08306000
  << Start at beginning of download list >>                    <<01549>>08308000
  NextRnum := integer(EnvRecord(cDownloadPtr));                <<01549>>08310000
                                                               <<01549>>08312000
  if NextRnum = cNil then                                      <<01549>>08314000
  begin                                                        <<01549>>08316000
    Status := cEmptyCompiledPart;                              <<01549>>08318000
    dERROR'RETURN;                                             <<01549>>08320000
  end;                                                         <<01549>>08322000
end;                                                           <<01549>>08324000
$PAGE "                     PREADENV"                          <<01549>>08326000
procedure PREADENV( EnvFileNum,NextRnum,EnvRecord,             <<01549>>08328000
                    Status,ErrNum );                           <<01549>>08330000
  value EnvFileNum;                                            <<01549>>08332000
  integer                                                      <<01549>>08334000
    EnvFileNum,NextRnum,Status,ErrNum;                         <<01549>>08336000
  logical array                                                <<01549>>08338000
    EnvRecord;                                                 <<01549>>08340000
                                                               <<01549>>08342000
comment                                                        <<01549>>08344000
  This procedure is used to read the compiled records out of   <<01549>>08346000
a PSP/3000 environment file.  These records are suitable for   <<01549>>08348000
direct inclusion in an MPE spool file.                         <<01549>>08350000
  Records are read one at a time, one record for each call to  <<01549>>08352000
PREADENV.  After the last downloadable record has been read,   <<01549>>08354000
the next call to PREADENV will result in the file's being      <<01549>>08356000
closed.                                                        <<01549>>08358000
  POPENENV must be called before the first call to PREADENV, an<<01549>>08360000
both the EnvFileNum and NextRnum returned by POPENENV must be  <<01549>>08362000
passed to the first call of PREADENV unchanged.  In addition,  <<01549>>08364000
EnvFileNum and NextRnum should not be changed between calls to <<01549>>08366000
PREADENV.                                                      <<01549>>08368000
                                                               <<01549>>08370000
                  IV          LA         I       I       I     <<01549>>08372000
  PREADENV (  EnvFileNum, NextRnum, EnvRecord, Status, ErrNum  <<01549>>08374000
                                                               <<01549>>08376000
_Parameters_                                                   <<01549>>08378000
                                                               <<01549>>08380000
  EnvFileNum      integer by value (required)                  <<01549>>08382000
                                                               <<01549>>08384000
                  This is the file number (as returned by      <<01549>>08386000
                  POPENENV) of the environment file to be      <<01549>>08388000
                  read.                                        <<01549>>08390000
                                                               <<01549>>08392000
  NextRnum        integer (required)                           <<01549>>08394000
                                                               <<01549>>08396000
                  This value is the record number of the next  <<01549>>08398000
                  record to be read by PREADENV.  It must be   <<01549>>08400000
                  set by POPENENV before the first call to PREA<<01549>>08402000
                  and must not be changed between subsequent   <<01549>>08404000
                  calls.  PREADENV uses this variable to keep  <<01549>>08406000
                  track of where it is in the list of download-<<01549>>08408000
                  able records.  When the last record is return<<01549>>08410000
                  to the calling routine, NextRnum will be set <<01549>>08412000
                  to -1.  The next call to PREADENV will       <<01549>>08414000
                  result in the environment file's being closed<<01549>>08416000
                  and Status will be set to indicate successful<<01549>>08418000
                  completion. (See below)                      <<01549>>08420000
                                                               <<01549>>08422000
  EnvRecord       logical array (required)                     <<01549>>08424000
                                                               <<01549>>08426000
                  This is where the record read in is put.     <<01549>>08428000
                  This array must be at least 512 words long   <<01549>>08430000
                  to avoid damage to the stack when a 512-word <<01549>>08432000
                  environment file record is read in to it.    <<01549>>08434000
                                                               <<01549>>08436000
  Status          integer (required)                           <<01549>>08438000
                                                               <<01549>>08440000
                  On return, this parameter is set to indicate <<01549>>08442000
                  in general terms what happened when PREADENV <<01549>>08444000
                  attempted to read the next record from the   <<01549>>08446000
                  environment file.  The values for Status here<<01549>>08448000
                  are the same as those for corresponding error<<01549>>08450000
                  in PLOADENV and POPENENV. They are:          <<01549>>08452000
                        value                meaning           <<01549>>08454000
                                                               <<01549>>08456000
                         -1        Successful completion.  All <<01549>>08458000
                                   the records have been read. <<01549>>08460000
                                   The file is now closed.     <<01549>>08462000
                                                               <<01549>>08464000
                          0        Successful read.  EnvRecord <<01549>>08466000
                                   contains the record which wa<<01549>>08468000
                                   read in.  NextRnum contains <<01549>>08470000
                                   the record number of the    <<01549>>08472000
                                   next record to be read, or  <<01549>>08474000
                                   -1 if that was the last     <<01549>>08476000
                                   record.                     <<01549>>08478000
                                                               <<01549>>08480000
                          6        Bad environment file. There <<01549>>08482000
                                   was something wrong with    <<01549>>08484000
                                   the environment file's      <<01549>>08486000
                                   internal format.  ErrNum    <<01549>>08488000
                                   says exactly what.          <<01549>>08490000
                                                               <<01549>>08492000
                          7        Couldn't read a record of   <<01549>>08494000
                                   the environment file.       <<01549>>08496000
                                   ErrNum contains FCHECK num. <<01549>>08498000
                                                               <<01549>>08500000
                          8        Couldn't close the environ- <<01549>>08502000
                                   ment file.  ErrNum contains <<01549>>08504000
                                   the FCHECK number.          <<01549>>08506000
$PAGE                                                          <<01549>>08508000
  ErrNum          integer (required)                           <<01549>>08510000
                                                               <<01549>>08512000
                  If an error occurred (as indicated by        <<01549>>08514000
                  Status > 0, above) ErrNum will contain       <<01549>>08516000
                  in detail the actual error.  For             <<01549>>08518000
                  errors resulting from MPE intrinsics,        <<01549>>08520000
                  ErrNum contains the error number             <<01549>>08522000
                  returned by FCHECK.  For errors              <<01549>>08524000
                  specific to environment files, ErrNum        <<01549>>08526000
                  contains one of the following values:        <<01549>>08528000
                                                               <<01549>>08530000
                     (The associated Status value is shown     <<01549>>08532000
                      in parentheses.)                         <<01549>>08534000
                                                               <<01549>>08536000
                        value                meaning           <<01549>>08538000
                                                               <<01549>>08540000
                          4 (6)    A pointer in the list of    <<01549>>08542000
                                   downloadable records was    <<01549>>08544000
                                   illegal.                    <<01549>>08546000
                                                               <<01549>>08548000
                          5 (6)    A record in the list of     <<01549>>08550000
                                   downloadable records had    <<01549>>08552000
                                   an illegal record type.     <<01549>>08554000
;                                                              <<01549>>08556000
$PAGE                                                          <<01549>>08558000
begin                                                          <<01549>>08560000
  << Equates used with environment files. >>                   <<01549>>08562000
  equate                                                       <<01549>>08564000
    cEnvFileCode    = 1112,    << File code for env. files >>  <<01549>>08566000
    cEnvFileRecSize = 512,                                     <<01549>>08568000
    cNil            = -1, << End-of-list. >>                   <<01549>>08570000
    cHeaderRnum     = 0,       << Record # of file header. >>  <<01549>>08572000
    cHeaderRecType  = 10000,   << Rec type of file header. >>  <<01549>>08574000
                                                               <<01549>>08576000
    cRecordTypeWord = 2,       << Offset at which can be   >>  <<01549>>08578000
                               << found the record type of >>  <<01549>>08580000
                               << an env. file record.     >>  <<01549>>08582000
                                                               <<01549>>08584000
    cChangedWord    = 4,       << Offset to the logical    >>  <<01549>>08586000
                               << value indicating whether >>  <<01549>>08588000
                               << this file was changed    >>  <<01549>>08590000
                               << since last compiled.     >>  <<01549>>08592000
                                                               <<01549>>08594000
    cDownloadPtr    = 5,       << Offset in file header at >>  <<01549>>08596000
                               << which the pointer to the >>  <<01549>>08598000
                               << downloadable stuff can   >>  <<01549>>08600000
                               << be found.                >>  <<01549>>08602000
                                                               <<01549>>08604000
    cNextRec        = 510;     << Offset in an env. record  >> <<01549>>08606000
                               << where ptr to next rec can >> <<01549>>08608000
                               << be found.                 >> <<01549>>08610000
$PAGE                                                          <<01549>>08612000
  << These are the values which Status can have on return. >>  <<01549>>08614000
                                                               <<01549>>08616000
  equate                                                       <<01549>>08618000
    cSuccessfulCompletion = -1,                                <<01549>>08620000
    cSuccessfulRead       = 0,                                 <<01549>>08622000
    cBadEnvFile           = 6,                                 <<01549>>08624000
    cCouldn'tReadRecord   = 7,                                 <<01549>>08626000
    cCouldn'tCloseEnvFile = 8;                                 <<01549>>08628000
                                                               <<01549>>08630000
  << These are the values which ErrNum can have on return. >>  <<01549>>08632000
  <<                                                       >>  <<01549>>08634000
  << ErrNum is undefined if Status is cSuccessfulRead      >>  <<01549>>08636000
  << or cSuccessfulCompletion.                             >>  <<01549>>08638000
  <<                                                       >>  <<01549>>08640000
  << ErrNum is listed below if Status is cBadEnvFile.      >>  <<01549>>08642000
  <<                                                       >>  <<01549>>08644000
  << ErrNum is the value returned by FCHECK if Status is   >>  <<01549>>08646000
  << any other error number. (See above)                   >>  <<01549>>08648000
                                                               <<01549>>08650000
  equate                                                       <<01549>>08652000
    << Status = cBadEnvFile >>                                 <<01549>>08654000
    cPtrBadInList   = 4,                                       <<01549>>08656000
    cIllegalRecType = 5;                                       <<01549>>08658000
                                                               <<01549>>08660000
  define dERROR'RETURN =                                       <<01549>>08662000
    begin                                                      <<01549>>08664000
      CLOSE'ENV'FILE;                                          <<01549>>08666000
      return;                                                  <<01549>>08668000
    end #;                                                     <<01549>>08670000
$PAGE "                 PREADENV -- SUBROUTINES"               <<01549>>08672000
logical subroutine OKAY'PTR(Ptr);                              <<01549>>08674000
  value Ptr;                                                   <<01549>>08676000
  integer Ptr;                                                 <<01549>>08678000
begin                                                          <<01549>>08680000
  if Ptr > 1 and  << first 2 records are headers >>            <<01549>>08682000
     Ptr < 32767  << largest legal ptr is 32766  >>            <<01549>>08684000
     or Ptr=cNil                                               <<01549>>08686000
  then OKAY'PTR := true                                        <<01549>>08688000
  else OKAY'PTR := false;                                      <<01549>>08690000
end;                                                           <<01549>>08692000
$PAGE                                                          <<01549>>08694000
logical subroutine READ'COMP'REC(Rnum);                        <<01549>>08696000
  value Rnum;                                                  <<01549>>08698000
  integer Rnum;                                                <<01549>>08700000
                                                               <<01549>>08702000
  comment                                                      <<01549>>08704000
    This subroutine reads record Rnum of the environment       <<01549>>08706000
  file into EnvRecord, and then checks to see that that record <<01549>>08708000
  is actually a compiled (downloadable) one.                   <<01549>>08710000
  ;                                                            <<01549>>08712000
begin                                                          <<01549>>08714000
  READ'COMP'REC := false;                                      <<01549>>08716000
                                                               <<01549>>08718000
  FREADDIR(EnvFileNum,EnvRecord,cEnvFileRecSize,               <<01549>>08720000
           double(Rnum));                                      <<01549>>08722000
  if <> then                                                   <<01549>>08724000
  begin                                                        <<01549>>08726000
    Status := cCouldn'tReadRecord;                             <<01549>>08728000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>08730000
    return;                                                    <<01549>>08732000
  end;                                                         <<01549>>08734000
                                                               <<01549>>08736000
  if EnvRecord(cRecordTypeWord) = 128 or                       <<01549>>08738000
     133 <= integer(EnvRecord(cRecordTypeWord)) <= 138         <<01549>>08740000
  then                                                         <<01549>>08742000
    READ'COMP'REC := true                                      <<01549>>08744000
  else begin                                                   <<01549>>08746000
    Status := cBadEnvFile;                                     <<01549>>08748000
    ErrNum := cIllegalRecType;                                 <<01549>>08750000
  end;                                                         <<01549>>08752000
end;                                                           <<01549>>08754000
                                                               <<01549>>08756000
subroutine CLOSE'ENV'FILE;                                     <<01549>>08758000
begin                                                          <<01549>>08760000
  FCLOSE(EnvFileNum,0,0); << Take all defaults >>              <<01549>>08762000
  if <> then                                                   <<01549>>08764000
  begin                                                        <<01549>>08766000
    Status := cCouldn'tCloseEnvFile;                           <<01549>>08768000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>08770000
  end;                                                         <<01549>>08772000
end;                                                           <<01549>>08774000
$PAGE "                PREADENV -- MAIN CODE"                  <<01549>>08776000
  Status := cSuccessfulRead; << Assume success at first >>     <<01549>>08778000
                                                               <<01549>>08780000
  if NextRnum = cNil then                                      <<01549>>08782000
  begin                                                        <<01549>>08784000
    <<** Last record has already been sent to calling routine. <<01549>>08786000
    <<** We just need to close the file, and return success.   <<01549>>08788000
    Status := cSuccessfulCompletion;                           <<01549>>08790000
    <<** This will change Status if it fails. **>>             <<01549>>08792000
    CLOSE'ENV'FILE;                                            <<01549>>08794000
    return;                                                    <<01549>>08796000
  end;                                                         <<01549>>08798000
                                                               <<01549>>08800000
  <<** Read the next record **>>                               <<01549>>08802000
  if not READ'COMP'REC(NextRnum) then                          <<01549>>08804000
    dERROR'RETURN;                                             <<01549>>08806000
                                                               <<01549>>08808000
  <<** Update NextRnum **>>                                    <<01549>>08810000
  NextRnum := integer(EnvRecord(cNextRec));                    <<01549>>08812000
  if not OKAY'PTR(NextRnum) then                               <<01549>>08814000
  begin                                                        <<01549>>08816000
    Status := cBadEnvFile;                                     <<01549>>08818000
    ErrNum := cPtrBadInList;                                   <<01549>>08820000
    dERROR'RETURN;                                             <<01549>>08822000
  end;                                                         <<01549>>08824000
end; << PREADENV >>                                            <<01549>>08826000
                                                               <<01549>>08828000
$PAGE "PCHECK'CIPER'ENV -- FORWARD DECLARATION"                <<04382>>08830000
logical procedure PCHECK'CIPER'ENV( Env'file'num,              <<04382>>08832000
                                    Scratch'buffer,            <<04382>>08834000
                                    Return'Status,             <<04382>>08836000
                                    Error'number   );          <<04382>>08838000
                                                               <<04382>>08840000
  integer                           Env'file'num,              <<04382>>08842000
                                    Return'Status,             <<04382>>08844000
                                    Error'number    ;          <<04382>>08846000
                                                               <<04382>>08848000
  logical array                     Scratch'buffer  ;          <<04382>>08850000
                                                               <<04382>>08852000
  option forward                                    ;          <<04382>>08854000
$PAGE "PLOAD'CIPER'ENV -- FORWARD DECLARATION"                 <<04382>>08856000
logical procedure PLOAD'CIPER'ENV( Out'file'num,               <<04382>>08858000
                                   Env'file'num,               <<04382>>08860000
                                   Scratch'buffer,             <<04382>>08862000
                                   Return'status,              <<04382>>08864000
                                   Error'number     );         <<04382>>08866000
                                                               <<04382>>08868000
  integer                          Out'file'num,               <<04382>>08870000
                                   Env'file'num,               <<04382>>08872000
                                   Return'status,              <<04382>>08874000
                                   Error'number      ;         <<04382>>08876000
                                                               <<04382>>08878000
  logical array                    Scratch'buffer    ;         <<04382>>08880000
                                                               <<04382>>08882000
  option forward                                     ;         <<04382>>08884000
$PAGE "                     PCHECKENV"                         <<01549>>08886000
procedure PCHECKENV( EnvFileName,Status,ErrNum );              <<01549>>08888000
  byte array EnvFileName;                                      <<01549>>08890000
  integer Status,ErrNum;                                       <<01549>>08892000
                                                               <<01549>>08894000
comment                                                        <<01549>>08896000
  This procedure is used to check the validity of an alleged   <<01549>>08898000
environment file supplied by a user.  It opens the file, and ma<<01549>>08900000
sure that the file supplied is actually an environment file, by<<01549>>08902000
looking at the file code (which should be 1112) and the record <<01549>>08904000
size (which should be 512 words).                              <<01549>>08906000
  If anything goes wrong, Status is set to explain the error in<<01549>>08908000
general terms, and ErrNum is set to explain exactly what happen<<01549>>08910000
No matter what happens, the file is closed before PCHECKENV ret<<01549>>08912000
                                                               <<01549>>08914000
                BA          I       I                          <<01549>>08916000
  PCHECKENV( EnvFileName, Status, ErrNum )                     <<01549>>08918000
                                                               <<01549>>08920000
_Parameters_                                                   <<01549>>08922000
                                                               <<01549>>08924000
  EnvFileName      byte array (required)                       <<01549>>08926000
                                                               <<01549>>08928000
                   This is the name of an environment file     <<01549>>08930000
                   (produced by PS2680) which is to be opened  <<01549>>08932000
                   for checking.  The name must be terminated  <<01549>>08934000
                   in a manner suitable for passing to FOPEN,  <<01549>>08936000
                   e.g. terminated by a blank.                 <<01549>>08938000
                                                               <<01549>>08940000
  Status           integer (required)                          <<01549>>08942000
                                                               <<01549>>08944000
                   On return, this parameter is set to indicate<<01549>>08946000
                   in general terms what happened when PCHECKEN<<01549>>08948000
                   attempted to open the environment file.     <<01549>>08950000
                   The values taken on by Status here are the  <<01549>>08952000
                   same as the corresponding values for Status <<01549>>08954000
                   returned by PLOADENV.  They are:            <<01549>>08956000
                                                               <<01549>>08958000
                        value                meaning           <<01549>>08960000
                                                               <<01549>>08962000
                          0        Successful.  The environ-   <<01549>>08964000
                                   ment file is OK, as far as  <<01549>>08966000
                                   we can tell without reading <<01549>>08968000
                                   through it.                 <<01549>>08970000
                                                               <<01549>>08972000
                          1        Couldn't open the environ-  <<01549>>08974000
                                   ment file.  ErrNum contains <<01549>>08976000
                                   the MPE error message num-  <<01549>>08978000
                                   ber as returned by FCHECK.  <<01549>>08980000
                                                               <<01549>>08982000
                          2        File supplied exists, but   <<01549>>08984000
                                   isn't an environment file.  <<01549>>08986000
                                   ErrNum contains what was    <<01549>>08988000
                                   wrong.                      <<01549>>08990000
                                                               <<01549>>08992000
                          3        Couldn't read the environ-  <<01549>>08994000
                                   ment file's header. (The    <<01549>>08996000
                                   first record of the file.)  <<01549>>08998000
                                   ErrNum contains FCHECK num. <<01549>>09000000
                                                               <<01549>>09002000
                          4        Nothing in compiled part.   <<01549>>09004000
                                   This environment file must  <<01549>>09006000
                                   be compiled by PS2680       <<01549>>09008000
                                   before it can be used.      <<01549>>09010000
                                                               <<01549>>09012000
                          5        Warning: environment file   <<01549>>09014000
                                   has been changed since last <<01549>>09016000
                                   compiled.                   <<01549>>09018000
                                                               <<01549>>09020000
                          6        Bad environment file. There <<01549>>09022000
                                   was something wrong with    <<01549>>09024000
                                   the environment file's      <<01549>>09026000
                                   internal format.  ErrNum    <<01549>>09028000
                                   says exactly what.          <<01549>>09030000
                                                               <<01549>>09032000
                          8        Couldn't close the environ- <<01549>>09034000
                                   ment file after an error was<<01549>>09036000
                                   detected.  ErrNum contains t<<01549>>09038000
                                   FCHECK number.              <<01549>>09040000
                                                               <<01549>>09042000
                          9        FGETINFO failed.  ErrNum    <<01549>>09044000
                                   contains the FCHECK number. <<01549>>09046000
                                                               <<01884>>09048000
                         10        FILE equation failed,       <<01884>>09050000
                                   possible infinite loop      <<01884>>09052000
                                   such as                     <<01884>>09054000
                                   FILE ENV1 DEV=LP ENV=*ENV1  <<01884>>09056000
$PAGE                                                          <<01549>>09058000
  ErrNum          integer (required)                           <<01549>>09060000
                                                               <<01549>>09062000
                  If an error occurred (as indicated by        <<01549>>09064000
                  a non-zero Status, above) ErrNum will        <<01549>>09066000
                  contain in detail the actual error.  For     <<01549>>09068000
                  errors resulting from MPE intrinsics,        <<01549>>09070000
                  ErrNum containst the error number            <<01549>>09072000
                  returned by FCHECK.  For errors specific     <<01549>>09074000
                  to environment files, ErrNum contains        <<01549>>09076000
                  one of the following values:                 <<01549>>09078000
                                                               <<01549>>09080000
                     (The associated Status value is shown     <<01549>>09082000
                      in parentheses.)                         <<01549>>09084000
                                                               <<01549>>09086000
                        value                meaning           <<01549>>09088000
                                                               <<01549>>09090000
                          1 (2)    File had wrong file code.   <<01549>>09092000
                                                               <<01549>>09094000
                          2 (2)    File had wrong record size. <<01549>>09096000
                                                               <<01549>>09098000
                          3 (6)    The file header was bad.    <<01549>>09100000
                                   This means either that it   <<01549>>09102000
                                   had the wrong record type   <<01549>>09104000
                                   or that the pointer to the  <<01549>>09106000
                                   downloadable stuff was      <<01549>>09108000
                                   invalid.                    <<01549>>09110000
;                                                              <<01549>>09112000
begin                                                          <<01549>>09114000
  << Equates used with environment files. >>                   <<01549>>09116000
  equate                                                       <<01549>>09118000
    cEnvFileCode    = 1112,    << File code for env. files >>  <<01549>>09120000
    cEnvFileRecSize = 512,                                     <<01549>>09122000
    cNil            = %177777, << End-of-list. >>              <<01549>>09124000
    cHeaderRnum     = 0,       << Record # of file header. >>  <<01549>>09126000
    cHeaderRecType  = 10000,   << Rec type of file header. >>  <<01549>>09128000
                                                               <<01549>>09130000
    cRecordTypeWord = 2,       << Offset at which can be   >>  <<01549>>09132000
                               << found the record type of >>  <<01549>>09134000
                               << an env. file record.     >>  <<01549>>09136000
                                                               <<01549>>09138000
    cChangedWord    = 4,       << Offset to the logical    >>  <<01549>>09140000
                               << value indicating whether >>  <<01549>>09142000
                               << this file was changed    >>  <<01549>>09144000
                               << since last compiled.     >>  <<01549>>09146000
                                                               <<01549>>09148000
    cDownloadPtr    = 5;       << Offset in file header at >>  <<01549>>09150000
                               << which the pointer to the >>  <<01549>>09152000
                               << downloadable stuff can   >>  <<01549>>09154000
                               << be found.                >>  <<01549>>09156000
                                                               <<01549>>09158000
  << These are the values which Status can have on return. >>  <<01549>>09160000
                                                               <<01549>>09162000
  equate                                                       <<01549>>09164000
    cSuccessfulOpen   = 0,                                     <<01549>>09166000
    cCouldn'tOpenEnvFile  = 1,                                 <<01549>>09168000
    cNotAnEnvFile         = 2,                                 <<01549>>09170000
    cCouldn'tReadHeader   = 3,                                 <<01549>>09172000
    cEmptyCompiledPart    = 4,                                 <<01549>>09174000
    cChangedSinceCompiled = 5,                                 <<01549>>09176000
    cBadEnvFile           = 6,                                 <<01549>>09178000
    cCouldn'tCloseEnvFile = 8,                                 <<01549>>09180000
    cFGETINFOfailed       = 9,                                 <<01884>>09182000
    cbadfileequation      = 11;                                <<01884>>09184000
                                                               <<01549>>09186000
  << These are the values which ErrNum can have on return. >>  <<01549>>09188000
  <<                                                       >>  <<01549>>09190000
  << ErrNum is undefined if Status is cSuccessfulOpen,     >>  <<01549>>09192000
  << cEmptyCompiledPart, or cChangedSinceCompiled.         >>  <<01549>>09194000
  <<                                                       >>  <<01549>>09196000
  << ErrNum is listed below if Status is cNotAnEnvFile or  >>  <<01549>>09198000
  << cBadEnvFile.                                          >>  <<01549>>09200000
  <<                                                       >>  <<01549>>09202000
  << ErrNum is the value returned by FCHECK if Status is   >>  <<01549>>09204000
  << any other error number. (See above)                   >>  <<01549>>09206000
                                                               <<01549>>09208000
  equate                                                       <<01549>>09210000
    << Status = cNotAnEnvFile >>                               <<01549>>09212000
    cWrongFileCode = 1,                                        <<01549>>09214000
    cWrongRecSize  = 2,                                        <<01549>>09216000
                                                               <<01549>>09218000
    << Status = cBadEnvFile >>                                 <<01549>>09220000
    cBadFileHeader  = 3;                                       <<01549>>09222000
                                                               <<01549>>09224000
  integer                                                      <<01549>>09226000
    FileCode,                                                  <<01549>>09228000
    RecordSize,                                                <<01549>>09230000
    EnvFileNum,                                                <<01549>>09232000
    NextRnum;                                                  <<01549>>09234000
                                                               <<01549>>09236000
  logical array                                                <<01549>>09238000
    EnvRecord(0:cEnvFileRecSize-1);                            <<01549>>09240000
                                                               <<01549>>09242000
   INTEGER                                                     <<01884>>09244000
      BLANKWORD := "  ";                                       <<01884>>09246000
                                                               <<01884>>09248000
   BYTE ARRAY BLANK(0:2) ;                                     <<01884>>09250000
                                                               <<01884>>09252000
   LOGICAL ARRAY DEVPARMS(0:100);                              <<01884>>09254000
                                                               <<01884>>09256000
   LOGICAL                                                     <<01884>>09258000
      ENV'TOKEN := "EN";                                       <<01884>>09260000
                                                               <<01884>>09262000
   INTEGER DP'INDEX,SIZE;                                      <<01884>>09264000
                                                               <<01884>>09266000
   INTEGER ARRAY INFO(0:100);                                  <<01884>>09268000
                                                               <<01884>>09270000
  define dERROR'RETURN =                                       <<01549>>09272000
    begin                                                      <<01549>>09274000
      CLOSE'ENV'FILE;                                          <<01549>>09276000
      return;                                                  <<01549>>09278000
    end #;                                                     <<01549>>09280000
$PAGE "                 PCHECKENV -- SUBROUTINES"              <<01549>>09282000
logical subroutine OKAY'PTR(Ptr);                              <<01549>>09284000
  value Ptr;                                                   <<01549>>09286000
  integer Ptr;                                                 <<01549>>09288000
begin                                                          <<01549>>09290000
  if Ptr > 1 and  << first 2 records are headers >>            <<01549>>09292000
     Ptr < 32767  << largest legal ptr is 32766  >>            <<01549>>09294000
     or Ptr=cNil                                               <<01549>>09296000
  then OKAY'PTR := true                                        <<01549>>09298000
  else OKAY'PTR := false;                                      <<01549>>09300000
end;                                                           <<01549>>09302000
                                                               <<01549>>09304000
logical subroutine OPEN'ENV'FILE;                              <<01549>>09306000
begin                                                          <<01549>>09308000
  OPEN'ENV'FILE := false;  << Assume failure >>                <<01549>>09310000
                                                               <<01549>>09312000
  EnvFileNum := FOPEN(EnvFileName,                             <<01549>>09314000
                      [5/0,   << reserved for MPE >>           <<01549>>09316000
                       1/1,   << disallow file eqns  >>        <<01884>>09318000
                       1/0,                                    <<01549>>09320000
                       1/0,                                    <<01549>>09322000
                       2/0,   << fixed length records >>       <<01549>>09324000
                       3/0,   << actual = formal      >>       <<01549>>09326000
                       1/0,   << binary               >>       <<01549>>09328000
                       2/1],  << old permanent file   >>       <<01549>>09330000
                                                               <<01549>>09332000
                           0); << Read only.                >> <<04448>>09334000
  if <> then                                                   <<01549>>09336000
  begin                                                        <<01549>>09338000
    Status := cCouldn'tOpenEnvFile;                            <<01549>>09340000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>09342000
    return;                                                    <<01549>>09344000
  end;                                                         <<01549>>09346000
                                                               <<01549>>09348000
  OPEN'ENV'FILE := true;                                       <<01549>>09350000
end;                                                           <<01549>>09352000
$PAGE                                                          <<01549>>09354000
logical subroutine CHECK'VALID'ENV'FILE;                       <<01549>>09356000
begin                                                          <<01549>>09358000
  CHECK'VALID'ENV'FILE := false;                               <<01549>>09360000
                                                               <<01549>>09362000
  FGETINFO(EnvFileNum, <<filename>>, <<foptions>>,             <<01549>>09364000
                       <<aoptions>>,                           <<01549>>09366000
           RecordSize, <<devtype>>,  <<ldnum>>,                <<01549>>09368000
                       <<hdaddr>>,                             <<01549>>09370000
           FileCode);                                          <<01549>>09372000
  if <> then                                                   <<01549>>09374000
  begin                                                        <<01549>>09376000
    Status := cFGETINFOfailed;                                 <<01549>>09378000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>09380000
    return;                                                    <<01549>>09382000
  end;                                                         <<01549>>09384000
                                                               <<01549>>09386000
  if FileCode <> cEnvFileCode then                             <<01549>>09388000
  begin                                                        <<01549>>09390000
    Status := cNotAnEnvFile;                                   <<01549>>09392000
    ErrNum := cWrongFileCode;                                  <<01549>>09394000
    return;                                                    <<01549>>09396000
  end                                                          <<01549>>09398000
  else if RecordSize <> cEnvFileRecSize then                   <<01549>>09400000
  begin                                                        <<01549>>09402000
    Status := cNotAnEnvFile;                                   <<01549>>09404000
    ErrNum := cWrongRecSize;                                   <<01549>>09406000
    return;                                                    <<01549>>09408000
  end;                                                         <<01549>>09410000
                                                               <<01549>>09412000
  CHECK'VALID'ENV'FILE := true;                                <<01549>>09414000
end;                                                           <<01549>>09416000
                                                               <<01549>>09418000
logical subroutine GET'FILE'HEADER;                            <<01549>>09420000
begin                                                          <<01549>>09422000
  GET'FILE'HEADER := false;                                    <<01549>>09424000
                                                               <<01549>>09426000
  FREADDIR(EnvFileNum,EnvRecord,cEnvFileRecSize,               <<01549>>09428000
           double(cHeaderRnum));                               <<01549>>09430000
  if <> then                                                   <<01549>>09432000
  begin                                                        <<01549>>09434000
    Status := cCouldn'tReadHeader;                             <<01549>>09436000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>09438000
    return;                                                    <<01549>>09440000
  end;                                                         <<01549>>09442000
                                                               <<01549>>09444000
  << See if the file header is okay. >>                        <<01549>>09446000
                                                               <<01549>>09448000
  if EnvRecord(cRecordTypeWord) <> cHeaderRecType              <<01549>>09450000
     or not OKAY'PTR(EnvRecord(cDownloadPtr))                  <<01549>>09452000
  then begin                                                   <<01549>>09454000
    Status := cBadEnvFile;                                     <<01549>>09456000
    ErrNum := cBadFileHeader;                                  <<01549>>09458000
    return;                                                    <<01549>>09460000
  end;                                                         <<01549>>09462000
                                                               <<01549>>09464000
  GET'FILE'HEADER := true;                                     <<01549>>09466000
end;                                                           <<01549>>09468000
                                                               <<01549>>09470000
subroutine CLOSE'ENV'FILE;                                     <<01549>>09472000
begin                                                          <<01549>>09474000
  FCLOSE(EnvFileNum,0,0); << Take all defaults >>              <<01549>>09476000
  if <> then                                                   <<01549>>09478000
  begin                                                        <<01549>>09480000
    Status := cCouldn'tCloseEnvFile;                           <<01549>>09482000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>09484000
  end;                                                         <<01549>>09486000
end;                                                           <<01549>>09488000
                                                               <<01884>>09490000
LOGICAL SUBROUTINE CHECK'FILE'EQUATION;                        <<01884>>09492000
BEGIN                                                          <<01884>>09494000
   CHECK'FILE'EQUATION := FALSE;                               <<01884>>09496000
   BLANK := BLANKWORD;                                         <<01884>>09498000
   IF ENVFILENAME <> "*" THEN                                  <<01884>>09500000
      CHECK'FILE'EQUATION := TRUE                              <<01884>>09502000
   ELSE                                                        <<01884>>09504000
   BEGIN  << BACK REFERENCE , CHECK FOR INFINITE LOOP>>        <<01884>>09506000
      IF XRETJTENTRY(ENVFILENAME(1), BLANK, BLANK,             <<01884>>09508000
         SIZE, INFO) <> 0 THEN                                 <<01884>>09510000
         STATUS := cbadfileequation                            <<01884>>09512000
      ELSE                                                     <<01884>>09514000
      BEGIN <<BACK REFERENCE RESULTS IN FILE EQUATION>>        <<01884>>09516000
         DEVPARMS := 0; <<INITIALIZE>>                         <<01884>>09518000
         PARSE'DEV'PARMS(INFO(INFO.(10:6) + 4 +                <<01884>>09520000
            INFO(INFO.(10:6) + 3).(0:8)&LSR(1)),               <<01884>>09522000
            DEVPARMS);                                         <<01884>>09524000
         IF NOT GET'DEV'PARM(ENV'TOKEN, DEVPARMS, DP'INDEX)    <<01884>>09526000
         THEN                                                  <<01884>>09528000
           CHECK'FILE'EQUATION := TRUE                         <<01884>>09530000
         ELSE                                                  <<01884>>09532000
           STATUS := cbadfileequation;                         <<01884>>09534000
      END;                                                     <<01884>>09536000
   END;                                                        <<01884>>09538000
END;  <<SUBROUTINE CHECK'FILE'EQUATION>>                       <<01884>>09540000
                                                               <<01884>>09542000
$PAGE "                PCHECKENV -- MAIN CODE"                 <<01549>>09544000
  Status := cSuccessfulOpen; << Assume success at first >>     <<01549>>09546000
                                                               <<01549>>09548000
   IF NOT CHECK'FILE'EQUATION THEN RETURN;                     <<01884>>09550000
                                                               <<01884>>09552000
  if not OPEN'ENV'FILE then return;                            <<01549>>09554000
                                                               <<01549>>09556000
  if not CHECK'VALID'ENV'FILE then                             <<01549>>09558000
    if PCHECK'CIPER'ENV( EnvFileNum, EnvRecord,                <<04382>>09560000
                         Status, ErrNum         )              <<04382>>09562000
    then                                                       <<04382>>09564000
      begin                                                    <<04382>>09566000
        CLOSE'ENV'FILE;                                        <<04382>>09568000
        return;                                                <<04382>>09570000
      end                                                      <<04382>>09572000
    else                                                       <<04382>>09574000
      begin                                                    <<04382>>09576000
        dERROR'RETURN;                                         <<04382>>09578000
      end;                                                     <<04382>>09580000
                                                               <<01549>>09582000
  if not GET'FILE'HEADER      then                             <<01549>>09584000
    dERROR'RETURN;                                             <<01549>>09586000
                                                               <<01549>>09588000
  << If this file has changed since it was last compiled, >>   <<01549>>09590000
  << we will set Status to indicate that.  This is only a >>   <<01549>>09592000
  << warning, however, so we do not do an ERROR'RETURN.   >>   <<01549>>09594000
                                                               <<01549>>09596000
  if EnvRecord(cChangedWord) then                              <<01549>>09598000
    Status := cChangedSinceCompiled;                           <<01549>>09600000
                                                               <<01549>>09602000
  << Start at beginning of download list >>                    <<01549>>09604000
  NextRnum := integer(EnvRecord(cDownloadPtr));                <<01549>>09606000
                                                               <<01549>>09608000
  if NextRnum = cNil then                                      <<01549>>09610000
  begin                                                        <<01549>>09612000
    Status := cEmptyCompiledPart;                              <<01549>>09614000
    dERROR'RETURN;                                             <<01549>>09616000
  end;                                                         <<01549>>09618000
                                                               <<01549>>09620000
  <<** Looks good -- now close the file **>>                   <<01549>>09622000
  CLOSE'ENV'FILE;                                              <<01549>>09624000
                                                               <<01549>>09626000
end;                                                           <<01549>>09628000
                                                               <<01549>>09630000
procedure FDEVICECONTROL( FileNum,Target,Tcount,ControlCode,   <<01549>>09632000
                          Parm1,Parm2,ErrNum );                <<01549>>09634000
  value                                                        <<01549>>09636000
    FileNum,Tcount,ControlCode,Parm1,Parm2;                    <<01549>>09638000
  integer                                                      <<01549>>09640000
    FileNum,Tcount,ErrNum;                                     <<01549>>09642000
  logical                                                      <<01549>>09644000
    ControlCode,Parm1,Parm2;                                   <<01549>>09646000
  logical array                                                <<01549>>09648000
    Target;                                                    <<01549>>09650000
  option external;                                             <<01549>>09652000
                                                               <<01549>>09654000
$PAGE "                     PLOADENV"                          <<01549>>09656000
procedure PLOADENV( OutFileNum,EnvFileName,                    <<01549>>09658000
                    Status,ErrNum );                           <<01549>>09660000
  value OutFileNum;                                            <<01549>>09662000
  integer                                                      <<01549>>09664000
    OutFileNum,Status,ErrNum;                                  <<01549>>09666000
  byte array                                                   <<01549>>09668000
    EnvFileName;                                               <<01549>>09670000
                                                               <<01549>>09672000
comment                                                        <<01549>>09674000
  This procedure is used to include a PSP/3000 environment     <<01549>>09676000
file in an MPE spoolfile.                                      <<01549>>09678000
                                                               <<01549>>09680000
                  IV          BA         I       I             <<01549>>09682000
  PLOADENV (  OutFileNum, EnvFileName, Status, ErrNum  )       <<01549>>09684000
                                                               <<01549>>09686000
_Parameters_                                                   <<01549>>09688000
                                                               <<01549>>09690000
  OutFileNum      integer by value (required)                  <<01549>>09692000
                                                               <<01549>>09694000
                  This is the file number (as returned by      <<01549>>09696000
                  FOPEN) of the output file currently being    <<01549>>09698000
                  created.  This is the file against which     <<01549>>09700000
                  calls to FDEVICECONTROL will be made to      <<01549>>09702000
                  include the environment file.                <<01549>>09704000
                                                               <<01549>>09706000
  EnvFileName     byte array (required)                        <<01549>>09708000
                                                               <<01549>>09710000
                  This is a normal MPE file name, terminated   <<01549>>09712000
                  appropriately so that a call to FOPEN can    <<01549>>09714000
                  be made using EnvFileName with no changes.   <<01549>>09716000
                  PLOADENV will attempt do determine that this <<01549>>09718000
                  file actually is an environment file, and    <<01549>>09720000
                  will fail otherwise.  The file must have a   <<01549>>09722000
                  file code of 1112, and must have record size <<01549>>09724000
                  512 words.  It must also, of course, already <<01549>>09726000
                  exist.                                       <<01549>>09728000
                                                               <<01549>>09730000
  Status          integer (required)                           <<01549>>09732000
                                                               <<01549>>09734000
                  On return, this parameter is set to indicate <<01549>>09736000
                  in general terms what happened when PLOADENV <<01549>>09738000
                  attempted to download the environment file.  <<01549>>09740000
                  The values taken on by Status are:           <<01549>>09742000
                                                               <<01549>>09744000
                        value                meaning           <<01549>>09746000
                                                               <<01549>>09748000
                          0        Successful.  The environ-   <<01549>>09750000
                                   ment file is downloaded.    <<01549>>09752000
                                                               <<01549>>09754000
                          1        Couldn't open the environ-  <<01549>>09756000
                                   ment file.  ErrNum contains <<01549>>09758000
                                   the MPE error message num-  <<01549>>09760000
                                   ber as returned by FCHECK.  <<01549>>09762000
$PAGE                                                          <<01549>>09764000
                          2        File supplied exists, but   <<01549>>09766000
                                   isn't an environment file.  <<01549>>09768000
                                   ErrNum contains what was    <<01549>>09770000
                                   wrong.                      <<01549>>09772000
                                                               <<01549>>09774000
                          3        Couldn't read the environ-  <<01549>>09776000
                                   ment file's header. (The    <<01549>>09778000
                                   first record of the file.)  <<01549>>09780000
                                   ErrNum contains FCHECK num. <<01549>>09782000
                                                               <<01549>>09784000
                          4        Nothing in compiled part.   <<01549>>09786000
                                   This environment file must  <<01549>>09788000
                                   be compiled by PS2680       <<01549>>09790000
                                   before it can be used.      <<01549>>09792000
                                                               <<01549>>09794000
                          5        Warning: environment file   <<01549>>09796000
                                   has been changed since last <<01549>>09798000
                                   compiled.  The old compiled <<01549>>09800000
                                   stuff was downloaded.       <<01549>>09802000
                                                               <<01549>>09804000
                          6        Bad environment file. There <<01549>>09806000
                                   was something wrong with    <<01549>>09808000
                                   the environment file's      <<01549>>09810000
                                   internal format.  ErrNum    <<01549>>09812000
                                   says exactly what.          <<01549>>09814000
                                                               <<01549>>09816000
                          7        Couldn't read a record of   <<01549>>09818000
                                   the environment file.       <<01549>>09820000
                                   ErrNum contains FCHECK num. <<01549>>09822000
                                                               <<01549>>09824000
                          8        Couldn't close the environ- <<01549>>09826000
                                   ment file.  ErrNum contains <<01549>>09828000
                                   the FCHECK number.          <<01549>>09830000
                                                               <<01549>>09832000
                          9        FGETINFO failed.  ErrNum    <<01549>>09834000
                                   contains the FCHECK number. <<01549>>09836000
                                                               <<01549>>09838000
                          10       FDEVICECONTROL failed.      <<01549>>09840000
                                   ErrNum contains the error   <<01549>>09842000
                                   number returned by          <<01549>>09844000
                                   FDEVICECONTROL.             <<01549>>09846000
$PAGE                                                          <<01549>>09848000
  ErrNum          integer (required)                           <<01549>>09850000
                                                               <<01549>>09852000
                  If an error occurred (as indicated by        <<01549>>09854000
                  a non-zero Status, above) ErrNum will        <<01549>>09856000
                  contain in detail the actual error.  For     <<01549>>09858000
                  errors resulting from MPE intrinsics,        <<01549>>09860000
                  ErrNum contains either the error number      <<01549>>09862000
                  returned by the intrinsic (for intrinsics    <<01549>>09864000
                  like FDEVICECONTROL) or the error number     <<01549>>09866000
                  returned by FCHECK (for intrinsics like      <<01549>>09868000
                  FOPEN, FCLOSE, FREADDIR, etc.).  For errors  <<01549>>09870000
                  specific to environment files, ErrNum con-   <<01549>>09872000
                  tains one of the following values:           <<01549>>09874000
                                                               <<01549>>09876000
                     (The associated Status value is shown     <<01549>>09878000
                      in parentheses.)                         <<01549>>09880000
                                                               <<01549>>09882000
                        value                meaning           <<01549>>09884000
                                                               <<01549>>09886000
                          1 (2)    File had wrong file code.   <<01549>>09888000
                                                               <<01549>>09890000
                          2 (2)    File had wrong record size. <<01549>>09892000
                                                               <<01549>>09894000
                          3 (6)    The file header was bad.    <<01549>>09896000
                                   This means either that it   <<01549>>09898000
                                   had the wrong record type   <<01549>>09900000
                                   or that the pointer to the  <<01549>>09902000
                                   downloadable stuff was      <<01549>>09904000
                                   invalid.                    <<01549>>09906000
                                                               <<01549>>09908000
                          4 (6)    A pointer in the list of    <<01549>>09910000
                                   downloadable records was    <<01549>>09912000
                                   illegal.                    <<01549>>09914000
                                                               <<01549>>09916000
                          5 (6)    A record in the list of     <<01549>>09918000
                                   downloadable records had    <<01549>>09920000
                                   an illegal record type.     <<01549>>09922000
                                                               <<01549>>09924000
                          6 (6)    There was no terminator for <<01549>>09926000
                                   a logical record within a   <<01549>>09928000
                                   physical record.            <<01549>>09930000
                                                               <<01549>>09932000
                          7 (6)    A logical record contained  <<01549>>09934000
                                   bad length words.           <<01549>>09936000
                                                               <<01549>>09938000
                          8 (6)    The list of compiled records<<01549>>09940000
                                   contained a loop.  The spool<<01549>>09942000
                                   file now contains a lot of  <<01549>>09944000
                                   garbage.                    <<01549>>09946000
;                                                              <<01549>>09948000
$PAGE                                                          <<01549>>09950000
begin                                                          <<01549>>09952000
  << Equates used with environment files. >>                   <<01549>>09954000
  equate                                                       <<01549>>09956000
    cEnvFileCode    = 1112,    << File code for env. files >>  <<01549>>09958000
    cEnvFileRecSize = 512,                                     <<01549>>09960000
    cNil            = %177777, << End-of-list. >>              <<01549>>09962000
    cHeaderRnum     = 0,       << Record # of file header. >>  <<01549>>09964000
    cHeaderRecType  = 10000,   << Rec type of file header. >>  <<01549>>09966000
                                                               <<01549>>09968000
    cRecordTypeWord = 2,       << Offset at which can be   >>  <<01549>>09970000
                               << found the record type of >>  <<01549>>09972000
                               << an env. file record.     >>  <<01549>>09974000
                                                               <<01549>>09976000
    cChangedWord    = 4,       << Offset to the logical    >>  <<01549>>09978000
                               << value indicating whether >>  <<01549>>09980000
                               << this file was changed    >>  <<01549>>09982000
                               << since last compiled.     >>  <<01549>>09984000
                                                               <<01549>>09986000
    cDownloadPtr    = 5,       << Offset in file header at >>  <<01549>>09988000
                               << which the pointer to the >>  <<01549>>09990000
                               << downloadable stuff can   >>  <<01549>>09992000
                               << be found.                >>  <<01549>>09994000
                                                               <<01549>>09996000
    cNextRec        = 510,     << Offset in an env. record  >> <<01549>>09998000
                               << where ptr to next rec can >> <<01549>>10000000
                               << be found.                 >> <<01549>>10002000
                                                               <<01549>>10004000
    cEndOfDataWord  = 509;     << In an env. record contain->> <<01549>>10006000
                               << ing logical records, this >> <<01549>>10008000
                               << word must have a -1 in it >> <<01549>>10010000
                               << terminating the last log- >> <<01549>>10012000
                               << ical record.              >> <<01549>>10014000
                                                               <<01549>>10016000
  << Offsets into logical records, from the first word in >>   <<01549>>10018000
  << the logical record.  See the 2680A DCS ERS for an    >>   <<01549>>10020000
  << explanation of logical records.                      >>   <<01549>>10022000
                                                               <<01549>>10024000
  equate                                                       <<01549>>10026000
    cLenPlus8 = 0,                                             <<01549>>10028000
    cLen      = 1,                                             <<01549>>10030000
    cFuncCode = 2,                                             <<01549>>10032000
    cP1       = 3,                                             <<01549>>10034000
    cP2       = 4,                                             <<01549>>10036000
    cData     = 5;                                             <<01549>>10038000
                                                               <<01549>>10040000
  << If the value for cLenPlus8 is -1, there are no more >>    <<01549>>10042000
  << logical records in the current physical record.     >>    <<01549>>10044000
                                                               <<01549>>10046000
  equate                                                       <<01549>>10048000
    cEndOfLogRecs = %177777;                                   <<01549>>10050000
$PAGE                                                          <<01549>>10052000
  << These are the values which Status can have on return. >>  <<01549>>10054000
                                                               <<01549>>10056000
  equate                                                       <<01549>>10058000
    cSuccessfulDownload   = 0,                                 <<01549>>10060000
    cCouldn'tOpenEnvFile  = 1,                                 <<01549>>10062000
    cNotAnEnvFile         = 2,                                 <<01549>>10064000
    cCouldn'tReadHeader   = 3,                                 <<01549>>10066000
    cEmptyCompiledPart    = 4,                                 <<01549>>10068000
    cChangedSinceCompiled = 5,                                 <<01549>>10070000
    cBadEnvFile           = 6,                                 <<01549>>10072000
    cCouldn'tReadRecord   = 7,                                 <<01549>>10074000
    cCouldn'tCloseEnvFile = 8,                                 <<01549>>10076000
    cFGETINFOfailed       = 9,                                 <<01549>>10078000
    cFDEVICECONTROLfailed = 10;                                <<01549>>10080000
                                                               <<01549>>10082000
  << These are the values which ErrNum can have on return. >>  <<01549>>10084000
  <<                                                       >>  <<01549>>10086000
  << ErrNum is undefined if Status is cSuccessfulDownLoad, >>  <<01549>>10088000
  << cEmptyCompiledPart, or cChangedSinceCompiled.         >>  <<01549>>10090000
  <<                                                       >>  <<01549>>10092000
  << ErrNum is listed below if Status is cNotAnEnvFile or  >>  <<01549>>10094000
  << cBadEnvFile.                                          >>  <<01549>>10096000
  <<                                                       >>  <<01549>>10098000
  << ErrNum is the value returned by FCHECK if Status is   >>  <<01549>>10100000
  << any other error number. (See above)                   >>  <<01549>>10102000
                                                               <<01549>>10104000
  equate                                                       <<01549>>10106000
    << Status = cNotAnEnvFile >>                               <<01549>>10108000
    cWrongFileCode = 1,                                        <<01549>>10110000
    cWrongRecSize  = 2,                                        <<01549>>10112000
                                                               <<01549>>10114000
    << Status = cBadEnvFile >>                                 <<01549>>10116000
    cBadFileHeader  = 3,                                       <<01549>>10118000
    cPtrBadInList   = 4,                                       <<01549>>10120000
    cIllegalRecType = 5,                                       <<01549>>10122000
    cNoTerminator   = 6,                                       <<01549>>10124000
    cBadLogicalRec  = 7,                                       <<01549>>10126000
    cLoopInList     = 8;                                       <<01549>>10128000
                                                               <<01549>>10130000
  logical array                                                <<01549>>10132000
    EnvRec(0:cEnvFileRecSize-1);                               <<01549>>10134000
  integer                                                      <<01549>>10136000
    EnvFileNum,                                                <<01549>>10138000
    FileCode,                                                  <<01549>>10140000
    RecordSize,                                                <<01549>>10142000
    NextRnum,                                                  <<01549>>10144000
    NextLogRec;                                                <<01549>>10146000
  double                                                       <<01549>>10148000
    NumRecsInFile, << Returned by FGETINFO >>                  <<01549>>10150000
    RecCount;      << # records written to spoolfile so far >> <<01549>>10152000
                                                               <<01549>>10154000
  define dERROR'RETURN =                                       <<01549>>10156000
    begin                                                      <<01549>>10158000
      CLOSE'ENV'FILE;                                          <<01549>>10160000
      return;                                                  <<01549>>10162000
    end #;                                                     <<01549>>10164000
$PAGE "                 PLOADENV -- SUBROUTINES"               <<01549>>10166000
logical subroutine OKAY'PTR(Ptr);                              <<01549>>10168000
  value Ptr;                                                   <<01549>>10170000
  integer Ptr;                                                 <<01549>>10172000
begin                                                          <<01549>>10174000
  if Ptr > 1 and  << first 2 records are headers >>            <<01549>>10176000
     Ptr < 32767  << largest legal ptr is 32766  >>            <<01549>>10178000
     or Ptr=cNil                                               <<01549>>10180000
  then OKAY'PTR := true                                        <<01549>>10182000
  else OKAY'PTR := false;                                      <<01549>>10184000
end;                                                           <<01549>>10186000
                                                               <<01549>>10188000
logical subroutine OPEN'ENV'FILE;                              <<01549>>10190000
begin                                                          <<01549>>10192000
  OPEN'ENV'FILE := false;  << Assume failure >>                <<01549>>10194000
                                                               <<01549>>10196000
  EnvFileNum := FOPEN(EnvFileName,                             <<01549>>10198000
                      [5/0,   << reserved for MPE >>           <<01549>>10200000
                       1/1,   << disallow file eqns  >>        <<01884>>10202000
                       1/0,                                    <<01549>>10204000
                       1/0,                                    <<01549>>10206000
                       2/0,   << fixed length records >>       <<01549>>10208000
                       3/0,   << actual = formal      >>       <<01549>>10210000
                       1/0,   << binary               >>       <<01549>>10212000
                       2/1],  << old permanent file   >>       <<01549>>10214000
                                                               <<01549>>10216000
                           0); << Read only.                >> <<04448>>10218000
  if <> then                                                   <<01549>>10220000
  begin                                                        <<01549>>10222000
    Status := cCouldn'tOpenEnvFile;                            <<01549>>10224000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>10226000
    return;                                                    <<01549>>10228000
  end;                                                         <<01549>>10230000
                                                               <<01549>>10232000
  OPEN'ENV'FILE := true;                                       <<01549>>10234000
end;                                                           <<01549>>10236000
$PAGE                                                          <<01549>>10238000
logical subroutine CHECK'VALID'ENV'FILE(NumRecsInFile);        <<01549>>10240000
  double NumRecsInFile;                                        <<01549>>10242000
begin                                                          <<01549>>10244000
  CHECK'VALID'ENV'FILE := false;                               <<01549>>10246000
                                                               <<01549>>10248000
  FGETINFO(EnvFileNum, <<filename>>, <<foptions>>,             <<01549>>10250000
                       <<aoptions>>,                           <<01549>>10252000
           RecordSize, <<devtype>>,  <<ldnum>>,                <<01549>>10254000
                       <<hdaddr>>,                             <<01549>>10256000
           FileCode,   <<recpt>>,                              <<01549>>10258000
           NumRecsInFile);                                     <<01549>>10260000
  if <> then                                                   <<01549>>10262000
  begin                                                        <<01549>>10264000
    Status := cFGETINFOfailed;                                 <<01549>>10266000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>10268000
    return;                                                    <<01549>>10270000
  end;                                                         <<01549>>10272000
                                                               <<01549>>10274000
  if FileCode <> cEnvFileCode then                             <<01549>>10276000
  begin                                                        <<01549>>10278000
    Status := cNotAnEnvFile;                                   <<01549>>10280000
    ErrNum := cWrongFileCode;                                  <<01549>>10282000
    return;                                                    <<01549>>10284000
  end                                                          <<01549>>10286000
  else if RecordSize <> cEnvFileRecSize then                   <<01549>>10288000
  begin                                                        <<01549>>10290000
    Status := cNotAnEnvFile;                                   <<01549>>10292000
    ErrNum := cWrongRecSize;                                   <<01549>>10294000
    return;                                                    <<01549>>10296000
  end;                                                         <<01549>>10298000
                                                               <<01549>>10300000
  CHECK'VALID'ENV'FILE := true;                                <<01549>>10302000
end;                                                           <<01549>>10304000
                                                               <<01549>>10306000
logical subroutine GET'FILE'HEADER;                            <<01549>>10308000
begin                                                          <<01549>>10310000
  GET'FILE'HEADER := false;                                    <<01549>>10312000
                                                               <<01549>>10314000
  FREADDIR(EnvFileNum,EnvRec,cEnvFileRecSize,                  <<01549>>10316000
           double(cHeaderRnum));                               <<01549>>10318000
  if <> then                                                   <<01549>>10320000
  begin                                                        <<01549>>10322000
    Status := cCouldn'tReadHeader;                             <<01549>>10324000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>10326000
    return;                                                    <<01549>>10328000
  end;                                                         <<01549>>10330000
                                                               <<01549>>10332000
  << See if the file header is okay. >>                        <<01549>>10334000
                                                               <<01549>>10336000
  if EnvRec(cRecordTypeWord) <> cHeaderRecType                 <<01549>>10338000
     or not OKAY'PTR(EnvRec(cDownloadPtr))                     <<01549>>10340000
  then begin                                                   <<01549>>10342000
    Status := cBadEnvFile;                                     <<01549>>10344000
    ErrNum := cBadFileHeader;                                  <<01549>>10346000
    return;                                                    <<01549>>10348000
  end;                                                         <<01549>>10350000
                                                               <<01549>>10352000
  GET'FILE'HEADER := true;                                     <<01549>>10354000
end;                                                           <<01549>>10356000
$PAGE                                                          <<01549>>10358000
logical subroutine READ'COMP'REC(Rnum);                        <<01549>>10360000
  value Rnum;                                                  <<01549>>10362000
  integer Rnum;                                                <<01549>>10364000
                                                               <<01549>>10366000
  comment                                                      <<01549>>10368000
    This subroutine reads record Rnum of the environment       <<01549>>10370000
  file into EnvRec, and then checks to see that that record    <<01549>>10372000
  is actually a compiled (downloadable) one.                   <<01549>>10374000
  ;                                                            <<01549>>10376000
begin                                                          <<01549>>10378000
  READ'COMP'REC := false;                                      <<01549>>10380000
                                                               <<01549>>10382000
  FREADDIR(EnvFileNum,EnvRec,cEnvFileRecSize,                  <<01549>>10384000
           double(Rnum));                                      <<01549>>10386000
  if <> then                                                   <<01549>>10388000
  begin                                                        <<01549>>10390000
    Status := cCouldn'tReadRecord;                             <<01549>>10392000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>10394000
    return;                                                    <<01549>>10396000
  end;                                                         <<01549>>10398000
                                                               <<01549>>10400000
  if EnvRec(cRecordTypeWord) = 128 or                          <<01549>>10402000
     133 <= integer(EnvRec(cRecordTypeWord)) <= 138            <<01549>>10404000
  then                                                         <<01549>>10406000
    READ'COMP'REC := true                                      <<01549>>10408000
  else begin                                                   <<01549>>10410000
    Status := cBadEnvFile;                                     <<01549>>10412000
    ErrNum := cIllegalRecType;                                 <<01549>>10414000
  end;                                                         <<01549>>10416000
end;                                                           <<01549>>10418000
                                                               <<01549>>10420000
subroutine CLOSE'ENV'FILE;                                     <<01549>>10422000
begin                                                          <<01549>>10424000
  FCLOSE(EnvFileNum,0,0); << Take all defaults >>              <<01549>>10426000
  if <> then                                                   <<01549>>10428000
  begin                                                        <<01549>>10430000
    Status := cCouldn'tCloseEnvFile;                           <<01549>>10432000
    FCHECK(EnvFileNum,ErrNum);                                 <<01549>>10434000
  end;                                                         <<01549>>10436000
end;                                                           <<01549>>10438000
$PAGE "                PLOADENV -- MAIN CODE"                  <<01549>>10440000
  Status := cSuccessfulDownload; << Assume success at first >> <<01549>>10442000
                                                               <<01549>>10444000
  if not OPEN'ENV'FILE then return;                            <<01549>>10446000
                                                               <<01549>>10448000
  if not CHECK'VALID'ENV'FILE(NumRecsInFile << output >>) then <<01549>>10450000
    if PCHECK'CIPER'ENV( EnvFileNum, EnvRec,                   <<04382>>10452000
                         Status, ErrNum      ) then            <<04382>>10454000
      begin                                                    <<04382>>10456000
        PLOAD'CIPER'ENV( OutFileNum, EnvFileNum, EnvRec,       <<04382>>10458000
                         Status, ErrNum                  );    <<04382>>10460000
        return;                                                <<04382>>10462000
      end                                                      <<04382>>10464000
    else                                                       <<04382>>10466000
      begin                                                    <<04382>>10468000
        dERROR'RETURN;                                         <<04382>>10470000
      end;                                                     <<04382>>10472000
                                                               <<01549>>10474000
  if not GET'FILE'HEADER      then                             <<01549>>10476000
    dERROR'RETURN;                                             <<01549>>10478000
                                                               <<01549>>10480000
  << If this file has changed since it was last compiled, >>   <<01549>>10482000
  << we will set Status to indicate that.  This is only a >>   <<01549>>10484000
  << warning, however, so we do not do an ERROR'RETURN.   >>   <<01549>>10486000
                                                               <<01549>>10488000
  if EnvRec(cChangedWord) then                                 <<01549>>10490000
    Status := cChangedSinceCompiled;                           <<01549>>10492000
                                                               <<01549>>10494000
  << Start at beginning of download list >>                    <<01549>>10496000
  NextRnum := EnvRec(cDownloadPtr);                            <<01549>>10498000
                                                               <<01549>>10500000
  if NextRnum = cNil then                                      <<01549>>10502000
  begin                                                        <<01549>>10504000
    Status := cEmptyCompiledPart;                              <<01549>>10506000
    dERROR'RETURN;                                             <<01549>>10508000
  end;                                                         <<01549>>10510000
                                                               <<01549>>10512000
  <<** Keep track of the number of records processed.  If this <<01549>>10514000
  <<** ever exceeds the number of records in the file, we have <<01549>>10516000
  <<** encountered a loop in the list of compiled records, so  <<01549>>10518000
  <<** we have a bad environment file.                         <<01549>>10520000
                                                               <<01549>>10522000
  RecCount := 0d;                                              <<01549>>10524000
                                                               <<01549>>10526000
  while NextRnum <> cNil do                                    <<01549>>10528000
  begin                                                        <<01549>>10530000
    if not OKAY'PTR(NextRnum) then                             <<01549>>10532000
    begin                                                      <<01549>>10534000
      Status := cBadEnvFile;                                   <<01549>>10536000
      ErrNum := cPtrBadInList;                                 <<01549>>10538000
      dERROR'RETURN;                                           <<01549>>10540000
    end;                                                       <<01549>>10542000
                                                               <<01549>>10544000
    << Read in the next compiled record >>                     <<01549>>10546000
                                                               <<01549>>10548000
    if not READ'COMP'REC(NextRnum) then                        <<01549>>10550000
      dERROR'RETURN;                                           <<01549>>10552000
                                                               <<01549>>10554000
    << Now go through the compiled record, one logical >>      <<01549>>10556000
    << record at a time.                               >>      <<01549>>10558000
                                                               <<01549>>10560000
    << This variable points to the start of the current >>     <<01549>>10562000
    << logical record.                                  >>     <<01549>>10564000
    NextLogRec := 0;                                           <<01549>>10566000
$PAGE                                                          <<01549>>10568000
    while EnvRec(NextLogRec+cLenPlus8) <> cEndOfLogRecs do     <<01549>>10570000
    begin                                                      <<01549>>10572000
                                                               <<01549>>10574000
      <<** Make sure this logical record is okay. **>>         <<01549>>10576000
                                                               <<01549>>10578000
      if integer(EnvRec(NextLogRec+cLenPlus8)) < 8 then        <<01549>>10580000
      begin                                                    <<01549>>10582000
        Status := cBadEnvFile;                                 <<01549>>10584000
        ErrNum := cBadLogicalRec;                              <<01549>>10586000
        dERROR'RETURN;                                         <<01549>>10588000
      end;                                                     <<01549>>10590000
                                                               <<01549>>10592000
      if integer(EnvRec(NextLogRec+cLenPlus8)) <>              <<01549>>10594000
         integer(EnvRec(NextLogRec+cLen)) + 8                  <<01549>>10596000
      then begin                                               <<01549>>10598000
        Status := cBadEnvFile;                                 <<01549>>10600000
        ErrNum := cBadLogicalRec;                              <<01549>>10602000
        dERROR'RETURN;                                         <<01549>>10604000
      end;                                                     <<01549>>10606000
                                                               <<01549>>10608000
      <<** Download the logical record **>>                    <<01549>>10610000
                                                               <<01549>>10612000
      FDEVICECONTROL( OutFileNum,                              <<01549>>10614000
                      EnvRec(NextLogRec+cData),                <<01549>>10616000
                      -(EnvRec(NextLogRec+cLenPlus8)-8),       <<01549>>10618000
                      EnvRec(NextLogRec+cFuncCode),            <<01549>>10620000
                      EnvRec(NextLogRec+cP1),                  <<01549>>10622000
                      EnvRec(NextLogRec+cP2),                  <<01549>>10624000
                      ErrNum );                                <<01549>>10626000
      if <> then                                               <<01549>>10628000
      begin                                                    <<01549>>10630000
        Status := cFDEVICECONTROLfailed;                       <<01549>>10632000
        dERROR'RETURN;                                         <<01549>>10634000
      end;                                                     <<01549>>10636000
                                                               <<01549>>10638000
      <<** The location of the next logical record is **>>     <<01549>>10640000
      <<** obtained by adding the length of the cur-  **>>     <<01549>>10642000
      <<** rent logical record to the current logical **>>     <<01549>>10644000
      <<** record's position.  The length of the log- **>>     <<01549>>10646000
      <<** ical record is the length of the data,     **>>     <<01549>>10648000
      <<** plus 5 words.  The length of the data in   **>>     <<01549>>10650000
      <<** bytes, plus 8 bytes, is kept as the first  **>>     <<01549>>10652000
      <<** word in the logical record.  If this is    **>>     <<01549>>10654000
      <<** odd, there will be a garbage byte at the   **>>     <<01549>>10656000
      <<** end of the data.  Therefore, we add one to **>>     <<01549>>10658000
      <<** the length plus 8, before dividing by two  **>>     <<01549>>10660000
      <<** to get the length in words.  This is still **>>     <<01549>>10662000
      <<** short by one word, so we add one.          **>>     <<01549>>10664000
                                                               <<01549>>10666000
      NextLogRec := NextLogRec +                               <<01549>>10668000
                    (integer(EnvRec(NextLogRec+cLenPlus8))+1)  <<01549>>10670000
                     / 2 + 1;                                  <<01549>>10672000
                                                               <<01549>>10674000
      if NextLogRec > cEndOfDataWord then                      <<01549>>10676000
      begin  << We went too far >>                             <<01549>>10678000
        Status := cBadEnvFile;                                 <<01549>>10680000
        ErrNum := cNoTerminator;                               <<01549>>10682000
        dERROR'RETURN;                                         <<01549>>10684000
      end;                                                     <<01549>>10686000
                                                               <<01549>>10688000
    end; << _while_ >>                                         <<01549>>10690000
                                                               <<01549>>10692000
    NextRnum := EnvRec(cNextRec);                              <<01549>>10694000
                                                               <<01549>>10696000
    RecCount := RecCount+1d;                                   <<01549>>10698000
    if RecCount > NumRecsInFile then                           <<01549>>10700000
    begin                                                      <<01549>>10702000
      Status := cBadEnvFile;                                   <<01549>>10704000
      ErrNum := cLoopInList;                                   <<01549>>10706000
      dERROR'RETURN;                                           <<01549>>10708000
    end;                                                       <<01549>>10710000
                                                               <<01549>>10712000
  end; << _while_ >>                                           <<01549>>10714000
                                                               <<01549>>10716000
  CLOSE'ENV'FILE;                                              <<01549>>10718000
                                                               <<01549>>10720000
end; << PLOADENV >>                                            <<04382>>10722000
$PAGE "PROCEDURE:  PCHECK'CIPER'ENV"                           <<04382>>10724000
logical procedure PCHECK'CIPER'ENV( Env'file'num,              <<04382>>10726000
                                    Scratch'buffer,            <<04382>>10728000
                                    Return'Status,             <<04382>>10730000
                                    Error'number   );          <<04382>>10732000
                                                               <<04382>>10734000
  integer                           Env'file'num,              <<04382>>10736000
                                    Return'Status,             <<04382>>10738000
                                    Error'number    ;          <<04382>>10740000
                                                               <<04382>>10742000
  logical array                     Scratch'buffer  ;          <<04382>>10744000
                                                               <<04382>>10746000
COMMENT                                                        <<04382>>10748000
                                                               <<04382>>10750000
  This procedure is used by PCHECKENV and PLOADENV to validate <<04382>>10752000
an alleged CIPER environment file.  By the time this procedure <<04382>>10754000
is called, the environment file will have been opened and      <<04382>>10756000
checked to see if it is a P2680 type environment (which it     <<04382>>10758000
will not have been, in order to get here).                     <<04382>>10760000
                                                               <<04382>>10762000
  Since a CIPER environment file has no special file code or   <<04382>>10764000
record size (in fact it is just an VFC file similar to those   <<04382>>10766000
used for the 2608A printer), the only way to determine validity<<04382>>10768000
is to look for one of the contructs                            <<04382>>10770000
                                                               <<04382>>10772000
      MODE= ,                                                  <<04382>>10774000
      MARGIN= ,                                                <<04382>>10776000
  or  VFC,xx,yyy                                               <<04382>>10778000
                                                               <<04382>>10780000
as the first record in the file.                               <<04382>>10782000
                                                               <<04382>>10784000
  This procedure does not verify that the contents of the file <<04382>>10786000
are correct (nor does the subroutine CHECK'VALID'ENV'FILE used <<04382>>10788000
by PCHECKENV and PLOADENV for P2680 files).  It merely deter-  <<04382>>10790000
mines that the file looks like a CIPER environment file.       <<04382>>10792000
                                                               <<04382>>10794000
  If anything goes wrong during the check, Return'Status is set<<04382>>10796000
to explain the error in general terms, and Error'number is set <<04382>>10798000
to explain exactly what happened.  Regardless of the result,   <<04382>>10800000
the file is left open when PCHECK'CIPER'ENV returns.           <<04382>>10802000
                                                               <<04382>>10804000
  Calling sequence:                                            <<04382>>10806000
                                                               <<04382>>10808000
                                I              LA       I      <<04382>>10810000
    PCHECK'CIPER'ENV( Env'file'num, Scratch'buffer, Status,    <<04382>>10812000
                                I                              <<04382>>10814000
                      Error'number                          )  <<04382>>10816000
                                                               <<04382>>10818000
                                                               <<04382>>10820000
  Parameters:                                                  <<04382>>10822000
                                                               <<04382>>10824000
    Env'file'num    integer (required)                         <<04382>>10826000
                                                               <<04382>>10828000
                    This is the file number of the opened CIPER<<04382>>10830000
                    for checking.                              <<04382>>10832000
                                                               <<04382>>10834000
    Scratch'buffer  logical array (required)                   <<04382>>10836000
                                                               <<04382>>10838000
                    This is (currently) a 512 word array used  <<04382>>10840000
                    by PCHECKENV and PLOADENV for reading re-  <<04382>>10842000
                    cords out of the environment file.  This   <<04382>>10844000
                    procedure uses it for the same purpose.    <<04382>>10846000
                    Since PCHECKENV and PLOADENV always have   <<04382>>10848000
                    this array, it is passed as a parameter to <<04382>>10850000
                    conserve stack space.                      <<04382>>10852000
                                                               <<04382>>10854000
    Return'status   integer (required)                         <<04382>>10856000
                                                               <<04382>>10858000
                    On return, this parameter is set to indi-  <<04382>>10860000
                    cate, in general terms, what happened when <<04382>>10862000
                    PCHECK'CIPER'ENV tried to evaluate the en- <<04382>>10864000
                    vironment file.  The values returned cor-  <<04382>>10866000
                    respond to those returned by PCHECKENV and <<04382>>10868000
                    PLOADENV.  They are:                       <<04382>>10870000
                                                               <<04382>>10872000
                      value               meaning              <<04382>>10874000
                                                               <<04382>>10876000
                        0       Successful.  The environment   <<04382>>10878000
                                file is okay, as far as we can <<04382>>10880000
                                tell without parsing the entire<<04382>>10882000
                                thing.                         <<04382>>10884000
                                                               <<04382>>10886000
                        2       File is not a recognizable en- <<04382>>10888000
                                vironment file.                <<04382>>10890000
                                                               <<04382>>10892000
                        3       Could not read the header re-  <<04382>>10894000
                                cord (record 0).               <<04382>>10896000
                                                               <<04382>>10898000
    Error'number    integer (required)                         <<04382>>10900000
                                                               <<04382>>10902000
                    If an error occurred (as indicated by      <<04382>>10904000
                    zero Return'status, above) Error'number    <<04382>>10906000
                    will contain in detail the actual error.   <<04382>>10908000
                    For errors resulting from MPE intrinsics,  <<04382>>10910000
                    Error'number contains the error number re- <<04382>>10912000
                    turned by FCHECK.  For errors specific to  <<04382>>10914000
                    environment files, Error'number contains   <<04382>>10916000
                    one of the following values:               <<04382>>10918000
                                                               <<04382>>10920000
                    (The associated Return'status value is     <<04382>>10922000
                     shown in parentheses.)                    <<04382>>10924000
                                                               <<04382>>10926000
                      value               meaning              <<04382>>10928000
                                                               <<04382>>10930000
                      9 (2)     File not a CIPER environment.  <<04382>>10932000
                                                               <<04382>>10934000
;                                                              <<04382>>10936000
$PAGE "PROCEDURE:  PCHECK'CIPER'ENV -- LOCAL DECLARATIONS"     <<04382>>10938000
begin                                                          <<04382>>10940000
                                                               <<04382>>10942000
  equate                                                       <<04382>>10944000
                                                               <<04382>>10946000
    max'parms                     = 4                          <<04382>>10948000
      << Maximum number of parameters (VFC,xx,yyy,comment) >>  <<04382>>10950000
                                                               <<04382>>10952000
   ,min'parms                     = 1                          <<04382>>10954000
      << Minimum number of parameters (MARGIN=) >>             <<04382>>10956000
                                                               <<04382>>10958000
  ;                                                            <<04382>>10960000
                                                               <<04382>>10962000
                                                               <<04382>>10964000
  double array                                                 <<04382>>10966000
                                                               <<04382>>10968000
    parm'info(0:max'parms-1)                                   <<04382>>10970000
      << Parameter information array >>                        <<04382>>10972000
                                                               <<04382>>10974000
  ;                                                            <<04382>>10976000
                                                               <<04382>>10978000
                                                               <<04382>>10980000
  double                                                       <<04382>>10982000
                                                               <<04382>>10984000
    this'parm                                                  <<04382>>10986000
      << Contains info for a specific parameter >>             <<04382>>10988000
                                                               <<04382>>10990000
  ;                                                            <<04382>>10992000
                                                               <<04382>>10994000
                                                               <<04382>>10996000
  byte pointer                                                 <<04382>>10998000
                                                               <<04382>>11000000
    parameter                     = this'parm                  <<04382>>11002000
      << Points to first character of a parameter >>           <<04382>>11004000
                                                               <<04382>>11006000
  ;                                                            <<04382>>11008000
                                                               <<04382>>11010000
                                                               <<04382>>11012000
  logical                                                      <<04382>>11014000
                                                               <<04382>>11016000
    l'parm                        = this'parm + 1              <<04382>>11018000
      << Parameter descriptor information >>                   <<04382>>11020000
                                                               <<04382>>11022000
  ;                                                            <<04382>>11024000
                                                               <<04382>>11026000
                                                               <<04382>>11028000
  define                                                       <<04382>>11030000
                                                               <<04382>>11032000
    parm'length                   = l'parm.(0:8) #             <<04382>>11034000
      << Length, in characters, of individual parameter >>     <<04382>>11036000
                                                               <<04382>>11038000
   ,p'alpha                       = l'parm.(8:1) #             <<04382>>11040000
      << True if parameter contains alphabetic characters >>   <<04382>>11042000
                                                               <<04382>>11044000
   ,p'numeric                     = l'parm.(9:1) #             <<04382>>11046000
      << True if parameter contains numeric characters >>      <<04382>>11048000
                                                               <<04382>>11050000
   ,p'special                     = l'parm.(10:1) #            <<04382>>11052000
      << True if parameter contains special characters >>      <<04382>>11054000
      << other than the specified delimiters           >>      <<04382>>11056000
                                                               <<04382>>11058000
   ,p'delimiter                   = l'parm.(11:5) #            <<04382>>11060000
      << Delimiter number (see below) >>                       <<04382>>11062000
                                                               <<04382>>11064000
  ;                                                            <<04382>>11066000
                                                               <<04382>>11068000
                                                               <<04382>>11070000
  equate  << Default delimiter assignments from MYCOMMMAND >>  <<04382>>11072000
                                                               <<04382>>11074000
    comma                         = 0                          <<04382>>11076000
   ,equal                         = 1                          <<04382>>11078000
   ,semicolon                     = 2                          <<04382>>11080000
   ,carriage'return               = 3                          <<04382>>11082000
                                                               <<04382>>11084000
  ;                                                            <<04382>>11086000
                                                               <<04382>>11088000
                                                               <<04382>>11090000
  equate                                                       <<04382>>11092000
                                                               <<04382>>11094000
    cr                            = %15                        <<04382>>11096000
   ,double'cr                     = %6415                      <<04382>>11098000
                                                               <<04382>>11100000
  ;                                                            <<04382>>11102000
                                                               <<04382>>11104000
                                                               <<04382>>11106000
  byte pointer                                                 <<04382>>11108000
                                                               <<04382>>11110000
    b'env'record                                               <<04382>>11112000
      << Set up to point to the Scratch'buffer >>              <<04382>>11114000
                                                               <<04382>>11116000
  ;                                                            <<04382>>11118000
                                                               <<04382>>11120000
                                                               <<04382>>11122000
  integer                                                      <<04382>>11124000
                                                               <<04382>>11126000
    number'of'parameters                                       <<04382>>11128000
      << MYCOMMAND returns the actual number of parameters >>  <<04382>>11130000
      << found in the parsed string.                       >>  <<04382>>11132000
                                                               <<04382>>11134000
   ,read'length                                                <<04382>>11136000
      << The transfer log as returned from FREAD.  >>          <<04382>>11138000
                                                               <<04382>>11140000
  ;                                                            <<04382>>11142000
                                                               <<04382>>11144000
                                                               <<04382>>11146000
  << These are the values which Return'status can have on >>   <<04382>>11148000
  << return:                                              >>   <<04382>>11150000
                                                               <<04382>>11152000
  equate                                                       <<04382>>11154000
                                                               <<04382>>11156000
    cSuccessfulCheck              = 0                          <<04382>>11158000
   ,cNotAnEnvFile                 = 2                          <<04382>>11160000
   ,cCouldn'tReadHeader           = 3                          <<04382>>11162000
                                                               <<04382>>11164000
  ;                                                            <<04382>>11166000
                                                               <<04382>>11168000
                                                               <<04382>>11170000
  << These are the values which Error'number can have on >>    <<04382>>11172000
  << return.                                             >>    <<04382>>11174000
  <<                                                     >>    <<04382>>11176000
  << Error'number is undefined if Return'status is       >>    <<04382>>11178000
  << cSuccessfulDownload.                                >>    <<04382>>11180000
  <<                                                     >>    <<04382>>11182000
  << Error'number is the value returned by FCHECK if     >>    <<04382>>11184000
  << Return'status is cCouldn'tReadHeader.               >>    <<04382>>11186000
                                                               <<04382>>11188000
  equate                                                       <<04382>>11190000
                                                               <<04382>>11192000
    cNotCIPEREnv                  = 9                          <<04382>>11194000
                                                               <<04382>>11196000
  ;                                                            <<04382>>11198000
$PAGE "PROCEDURE:  PCHECK'CIPER'ENV -- PROCEDURE BODY"         <<04382>>11200000
  << First, assume a successful completion, and initialize >>  <<04382>>11202000
  << the return information accordingly.                   >>  <<04382>>11204000
                                                               <<04382>>11206000
  PCHECK'CIPER'ENV := true;                                    <<04382>>11208000
  Return'status := cSuccessfulCheck;                           <<04382>>11210000
  Error'number := cSuccessfulCheck;                            <<04382>>11212000
                                                               <<04382>>11214000
                                                               <<04382>>11216000
  << Next, initialize the byte pointer into the scratch  >>    <<04382>>11218000
  << buffer we are given.                                >>    <<04382>>11220000
                                                               <<04382>>11222000
  @b'env'record := @scratch'buffer & lsl(1);                   <<04382>>11224000
                                                               <<04382>>11226000
                                                               <<04382>>11228000
  << Read the header record from the file >>                   <<04382>>11230000
                                                               <<04382>>11232000
  read'length := fread(env'file'num, scratch'buffer, 36);      <<04382>>11234000
  if <> then                                                   <<04382>>11236000
    begin                                                      <<04382>>11238000
      return'status := cCouldn'tReadHeader;                    <<04382>>11240000
      FCHECK(env'file'num, Error'number);                      <<04382>>11242000
      return;                                                  <<04382>>11244000
    end;                                                       <<04382>>11246000
                                                               <<04382>>11248000
                                                               <<04382>>11250000
  scratch'buffer(read'length) := double'cr;                    <<04382>>11252000
                                                               <<04382>>11254000
                                                               <<04382>>11256000
  << Parse the header record so we can look for a valid >>     <<04382>>11258000
  << command.                                           >>     <<04382>>11260000
                                                               <<04382>>11262000
  MYCOMMAND( b'env'record, << delimiters defaulted >>,         <<04382>>11264000
             max'parms, number'of'parameters, parm'info );     <<04382>>11266000
                                                               <<04382>>11268000
  this'parm := parm'info;                                      <<04382>>11270000
                                                               <<04382>>11272000
                                                               <<04382>>11274000
  << Now look for one of "MODE=", "MARGIN=", or "VFC," >>      <<04382>>11276000
                                                               <<04382>>11278000
  if parm'length > 0 and                                       <<04382>>11280000
     (min'parms <= number'of'parameters <= max'parms) then     <<04382>>11282000
    begin  << First parm must not be null parameter >>         <<04382>>11284000
                                                               <<04382>>11286000
      if parameter = "MARGIN" and parm'length = 6 and          <<04382>>11288000
         p'delimiter = equal then                              <<04382>>11290000
        begin                                                  <<04382>>11292000
          << All okay, so just branch around to the exit >>    <<04382>>11294000
        end                                                    <<04382>>11296000
      else                                                     <<04382>>11298000
        begin                                                  <<04382>>11300000
          if parameter = "MODE" and parm'length = 4 and        <<04382>>11302000
             p'delimiter = equal then                          <<04382>>11304000
            begin                                              <<04382>>11306000
              << All okay, so branch to exit >>                <<04382>>11308000
            end                                                <<04382>>11310000
          else                                                 <<04382>>11312000
            begin                                              <<04382>>11314000
              if parameter = "VFC" and parm'length = 3 and     <<04382>>11316000
                 p'delimiter = comma then                      <<04382>>11318000
                begin                                          <<04382>>11320000
                  << All okay, so branch to exit >>            <<04382>>11322000
                end                                            <<04382>>11324000
              else                                             <<04382>>11326000
                begin                                          <<04382>>11328000
                  PCHECK'CIPER'ENV := false;                   <<04382>>11330000
                  Return'status := cNotAnEnvFile;              <<04382>>11332000
                  Error'number := cNotCiperEnv;                <<04382>>11334000
                end;                                           <<04382>>11336000
            end;                                               <<04382>>11338000
        end;                                                   <<04382>>11340000
                                                               <<04382>>11342000
    end                                                        <<04382>>11344000
  else                                                         <<04382>>11346000
    begin                                                      <<04382>>11348000
                                                               <<04382>>11350000
      PCHECK'CIPER'ENV := false;                               <<04382>>11352000
      Return'status := cNotAnEnvFile;                          <<04382>>11354000
      Error'number := cNotCIPEREnv;                            <<04382>>11356000
                                                               <<04382>>11358000
    end;                                                       <<04382>>11360000
                                                               <<04382>>11362000
end;  << of procedure PCHECK'CIPER'ENV >>                      <<04382>>11364000
$PAGE "PLOAD'CIPER'ENV"                                        <<04382>>11366000
logical procedure PLOAD'CIPER'ENV( Out'file'num,               <<04382>>11368000
                                   Env'file'num,               <<04382>>11370000
                                   Scratch'buffer,             <<04382>>11372000
                                   Return'status,              <<04382>>11374000
                                   Error'number     );         <<04382>>11376000
                                                               <<04382>>11378000
  integer                          Out'file'num,               <<04382>>11380000
                                   Env'file'num,               <<04382>>11382000
                                   Return'status,              <<04382>>11384000
                                   Error'number      ;         <<04382>>11386000
                                                               <<04382>>11388000
  logical array                    Scratch'buffer    ;         <<04382>>11390000
                                                               <<04382>>11392000
                                                               <<04382>>11394000
COMMENT                                                        <<04382>>11396000
                                                               <<04382>>11398000
  This procedure is called by PLOADENV to parse a CIPER envir- <<04382>>11400000
onment file and send the results to the specified output file. <<04382>>11402000
PLOADENV will have already opened the environment file and de- <<04382>>11404000
termined that it is not a P2680 environment.                   <<04382>>11406000
                                                               <<04382>>11408000
  The output file specified can be either spooled or non-spool-<<04382>>11410000
ed, and this procedure makes no check.  FDEVICECONTROL, which  <<04382>>11412000
is used to transmit the environment commands to the output     <<04382>>11414000
file, will determine if the file is a spoolfile or not.        <<04382>>11416000
                                                               <<04382>>11418000
  If anything goes wrong during the environment load,          <<04382>>11420000
Return'status is set to explain the error in general terms, and<<04382>>11422000
Error'number is set to explain exactly what happened.  Regard- <<04382>>11424000
less of the outcome of the load, the environment file will be  <<04382>>11426000
closed before this procedure returns.                          <<04382>>11428000
                                                               <<04382>>11430000
  Calling sequence:                                            <<04382>>11432000
                                                               <<04382>>11434000
                               I             I                 <<04382>>11436000
    PLOAD'CIPER'ENV( Out'file'num, Env'file'num,               <<04382>>11438000
                                LA              I              <<04382>>11440000
                     Scratch'buffer, Return'status,            <<04382>>11442000
                               I                               <<04382>>11444000
                     Error'number                    )         <<04382>>11446000
                                                               <<04382>>11448000
                                                               <<04382>>11450000
  Parameters:                                                  <<04382>>11452000
                                                               <<04382>>11454000
    Out'file'num    integer (required)                         <<04382>>11456000
                                                               <<04382>>11458000
                    This is the file number of the destination <<04382>>11460000
                    device file.  It may be spooled or non-    <<04382>>11462000
                    spooled.                                   <<04382>>11464000
                                                               <<04382>>11466000
    Env'file'num    integer (required)                         <<04382>>11468000
                                                               <<04382>>11470000
                    This is the file number of the environment <<04382>>11472000
                    file to load.  It is open, but may or may  <<04382>>11474000
                    not be rewound, so a rewind is always per- <<04382>>11476000
                    formed.                                    <<04382>>11478000
                                                               <<04382>>11480000
    Scratch'buffer  logical array (required)                   <<04382>>11482000
                                                               <<04382>>11484000
                    This is (currently) a 512 word array de-   <<04382>>11486000
                    clared by PLOADENV for reading environment <<04382>>11488000
                    file records.  It is passed to this proce- <<04382>>11490000
                    dure, so a local scratch array is not re-  <<04382>>11492000
                    quired.  This is to conserve stack space.  <<04382>>11494000
                                                               <<04382>>11496000
    Return'status   integer (required)                         <<04382>>11498000
                                                               <<04382>>11500000
                    On return, this parameter is set to indi-  <<04382>>11502000
                    cate, in general terms, what happened when <<04382>>11504000
                    PLOAD'CIPER'ENV tried to download the en-  <<04382>>11506000
                    vironment file.  The values returned cor-  <<04382>>11508000
                    respond to those returned by PCHECKENV and <<04382>>11510000
                    PLOADENV.  They are:                       <<04382>>11512000
                                                               <<04382>>11514000
                      value               meaning              <<04382>>11516000
                                                               <<04382>>11518000
                        0       Successful.  The environment   <<04382>>11520000
                                file is downloaded.            <<04382>>11522000
                                                               <<04382>>11524000
                        3       Couldn't read the environment  <<04382>>11526000
                                file's header record.          <<04382>>11528000
                                                               <<04382>>11530000
                        6       Bad environment file.  There   <<04382>>11532000
                                was something wrong with the   <<04382>>11534000
                                environment file's internal    <<04382>>11536000
                                format.                        <<04382>>11538000
                                                               <<04382>>11540000
                        7       Couldn't read a record of the  <<04382>>11542000
                                environment file.              <<04382>>11544000
                                                               <<04382>>11546000
                        8       Couldn't close the environment <<04382>>11548000
                                file.                          <<04382>>11550000
                                                               <<04382>>11552000
                       10       FDEVICECONTROL failed.         <<04382>>11554000
                                Error'number contains the error<<04382>>11556000
                                number returned by             <<04382>>11558000
                                FDEVICECONTROL.                <<04382>>11560000
                                                               <<04382>>11562000
    Error'number    integer (required)                         <<04382>>11564000
                                                               <<04382>>11566000
                    If an error occurred (as indicated by      <<04382>>11568000
                    Return'status, above) Error'number will    <<04382>>11570000
                    contain in detail the actual error.  For   <<04382>>11572000
                    errors resulting from MPE intrinsics,      <<04382>>11574000
                    Error'number contains the error number re- <<04382>>11576000
                    turned by FCHECK.  For errors specific to  <<04382>>11578000
                    environment files, Error'number contains   <<04382>>11580000
                    one of the following values:               <<04382>>11582000
                                                               <<04382>>11584000
                    (The associated Return'status value is     <<04382>>11586000
                     shown in parentheses.)                    <<04382>>11588000
                                                               <<04382>>11590000
                      value               meaning              <<04382>>11592000
                                                               <<04382>>11594000
                      10 (6)    Illegal command or parameter   <<04382>>11596000
                                in CIPER environment.          <<04382>>11598000
                                                               <<04382>>11600000
                                                               <<04382>>11602000
;                                                              <<04382>>11604000
$PAGE "PLOAD'CIPER'ENV -- LOCAL DECLARATIONS"                  <<04382>>11606000
begin                                                          <<04382>>11608000
                                                               <<04382>>11610000
  equate                                                       <<04382>>11612000
                                                               <<04382>>11614000
    max'parms                     = 4                          <<04382>>11616000
      << Maximum number of parameters (VFC,xx,yyy,comment) >>  <<04382>>11618000
                                                               <<04382>>11620000
   ,min'parms                     = 2                          <<04382>>11622000
      << Minimum number of parameters (MARGIN=xx or MODE=xx) >><<04382>>11624000
                                                               <<04382>>11626000
   ,margin'parms                  = 2                          <<04382>>11628000
      << Number of parameters in a valid MARGIN command >>     <<04382>>11630000
                                                               <<04382>>11632000
   ,mode'parms                    = 2                          <<04382>>11634000
      << Number of parameters in a valid MODE= command >>      <<04382>>11636000
                                                               <<04382>>11638000
   ,vfc'parms'w'o'comment         = 3                          <<04382>>11640000
      << Number of parameters in a valid VFC command that >>   <<04382>>11642000
      << has no comment as the last parameter             >>   <<04382>>11644000
                                                               <<04382>>11646000
   ,vfc'parms'w'comment           = 4                          <<04382>>11648000
      << Number of parameters in a valid VFC command that >>   <<04382>>11650000
      << has a comment string as the last parameter       >>   <<04382>>11652000
                                                               <<04382>>11654000
   ,max'vfc'lines                 = 127                        <<04382>>11656000
      << Maximum number of lines in a VFC download >>          <<04382>>11658000
                                                               <<04382>>11660000
   ,max'read'length               = 36                         <<04382>>11662000
      << Maximum count parameter used in FREAD calls >>        <<04382>>11664000
                                                               <<04382>>11666000
   ,vfc'read'length               = 8                          <<04382>>11668000
      << Vfc records are 8 words long >>                       <<04382>>11670000
                                                               <<04382>>11672000
   ,min'margin                    = 1                          <<04382>>11674000
      << Minimum allowed value for left margin >>              <<04382>>11676000
                                                               <<04382>>11678000
   ,max'margin                    = 16                         <<04382>>11680000
      << Maximum allowed value for left margin >>              <<04382>>11682000
                                                               <<04382>>11684000
  ;                                                            <<04382>>11686000
                                                               <<04382>>11688000
                                                               <<04382>>11690000
  double array                                                 <<04382>>11692000
                                                               <<04382>>11694000
    parm'info(0:max'parms-1)                                   <<04382>>11696000
      << Parameter information array >>                        <<04382>>11698000
                                                               <<04382>>11700000
  ;                                                            <<04382>>11702000
                                                               <<04382>>11704000
                                                               <<04382>>11706000
  double                                                       <<04382>>11708000
                                                               <<04382>>11710000
    this'parm                                                  <<04382>>11712000
      << Contains info for a specific parameter >>             <<04382>>11714000
                                                               <<04382>>11716000
  ;                                                            <<04382>>11718000
                                                               <<04382>>11720000
                                                               <<04382>>11722000
  byte pointer                                                 <<04382>>11724000
                                                               <<04382>>11726000
    parameter                     = this'parm                  <<04382>>11728000
      << Points to first character of a parameter >>           <<04382>>11730000
                                                               <<04382>>11732000
  ;                                                            <<04382>>11734000
                                                               <<04382>>11736000
                                                               <<04382>>11738000
  logical                                                      <<04382>>11740000
                                                               <<04382>>11742000
    l'parm                        = this'parm + 1              <<04382>>11744000
      << Parameter descriptor information >>                   <<04382>>11746000
                                                               <<04382>>11748000
  ;                                                            <<04382>>11750000
                                                               <<04382>>11752000
                                                               <<04382>>11754000
  define  << Parameter descriptor sub-fields >>                <<04382>>11756000
                                                               <<04382>>11758000
    parm'length                   = l'parm.(0:8) #             <<04382>>11760000
      << Length, in characters, of individual parameter >>     <<04382>>11762000
                                                               <<04382>>11764000
   ,p'alpha                       = l'parm.(8:1) #             <<04382>>11766000
      << True if parameter contains alphabetic characters >>   <<04382>>11768000
                                                               <<04382>>11770000
   ,p'numeric                     = l'parm.(9:1) #             <<04382>>11772000
      << True if parameter contains numeric characters >>      <<04382>>11774000
                                                               <<04382>>11776000
   ,p'special                     = l'parm.(10:1) #            <<04382>>11778000
      << True if parameter contains special characters >>      <<04382>>11780000
      << other than the specified delimiters           >>      <<04382>>11782000
                                                               <<04382>>11784000
   ,p'delimiter                   = l'parm.(11:5) #            <<04382>>11786000
      << Delimiter number (see below) >>                       <<04382>>11788000
                                                               <<04382>>11790000
  ;                                                            <<04382>>11792000
                                                               <<04382>>11794000
                                                               <<04382>>11796000
  equate  << Default delimiter assignments from MYCOMMMAND >>  <<04382>>11798000
                                                               <<04382>>11800000
    comma                         = 0                          <<04382>>11802000
   ,equal                         = 1                          <<04382>>11804000
   ,semicolon                     = 2                          <<04382>>11806000
   ,carriage'return               = 3                          <<04382>>11808000
                                                               <<04382>>11810000
  ;                                                            <<04382>>11812000
                                                               <<04382>>11814000
                                                               <<04382>>11816000
  equate  << FCONTROL and FDEVICECONTROL function codes: >>    <<04382>>11818000
                                                               <<04382>>11820000
    func'file'rewind              = 5                          <<04382>>11822000
      << Rewind file to start >>                               <<04382>>11824000
                                                               <<04382>>11826000
   ,func'vfu'download             = 64                         <<04382>>11828000
      << Downloads VFC information to Out'file'num >>          <<04382>>11830000
                                                               <<04382>>11832000
   ,func'margin'set               = 65                         <<04382>>11834000
      << Downloads left margin setting to output file >>       <<04382>>11836000
                                                               <<04382>>11838000
   ,func'mode'set                 = 146                        <<04382>>11840000
      << Sets 'feature' or 'transparent' access mode >>        <<04382>>11842000
                                                               <<04382>>11844000
  ;                                                            <<04382>>11846000
                                                               <<04382>>11848000
                                                               <<04382>>11850000
  equate                                                       <<04382>>11852000
                                                               <<04382>>11854000
    double'cr                     = %6415                      <<04382>>11856000
      << Double carriage return for parsing with MYCOMMAND >>  <<04382>>11858000
                                                               <<04382>>11860000
                                                               <<04382>>11862000
  ;                                                            <<04382>>11864000
                                                               <<04382>>11866000
                                                               <<04382>>11868000
  logical array                                                <<04382>>11870000
                                                               <<04382>>11872000
    read'buffer(*)                = Scratch'buffer             <<04382>>11874000
      << Part of the scratch buffer that is used as an >>      <<04382>>11876000
      << input buffer for FREAD calls                  >>      <<04382>>11878000
                                                               <<04382>>11880000
  ;                                                            <<04382>>11882000
                                                               <<04382>>11884000
                                                               <<04382>>11886000
  logical pointer                                              <<04382>>11888000
                                                               <<04382>>11890000
                                                               <<04382>>11892000
    vfc'image                                                  <<04382>>11894000
      << Part of the scratch buffer that is used to con- >>    <<04382>>11896000
      << struct an image of the VFC that later gets sent >>    <<04382>>11898000
      << to the output file                              >>    <<04382>>11900000
                                                               <<04382>>11902000
  ;                                                            <<04382>>11904000
                                                               <<04382>>11906000
                                                               <<04382>>11908000
  byte pointer                                                 <<04382>>11910000
                                                               <<04382>>11912000
    b'read'buffer                                              <<04382>>11914000
      << Set up to point to the Scratch'buffer >>              <<04382>>11916000
                                                               <<04382>>11918000
   ,b'vfc'image                                                <<04382>>11920000
      << byte pointer to the vfc image >>                      <<04382>>11922000
                                                               <<04382>>11924000
  ;                                                            <<04382>>11926000
                                                               <<04382>>11928000
                                                               <<04382>>11930000
  integer                                                      <<04382>>11932000
                                                               <<04382>>11934000
    number'of'parameters                                       <<04382>>11936000
      << MYCOMMAND returns the actual number of parameters >>  <<04382>>11938000
      << found in the parsed string.                       >>  <<04382>>11940000
                                                               <<04382>>11942000
   ,read'length                                                <<04382>>11944000
      << The transfer log as returned from FREAD.  >>          <<04382>>11946000
                                                               <<04382>>11948000
   ,lines'in'file                  := 0                        <<04382>>11950000
      << Number of lines read from environment file >>         <<04382>>11952000
                                                               <<04382>>11954000
   ,parm'num                                                   <<04382>>11956000
      << Index into parm'info descriptor array >>              <<04382>>11958000
                                                               <<04382>>11960000
   ,count                                                      <<04382>>11962000
      << Word count passed to FDEVICECONTROL >>                <<04382>>11964000
                                                               <<04382>>11966000
   ,lines'in'vfc                                               <<04382>>11968000
      << Index to Vfc image under construction >>              <<04382>>11970000
                                                               <<04382>>11972000
   ,channel'index                                              <<04382>>11974000
      << Index to each bit of a VFC line >>                    <<04382>>11976000
                                                               <<04382>>11978000
  ;                                                            <<04382>>11980000
                                                               <<04382>>11982000
                                                               <<04382>>11984000
  logical                                                      <<04382>>11986000
                                                               <<04382>>11988000
    P1                            := 0                         <<04382>>11990000
   ,P2                            := 0                         <<04382>>11992000
   ,dummy'parm                    := 0                         <<04382>>11994000
      << Parameters passed to FCONTROL and FDEVICECONTROL >>   <<04382>>11996000
                                                               <<04382>>11998000
  ;                                                            <<04382>>12000000
                                                               <<04382>>12002000
                                                               <<04382>>12004000
  logical                                                      <<04382>>12006000
                                                               <<04382>>12008000
    mode'encountered               := false                    <<04382>>12010000
      << Set true if a MODE= command is ever found in the >>   <<04382>>12012000
      << environment file                                 >>   <<04382>>12014000
                                                               <<04382>>12016000
   ,margin'encountered             := false                    <<04382>>12018000
      << Set true if a MARGIN= command is ever found in the >> <<04382>>12020000
      << environment file                                   >> <<04382>>12022000
                                                               <<04382>>12024000
   ,vfc'encountered                := false                    <<04382>>12026000
      << Set true if a VFC command is ever found in the  >>    <<04382>>12028000
      << environment file                                >>    <<04382>>12030000
                                                               <<04382>>12032000
   ,channel'one'set                                            <<04382>>12034000
      << Set true if at least one VFC line has channel >>      <<04382>>12036000
      << one set.                                      >>      <<04382>>12038000
                                                               <<04382>>12040000
   ,end'of'file                                                <<04382>>12042000
      << Set true if the end of file is found while looking >> <<04382>>12044000
      << for major commands in the outer block of the pro-  >> <<04382>>12046000
      << cedure.                                            >> <<04382>>12048000
                                                               <<04382>>12050000
  ;                                                            <<04382>>12052000
                                                               <<04382>>12054000
                                                               <<04382>>12056000
  << These are the values which Return'status can have on >>   <<04382>>12058000
  << return:                                              >>   <<04382>>12060000
                                                               <<04382>>12062000
  equate                                                       <<04382>>12064000
                                                               <<04382>>12066000
    cSuccessfulLoad               = 0                          <<04382>>12068000
   ,cNotAnEnvFile                 = 2                          <<04382>>12070000
   ,cCouldn'tReadHeader           = 3                          <<04382>>12072000
   ,cBadEnvFile                   = 6                          <<04382>>12074000
   ,cCouldn'tReadRecord           = 7                          <<04382>>12076000
   ,cCouldn'tCloseEnvFile         = 8                          <<04382>>12078000
   ,cFDEVICECONTROLfailed         = 10                         <<04382>>12080000
   ,cCouldn'tPositionEnvFile      = 12                         <<04382>>12082000
                                                               <<04382>>12084000
  ;                                                            <<04382>>12086000
                                                               <<04382>>12088000
                                                               <<04382>>12090000
  << These are the values which Error'number can have on >>    <<04382>>12092000
  << return.                                             >>    <<04382>>12094000
  <<                                                     >>    <<04382>>12096000
  << Error'number is undefined if Return'status is       >>    <<04382>>12098000
  << cSuccessfulDownload.                                >>    <<04382>>12100000
  <<                                                     >>    <<04382>>12102000
  << Error'number is the value returned by FCHECK if     >>    <<04382>>12104000
  << Return'status is cCouldn'tReadHeader.               >>    <<04382>>12106000
                                                               <<04382>>12108000
  equate                                                       <<04382>>12110000
                                                               <<04382>>12112000
    cNotCIPEREnv                  = 9                          <<04382>>12114000
   ,cSomethingIsWrong             = 10                         <<04382>>12116000
                                                               <<04382>>12118000
  ;                                                            <<04382>>12120000
$PAGE "PLOAD'CIPER'ENV -- SUBROUTINE PROCESS'MODE'COMMAND"     <<04382>>12122000
subroutine Process'MODE'command;                               <<04382>>12124000
                                                               <<04382>>12126000
COMMENT                                                        <<04382>>12128000
                                                               <<04382>>12130000
  This subroutine performs the function of parsing out a       <<04382>>12132000
                                                               <<04382>>12134000
      MODE=[FEATURE/TRANSPARENT]                               <<04382>>12136000
                                                               <<04382>>12138000
command.  If the command is valid, the subroutine will perform <<04382>>12140000
the appropriate FDEVICECONTROL call.  If not valid, both       <<04382>>12142000
Status'return and Error'number will be set to indicate the     <<04382>>12144000
abnormal condition that exists.                                <<04382>>12146000
                                                               <<04382>>12148000
;                                                              <<04382>>12150000
                                                               <<04382>>12152000
begin                                                          <<04382>>12154000
                                                               <<04382>>12156000
  count := P1 := P2 := 0; << Initialize FDEVICECONTROL parms >><<04382>>12158000
                                                               <<04382>>12160000
  if lines'in'file = (if margin'encountered then 2 else 1) then<<04382>>12162000
    begin                                                      <<04382>>12164000
                                                               <<04382>>12166000
      mode'encountered := true;                                <<04382>>12168000
                                                               <<04382>>12170000
      if number'of'parameters = mode'parms then                <<04382>>12172000
        begin                                                  <<04382>>12174000
                                                               <<04382>>12176000
          this'parm := parm'info(parm'num := parm'num + 1);    <<04382>>12178000
                                                               <<04382>>12180000
          P1.(15:1) := parameter = "FEATURE"                   <<04382>>12182000
                       land parm'length = 7;                   <<04382>>12184000
                                                               <<04382>>12186000
          if P1 or parameter = "TRANSPARENT" and parm'length=11<<04382>>12188000
          then                                                 <<04382>>12190000
            begin                                              <<04382>>12192000
                                                               <<04382>>12194000
              FDEVICECONTROL( Out'file'num                     <<04382>>12196000
                             ,Scratch'buffer << placeholder >> <<04382>>12198000
                             ,integer(dummy'parm)  << 0 >>     <<04382>>12200000
                             ,func'mode'set                    <<04382>>12202000
                             ,P1                               <<04382>>12204000
                             ,P2  << 0 >>                      <<04382>>12206000
                             ,Error'number    );               <<04382>>12208000
                                                               <<04382>>12210000
              if <> then                                       <<04382>>12212000
                begin                                          <<04382>>12214000
                                                               <<04382>>12216000
                  Return'status := cFDEVICECONTROLfailed;      <<04382>>12218000
                                                               <<04382>>12220000
                end;                                           <<04382>>12222000
            end                                                <<04382>>12224000
          else                                                 <<04382>>12226000
            begin                                              <<04382>>12228000
                                                               <<04382>>12230000
              Return'status := cBadEnvFile;                    <<04382>>12232000
              Error'number := cSomethingIsWrong;               <<04382>>12234000
                                                               <<04382>>12236000
            end;                                               <<04382>>12238000
        end                                                    <<04382>>12240000
      else                                                     <<04382>>12242000
        begin                                                  <<04382>>12244000
                                                               <<04382>>12246000
          Return'status := cBadEnvFile;                        <<04382>>12248000
          Error'number := cSomethingIsWrong;                   <<04382>>12250000
                                                               <<04382>>12252000
        end;                                                   <<04382>>12254000
                                                               <<04382>>12256000
    end                                                        <<04382>>12258000
  else                                                         <<04382>>12260000
    begin                                                      <<04382>>12262000
                                                               <<04382>>12264000
      Return'status := cBadEnvFile;                            <<04382>>12266000
      Error'number := cSomethingIsWrong;                       <<04382>>12268000
                                                               <<04382>>12270000
    end;                                                       <<04382>>12272000
                                                               <<04382>>12274000
end;  << of subroutine Process'mode'command >>                 <<04382>>12276000
$PAGE "PLOAD'CIPER'ENV -- SUBROUTINE PROCESS'MARGIN'COMMAND"   <<04382>>12278000
subroutine Process'MARGIN'command;                             <<04382>>12280000
                                                               <<04382>>12282000
COMMENT                                                        <<04382>>12284000
                                                               <<04382>>12286000
  This subroutine performs the function of parsing out the     <<04382>>12288000
                                                               <<04382>>12290000
      MARGIN=xx    ( 1 <= xx <= 16 )                           <<04382>>12292000
                                                               <<04382>>12294000
command.  If the command is valid, the appropriate call to     <<04382>>12296000
FDEVICECONTROL will be made.  If not valid, both Status'return <<04382>>12298000
and Error'number will be updated to reflect the error that     <<04382>>12300000
occurred.                                                      <<04382>>12302000
                                                               <<04382>>12304000
;                                                              <<04382>>12306000
begin                                                          <<04382>>12308000
                                                               <<04382>>12310000
  count := P1 := P2 := 0; << Initialize FDEVICECONTROL parms >><<04382>>12312000
                                                               <<04382>>12314000
  if lines'in'file = (if mode'encountered then 2 else 1) then  <<04382>>12316000
    begin                                                      <<04382>>12318000
                                                               <<04382>>12320000
      margin'encountered := true;                              <<04382>>12322000
                                                               <<04382>>12324000
      if number'of'parameters = margin'parms then              <<04382>>12326000
        begin                                                  <<04382>>12328000
                                                               <<04382>>12330000
          this'parm := parm'info(parm'num := parm'num + 1);    <<04382>>12332000
                                                               <<04382>>12334000
          P1 := BINARY( parameter, parm'length );              <<04382>>12336000
          if = and (min'margin <=integer(P1)<= max'margin) then<<04382>>12338000
            begin                                              <<04382>>12340000
                                                               <<04382>>12342000
              P1 := P1 - 1;  << Decrement for driver >>        <<04382>>12344000
                                                               <<04382>>12346000
              FDEVICECONTROL( Out'file'num                     <<04382>>12348000
                             ,Scratch'buffer << placeholder >> <<04382>>12350000
                             ,integer(dummy'parm)  << count >> <<04382>>12352000
                             ,func'margin'set                  <<04382>>12354000
                             ,P1                               <<04382>>12356000
                             ,P2  << 0 >>                      <<04382>>12358000
                             ,Error'number   );                <<04382>>12360000
                                                               <<04382>>12362000
              if <> then                                       <<04382>>12364000
                begin                                          <<04382>>12366000
                                                               <<04382>>12368000
                  Return'status := cFDEVICECONTROLfailed;      <<04382>>12370000
                                                               <<04382>>12372000
                end;                                           <<04382>>12374000
            end                                                <<04382>>12376000
          else                                                 <<04382>>12378000
            begin                                              <<04382>>12380000
                                                               <<04382>>12382000
              Return'status := cBadEnvFile;                    <<04382>>12384000
              Error'number := cSomethingIsWrong;               <<04382>>12386000
                                                               <<04382>>12388000
            end;                                               <<04382>>12390000
        end                                                    <<04382>>12392000
      else                                                     <<04382>>12394000
        begin                                                  <<04382>>12396000
                                                               <<04382>>12398000
          Return'status := cBadEnvFile;                        <<04382>>12400000
          Error'number := cSomethingIsWrong;                   <<04382>>12402000
                                                               <<04382>>12404000
        end;                                                   <<04382>>12406000
    end                                                        <<04382>>12408000
  else                                                         <<04382>>12410000
    begin                                                      <<04382>>12412000
                                                               <<04382>>12414000
      Return'status := cBadEnvFile;                            <<04382>>12416000
      Error'number := cSomethingIsWrong;                       <<04382>>12418000
                                                               <<04382>>12420000
    end;                                                       <<04382>>12422000
                                                               <<04382>>12424000
end;  << of subroutine Process'MARGIN'command >>               <<04382>>12426000
$PAGE "PLOAD'CIPER'ENV -- SUBROUTINE PROCESS'VFC'COMMAND"      <<04382>>12428000
subroutine Process'VFC'command;                                <<04382>>12430000
                                                               <<04382>>12432000
COMMENT                                                        <<04382>>12434000
                                                               <<04382>>12436000
  This subroutine performs the function of parsing out the     <<04382>>12438000
                                                               <<04382>>12440000
      VFC,x,yyy,comment                                        <<04382>>12442000
                                                               <<04382>>12444000
command.  If the command is valid, the appropriate call to     <<04382>>12446000
FDEVICECONTROL will be made.  If not valid, both Status'return <<04382>>12448000
and Error'number will be updated to reflect the error that     <<04382>>12450000
occurred.                                                      <<04382>>12452000
                                                               <<04382>>12454000
;                                                              <<04382>>12456000
                                                               <<04382>>12458000
begin                                                          <<04382>>12460000
                                                               <<04382>>12462000
  count := P1 := P2 := 0; << Initialize FDEVICECONTROL parms >><<04382>>12464000
                                                               <<04382>>12466000
 if lines'in'file = (if margin'encountered and mode'encountered<<04382>>12468000
                        then 3                                 <<04382>>12470000
                        else if margin'encountered             <<04382>>12472000
                             or mode'encountered then 2 else 1)<<04382>>12474000
 then                                                          <<04382>>12476000
                                                               <<04382>>12478000
  begin                                                        <<04382>>12480000
                                                               <<04382>>12482000
  vfc'encountered := true;                                     <<04382>>12484000
                                                               <<04382>>12486000
  if number'of'parameters = vfc'parms'w'comment then           <<04382>>12488000
   begin                                                       <<04382>>12490000
                                                               <<04382>>12492000
   this'parm := parm'info(2);                                  <<04382>>12494000
                                                               <<04382>>12496000
   if p'delimiter <> comma then                                <<04382>>12498000
    begin                                                      <<04382>>12500000
                                                               <<04382>>12502000
    Return'status := cBadEnvFile;                              <<04382>>12504000
    Error'number := cSomethingIsWrong;                         <<04382>>12506000
    return;                                                    <<04382>>12508000
                                                               <<04382>>12510000
    end;                                                       <<04382>>12512000
                                                               <<04382>>12514000
   number'of'parameters := vfc'parms'w'o'comment;              <<04382>>12516000
                                                               <<04382>>12518000
   end;                                                        <<04382>>12520000
                                                               <<04382>>12522000
                                                               <<04382>>12524000
  if number'of'parameters = vfc'parms'w'o'comment then         <<04382>>12526000
   begin                                                       <<04382>>12528000
                                                               <<04382>>12530000
   this'parm := parm'info(parm'num := parm'num + 1);           <<04382>>12532000
                                                               <<04382>>12534000
   if p'delimiter = comma then                                 <<04382>>12536000
    begin                                                      <<04382>>12538000
                                                               <<04382>>12540000
    if parm'length = 0 or parameter = " " then                 <<04382>>12542000
     begin                                                     <<04382>>12544000
                                                               <<04382>>12546000
     P1 := 6;                                                  <<04382>>12548000
                                                               <<04382>>12550000
     end                                                       <<04382>>12552000
    else                                                       <<04382>>12554000
     begin                                                     <<04382>>12556000
                                                               <<04382>>12558000
     P1 := BINARY(parameter, parm'length);                     <<04382>>12560000
                                                               <<04382>>12562000
     if = then                                                 <<04382>>12564000
      begin                                                    <<04382>>12566000
      if P1 <> 6 and P1 <> 8 then P1 := 6; << default to 6 >>  <<04382>>12568000
      end                                                      <<04382>>12570000
     else                                                      <<04382>>12572000
      begin                                                    <<04382>>12574000
      Return'status := cBadEnvFile;                            <<04382>>12576000
      Error'number := cSomethingIsWrong;                       <<04382>>12578000
      return;                                                  <<04382>>12580000
      end;                                                     <<04382>>12582000
                                                               <<04382>>12584000
     end;                                                      <<04382>>12586000
                                                               <<04382>>12588000
      this'parm := parm'info(parm'num := parm'num + 1);        <<04382>>12590000
                                                               <<04382>>12592000
      count := BINARY(parameter, parm'length);                 <<04382>>12594000
                                                               <<04382>>12596000
      if = and ( 0 <= count <= max'vfc'lines ) then            <<04382>>12598000
       begin                                                   <<04382>>12600000
                                                               <<04382>>12602000
       if count = 0 then                                       <<04382>>12604000
        begin                                                  <<04382>>12606000
                                                               <<04382>>12608000
        FDEVICECONTROL( Out'file'num                           <<04382>>12610000
                       ,Scratch'buffer  << placeholder >>      <<04382>>12612000
                       ,count                                  <<04382>>12614000
                       ,func'vfu'download                      <<04382>>12616000
                       ,P1                                     <<04382>>12618000
                       ,P2  << 0 >>                            <<04382>>12620000
                       ,Error'number        );                 <<04382>>12622000
                                                               <<04382>>12624000
        if <> then                                             <<04382>>12626000
         begin                                                 <<04382>>12628000
                                                               <<04382>>12630000
         Return'status := cFDEVICECONTROLfailed;               <<04382>>12632000
                                                               <<04382>>12634000
         end;                                                  <<04382>>12636000
        end                                                    <<04382>>12638000
       else                                                    <<04382>>12640000
        begin                                                  <<04382>>12642000
         vfc'image := 0;                                       <<04382>>12644000
         move vfc'image(1) := vfc'image,(max'vfc'lines);       <<04382>>12646000
                                                               <<04382>>12648000
         lines'in'vfc := 0;                                    <<04382>>12650000
                                                               <<04382>>12652000
         read'buffer := 0;                                     <<04382>>12654000
         move read'buffer(1) := read'buffer,(vfc'read'length); <<04382>>12656000
                                                               <<04382>>12658000
         read'length := FREAD( Env'file'num                    <<04382>>12660000
                              ,read'buffer                     <<04382>>12662000
                              ,vfc'read'length );              <<04382>>12664000
                                                               <<04382>>12666000
         if < then                                             <<04382>>12668000
          begin                                                <<04382>>12670000
          Return'status := cCouldn'tReadRecord;                <<04382>>12672000
          FCHECK( Env'file'num, Error'number );                <<04382>>12674000
          return;                                              <<04382>>12676000
          end;                                                 <<04382>>12678000
                                                               <<04382>>12680000
         while = and lines'in'vfc < max'vfc'lines do           <<04382>>12682000
          begin                                                <<04382>>12684000
                                                               <<04382>>12686000
          channel'index := 15;                                 <<04382>>12688000
                                                               <<04382>>12690000
          do                                                   <<04382>>12692000
           begin                                               <<04382>>12694000
                                                               <<04382>>12696000
           vfc'image(lines'in'vfc) := vfc'image(lines'in'vfc)  <<04382>>12698000
                                    & lsl(1);                  <<04382>>12700000
                                                               <<04382>>12702000
           if b'read'buffer(channel'index) = " "               <<04382>>12704000
           or b'read'buffer(channel'index) = "0" then          <<04382>>12706000
            begin                                              <<04382>>12708000
            << do nothing, vfc'image is already zero >>        <<04382>>12710000
            end                                                <<04382>>12712000
           else                                                <<04382>>12714000
            begin                                              <<04382>>12716000
            if b'read'buffer(channel'index) = "1" then         <<04382>>12718000
             begin                                             <<04382>>12720000
              vfc'image(lines'in'vfc) :=                       <<04382>>12722000
                vfc'image(lines'in'vfc) lor 1;                 <<04382>>12724000
             end                                               <<04382>>12726000
            else                                               <<04382>>12728000
             begin                                             <<04382>>12730000
              Return'status := cBadEnvFile;                    <<04382>>12732000
              Error'number := cSomethingIsWrong;               <<04382>>12734000
              return;                                          <<04382>>12736000
             end;                                              <<04382>>12738000
            end;                                               <<04382>>12740000
           end                                                 <<04382>>12742000
          until (channel'index := channel'index - 1) < 0;      <<04382>>12744000
                                                               <<04382>>12746000
          lines'in'vfc := lines'in'vfc + 1;                    <<04382>>12748000
                                                               <<04382>>12750000
          << get the next record, if any >>                    <<04382>>12752000
                                                               <<04382>>12754000
          read'buffer := 0;                                    <<04382>>12756000
          move read'buffer := read'buffer(1),(vfc'read'length);<<04382>>12758000
                                                               <<04382>>12760000
          read'length := FREAD( Env'file'num                   <<04382>>12762000
                               ,read'buffer                    <<04382>>12764000
                               ,vfc'read'length );             <<04382>>12766000
                                                               <<04382>>12768000
          if < then                                            <<04382>>12770000
           begin                                               <<04382>>12772000
           Return'status := cCouldn'tReadRecord;               <<04382>>12774000
           FCHECK( Env'file'num, Error'number );               <<04382>>12776000
           return;                                             <<04382>>12778000
           end;                                                <<04382>>12780000
                                                               <<04382>>12782000
          end;  << of while = and ... >>                       <<04382>>12784000
                                                               <<04382>>12786000
         << Make sure at least one line has channel one set >> <<04382>>12788000
                                                               <<04382>>12790000
         lines'in'vfc := 0;                                    <<04382>>12792000
         channel'one'set := false;                             <<04382>>12794000
                                                               <<04382>>12796000
         do                                                    <<04382>>12798000
          begin                                                <<04382>>12800000
                                                               <<04382>>12802000
          channel'one'set := channel'one'set                   <<04382>>12804000
                             lor vfc'image(lines'in'vfc);      <<04382>>12806000
                                                               <<04382>>12808000
          end                                                  <<04382>>12810000
         until (lines'in'vfc := lines'in'vfc + 1) = count;     <<04382>>12812000
                                                               <<04382>>12814000
         if not channel'one'set then                           <<04382>>12816000
          begin                                                <<04382>>12818000
                                                               <<04382>>12820000
          Return'status := cBadEnvFile;                        <<04382>>12822000
          Error'number := cSomethingIsWrong;                   <<04382>>12824000
          return;                                              <<04382>>12826000
                                                               <<04382>>12828000
          end;                                                 <<04382>>12830000
                                                               <<04382>>12832000
         << All is okay, so send it to the output file. >>     <<04382>>12834000
                                                               <<04382>>12836000
         FDEVICECONTROL( Out'file'num                          <<04382>>12838000
                        ,vfc'image                             <<04382>>12840000
                        ,count                                 <<04382>>12842000
                        ,func'vfu'download                     <<04382>>12844000
                        ,P1                                    <<04382>>12846000
                        ,P2  << 0 >>                           <<04382>>12848000
                        ,Error'number        );                <<04382>>12850000
                                                               <<04382>>12852000
                                                               <<04382>>12854000
         if <> then                                            <<04382>>12856000
          begin                                                <<04382>>12858000
                                                               <<04382>>12860000
          Return'status := cFDEVICECONTROLfailed;              <<04382>>12862000
                                                               <<04382>>12864000
          end;                                                 <<04382>>12866000
         end;                                                  <<04382>>12868000
        end                                                    <<04382>>12870000
       else                                                    <<04382>>12872000
        begin                                                  <<04382>>12874000
        Return'status := cBadEnvFile;                          <<04382>>12876000
        Error'number := cSomethingIsWrong;                     <<04382>>12878000
        end;                                                   <<04382>>12880000
    end                                                        <<04382>>12882000
   else                                                        <<04382>>12884000
    begin                                                      <<04382>>12886000
    Return'status := cBadEnvFile;                              <<04382>>12888000
    Error'number := cSomethingIsWrong;                         <<04382>>12890000
    end;                                                       <<04382>>12892000
   end                                                         <<04382>>12894000
  else                                                         <<04382>>12896000
   begin                                                       <<04382>>12898000
   Return'status := cBadEnvFile;                               <<04382>>12900000
   Error'number := cSomethingIsWrong;                          <<04382>>12902000
   end;                                                        <<04382>>12904000
  end                                                          <<04382>>12906000
 else                                                          <<04382>>12908000
  begin                                                        <<04382>>12910000
  Return'status := cBadEnvFile;                                <<04382>>12912000
  Error'number := cSomethingIsWrong;                           <<04382>>12914000
  end;                                                         <<04382>>12916000
end;  << of subroutine Process'VFC'command >>                  <<04382>>12918000
$PAGE "PLOAD'CIPER'ENV -- PROCEDURE BODY"                      <<04382>>12920000
  << First, initialize any pointers to various parts of the >> <<04382>>12922000
  << Scratch'buffer array.                                  >> <<04382>>12924000
                                                               <<04382>>12926000
  @b'read'buffer := @scratch'buffer & lsl(1);                  <<04382>>12928000
                                                               <<04382>>12930000
  @vfc'image := @scratch'buffer + max'read'length + 1;         <<04382>>12932000
  @b'vfc'image := @vfc'image & lsl(1);                         <<04382>>12934000
                                                               <<04382>>12936000
                                                               <<04382>>12938000
  << Assume successful completion. >>                          <<04382>>12940000
                                                               <<04382>>12942000
  Return'status := cSuccessfulLoad;                            <<04382>>12944000
  Error'number := cSuccessfulLoad;                             <<04382>>12946000
                                                               <<04382>>12948000
                                                               <<04382>>12950000
  << Rewind the environment file, in case PCHECK'CIPER'ENV >>  <<04382>>12952000
  << has been called first (it reads the first record of   >>  <<04382>>12954000
  << the file).                                            >>  <<04382>>12956000
                                                               <<04382>>12958000
  FCONTROL( Env'file'num, func'file'rewind, dummy'parm );      <<04382>>12960000
                                                               <<04382>>12962000
  if <> then                                                   <<04382>>12964000
    begin                                                      <<04382>>12966000
                                                               <<04382>>12968000
      Return'status := cCouldn'tPositionEnvFile;               <<04382>>12970000
      FCHECK( Env'file'num, Error'number );                    <<04382>>12972000
                                                               <<04382>>12974000
    end;                                                       <<04382>>12976000
                                                               <<04382>>12978000
                                                               <<04382>>12980000
  << The outer loop following will parse one of three types >> <<04382>>12982000
  << of command:                                            >> <<04382>>12984000
  <<                                                        >> <<04382>>12986000
  <<    MODE=xx  or  MARGIN=xx  or  VFC,xx,yyy,comment      >> <<04382>>12988000
  <<                                                        >> <<04382>>12990000
  << The MODE= or MARGIN= can be either the first or second >> <<04382>>12992000
  << line in the file, in any order.  If present, they MUST >> <<04382>>12994000
  << preceed the VFC command.                               >> <<04382>>12996000
                                                               <<04382>>12998000
  End'of'file := false;                                        <<04382>>13000000
                                                               <<04382>>13002000
  while Return'status = 0 and not End'of'file do               <<04382>>13004000
    begin                                                      <<04382>>13006000
                                                               <<04382>>13008000
      read'buffer := 0;                                        <<04382>>13010000
      move read'buffer(1) := read'buffer,(max'read'length);    <<04382>>13012000
                                                               <<04382>>13014000
                                                               <<04382>>13016000
      read'length := FREAD( Env'file'num                       <<04382>>13018000
                           ,read'buffer                        <<04382>>13020000
                           ,max'read'length );                 <<04382>>13022000
      if <> then                                               <<04382>>13024000
        begin                                                  <<04382>>13026000
                                                               <<04382>>13028000
          if > then                                            <<04382>>13030000
            begin                                              <<04382>>13032000
                                                               <<04382>>13034000
              End'of'file := true;                             <<04382>>13036000
                                                               <<04382>>13038000
            end                                                <<04382>>13040000
          else                                                 <<04382>>13042000
            begin                                              <<04382>>13044000
                                                               <<04382>>13046000
              Return'status := cCouldn'tReadRecord;            <<04382>>13048000
              FCHECK(env'file'num, Error'number );             <<04382>>13050000
                                                               <<04382>>13052000
            end;                                               <<04382>>13054000
                                                               <<04382>>13056000
        end                                                    <<04382>>13058000
      else                                                     <<04382>>13060000
        begin                                                  <<04382>>13062000
                                                               <<04382>>13064000
          lines'in'file := lines'in'file + 1;                  <<04382>>13066000
                                                               <<04382>>13068000
          if vfc'encountered then                              <<04382>>13070000
            begin                                              <<04382>>13072000
                                                               <<04382>>13074000
              Return'status := cBadEnvFile;                    <<04382>>13076000
              Error'number := cSomethingIsWrong;               <<04382>>13078000
                                                               <<04382>>13080000
            end                                                <<04382>>13082000
          else                                                 <<04382>>13084000
            begin                                              <<04382>>13086000
                                                               <<04382>>13088000
              read'buffer(read'length) := double'cr;           <<04382>>13090000
                                                               <<04382>>13092000
              MYCOMMAND(b'read'buffer,,max'parms,              <<04382>>13094000
                        number'of'parameters, parm'info);      <<04382>>13096000
                                                               <<04382>>13098000
              this'parm := parm'info(parm'num := 0);           <<04382>>13100000
                                                               <<04382>>13102000
              if parameter = "MODE" and parm'length = 4        <<04382>>13104000
                 and p'delimiter = equal then                  <<04382>>13106000
                begin                                          <<04382>>13108000
                                                               <<04382>>13110000
                  Process'MODE'command;                        <<04382>>13112000
                                                               <<04382>>13114000
                end                                            <<04382>>13116000
              else                                             <<04382>>13118000
                begin                                          <<04382>>13120000
                                                               <<04382>>13122000
                  if parameter = "MARGIN" and parm'length = 6  <<04382>>13124000
                     and p'delimiter = equal then              <<04382>>13126000
                    begin                                      <<04382>>13128000
                                                               <<04382>>13130000
                      Process'MARGIN'command;                  <<04382>>13132000
                                                               <<04382>>13134000
                    end                                        <<04382>>13136000
                  else                                         <<04382>>13138000
                    begin                                      <<04382>>13140000
                                                               <<04382>>13142000
                      if parameter = "VFC" and parm'length = 3 <<04382>>13144000
                         and p'delimiter = comma then          <<04382>>13146000
                        begin                                  <<04382>>13148000
                                                               <<04382>>13150000
                          Process'VFC'command;                 <<04382>>13152000
                                                               <<04382>>13154000
                        end                                    <<04382>>13156000
                      else                                     <<04382>>13158000
                        begin                                  <<04382>>13160000
                                                               <<04382>>13162000
                          Return'status := cBadEnvFile;        <<04382>>13164000
                          Error'number := cSomethingIsWrong;   <<04382>>13166000
                                                               <<04382>>13168000
                        end;                                   <<04382>>13170000
                    end;                                       <<04382>>13172000
                end;                                           <<04382>>13174000
            end;                                               <<04382>>13176000
        end;                                                   <<04382>>13178000
    end;  << of while Return'status = 0 . . . >>               <<04382>>13180000
                                                               <<04382>>13182000
                                                               <<04382>>13184000
  << Close the environment file, now that we are finished >>   <<04382>>13186000
  << with it                                              >>   <<04382>>13188000
                                                               <<04382>>13190000
  FCLOSE( Env'file'num, 0, 0 );                                <<04382>>13192000
                                                               <<04382>>13194000
  if <> then                                                   <<04382>>13196000
    begin                                                      <<04382>>13198000
                                                               <<04382>>13200000
      Return'status := cCouldn'tCloseEnvFile;                  <<04382>>13202000
      FCHECK( Env'file'num, Error'number );                    <<04382>>13204000
                                                               <<04382>>13206000
    end;                                                       <<04382>>13208000
                                                               <<04382>>13210000
                                                               <<04382>>13212000
end;  << of procedure PLOAD'CIPER'ENV >>                       <<04382>>13214000
$PAGE "CHECKASS'CLASS - SEE IF DEVCLASS ASSOC W/ USER"         <<04833>>13218000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>13220000
                                                                        13222000
<< Note:  Procedure CHECKASS'CLASS was moved unchanged from >> <<04833>>13224000
<< OPCOMMAND to SPOOLCOMS as part of this enhancement.  Its >> <<04833>>13226000
<< fix number(s) were not changed.                          >> <<04833>>13228000
                                                                        13230000
LOGICAL PROCEDURE CHECKASS'CLASS(CLASS'INDEX,CLASS'NAME,       <<04833>>13232000
                                 ERROR'RETURN);                <<04833>>13234000
VALUE CLASS'INDEX;                                             <<04833>>13236000
INTEGER                                                        <<04833>>13238000
   CLASS'INDEX,                                                <<04833>>13240000
   ERROR'RETURN;                                               <<04833>>13242000
BYTE ARRAY                                                     <<04833>>13244000
   CLASS'NAME;                                                 <<04833>>13246000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<04833>>13248000
COMMENT                                                        <<04833>>13250000
   THE PROCEDURE EXPECTS ONE AND ONLY ONE OF THE CLASS'INDEX   <<04833>>13252000
   OR CLASS'NAME. WILL RETURN TRUE IF THE CLASS'NAME OR CLASS  <<04833>>13254000
   INDEX POINT TO CLASSES WHICH ARE CURRENTLY ASSOCIATED WITH  <<04833>>13256000
   THE EXECUTING USER.                                         <<04833>>13258000
                                                               <<04833>>13260000
INPUT:   ONE OF CLASS'INDEX OR CLASS'NAME                      <<04833>>13262000
         IF CLASS'NAME THEN LAST CHARACTER IN STRING SHOULD    <<04833>>13264000
         BE A NON-ALPHANUMERIC.                                <<04833>>13266000
OUTPUT:  TRUE OR FALSE                                         <<04833>>13268000
         ERROR'RETURN SET AN ABNORMAL CONDITIONS.              <<04833>>13270000
**** WARNING: LDT SIR MUST BE LOCKED EXTERNALLY ****           <<04833>>13272000
END COMMENT;                                                   <<04833>>13274000
BEGIN                                                          <<04833>>13276000
INTEGER                                                        <<04833>>13278000
   CLASS'LEN,                                                  <<04833>>13280000
   INDEX := 0;                                                 <<04833>>13282000
INTEGER ARRAY                                                  <<04833>>13284000
   LCLASS'NAME(0:4),                                           <<04833>>13286000
   INFO'BUF(0:130);                                            <<04833>>13288000
BYTE ARRAY                                                     <<04833>>13290000
   LCLASS'NAME'(*) = LCLASS'NAME,                              <<04833>>13292000
   INFO'BUF'(*) = INFO'BUF(3);                                 <<04833>>13294000
LOGICAL                                                        <<04833>>13296000
   PARMASK = Q - 4;                                            <<04833>>13298000
DEFINE                                                         <<04833>>13300000
   NUM'OF'LDEVS = INTEGER(INFO'BUF')#,                         <<04833>>13302000
   LDEV = INTEGER(INFO'BUF'(INDEX))#,                          <<04833>>13304000
   INDEX'PRESENT = PARMASK.(13:1)#,                            <<04833>>13306000
   NAME'PRESENT = PARMASK.(14:1)#,                             <<04833>>13308000
   ERROR'PRESENT = PARMASK#;                                   <<04833>>13310000
                                                               <<04833>>13312000
                                                               <<04833>>13314000
                                                               <<04833>>13316000
CHECKASS'CLASS := FALSE;                                       <<04833>>13318000
IF (INDEX'PRESENT LAND NAME'PRESENT) OR                        <<04833>>13320000
   (NOT INDEX'PRESENT LAND NOT NAME'PRESENT) THEN              <<04833>>13322000
   BEGIN                                                       <<04833>>13324000
      IF ERROR'PRESENT THEN                                    <<04833>>13326000
         ERROR'RETURN := 1;                                    <<04833>>13328000
      RETURN;                                                  <<04833>>13330000
   END;                                                        <<04833>>13332000
IF NAME'PRESENT THEN                                           <<04833>>13334000
   BEGIN                                                       <<04833>>13336000
      LCLASS'NAME := "  ";                                     <<04833>>13338000
      MOVE LCLASS'NAME(1) := LCLASS'NAME,(4);                  <<04833>>13340000
      MOVE CLASS'NAME := CLASS'NAME WHILE AN,1;                <<04833>>13342000
      IF (CLASS'LEN := TOS - @CLASS'NAME) > 8 THEN             <<04833>>13344000
         BEGIN                                                 <<04833>>13346000
            IF ERROR'PRESENT THEN                              <<04833>>13348000
               ERROR'RETURN := 2;                              <<04833>>13350000
            RETURN;                                            <<04833>>13352000
         END;                                                  <<04833>>13354000
      MOVE LCLASS'NAME' := CLASS'NAME,(CLASS'LEN);             <<04833>>13356000
      IF NOT GETCLASS(INFO'BUF,TRUE,,,LCLASS'NAME) THEN        <<04833>>13358000
         BEGIN                                                 <<04833>>13360000
            IF ERROR'PRESENT THEN                              <<04833>>13362000
               ERROR'RETURN := 3;                              <<04833>>13364000
            RETURN;                                            <<04833>>13366000
         END;                                                  <<04833>>13368000
   END                                                         <<04833>>13370000
ELSE                                                           <<04833>>13372000
   BEGIN                                                       <<04833>>13374000
      IF NOT GETCLASS( INFO'BUF, TRUE, ,CLASS'INDEX ) THEN     <<04833>>13376000
         BEGIN                                                 <<04833>>13378000
            IF ERROR'PRESENT THEN                              <<04833>>13380000
               ERROR'RETURN := 3;                              <<04833>>13382000
            RETURN;                                            <<04833>>13384000
         END;                                                  <<04833>>13386000
   END;                                                        <<04833>>13388000
CHECKASS'CLASS := TRUE;                                        <<04833>>13390000
WHILE (INDEX := INDEX + 1) <= NUM'OF'LDEVS DO                  <<04833>>13392000
   BEGIN                                                       <<04833>>13394000
      IF NOT CHECKASS(LDEV) THEN                               <<04833>>13396000
         CHECKASS'CLASS := FALSE;                              <<04833>>13398000
   END;                                                        <<04833>>13400000
END;                                                           <<04833>>13402000
$PAGE "SENDSPOOLERMSG - AWAKE SPOOLER WITH NEW DIRECTIVE"      <<04833>>13404000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>13406000
                                                                        13408000
<< Note:  Procedure SENDSPOOLERMSG was moved unchanged from >> <<04833>>13410000
<< OPCOMMAND to SPOOLCOMS as part of this enhancement.  Its >> <<04833>>13412000
<< fix number(s) were not changed.                          >> <<04833>>13414000
                                                                        13416000
LOGICAL PROCEDURE SENDSPOOLERMSG(LDEV,DIRECTIVE,SPOOFLING,              13418000
        ARRAYINFO,                                             <<04833>>13420000
        ERRNUM,PARMNUM);                                                13422000
   VALUE LDEV,DIRECTIVE,SPOOFLING;                                      13424000
   INTEGER DIRECTIVE,ERRNUM,PARMNUM;                                    13426000
   LOGICAL LDEV,SPOOFLING;                                              13428000
   LOGICAL ARRAY ARRAYINFO;                                    <<04833>>13430000
   OPTION PRIVILEGED,UNCALLABLE;                                        13432000
BEGIN                                                                   13434000
                                                                        13436000
COMMENT                                                                 13438000
   THIS PROCEDURE IS USED BY ALL OF THE SPOOLING COMMAND EXECUTORS      13440000
   TO SEND THE APPROPRIATE SPOOLER A DIRECTIVE. THE SPOOLER STACK       13442000
   IS LOCATED AND WORD 1 IS USED FOR COMMUNICATION IN THE SPOOLERS      13444000
   GLOBAL DB AREA. BIT  0 ON INDICATES THE SPOOLER IS BUSY WITH         13446000
   ANOTHER REQUEST. BITS 8 THROUGH 12 INDICATE SPOOLREQUESTS WHILE      13448000
   BITS 13 THROUGH 15 INDICATE A FILEREQUEST.                           13450000
   SPOOLREQUEST                       FILEREQUEST                       13452000
     0 = PRIORDIRECTIVE          0= FINISHFILE                          13454000
     1 = QUITSPOOLING            1= DELETEFILE                          13456000
     2 = WAITSPOOLING            2= DEFERFILE                           13458000
     3 = RESUMESPOOLING          3= RELINKFILE                          13460000
   ARRAYINFO CONTAINS INFORMATION FOR                          <<04833>>13462000
      RESUMESPOOL                                              <<04833>>13464000
          ARRAYINFO(0) IS LOGICAL VARIABLE "BACK"              <<04833>>13466000
                       = -1 BACKWARD RESTART                   <<04833>>13468000
                       = 0  FORWARD RESTART                    <<04833>>13470000
          ARRAYINFO(1) IS PAGE COUNT FOR RESTART               <<04833>>13472000
                       = -1 BEGINNING OF FILE                  <<04833>>13474000
          ARRAYINFO(2) IS FILE COUNT FOR RESTART               <<04833>>13476000
                                             ;                          13478000
                                                                        13480000
POINTER SYS'PCBTP = 3;                                                  13482000
INTEGER SPOOLERPCB;                                                     13484000
INTEGER ARRAY LDT(0:LDTSIZE-1);                                         13486000
INTEGER ARRAY SPOOLERCOMM(0:5);                                         13488000
DEFINE SPOOLERDST = SYS'PCBTP(SPOOLERPCB + PCB'STACKDST)#;              13490000
EQUATE DIRECTIV = 0,                                                    13492000
       DADWAIT = 1;                                                     13494000
                                                                        13496000
LOGICAL RESULT = SENDSPOOLERMSG;                                        13498000
EQUATE SHUT = 0,                                                        13500000
       OPEN = 1,                                               <<04833>>13502000
       UNCHANGED = 2;                                          <<04833>>13504000
EQUATE                                                                  13506000
       JOBSYNC = %121,                                                  13508000
       UCOPLPIN = 2;                                                    13510000
                                                                        13512000
                                                                        13514000
EQUATE BACKWARDS=46, <<DB RELATIVE>>                           <<04833>>13516000
       PAGEPTR = 47, <<LOCATIONS IN >>                         <<04833>>13518000
       FILEPTR = 48; <<SPOOLER STACK>>                         <<04833>>13520000
LOGICAL BACK;                                                  <<04833>>13522000
INTEGER PAGES,FILES;                                           <<04833>>13524000
DEFINE FILEDIRECTIVE = DIRECTIVE.(12:4)#,                      <<04833>>13526000
       PROCDIRECTIVE = DIRECTIVE.(8:4)#;                       <<04833>>13528000
SUBROUTINE DEF'MOVEFROMDSEG;                                            13530000
SUBROUTINE DEF'MOVETODSEG;                                              13532000
                                                               <<04833>>13534000
LOGICAL SUBROUTINE VALID'LDEV(LDEV);                           <<04833>>13536000
   VALUE LDEV; INTEGER LDEV;                                   <<04833>>13538000
   BEGIN                                                       <<04833>>13540000
                                                               <<04833>>13542000
      VALID'LDEV := FALSE;                                     <<04833>>13544000
      IF LDEV < 1 THEN                                         <<04833>>13546000
      BEGIN      <<BAD LOGICAL DEVICE>>                        <<04833>>13548000
         PARMNUM := 1; ERRNUM := EXPLDEVBAD;                   <<04833>>13550000
      END                                                      <<04833>>13552000
      ELSE                                                     <<04833>>13554000
      IF LDEV > LPDT(LPDT'MAXDEV) THEN                         <<04833>>13556000
      BEGIN   <<DEVICE NOT IN CONFIGURATION>>                  <<04833>>13558000
         PARMNUM := 1; ERRNUM := LDEVNOTCONFIG;                <<04833>>13560000
      END                                                      <<04833>>13562000
      ELSE                                                     <<04833>>13564000
      IF LPDT(LDEV * LPDTSIZE + LPDT'VIRTUAL) = 1 THEN         <<04833>>13566000
      BEGIN     <<NOT REAL>>                                   <<04833>>13568000
         PARMNUM := 1; ERRNUM := LDEVNOTREAL;                  <<04833>>13570000
      END                                                      <<04833>>13572000
      ELSE VALID'LDEV := TRUE;                                 <<04833>>13574000
   END; <<SUBROUTINE VALID'LDEV>>                              <<04833>>13576000
                                                               <<04833>>13578000
<<>>                                                           <<04833>>13580000
SENDSPOOLERMSG := FALSE;                                                13582000
BACK := ARRAYINFO;                                             <<04833>>13584000
PAGES := ARRAYINFO(1);                                         <<04833>>13586000
FILES := ARRAYINFO(2);                                         <<04833>>13588000
IF NOT VALID'LDEV(LDEV) THEN RETURN; <<INVALID LDEV>>          <<04833>>13590000
MOVEFROMDSEG( LDT,LDTDST,LDEV*LDTSIZE,LDTSIZE);                         13592000
IF SPOOFLING <> UNCHANGED THEN                                 <<04833>>13594000
LDT(LD'SQ) := SPOOFLING; <<SHUTQ/OPENQ>>                                13596000
IF LDT(LD'MAINPIN) = 0 OR LDT(LD'SP) = NOSPOOLER THEN          <<04833>>13598000
BEGIN  <<DEVICE NOT SPOOLED>>                                  <<04833>>13600000
   PARMNUM := 1; ERRNUM := DEVICENOTSPOOLED;                   <<04833>>13602000
   RETURN;                                                     <<04833>>13604000
END;                                                           <<04833>>13606000
SPOOLERPCB := LDT(LD'MAINPIN) * PCBSIZE;                                13608000
EXCHANGEDB(SPOOLERDST);                                                 13610000
IF LOGICAL(DBP(DIRECTIV).(0:1)) THEN                                    13612000
BEGIN     <<SPOOLER BUSY>>                                              13614000
   EXCHANGEDB(0);    <<RETURN TO CI STACK>>                    <<04833>>13616000
   PARMNUM := 1;                                                        13618000
   ERRNUM := SPOOLERBUSY;                                               13620000
END                                                                     13622000
ELSE                                                                    13624000
BEGIN   <<SPOOLER NOT BUSY>>                                            13626000
   DBP(DIRECTIV) := DIRECTIVE;                                          13628000
   IF PROCDIRECTIVE = RESUMESPOOLING THEN                      <<04833>>13630000
   BEGIN                                                       <<04833>>13632000
      DBP(BACKWARDS) := BACK;                                  <<04833>>13634000
      DBP(PAGEPTR) := PAGES;                                   <<04833>>13636000
      DBP(FILEPTR) := FILES;                                   <<04833>>13638000
   END;                                                        <<04833>>13640000
   EXCHANGEDB(0);                                                       13642000
   MOVETODSEG(LDTDST,LDEV*LDTSIZE, LDT,LDTSIZE);                        13644000
   AWAKE(SPOOLERPCB,DADWAIT,0);                                         13646000
   SENDSPOOLERMSG := TRUE;                                              13648000
END;                                                                    13650000
   IF RESULT AND SPOOFLING = OPEN THEN                                  13652000
   BEGIN                                                                13654000
      DISABLE;                                                          13656000
      ABSYS'JOBSYNC.(DEVFREED'F) := 1;                                  13658000
      ENABLE;                                                           13660000
      AWAKE(SYSPROC(UCOPLPIN),%20,0);                                   13662000
   END;                                                                 13664000
END;  <<SENDSPOOLERMSG>>                                                13666000
$PAGE "DELETESPOOLFILE EXECUTOR"                               <<04833>>13668000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>13670000
                                                                        13672000
<< Note:  Procedure CXDELETESPOOLFILE was  moved  unchanged >> <<04833>>13674000
<< from OPCOMMAND to SPOOLCOMS as part of this enhancement. >> <<04833>>13676000
<< Its fix number(s) were not changed.                      >> <<04833>>13678000
                                                                        13680000
PROCEDURE CXDELETESPOOLFILE  EXECUTORHEAD;                              13682000
BEGIN                                                                   13684000
   COMMENT                                                              13686000
      THE SYNTAX OF THIS COMMAND IS:                                    13688000
         DELETESPOOLFILE #ONNN                                          13690000
         DELETESPOOLFILE #INNN                                          13692000
         DELETESPOOLFILE  LDEV                                 <<04833>>13694000
   ;                                                                    13696000
   DOUBLE DL := [8/",", 8/".", 8/";", 8/%15]D;                          13698000
   BYTE ARRAY DL'(*)=DL;                                                13700000
   DOUBLE ARRAY PARM(0:3)=Q;                                            13702000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         13704000
                                                                        13706000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3;                                 13708000
   INTEGER PARM1=PARM+1, PARM2=PARM+3, PARM3=PARM+5;                    13710000
   INTEGER NUMPARMS,FILENUM,SAVESIR,DELETE'RETURN;                      13712000
   EQUATE COMMA=0, PERIOD=1, SEMICOLON=2;                               13714000
   LOGICAL OUT;                                                         13716000
   INTEGER DFID;                                                        13718000
   INTEGER XDDEP;                                              <<04833>>13720000
   INTEGER SAVELPDT,SAVELDT,SAVEXDD;                                    13722000
   INTEGER ARRAY XDD(0:XDDSIZE);                                        13724000
   LOGICAL FIND;                                                        13726000
   LOGICAL LDEV'SPECIFIED := FALSE;                            <<04833>>13728000
   INTEGER LDEV;                                               <<04833>>13730000
   INTEGER POINTER DEVP;                                       <<04833>>13732000
   EQUATE <<DIRECTION>>                                        <<04833>>13734000
          IN=0,                                                <<04833>>13736000
          OUT0=3, <<SPOOFLING ON + OUTPUT SPOOLING>>           <<04833>>13738000
          EITHER = -1;                                         <<04833>>13740000
   INTEGER DIRECTION := EITHER;                                <<04833>>13742000
   <<CI/SPOOLER DIRECTIVE>>                                    <<04833>>13744000
   EQUATE NODIRECTIVE = %100000;                               <<04833>>13746000
   INTEGER NEWDIRECTIVE := NODIRECTIVE;                        <<04833>>13748000
   DEFINE PROCDIRECTIVE = NEWDIRECTIVE.(8:4)#,                 <<04833>>13750000
          FILEDIRECTIVE = NEWDIRECTIVE.(12:4)#;                <<04833>>13752000
   INTEGER SPOOLERPCB;                                         <<04833>>13754000
   INTEGER ARRAY DEVINFO(0:8) = Q;                             <<04833>>13756000
   LOGICAL ARRAY SPOOLINFO(0:3);                               <<04833>>13758000
   INTEGER INFO;                                               <<04833>>13760000
   LOGICAL REPLY := [8/3,8/2]; <<MAXSTRING LEN 3,STRING>>      <<04833>>13762000
   LOGICAL ARRAY OFFSET(0:8) = Q;                              <<04833>>13764000
   BYTE ARRAY BOFFSET(*) = OFFSET(1);                          <<04833>>13766000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                             <<04833>>13768000
   INTEGER SPOOFLING;                                          <<04833>>13770000
   EQUATE SHUT = 0,                                            <<04833>>13772000
          OPEN = 1,                                            <<04833>>13774000
          UNCHANGED = 2;                                       <<04833>>13776000
                                                               <<04833>>13778000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         13780000
LOGICAL SUBROUTINE ASS'DFID;                                   <<04833>>13782000
COMMENT                                                        <<04833>>13784000
   SUBROUTINE FINDS OUT IF A PARTICULAR DEVICE FILE ID         <<04833>>13786000
   RESIDES ON A DEVICE OR A DEVICE CLASS WHICH IS ASSOCI-      <<04833>>13788000
   ATED WITH THE USER INVOKING THE COMMAND.                    <<04833>>13790000
                                                               <<04833>>13792000
NOTE:                                                          <<04833>>13794000
   IDD OR ODD SIR ALREADY LOCKED.                              <<04833>>13796000
   WHEN FILE IS NOT FOUND RETURNS TRUE. WILL BE CAUGHT ON      <<04833>>13798000
   SECOND CALL TO SFINDODD OR SFINDIDD.                        <<04833>>13800000
END COMMENT.;                                                  <<04833>>13802000
BEGIN                                                          <<04833>>13804000
   ASS'DFID := FALSE;                                          <<04833>>13806000
   FIND := IF OUT THEN SFINDODD(DFID,XDDEP)                    <<04833>>13808000
                  ELSE SFINDIDD(DFID,XDDEP);                   <<04833>>13810000
   IF NOT FIND THEN                                            <<04833>>13812000
      BEGIN                                                    <<04833>>13814000
         ASS'DFID := TRUE;                                     <<04833>>13816000
         RETURN;                                               <<04833>>13818000
      END;                                                     <<04833>>13820000
   MOVEFROMDSEG( XDD,IF OUT THEN ODDDST ELSE IDDDST,           <<04833>>13822000
                XDDEP.(1:15),XDDSIZE);                         <<04833>>13824000
   IF LOGICAL(XDD(XD'C)) THEN                                  <<04833>>13826000
      BEGIN                                                    <<04833>>13828000
         IF CHECKASS'CLASS(XDD(XD'DEVICE)) THEN                <<04833>>13830000
            ASS'DFID := TRUE;                                  <<04833>>13832000
      END                                                      <<04833>>13834000
   ELSE                                                        <<04833>>13836000
      BEGIN                                                    <<04833>>13838000
         IF CHECKASS(XDD(XD'DEVICE)) THEN                      <<04833>>13840000
            ASS'DFID := TRUE;                                  <<04833>>13842000
      END;                                                     <<04833>>13844000
END;                                                           <<04833>>13846000
                                                                        13848000
                                                                        13850000
   LOGIMAGE( M'DELETESPOOLFILE, PARMSP );                      <<04833>>13852000
   ERRNUM := 0;                                                         13854000
   MYCOMMAND(PARMSP,DL',2,NUMPARMS,PARM);<<PARSE PARAMETERS>>           13856000
   IF NUMPARMS=0 THEN <<NEED AT LEAST ONE PARAMETER>>                   13858000
   BEGIN                                                                13860000
      PARMNUM:=1;                                                       13862000
      CIERR(ERRNUM:=EXPSPFNAME,PARMSP);                                 13864000
   END                                                                  13866000
   ELSE                                                                 13868000
   IF FIRSTLEN > 0 THEN                                        <<04833>>13870000
      IF NUMPARMS<>1 THEN <<TOO MANY PARMS SPECIFIED>>                  13872000
      BEGIN                                                             13874000
         PARMNUM:=2;                                                    13876000
         CIERR(ERRNUM:=FILENUMNOOTHERP,SNDPARM);                        13878000
      END                                                               13880000
      ELSE <<PARSE FILE NUM>>                                           13882000
         IF FIRSTPARM = "#" THEN <<FILENUM SPECIFIED>>         <<04833>>13884000
         BEGIN                                                 <<04833>>13886000
         IF (FIRSTLEN<3) OR                                             13888000
           (NOT ((FIRSTPARM(1)="O") LOR (FIRSTPARM(1)="I"))) THEN       13890000
         BEGIN                                                          13892000
            PARMNUM:=1;                                                 13894000
            CIERR(ERRNUM:=EXPOORINUM,FIRSTPARM(1));                     13896000
         END                                                            13898000
         ELSE                                                           13900000
         BEGIN                                                          13902000
            FILENUM:=BINARY(FIRSTPARM(2),FIRSTLEN-2);                   13904000
            IF <> OR NOT (1<=FILENUM<=%77777) THEN             <<04833>>13906000
                  << BAD FILE NUMBER >>                        <<04833>>13908000
            BEGIN                                                       13910000
               PARMNUM:=1;                                              13912000
               CIERR(ERRNUM:=BADFILENUM,FIRSTPARM(2));                  13914000
            END;                                                        13916000
         END;                                                  <<04833>>13918000
      END                                                      <<04833>>13920000
     ELSE                                                               13922000
     BEGIN                                                              13924000
        <<ASSUME LOGICAL DEVICE SPECIFIED>>                    <<04833>>13926000
        LDEV'SPECIFIED := TRUE;                                <<04833>>13928000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,ERRNUM,PARMNUM,1); <<04833>>13930000
      IF < THEN RETURN;                                        <<04833>>13932000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV<<04833>>13934000
      IF CHECKASS(LDEV) OR                                     <<04833>>13936000
         CHECKALLOW(M'DELETESPOOLFILE) THEN <<USER HAS ACCESS>><<04833>>13938000
      BEGIN                                                    <<04833>>13940000
      FILEDIRECTIVE := DELETEFILE;                             <<04833>>13942000
      PROCDIRECTIVE := PRIORDIRECTIVE;                         <<04833>>13944000
      @DEVP := LDEV * LDTSIZE;                                 <<04833>>13946000
      SAVESIR := GETSIR( LDTSIR );                             <<04833>>13948000
      MOVEFROMDSEG(  LDT, LDTDST, @DEVP, LDTSIZE );            <<04833>>13950000
      IF LDT(LD'SP) = NOSPOOLER THEN                           <<04833>>13952000
      BEGIN     <<NOT A SPOOLED DEVICE>>                       <<04833>>13954000
         PARMNUM := 1;                                         <<04833>>13956000
         RELSIR(LDTSIR,SAVESIR);                               <<04833>>13958000
         CIERR(ERRNUM := DEVICENOTSPOOLED,FIRSTPARM);          <<04833>>13960000
         RETURN;                                               <<04833>>13962000
      END                                                      <<04833>>13964000
     ELSE                                                      <<04833>>13966000
     IF NOT SFINDACTIVE(LDEV,DFID) THEN                        <<04833>>13968000
     BEGIN   <<LDEV IS NOT ACTIVE>>                            <<04833>>13970000
        RELSIR(LDTSIR,SAVESIR);                                <<04833>>13972000
        PARMNUM := 1;                                          <<04833>>13974000
        CIERR(ERRNUM := LDEVNOTACTIVE,FIRSTPARM);              <<04833>>13976000
        RETURN;                                                <<04833>>13978000
     END                                                       <<04833>>13980000
      ELSE                                                     <<04833>>13982000
      IF LDT(LD'SP) = INPUTSPOOLER THEN <<INPUT SPOOLER>>      <<04833>>13984000
      DIRECTION := IN                                          <<04833>>13986000
      ELSE                                                     <<04833>>13988000
      DIRECTION := OUT0;                                       <<04833>>13990000
      SPOOFLING := UNCHANGED; <<LEAVE SPOOL QUEUE >>           <<04833>>13992000
      IF NOT SENDSPOOLERMSG(LDEV,NEWDIRECTIVE,SPOOFLING,       <<04833>>13994000
            SPOOLINFO,                                         <<04833>>13996000
             ERRNUM,PARMNUM) THEN                              <<04833>>13998000
         BEGIN                                                 <<04833>>14000000
         RELSIR(LDTSIR,SAVESIR);                               <<04833>>14002000
         CIERR(ERRNUM,FIRSTPARM);                              <<04833>>14004000
         RETURN;                                               <<04833>>14006000
         END;                                                  <<04833>>14008000
      RELSIR(LDTSIR,SAVESIR);                                  <<04833>>14010000
   END                                                         <<04833>>14012000
   ELSE                                                        <<04833>>14014000
      BEGIN                                                    <<04833>>14016000
         PARMNUM:=1;                                           <<04833>>14018000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                  <<04833>>14020000
      END;                                                     <<04833>>14022000
     RETURN; <<COMPLETED LDEV CASE>>                           <<04833>>14024000
 END;  <<LDEV CASE>>                                           <<04833>>14026000
            <<CONTINUATION OF DFID CASE>>                      <<04833>>14028000
   IF ERRNUM<>0 THEN RETURN;                                            14030000
   TOS := FILENUM;                                             <<04833>>14032000
   IF FIRSTPARM(1) = "O" THEN                                  <<04833>>14034000
      BEGIN                                                    <<04833>>14036000
      OUT := TRUE;                                             <<04833>>14038000
      TOS.(0:1) := 1;                                          <<04833>>14040000
      END                                                      <<04833>>14042000
   ELSE IF FIRSTPARM(1) = "I" THEN                             <<04833>>14044000
      OUT := FALSE;                                            <<04833>>14046000
   DFID := TOS;                                                <<04833>>14048000
   SAVELDT := GETSIR(LDTSIR);                                  <<04833>>14050000
   SAVEXDD := GETSIR(IF OUT THEN ODDSIR ELSE IDDSIR);          <<04833>>14052000
   IF NOT CHECKALLOW(M'DELETESPOOLFILE) AND                    <<04833>>14054000
      NOT ASS'DFID THEN                                        <<04833>>14056000
   BEGIN                                                                14058000
   PARMNUM := 0;                                                        14060000
   RELSIR(IF OUT THEN ODDSIR ELSE IDDSIR,SAVEXDD);             <<04833>>14062000
   RELSIR(LDTSIR,SAVELDT);                                     <<04833>>14064000
   CIERR(ERRNUM := OPCOMMNOTALLOW);                                     14066000
   END                                                                  14068000
   ELSE                                                                 14070000
   BEGIN                                                                14072000
         IF OUT THEN FIND := SFINDODD(DFID,XDDEP)                       14074000
             ELSE FIND := SFINDIDD(DFID,XDDEP);                         14076000
         IF NOT FIND THEN                                               14078000
            BEGIN <<NO SUCH FILE>>                             <<04833>>14080000
            ERRNUM := NOSUCHFILE;                              <<04833>>14082000
            RELSIR(IF OUT THEN ODDSIR ELSE IDDSIR,SAVEXDD);    <<04833>>14084000
            RELSIR(LDTSIR,SAVELDT);                            <<04833>>14086000
            END                                                <<04833>>14088000
         ELSE                                                           14090000
         BEGIN                                                          14092000
            MOVEFROMDSEG( XDD,IF OUT THEN ODDDST ELSE IDDDST,           14094000
              XDDEP.(1:15),XDDSIZE);                                    14096000
            RELSIR(IF OUT THEN ODDSIR ELSE IDDSIR,SAVEXDD);    <<04833>>14098000
            RELSIR(LDTSIR,SAVELDT);                            <<04833>>14100000
            IF XDD(XD'STATE)= DFACTIVE THEN <<FILE ACTIVE >>            14102000
            BEGIN                                                       14104000
                  IF VERIFY'MASTEROP(XDD(XD'DEVICE)) THEN               14106000
                     DELETE'RETURN := 1                                 14108000
                  ELSE                                                  14110000
                     BEGIN                                              14112000
                     DELETE'RETURN :=                                   14114000
                         DELETEDEVFILE(DFID,FALSE) ;                    14116000
                     IF DELETE'RETURN = 0                               14118000
                        THEN                                            14120000
                        BEGIN                                  <<04833>>14122000
                           IF LPDT(XDD(XD'DEVICE)*LPDTSIZE     <<04833>>14124000
                               + LPDT'VIRTUAL) = 1 OR          <<04833>>14126000
                              XDD(XD'C) = 1 THEN <<NORMAL>>    <<04833>>14128000
                           ELSE                                <<04833>>14130000
                        CIERR(-SPACTLDEV,FIRSTPARM,%10000,              14132000
                              XDD(XD'DEVICE))                           14134000
                        END                                    <<04833>>14136000
                        ELSE                                   <<04833>>14138000
                           CIERR(-SPACTLDEVNODEL,,%10000,               14140000
                               XDD(XD'DEVICE));                         14142000
                     END;                                               14144000
            END                                                         14146000
            ELSE                                                        14148000
               DELETE'RETURN := DELETEDEVFILE(DFID,FALSE);              14150000
         END;                                                           14152000
                                                                        14154000
         IF ERRNUM <> 0 THEN                                            14156000
         BEGIN                                                          14158000
            PARMNUM := 1;                                               14160000
            CIERR(ERRNUM,FIRSTPARM);    <<NOSUCHFILE>>                  14162000
         END;                                                           14164000
         IF DELETE'RETURN <> 0 THEN <<BAD RETURN>>                      14166000
         CASE DELETE'RETURN OF                                          14168000
         BEGIN                                                          14170000
            ;                     <<0>>                                 14172000
                                                                        14174000
            ;                     <<1>>                                 14176000
            BEGIN                 <<2>>                                 14178000
               PARMNUM := 1;                                            14180000
               CIERR(ERRNUM:=NOSUCHFILE,FIRSTPARM);                     14182000
            END;                                                        14184000
            BEGIN                 <<3>>                                 14186000
               PARMNUM := 1;                                            14188000
               CIERR(ERRNUM:=WRONGSTATE,FIRSTPARM);                     14190000
            END;                                                        14192000
           BEGIN                 << 4 >>                       <<04833>>14194000
             PARMNUM := 1;                                     <<04833>>14196000
             CIERR(ERRNUM:=CANT'DELETE'STDIN,FIRSTPARM);       <<04833>>14198000
           END;                                                <<04833>>14200000
         END;                                                           14202000
   END;                                                                 14204000
END;   << CXDELETESPOOLFILE >>                                 <<04833>>14206000
$PAGE "ALTSPOOLFILE EXECUTOR"                                  <<04833>>14208000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>14210000
                                                                        14212000
<< Note:  Procedure CXALTSPOOLFILE was moved unchanged from >> <<04833>>14214000
<< OPCOMMAND to SPOOLCOMS as part of this enhancement.  Its >> <<04833>>14216000
<< fix number(s) were not changed.                          >> <<04833>>14218000
                                                                        14220000
PROCEDURE CXALTSPOOLFILE EXECUTORHEAD;                                  14222000
BEGIN                                                                   14224000
   COMMENT                                                     <<04833>>14226000
      THE SYNTAX OF THIS COMMAND IS            ;               <<04833>>14228000
                                                               <<04833>>14230000
<<    ALTSPOOLFILE   { #Onnn } ; [PRI=outputpriority] >>       <<04833>>14232000
<<                   {  ldev1}   [COPIES=numcopies  ] >>       <<04833>>14234000
<<                               [DEV= {ldev2}      ] >>       <<04833>>14236000
<<                               [     {devclass}   ] >>       <<04833>>14238000
<<                               [DEFER             ] >>       <<04833>>14240000
<<                                                           >><<04859>>14242000
<< * Fix information:                                        >><<04859>>14244000
<<   When ;DEV= xxxx is specified, the job's JMAT is updated >><<04859>>14246000
<<   with the new device/device class information.  Also,    >><<04859>>14248000
<<   another sequence is used for obtaining SIRs.  The       >><<04859>>14250000
<<   sequence is JMATSIR, LDTSIR, LPDTSIR and the ODDSIR     >><<04859>>14252000
<<   when you obtain the SIRs.  You release them is the      >><<04859>>14254000
<<   following order:  ODDSIR, LPTDSIR, LDTSIR, JMATSIR.     >><<04859>>14256000
<<                                                           >><<04859>>14258000
                                                               <<04833>>14260000
   EQUATE COMMA=0, EQUAL=1, SEMICOLON=2;                                14262000
   EQUATE OUTPUTDEV=4;                                                  14264000
   EQUATE MAXPARMS=8;                                                   14266000
   EQUATE PRIKEY=1,DEVKEY=2,COPYKEY=3,DEFERKEY=4;                       14268000
   DOUBLE ARRAY PARM(0:MAXPARMS)=Q;                                     14270000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM=PARM+4,         14272000
                FOURTHPARM=PARM+6, FIFTHPARM=PARM+8,SIXTHPARM=PARM+10,  14274000
        SEVENTHPARM=PARM+12,EIGHTHPARM=PARM+14;                         14276000
   BYTE FIRSTLEN=PARM+1, SNDLEN=PARM+3, TRDLEN=PARM+5,                  14278000
        FOURTLEN=PARM+7, FIFTHLEN=PARM+9,                               14280000
        SIXTHLEN=PARM+11, SEVENTHLEN=PARM+13;                           14282000
   INTEGER PARM1=PARM+1, PARM2=PARM+3, PARM3=PARM+5, PARM4=PARM+7,      14284000
           PARM5=PARM+9, PARM6=PARM+11, PARM7=PARM+13;                  14286000
DEFINE ODD'ENTRYSIZE= XDDSIZE#;                                         14288000
   LOGICAL CLASS,RELINK,COMMAND'ALLOWED;                       <<04833>>14290000
   LOGICAL PRIFLAG,DEFERFLAG;                                           14292000
   INTEGER SAVESIR,NUMPARMS,ENTRYP,FILENUM,PRI:=-1,DEVICE:=0;           14294000
   INTEGER SAVELDT,SAVELPDT,SAVEXDD;                                    14296000
   INTEGER KEY,COPIES,ROOSTERPARM,DFID,XDDEP;                           14298000
   BYTE POINTER PARMPTR;                                                14300000
   BYTE LEN,OLDBYTE;                                                    14302000
   INTEGER LASTDEL,CURRDEL;                                             14304000
   INTEGER ARRAY JMATENTRY(0:JMATENTRYSIZE-1);                 <<04859>>14306000
   INTEGER ARRAY JMATHEADER(0:JMATHEADERSIZE-1);               <<04859>>14308000
   INTEGER ARRAY XDD(0:ODD'ENTRYSIZE);                                  14310000
   INTEGER ARRAY DEVINFO(0:8)=Q;                                        14312000
   INTEGER ARRAY LPDT(*)=DEVINFO+2;                                     14314000
   INTEGER ARRAY CLASSNAME(0:4);                               <<04833>>14316000
   BYTE ARRAY CLASSNAME'(*) = CLASSNAME;                       <<04833>>14318000
   INTEGER ARRAY LDT(*)=DEVINFO+4;                                      14320000
   LOGICAL ARRAY SPOOLINFO(0:3);                               <<04833>>14322000
   LOGICAL LDEV,ALTER'LDEV,ALTER'ACTIVE'DFID;                  <<04833>>14324000
   EQUATE <<DIRECTION>>                                        <<04833>>14326000
          IN=0,                                                <<04833>>14328000
          OUT=3, <<SPOOFLING ON + OUTPUT SPOOLING>>            <<04833>>14330000
          EITHER = -1;                                         <<04833>>14332000
   INTEGER DIRECTION := EITHER;                                <<04833>>14334000
INTEGER SAVEJMAT,JBNMBR,JMAT'DSTP;                             <<04859>>14336000
LOGICAL LJOBTYPEJOB;                                           <<04859>>14338000
   <<CI/SPOOLER DIRECTIVE>>                                    <<04833>>14340000
   EQUATE NODIRECTIVE = %100000;                               <<04833>>14342000
   INTEGER NEWDIRECTIVE := NODIRECTIVE;                        <<04833>>14344000
   DEFINE PROCDIRECTIVE = NEWDIRECTIVE.(8:4)#,                 <<04833>>14346000
          ALTER'DEV     = NEWDIRECTIVE.(1:1)#,                 <<04833>>14348000
          FILEDIRECTIVE = NEWDIRECTIVE.(12:4)#;                <<04833>>14350000
   INTEGER SPOOFLING;                                          <<04833>>14352000
   EQUATE SHUT = 0,                                            <<04833>>14354000
          OPEN = 1,                                            <<04833>>14356000
          UNCHANGED = 2;                                       <<04833>>14358000
   INTEGER ACTIVE'PRI;                                         <<04833>>14360000
   LOGICAL WAKE'SPOOLER;  << The Spooler of ACTIVE Device  >>  <<04833>>14362000
                          << Files needs to be informed of >>  <<04833>>14364000
                          << changes to the Device File    >>  <<04833>>14366000
                          << only if the File is DEFERred  >>  <<04833>>14368000
                          << or if its DEV has changed.    >>  <<04833>>14370000
                                                               <<04833>>14372000
                                                               <<04833>>14374000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         14376000
   SUBROUTINE DEF'MOVETODSEG;                                           14378000
   LOGICAL SUBROUTINE GETNEXT;                                          14380000
   BEGIN                                                                14382000
      PARMNUM:=PARMNUM+1;                                               14384000
      IF PARMNUM<NUMPARMS THEN                                          14386000
      BEGIN                                                             14388000
         GETNEXT:=TRUE;                                                 14390000
         LASTDEL:=CURRDEL;                                              14392000
         TOS:=PARM(PARMNUM);                                            14394000
         CURRDEL:=S0.DELIMITER;                                         14396000
         LEN:=TOS&LSR(8);                                               14398000
         @PARMPTR:=TOS;                                                 14400000
      END ELSE GETNEXT:=FALSE;                                          14402000
   END;                                                                 14404000
                                                               <<04859>>14406000
                                                               <<04859>>14408000
<< This subroutine is called when the outclass for a job is  >><<04859>>14410000
<< modified.  This subroutine will update the JMAT for the   >><<04859>>14412000
<< job with the modified JLIST                               >><<04859>>14414000
<< This routine is only called if the output spoolfile is    >><<04859>>14416000
<< still opened.  That is the job is still executing.        >><<04859>>14418000
SUBROUTINE UPDATEJMAT;                                         <<04859>>14420000
BEGIN                                                          <<04859>>14422000
LJOBTYPEJOB:=TRUE; << YES...WE DO WANT A JOB >>                <<04859>>14424000
FINDJOB(JMATENTRY,JMAT'DSTP,JBNMBR,LJOBTYPEJOB); << GET ENTRY ><<04859>>14426000
JMATENTRY(JM'C):=CLASS; << Set class/dev bit >>                <<04859>>14428000
IF CLASS THEN JMATENTRY(JMAT'ORIGLIST):=DEVICE                 <<04859>>14430000
         ELSE JMATENTRY(JM'JLIST):=DEVICE;                     <<04859>>14432000
<< Write the updated JMATENTRY back to the JMAT >>             <<04859>>14434000
TOS:=JMATDST;                                                  <<04859>>14436000
TOS:=JMAT'DSTP;                                                <<04859>>14438000
TOS:=@JMATENTRY;                                               <<04859>>14440000
TOS:=JMATENTRYSIZE;                                            <<04859>>14442000
ASSEMBLE( MTDS 4 );                                            <<04859>>14444000
END; << UPDATEJMAT >>                                          <<04859>>14446000
                                                               <<04859>>14448000
LOGICAL SUBROUTINE ASS'DFID;                                   <<04833>>14450000
COMMENT                                                        <<04833>>14452000
   SUBROUTINE FINDS OUT IF A PARTICULAR DEVICE FILE ID         <<04833>>14454000
   RESIDES ON A DEVICE OR DEVICE CLASS WHICH IS ASSOCI-        <<04833>>14456000
   ATED WITH THE USER INVOKING THE COMMAND.                    <<04833>>14458000
                                                               <<04833>>14460000
NOTE:                                                          <<04833>>14462000
   LDT,LPDT,ODD SIRS ALREADY AQUIRED WHEN ASS'DFID IS          <<04833>>14464000
   CALLED.                                                     <<04833>>14466000
   WHEN FILE IS NOT FOUND TRUE IS RETURNED.THE ERROR           <<04833>>14468000
   WILL BE CAUGHT ON THE SECOND CALL TO SFINDODD.              <<04833>>14470000
END COMMENT.;                                                  <<04833>>14472000
BEGIN                                                          <<04833>>14474000
   ASS'DFID := FALSE;                                          <<04833>>14476000
   IF NOT SFINDODD(DFID,XDDEP) THEN                            <<04833>>14478000
      BEGIN                                                    <<04833>>14480000
         ASS'DFID := TRUE;                                     <<04833>>14482000
         RETURN;                                               <<04833>>14484000
      END;                                                     <<04833>>14486000
   MOVEFROMDSEG( XDD,ODDDST,XDDEP.(1:15),XDDSIZE);             <<04833>>14488000
   IF LOGICAL(XDD(XD'C)) THEN                                  <<04833>>14490000
      BEGIN                                                    <<04833>>14492000
         IF CHECKASS'CLASS(XDD(XD'DEVICE)) THEN                <<04833>>14494000
            ASS'DFID := TRUE;                                  <<04833>>14496000
      END                                                      <<04833>>14498000
   ELSE                                                        <<04833>>14500000
      BEGIN                                                    <<04833>>14502000
         IF CHECKASS(XDD(XD'DEVICE)) THEN                      <<04833>>14504000
            ASS'DFID := TRUE;                                  <<04833>>14506000
      END;                                                     <<04833>>14508000
END;                                                           <<04833>>14510000
$PAGE                                                                   14512000
<<***********************************************************>><<04859>>14514000
<<      START OF MAIN BODY OF EXECUTOR                       >><<04859>>14516000
<<                                                           >><<04859>>14518000
<< NOTE:  JMAT is now updated when a ";DEV=nn" is specifed   >><<04859>>14520000
   LOGIMAGE( M'ALTSPOOLFILE, PARMSP );  << LOG OP COMMAND >>   <<04833>>14522000
   ERRNUM := 0;                                                         14524000
   PARMNUM := 0;                                                        14526000
   ALTER'LDEV := FALSE;                                        <<04833>>14528000
   ALTER'ACTIVE'DFID := FALSE;                                 <<04833>>14530000
   WAKE'SPOOLER := FALSE;                                      <<04833>>14532000
   ACTIVE'PRI := 0;                                            <<04833>>14534000
   PRI := -1;                                                           14536000
   COPIES := DEVICE := 0;                                               14538000
   RELINK := FALSE;                                                     14540000
   CLASS := FALSE;                                                      14542000
   PRIFLAG := DEFERFLAG := FALSE;                                       14544000
   COMMAND'ALLOWED := CHECKALLOW(M'ALTSPOOLFILE);              <<04833>>14546000
   MYCOMMAND(PARMSP,,MAXPARMS,NUMPARMS,PARM); <<PARSE PARMS>>           14548000
   IF NOT (2<=NUMPARMS<=8) THEN                                         14550000
   BEGIN                                                                14552000
      TOS:=ERRNUM:=EXPOAND1PARM;                                        14554000
      IF NUMPARMS = 0 THEN TOS := @PARMSP                               14556000
      ELSE                                                              14558000
      IF NUMPARMS<MAXPARMS THEN                                         14560000
      BEGIN                                                             14562000
         PARMNUM:=NUMPARMS;                                             14564000
         TOS:=PARM(NUMPARMS-1);                                         14566000
         DEL;                                                           14568000
      END                                                               14570000
      ELSE                                                              14572000
      BEGIN                                                             14574000
         PARMNUM:=MAXPARMS;                                             14576000
         TOS:=@EIGHTHPARM;                                              14578000
      END;                                                              14580000
      CIERR(*,*);                                                       14582000
   END                                                                  14584000
   ELSE                                                                 14586000
   BEGIN                                                                14588000
      IF FIRSTLEN<3 OR FIRSTPARM<>"#" OR                                14590000
      FIRSTPARM(1)<>"O"  THEN                                           14592000
      BEGIN                                                    <<04833>>14594000
       LDEV := VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,                <<04833>>14596000
                ERRNUM,PARMNUM,1);                             <<04833>>14598000
       IF < THEN                                               <<04833>>14600000
       BEGIN                                                   <<04833>>14602000
          PARMNUM := 1;                                        <<04833>>14604000
          ERRNUM := EXPONUM;                                   <<04833>>14606000
          CIERR(ERRNUM,FIRSTPARM);                             <<04833>>14608000
          RETURN;                                              <<04833>>14610000
       END;                                                    <<04833>>14612000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;                    <<04833>>14614000
      IF CHECKASS(LDEV) OR COMMAND'ALLOWED THEN                <<04833>>14616000
         ALTER'LDEV := TRUE; <<USER HAS ACCESS>>               <<04833>>14618000
     END                                                       <<04833>>14620000
      ELSE                                                              14622000
      BEGIN                                                             14624000
         FILENUM:=BINARY(FIRSTPARM(2),FIRSTLEN-2);                      14626000
         IF <> OR NOT (1<=FILENUM<=%77777)                     <<04833>>14628000
            THEN ERRNUM := BADFILENUM;                         <<04833>>14630000
      END;                                                              14632000
      IF ERRNUM<>0 THEN                                                 14634000
      BEGIN                                                             14636000
         PARMNUM:=1;                                                    14638000
         CIERR(ERRNUM,FIRSTPARM);                                       14640000
         RETURN;                                                        14642000
      END;                                                              14644000
      CURRDEL:=PARM1.DELIMITER;                                         14646000
      PARMNUM:=0;                                                       14648000
      WHILE GETNEXT DO <<PROCESS EACH KEY>>                             14650000
      BEGIN                                                             14652000
         IF PARMPTR = "PRI" AND LEN = 3 THEN KEY:=PRIKEY                14654000
         ELSE                                                           14656000
         IF PARMPTR = "DEV" AND LEN = 3 THEN KEY:=DEVKEY                14658000
         ELSE                                                           14660000
         IF PARMPTR = "COPIES" AND LEN = 6 THEN KEY:=COPYKEY            14662000
         ELSE                                                           14664000
         IF PARMPTR = "DEFER" AND LEN = 5 THEN KEY:=DEFERKEY            14666000
         ELSE                                                           14668000
                                                                        14670000
                                                                        14672000
         BEGIN                                                          14674000
            CIERR(ERRNUM := EXP1OFKEY,PARMPTR);                         14676000
            RETURN;                                                     14678000
         END;                                                           14680000
            IF LASTDEL <> SEMICOLON THEN                                14682000
            BEGIN                                                       14684000
               CIERR(ERRNUM := EXPSEMICOLON,PARMPTR);                   14686000
               RETURN;                                                  14688000
            END;                                                        14690000
         IF KEY=PRIKEY THEN                                             14692000
         BEGIN                                                          14694000
            IF PRIFLAG THEN                                             14696000
            CIERR(-PRIOVERPRI,PARMPTR)                                  14698000
            ELSE                                                        14700000
            IF DEFERFLAG THEN                                           14702000
            CIERR(-PRIOVERDEFER,PARMPTR);                               14704000
            DEFERFLAG := FALSE;                                         14706000
            PRIFLAG := TRUE;                                            14708000
         END;                                                           14710000
         IF KEY = DEFERKEY THEN                                         14712000
         BEGIN                                                          14714000
            IF PRIFLAG THEN                                             14716000
            CIERR(-DEFEROVERPRI,PARMPTR);                               14718000
            PRIFLAG := FALSE;                                           14720000
            DEFERFLAG := TRUE;                                          14722000
            <<FINISHED FOR DEFER PARSE>>                                14724000
         END                                                            14726000
         ELSE                                                           14728000
         BEGIN                                                          14730000
            IF CURRDEL <> EQUAL THEN                                    14732000
            BEGIN                                                       14734000
               CIERR(ERRNUM := EXPEQUALS,PARMPTR);                      14736000
               RETURN;                                                  14738000
            END;                                                        14740000
            GETNEXT; <<GET PARAMETER FOLLOWING EQUALS>>                 14742000
         END;                                                           14744000
         CASE KEY OF                                                    14746000
         BEGIN                                                          14748000
            <<0>>                                                       14750000
              ;                                                         14752000
            <<1>>                                                       14754000
            BEGIN   <<PRIORITY>>                                        14756000
               PRI := BINARY(PARMPTR,LEN);                              14758000
               IF <> OR NOT (0<=PRI<=14) THEN                           14760000
               BEGIN                                                    14762000
                  CIERR(ERRNUM := EXPO0TO14,PARMPTR);                   14764000
                  RETURN;                                               14766000
               END;                                                     14768000
               RELINK := TRUE;                                          14770000
            END;                                                        14772000
            <<2>>                                                       14774000
         BEGIN        <<DEVICE>>                                        14776000
            OLDBYTE:=PARMPTR(LEN);                                      14778000
            PARMPTR(LEN):=" "; <<TERMINATE DEV WITH BLANK>>             14780000
            TOS:=GETDEVINFO(PARMPTR,DEVINFO); <<GET INFO ON DEVICE>>    14782000
            PARMPTR(LEN):=OLDBYTE; <<RESTORE DEVICE TERMINATING CHAR.>> 14784000
            IF TOS<>0 THEN <<BAD DEVICE>>                               14786000
            BEGIN                                                       14788000
               CIERR(ERRNUM:=NOSUCHDEV,PARMPTR);                        14790000
               RETURN;                                                  14792000
            END;                                                        14794000
            IF NOT VALIDSPOOLEE (LDT(LD'DEVTYPE), TRUE) THEN            14796000
                  <<DEVICE IS NOT OUTPUT DEVICE>>                       14798000
            BEGIN                                                       14800000
               CIERR(ERRNUM:=DEVNOTOUTPUT,PARMPTR);                     14802000
               RETURN;                                                  14804000
            END;                                                        14806000
            IF DEVINFO<0 THEN <<GOT DEVICE CLASS>>                      14808000
            BEGIN                                                       14810000
               MOVE CLASSNAME := 5("  ");                      <<04833>>14812000
               MOVE CLASSNAME' := PARMPTR,(LEN);               <<04833>>14814000
               IF VERIFY'MASTOP'C(CLASSNAME) THEN              <<04833>>14816000
                  RETURN;                                      <<04833>>14818000
               CLASS:=TRUE;                                             14820000
               DEVICE:=-DEVINFO;                                        14822000
               IF NOT CHECKASS'CLASS(DEVICE) AND               <<04833>>14824000
                  NOT COMMAND'ALLOWED THEN                     <<04833>>14826000
                  BEGIN                                        <<04833>>14828000
                     CIERR(ERRNUM:=USERNOACC2DEV,PARMPTR);     <<04833>>14830000
                     RETURN;                                   <<04833>>14832000
                  END;                                         <<04833>>14834000
            END                                                         14836000
            ELSE  <<GOT DEVICE #>>                                      14838000
            BEGIN                                                       14840000
               IF VERIFY'MASTEROP(DEVINFO) THEN                <<04833>>14842000
                  RETURN;                                      <<04833>>14844000
               CLASS:=FALSE;                                            14846000
               DEVICE:=DEVINFO;                                         14848000
               IF NOT CHECKASS(DEVICE) AND                     <<04833>>14850000
                  NOT COMMAND'ALLOWED THEN                     <<04833>>14852000
                  BEGIN                                        <<04833>>14854000
                     CIERR(ERRNUM:=USERNOACC2DEV,PARMPTR);     <<04833>>14856000
                     RETURN;                                   <<04833>>14858000
                  END;                                         <<04833>>14860000
            END;                                                        14862000
            RELINK := TRUE;                                             14864000
         WAKE'SPOOLER := TRUE;                                 <<04833>>14866000
         END;                                                           14868000
            <<3>>                                                       14870000
            BEGIN        <<COPIES>>                                     14872000
               COPIES := BINARY(PARMPTR,LEN);                           14874000
               IF <> OR NOT (1<=COPIES<=127 ) THEN                      14876000
               BEGIN                                                    14878000
                  CIERR(ERRNUM:= EXP1TO127,PARMPTR);                    14880000
                  RETURN;                                               14882000
               END;                                                     14884000
            END;                                                        14886000
            <<4>>                                                       14888000
            BEGIN   <<DEFER>>                                           14890000
               PRI := 0;                                                14892000
               RELINK := TRUE;                                          14894000
            WAKE'SPOOLER := TRUE;                              <<04833>>14896000
            END;                                                        14898000
        END; <<END OF CASE>>                                            14900000
     END;    <<END OF DO LOOP FOR KEYWORDS>>                            14902000
         IF ALTER'LDEV THEN                                    <<04833>>14904000
         BEGIN    <<ALTSPOOLFILE LDEV;...>>                    <<04833>>14906000
            IF NOT SFINDACTIVE(LDEV,FILENUM) THEN              <<04833>>14908000
            BEGIN <<LDEV IS NOT ACTIVE>>                       <<04833>>14910000
               PARMNUM := 1;                                   <<04833>>14912000
               CIERR(ERRNUM := LDEVNOTACTIVE,FIRSTPARM);       <<04833>>14914000
               RETURN;                                         <<04833>>14916000
            END;                                               <<04833>>14918000
         END;                                                  <<04833>>14920000
                                                               <<04833>>14922000
ACTIVEDFID:                                                    <<04833>>14924000
                                                               <<04833>>14926000
      IF ALTER'ACTIVE'DFID  AND  WAKE'SPOOLER  THEN            <<04833>>14928000
      BEGIN                                                    <<04833>>14930000
         DIRECTION := OUT;                                     <<04833>>14932000
         PROCDIRECTIVE := PRIORDIRECTIVE;                      <<04833>>14934000
         SPOOFLING := UNCHANGED;                               <<04833>>14936000
         FILEDIRECTIVE :=                                      <<04833>>14938000
            RELINKFILE;                                        <<04833>>14940000
         SAVELDT := GETSIR(LDTSIR);                            <<04833>>14942000
         IF NOT SENDSPOOLERMSG(LDEV,NEWDIRECTIVE,SPOOFLING,    <<04833>>14944000
            SPOOLINFO,                                         <<04833>>14946000
               ERRNUM,PARMNUM) THEN                            <<04833>>14948000
         BEGIN      <<SPOOLER NOT RESPONDING>>                 <<04833>>14950000
            RELSIR(LDTSIR,SAVELDT);                            <<04833>>14952000
            CIERR(ERRNUM,FIRSTPARM);                           <<04833>>14954000
            RETURN;                                            <<04833>>14956000
         END;                                                  <<04833>>14958000
         RELSIR(LDTSIR,SAVELDT);                               <<04833>>14960000
      END;                                                     <<04833>>14962000
                                                               <<04833>>14964000
      SAVEJMAT:=GETSIR(JMATSIR);                               <<04859>>14966000
      SAVELDT := GETSIR(LDTSIR);                               <<04833>>14968000
      SAVELPDT := GETSIR(LPDTSIR);                             <<04833>>14970000
      SAVEXDD := GETSIR(ODDSIR);                               <<04833>>14972000
      TOS := FILENUM;                                          <<04833>>14974000
      TOS.(0:1) := 1;                                          <<04833>>14976000
      DFID := TOS;                                             <<04833>>14978000
      IF ALTER'LDEV OR ALTER'ACTIVE'DFID OR                    <<04833>>14980000
         COMMAND'ALLOWED OR                                    <<04833>>14982000
         ASS'DFID THEN                                         <<04833>>14984000
     BEGIN                                                              14986000
        ROOSTERPARM := 0;                                               14988000
        IF NOT SFINDODD(DFID,XDDEP) THEN                                14990000
        BEGIN                                                           14992000
           PARMNUM := 1;                                                14994000
           ERRNUM := NOSUCHFILE;                                        14996000
        END                                                             14998000
        ELSE                                                            15000000
        BEGIN   <<VALID DEVICEFILE ID>>                                 15002000
           XDDEP :=INTEGER(LOGICAL(XDDEP) LAND %77777);                 15004000
                   <<TURN OFF HIGH BIT SET BY SFINDODD  >>              15006000
           MOVEFROMDSEG( XDD,ODDDST,XDDEP,XDDSIZE);                     15008000
            IF XDD(XD'STATE) <> DFACTIVE                       <<04833>>15010000
               OR ALTER'ACTIVE'DFID THEN                       <<04833>>15012000
           BEGIN       <<FILE NOT ACTIVE ON LDEV>>                      15014000
              IF XDD(XD'SPOOLFILE) = 0 THEN                             15016000
              BEGIN                                                     15018000
                 PARMNUM := 1;                                          15020000
                 ERRNUM := NOSUCHFILE;                                  15022000
              END                                                       15024000
              ELSE                                                      15026000
              BEGIN   <<PASSED ALL TESTS>>                              15028000
            IF ACTIVE'PRI <> 0 THEN                            <<04833>>15030000
            BEGIN                                              <<04833>>15032000
               XDD(XD'OUTPRI) := ACTIVE'PRI;                   <<04833>>15034000
               RELINK := TRUE;                                 <<04833>>15036000
            END;                                               <<04833>>15038000
                 IF COPIES > 0 THEN XDD(XD'NUMCOPIES) := COPIES;        15040000
                 IF PRI >= 0 THEN XDD(XD'OUTPRI) := PRI;                15042000
                 IF DEVICE <> 0 THEN                                    15044000
                 BEGIN                                                  15046000
                    XDD(XD'DEVICE) := DEVICE;                           15048000
                    XDD(XD'C) := CLASS;                                 15050000
                    << Update JMAT with new JLIST if OPENED>>  <<04859>>15052000
                    IF XDD(XD'STATE) = DFOPENED                <<04859>>15054000
                       THEN BEGIN                              <<04859>>15056000
                            JBNMBR:=XDD(XD'JNUM);              <<04859>>15058000
                            UPDATEJMAT;                        <<04859>>15060000
                            END;                               <<04859>>15062000
                 END;                                                   15064000
                MOVETODSEG(ODDDST,XDDEP, XDD,XDDSIZE);                  15066000
                 IF RELINK THEN                                         15068000
                 BEGIN   <<MUST RELINK ODD ENTRY>>                      15070000
                    TOS := XDD(XD'DEVICE);                              15072000
                    IF LOGICAL(XDD(XD'C)) THEN TOS := -TOS;             15074000
                    ASSEMBLE(DUP);                                      15076000
                    TOS := XDDEP;                                       15078000
                    ASSEMBLE(CAB);                                      15080000
                    EXCHANGEDB(ODDDST);                                 15082000
                    SRELINKODD(*,*);                                    15084000
                    EXCHANGEDB(0);                                      15086000
                    ROOSTERPARM := TOS;                                 15088000
                 END ;                                                  15090000
              END;                                                      15092000
           END                                                          15094000
              ELSE                                                      15096000
              BEGIN   <<FILE IS ACTIVE ON SOME DEVICE>>                 15098000
                    ERRNUM := WRONGSTATE;                               15100000
                    PARMNUM := 1;                                       15102000
            LDEV := XDD(XD'DEVICE);                            <<04833>>15104000
            ACTIVE'PRI := XDD(XD'OUTPRI);                      <<04833>>15106000
              END;                                                      15108000
        END;                                                            15110000
           RELSIR(ODDSIR,SAVEXDD);                                      15112000
           RELSIR(LPDTSIR,SAVELPDT);                                    15114000
           RELSIR(LDTSIR,SAVELDT);                                      15116000
           RELSIR(JMATSIR,SAVEJMAT);                           <<04859>>15118000
           IF ROOSTERPARM <> 0 THEN                                     15120000
              SROOSTER(ROOSTERPARM);                                    15122000
            IF ERRNUM = WRONGSTATE                             <<04833>>15124000
            THEN                                               <<04833>>15126000
               BEGIN                                           <<04833>>15128000
                  ERRNUM := PARMNUM := 0;                      <<04833>>15130000
                  ALTER'ACTIVE'DFID := TRUE;                   <<04833>>15132000
                  GO TO ACTIVEDFID;                            <<04833>>15134000
               END;                                            <<04833>>15136000
        END                                                             15138000
           ELSE                                                         15140000
           BEGIN                                                        15142000
              PARMNUM := 0;                                             15144000
              RELSIR(ODDSIR,SAVEXDD);                          <<04833>>15146000
              RELSIR(LPDTSIR,SAVELPDT);                        <<04833>>15148000
              RELSIR(LDTSIR,SAVELDT);                          <<04833>>15150000
              RELSIR(JMATSIR,SAVEJMAT);                        <<04859>>15152000
              CIERR(ERRNUM := OPCOMMNOTALLOW);                          15154000
              RETURN;                                          <<04833>>15156000
           END;                                                         15158000
           IF ERRNUM <> 0 THEN                                          15160000
           BEGIN                                                        15162000
              PARMNUM := 1;                                             15164000
              CIERR(ERRNUM,FIRSTPARM);                                  15166000
           END;                                                         15168000
    END;                                                                15170000
END;   << CXALTSPOOLFILE >>                                    <<04833>>15172000
$PAGE "STARTSPOOL EXECUTOR"                                    <<04833>>15174000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>15176000
                                                                        15178000
<< Note:  Procedure CXSTARTSPOOL was moved  unchanged  from >> <<04833>>15180000
<< OPCOMMAND to SPOOLCOMS as part of this enhancement.  Its >> <<04833>>15182000
<< fix number(s) were not changed.                          >> <<04833>>15184000
                                                                        15186000
PROCEDURE CXSTARTSPOOL EXECUTORHEAD;                                    15188000
BEGIN                                                                   15190000
<<                                                                      15192000
   COMMENT                                                              15194000
      THE SYNTAX OF THIS COMMAND IS:                                    15196000
         STARTSPOOL {ldev     } [;SHUTQ]                                15198000
                    {deviceclass}                                       15200000
         WHERE ldev IS ANY REAL LOGICAL DEVICE                          15202000
   ;                                                                    15204000
>>                                                                      15206000
   DOUBLE DL := [8/",", 8/";", 8/%15, 8/0]D;                            15208000
   BYTE ARRAY DL'(*)=DL;                                                15210000
   DOUBLE ARRAY PARM(0:1)=Q;                                            15212000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM = PARM+4;       15214000
   BYTE LEN=PARM+1,LEN2 = PARM+3;                              <<04833>>15216000
   INTEGER PARM1 = PARM+1, PARM2=PARM+3;                       <<04833>>15218000
   EQUATE COMMA = 0, SEMICOLON = 1;                            <<04833>>15220000
   LOGICAL OPENQ := TRUE;                                      <<04833>>15222000
   LOGICAL LDEV;                                                        15224000
                                                               <<04833>>15226000
   INTEGER NUMPARMS;                                                    15228000
   INTEGER POINTER DEVP;                                                15230000
   EQUATE <<DIRECTION>>                                                 15232000
          IN=0,                                                         15234000
          OUT=1, << OUTPUT SPOOLING>>                                   15236000
          EITHER = -1;                                                  15238000
   INTEGER DIRECTION := EITHER;                                         15240000
   DEFINE SPOOFLING = DIRECTION.(14:1)#; <<OPENQ,SHUTQ>>                15242000
   <<CI/SPOOLER DIRECTIVE>>                                             15244000
   EQUATE NODIRECTIVE = %100000;                                        15246000
   INTEGER NEWDIRECTIVE := NODIRECTIVE;                                 15248000
   DEFINE PROCDIRECTIVE = NEWDIRECTIVE.(8:4)#,                          15250000
          FILEDIRECTIVE = NEWDIRECTIVE.(12:4)#;                         15252000
   INTEGER SPOOLERPCB,SAVESIR;                                          15254000
   INTEGER ARRAY DEVINFO(0:8) = Q;                                      15256000
   INTEGER INFO;                                                        15258000
   LOGICAL REPLY := [8/3,8/2]; <<MAXSTRING LEN 3,STRING>>               15260000
   LOGICAL ARRAY OFFSET(0:8) = Q;                                       15262000
   BYTE ARRAY BOFFSET(*) = OFFSET;                                      15264000
   INTEGER INITIATE'RESULT;                                             15266000
      INTEGER ARRAY CLASSNAME(0:8);                            <<04833>>15268000
      BYTE ARRAY B'CLASSNAME(*) = CLASSNAME;                   <<04833>>15270000
      INTEGER ARRAY GETCLASSBUF(0:130);                        <<04833>>15272000
      BYTE ARRAY LDEVS(*) = GETCLASSBUF(3);                    <<04833>>15274000
      INTEGER ASS'USER;                                        <<04833>>15276000
   LOGICAL ARRAY SPOOLINFO(0:3);                               <<04833>>15278000
                                                                        15280000
   SUBROUTINE RESETSPSQ;                                                15282000
                                                                        15284000
   BEGIN                                                                15286000
      @DEVP := LDEV*LDTSIZE;                                            15288000
      EXCHANGEDB(LDTDST);                                               15290000
      SAVESIR := GETSIR(LDTSIR);                                        15292000
      DEVP(LD'SP) := NOSPOOLER;                                         15294000
      DEVP(LD'SQ) := 0;                                                 15296000
      RELSIR(LDTSIR,SAVESIR);                                           15298000
      EXCHANGEDB(0);                                                    15300000
         OPENQ := FALSE;                                       <<04833>>15302000
   END;    <<RESETSPSQ>>                                                15304000
                                                                        15306000
                                                                        15308000
      SUBROUTINE C'SETSQ; <<SET SPOOL QUEUE BITS IN DCT>>      <<04833>>15310000
                                                               <<04833>>15312000
      BEGIN                                                    <<04833>>15314000
         @DEVP := GETCLASSBUF;                                 <<04833>>15316000
         EXCHANGEDB(LDTDST);                                   <<04833>>15318000
         DEVP(DC'SQ) := 1;                                     <<04833>>15320000
         EXCHANGEDB(0);                                        <<04833>>15322000
      END;  <<SUBROUTINE C'SETSQ>>                             <<04833>>15324000
                                                               <<04833>>15326000
   SUBROUTINE TELL'UCOP;                                       <<04833>>15328000
   <<AWAKE UCOP PIN BY SETTING JOBSYNC FLAG>>                  <<04833>>15330000
   <<ANY JOBS IN QUEUE WAITING FOR THIS CLASS OR DEVICE >>     <<04833>>15332000
   <<CAN THEN EXECUTE>>                                        <<04833>>15334000
                                                               <<04833>>15336000
   BEGIN                                                       <<04833>>15338000
      DISABLE;                                                 <<04833>>15340000
      ABSYS'JOBSYNC.(DEVFREED'F) := 1;                         <<04833>>15342000
      ENABLE;                                                  <<04833>>15344000
      AWAKE(SYSPROC(UCOPLPIN),%20,0);                          <<04833>>15346000
   END; <<TELL'UCOP>>                                          <<04833>>15348000
   LOGIMAGE( M'STARTSPOOL, PARMSP );  << LOG OP COMMAND >>     <<04833>>15350000
   MYCOMMAND(PARMSP,DL',3,NUMPARMS,PARM);                      <<04833>>15352000
   ERRNUM := PARMNUM := 0;                                     <<04833>>15354000
   IF NUMPARMS = 0 THEN <<MUST HAVE AT LEAST 1 PARM>>          <<04833>>15356000
   BEGIN                                                       <<04833>>15358000
      CIERR(ERRNUM := -EXP1OFLDEVORSHUTQ,PARMSP);              <<04833>>15360000
      RETURN;                                                  <<04833>>15362000
   END                                                         <<04833>>15364000
   ELSE                                                        <<04833>>15366000
   IF LEN=0 THEN                                               <<04833>>15368000
   BEGIN                                                       <<04833>>15370000
      PARMNUM := 1;                                            <<04833>>15372000
      CIERR(ERRNUM := EXPLDEVBAD,FIRSTPARM);                   <<04833>>15374000
      RETURN;                                                  <<04833>>15376000
   END                                                         <<04833>>15378000
   ELSE                                                        <<04833>>15380000
   IF NUMPARMS > 2 THEN                                        <<04833>>15382000
   BEGIN                                                       <<04833>>15384000
      PARMNUM := 2;                                            <<04833>>15386000
      CIERR(ERRNUM := STARTSP2PARM,TRDPARM);                   <<04833>>15388000
      RETURN;                                                  <<04833>>15390000
   END;                                                        <<04833>>15392000
   IF NUMPARMS = 2 THEN <<MAXIMUM NUMBER OF PARMS>>            <<04833>>15394000
   BEGIN                                                       <<04833>>15396000
      IF PARM1.DELIMITER <> SEMICOLON THEN                     <<04833>>15398000
      <<MUST HAVE SEMICOLON SEPARATION>>                       <<04833>>15400000
      BEGIN                                                    <<04833>>15402000
         PARMNUM := 2;                                         <<04833>>15404000
         CIERR(ERRNUM := EXPSEMICOLON,FIRSTPARM(LEN));         <<04833>>15406000
      END                                                      <<04833>>15408000
      ELSE                                                     <<04833>>15410000
         <<IS SHUTQ SPECIFIED?>>                               <<04833>>15412000
      BEGIN                                                    <<04833>>15414000
         IF LEN2 <> 5 OR SNDPARM <> "SHUTQ" THEN             <<SP.36>>  15416000
         BEGIN                                                 <<04833>>15418000
            PARMNUM := 2;                                      <<04833>>15420000
            CIERR(ERRNUM := EXPSHUTQ,SNDPARM);                 <<04833>>15422000
            RETURN;                                            <<04833>>15424000
         END                                                   <<04833>>15426000
         ELSE                                                  <<04833>>15428000
         OPENQ := FALSE;                                       <<04833>>15430000
      END;                                                     <<04833>>15432000
   END;                                                        <<04833>>15434000
   IF ERRNUM <> 0 THEN RETURN;                                 <<04833>>15436000
                                                               <<04833>>15438000
                                                               <<04833>>15440000
      LDEV := BINARY(FIRSTPARM,LEN);                           <<04833>>15442000
      IF < THEN                                                <<04833>>15444000
      BEGIN  <<TRY CLASS>>                                     <<04833>>15446000
         IF LEN > 8 THEN                                       <<04833>>15448000
         BEGIN  << CLASSNAME TOO LONG>>                        <<04833>>15450000
            PARMNUM := 1;                                      <<04833>>15452000
            CIERR(ERRNUM := EXPDEVCLASSLONG,FIRSTPARM);        <<04833>>15454000
            RETURN;                                            <<04833>>15456000
         END;                                                  <<04833>>15458000
         <<DETERMINE IF DEVCLASS IS ACCESSIBLE>>               <<04833>>15460000
         MOVE B'CLASSNAME := FIRSTPARM,(8);                    <<04833>>15462000
         MOVE B'CLASSNAME := B'CLASSNAME WHILE ANS,1;          <<04833>>15464000
         MOVE * := "       ";                                  <<04833>>15466000
         ASS'USER := ASSOC'CLASS(CLASSNAME);                   <<04833>>15468000
         IF ASS'USER = -1 THEN                                 <<04833>>15470000
         BEGIN                                                 <<04833>>15472000
            PARMNUM := 1;                                      <<04833>>15474000
            CIERR(ERRNUM := BADCLASSNAME,FIRSTPARM);           <<04833>>15476000
            RETURN;                                            <<04833>>15478000
         END;                                                  <<04833>>15480000
         SAVESIR := GETSIR(LDTSIR);                            <<04833>>15482000
         IF VERIFY'MASTOP'C(CLASSNAME) THEN                    <<04833>>15484000
            BEGIN                                              <<04833>>15486000
               RELSIR(LDTSIR,SAVESIR);                         <<04833>>15488000
               RETURN;                                         <<04833>>15490000
            END;                                               <<04833>>15492000
         GETCLASS(GETCLASSBUF,TRUE,,,CLASSNAME);               <<04833>>15494000
         LDEV := GETCLASSBUF(3).(8:8); <<FIRST LDEV IN CLASS>> <<04833>>15496000
         << IS REQUESTOR ASSOCIATOR OF THIS CLASS?>>           <<04833>>15498000
         IF CHECKASS'CLASS(,B'CLASSNAME) OR                    <<04833>>15500000
            CHECKALLOW(M'STARTSPOOL) THEN                      <<04833>>15502000
         <<USER HAS ACCESS>>                                   <<04833>>15504000
         ELSE                                                  <<04833>>15506000
         BEGIN                                                 <<04833>>15508000
            PARMNUM := 1;                                      <<04833>>15510000
            RELSIR(LDTSIR,SAVESIR);                            <<04833>>15512000
            CIERR(ERRNUM := USERNOACC2CLASS,PARMSP);           <<04833>>15514000
            RETURN;                                            <<04833>>15516000
         END;                                                  <<04833>>15518000
                                                               <<04833>>15520000
         <<USER HAS ACCESS>>                                   <<04833>>15522000
         << TO CLASS      >>                                   <<04833>>15524000
         IF LOGICAL(C'SQ) THEN                                 <<04833>>15526000
         BEGIN  <<DEVICECLASS ALREADY SPOOLED>>                <<04833>>15528000
            PARMNUM := 1;                                      <<04833>>15530000
            RELSIR(LDTSIR,SAVESIR);                            <<04833>>15532000
            CIERR(ERRNUM := CLASSALREADYSPOOLED,FIRSTPARM);    <<04833>>15534000
            RETURN;                                            <<04833>>15536000
         END;                                                  <<04833>>15538000
                                                               <<04833>>15540000
         IF NOT VALIDSPOOLEE(C'DEVTYPE,DIRECTION := OUT) THEN  <<04833>>15542000
           BEGIN                                               <<04833>>15544000
              PARMNUM := 1;                                    <<04833>>15546000
              RELSIR(LDTSIR,SAVESIR);                          <<04833>>15548000
              CIERR(ERRNUM := CLTYPENOTSPOOLEE,FIRSTPARM);     <<04833>>15550000
              RETURN;                                          <<04833>>15552000
           END;                                                <<04833>>15554000
                                                               <<04833>>15556000
         IF NUMPARMS > 1 THEN                                  <<04833>>15558000
         BEGIN  <<CANNOT SPECIFY "SHUTQ" WITH >>               <<04833>>15560000
                <<DEVICECLASS>>                                <<04833>>15562000
            PARMNUM := 2;                                      <<04833>>15564000
            RELSIR(LDTSIR, SAVESIR);                           <<04833>>15566000
            CIERR(ERRNUM := CLASSXPARMS, SNDPARM);             <<04833>>15568000
            RETURN;                                            <<04833>>15570000
         END;                                                  <<04833>>15572000
         <<NOW WE CAN SET THE SPOOLING BIT IN >>               <<04833>>15574000
         << THE DEVICE CLASS ENTRY>>                           <<04833>>15576000
         C'SETSQ;                                              <<04833>>15578000
         <<TELL UCOP THAT QUEUE IS OPEN>>                      <<04833>>15580000
         TELL'UCOP;                                            <<04833>>15582000
         RELSIR(LDTSIR,SAVESIR);                               <<04833>>15584000
      END                                                      <<04833>>15586000
      ELSE                                                     <<04833>>15588000
   BEGIN                                                                15590000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);               15592000
      IF < THEN RETURN;                                                 15594000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>15596000
      IF CHECKASS(LDEV) OR                                              15598000
         CHECKALLOW(M'STARTSPOOL) THEN <<USER HAS ACCESS>>              15600000
      BEGIN                                                             15602000
         INFO := GETDEVINFO(FIRSTPARM,DEVINFO);                         15604000
         IF (0<= INFO <=3) THEN                                         15606000
         CASE INFO OF                                                   15608000
         BEGIN                                                          15610000
            ;      <<0>> <<OK , NO ERRORS>>                             15612000
            BEGIN  <<1>> <<INVALID DEVCLASS>>                           15614000
               PARMNUM := 1;                                            15616000
               CIERR(ERRNUM := INVDEVCLASS,FIRSTPARM);                  15618000
               RETURN;                                                  15620000
            END;                                                        15622000
            BEGIN  <<2>> <<UNKNOWN DEVCLASS>>                           15624000
               PARMNUM := 1;                                            15626000
               CIERR(ERRNUM := UNKNOWNDEVCL,FIRSTPARM);                 15628000
               RETURN;                                                  15630000
            END;                                                        15632000
            BEGIN  <<3>> <<UNKNOWN LOGICAL DEVICE>>                     15634000
               PARMNUM := 1;                                            15636000
               CIERR(ERRNUM := EXPLDEVBAD,FIRSTPARM);                   15638000
               RETURN;                                                  15640000
            END;                                                        15642000
         END;  <<CASE>>                                                 15644000
                                                                        15646000
         IF INFO = -1 THEN                                              15648000
         BEGIN                                                          15650000
            PARMNUM := 1;                                               15652000
            CIERR(ERRNUM := LDEVNOTREAL,FIRSTPARM);                     15654000
            RETURN;                                                     15656000
         END;                                                           15658000
         IF DEVINFO(1) = READERPUNCH THEN <<READER PUNCH>>              15660000
         BEGIN    <<DETERMINE IF INPUT OR OUTPUT>>                      15662000
            GENMSG(CIGENERALMSGSET,SPOOLINOROUT,%10000,LDEV,            15664000
                   ,,,,,,,, [1/1, 15/0]);                               15666000
            READX(OFFSET, -3);                                          15668000
            MOVE BOFFSET := BOFFSET WHILE AS;                           15670000
            IF BOFFSET = "IN" THEN DIRECTION := IN                      15672000
               ELSE IF BOFFSET = "OUT" THEN                             15674000
                  DIRECTION := OUT                                      15676000
                     ELSE                                               15678000
                     BEGIN                                              15680000
                        PARMNUM := 0;                                   15682000
                        CIERR(ERRNUM := EXPINOROUT);                    15684000
                        RETURN;                                         15686000
                     END;                                               15688000
         END   <<END OF READER/PUNCH CASE>>                             15690000
         ELSE                                                           15692000
         BEGIN                                                          15694000
            IF NOT VALIDSPOOLEE(DEVINFO(1),DIRECTION := OUT) THEN       15696000
               IF NOT VALIDSPOOLEE(DEVINFO(1),DIRECTION := IN) THEN     15698000
               BEGIN                                                    15700000
                  PARMNUM := 1;                                         15702000
                  CIERR(ERRNUM := DEVTYPENOTSPOOLEE,FIRSTPARM);         15704000
                  RETURN;                                               15706000
               END;                                                     15708000
         END;                                                           15710000
                                                                        15712000
         IF DIRECTION = IN AND NUMPARMS > 1 THEN               <<04833>>15714000
         BEGIN  << SHUTQ SPECIFIED FOR INPUT SPOOLEE>>         <<04833>>15716000
            PARMNUM := 2;                                      <<04833>>15718000
            CIERR(ERRNUM := SHUTQINPUT,SNDPARM);               <<04833>>15720000
            RETURN;                                            <<04833>>15722000
         END;                                                  <<04833>>15724000
         <<NOW WE CAN INITIATE SPOOLING>>                               15726000
         IF DIRECTION = OUT THEN <<SET SPOOL QUEUE>>           <<04833>>15728000
         SPOOFLING := OPENQ;<<OPENQ>>                          <<04833>>15730000
         INITIATE'RESULT := INITIATESPOOLER(LDEV,DIRECTION);            15732000
         INITIATE'RESULT := INITIATE'RESULT + 2; <<FOR CASE>>           15734000
         CASE INITIATE'RESULT OF                                        15736000
         BEGIN                                                          15738000
            BEGIN    <<-2>> <<OWNED OUT>>                               15740000
               PARMNUM := 1;                                            15742000
               CIERR(ERRNUM := SPOOLEEOWNEDOUT,FIRSTPARM);              15744000
               RETURN;                                                  15746000
            END;                                                        15748000
            BEGIN    <<-1>>  <<OWNED IN>>                               15750000
               PARMNUM := 1;                                            15752000
               CIERR(ERRNUM := SPOOLEEOWNEDIN,FIRSTPARM);               15754000
               RETURN;                                                  15756000
            END;                                                        15758000
            BEGIN    <<0>>   <<OK>>                                     15760000
               <<OK>>                                                   15762000
               IF OPENQ THEN TELL'UCOP;                        <<04833>>15764000
            END;                                                        15766000
            BEGIN    <<1>>   <<OWNED, NOT SPOOLED>>                     15768000
               PARMNUM := 1;                                            15770000
               CIERR(ERRNUM := DEVOWNED,FIRSTPARM);                     15772000
               RETURN;                                                  15774000
            END;                                                        15776000
            BEGIN    <<2>>  <<NOT REAL DEVICE>>                         15778000
               PARMNUM := 1;                                            15780000
               CIERR(ERRNUM := LDEVNOTREAL,FIRSTPARM);                  15782000
               RETURN;                                                  15784000
            END;                                                        15786000
            BEGIN    <<3>>  <<NOT SPOOLEE>>                             15788000
               PARMNUM := 1;                                            15790000
               RESETSPSQ;  <<RESET LDT SPOOLING BITS>>                  15792000
               CIERR(ERRNUM := DEVTYPENOTSPOOLEE,FIRSTPARM);            15794000
               RETURN;                                                  15796000
            END;                                                        15798000
            BEGIN    <<4>>  <<NOT JOB OR DATA ACCEPTING>>               15800000
               PARMNUM := 1;                                            15802000
               RESETSPSQ;                                               15804000
               CIERR(ERRNUM := DEVNOTJOBDATA,FIRSTPARM);                15806000
               RETURN;                                                  15808000
            END;                                                        15810000
            BEGIN     <<5>>  <<OWNED BY DIAGNOSTICS>>                   15812000
               PARMNUM := 1;                                            15814000
               CIERR(ERRNUM := DEVOWNEDDIAG,FIRSTPARM);                 15816000
               RETURN;                                                  15818000
            END;                                                        15820000
            BEGIN    <<6>>  <<NO STACK SEGMENT AVAIL>>                  15822000
               PARMNUM := 0;                                            15824000
               RESETSPSQ;                                               15826000
               CIERR(ERRNUM := UNABLETOGETSTACK);                       15828000
            END;                                                        15830000
            BEGIN    <<7>> <<UNABLE TO PROCREATE>>                      15832000
               PARMNUM := 0;                                            15834000
               RESETSPSQ;                                               15836000
               CIERR(ERRNUM := UNABLETOPROCREATE);                      15838000
               RETURN;                                                  15840000
            END;                                                        15842000
            BEGIN    <<8>>  <<SPOOLER PROCESS BUSY>>                    15844000
               PARMNUM := 0;                                            15846000
               RESETSPSQ;                                               15848000
               CIERR(ERRNUM := SPOOLERBUSY);                            15850000
               RETURN;                                                  15852000
            END;                                                        15854000
            BEGIN    <<9>>  <<DEVICE DOWNED, UNAVAILABLE>>     <<04833>>15856000
               PARMNUM := 0;                                   <<04833>>15858000
               RESETSPSQ;                                      <<04833>>15860000
               CIERR(ERRNUM:=DEVISDOWN);                       <<04833>>15862000
               RETURN;                                         <<04833>>15864000
            END;                                               <<04833>>15866000
        END;    <<CASE>>                                                15868000
      END                                                               15870000
      ELSE                                                              15872000
      BEGIN                                                             15874000
         PARMNUM:=1;                                                    15876000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                           15878000
      END;                                                              15880000
   END;                                                                 15882000
END;   <<STARTSPOOL>>                                                   15884000
$PAGE "STOPSPOOL EXECUTOR"                                     <<04833>>15886000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>15888000
                                                                        15890000
<< Note:  Procedure CXSTOPSPOOL was  moved  unchanged  from >> <<04833>>15892000
<< OPCOMMAND to SPOOLCOMS as part of this enhancement.  Its >> <<04833>>15894000
<< fix number(s) were not changed.                          >> <<04833>>15896000
                                                                        15898000
PROCEDURE CXSTOPSPOOL EXECUTORHEAD;                                     15900000
BEGIN                                                                   15902000
<<                                                                      15904000
   COMMENT                                                              15906000
      THE SYNTAX OF THIS COMMAND IS:                                    15908000
         STOPSPOOL {ldev     } [;SHUTQ]                                 15910000
                    {deviceclass}                                       15912000
         WHERE ldev IS ANY REAL LOGICAL DEVICE                          15914000
   ;                                                                    15916000
>>                                                                      15918000
   DOUBLE DL := [8/",", 8/";", 8/%15, 8/0]D;                            15920000
   BYTE ARRAY DL'(*)=DL;                                                15922000
   DOUBLE ARRAY PARM(0:1)=Q;                                            15924000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM = PARM+4;       15926000
   BYTE LEN=PARM+1,LEN2 = PARM+3;                              <<04833>>15928000
   INTEGER PARM1 = PARM+1, PARM2=PARM+3;                       <<04833>>15930000
   EQUATE COMMA = 0, SEMICOLON = 1;                            <<04833>>15932000
   LOGICAL OPENQ := FALSE;                                     <<04833>>15934000
   LOGICAL LDEV;                                                        15936000
   INTEGER NUMPARMS;                                                    15938000
   INTEGER POINTER DEVP;                                                15940000
   EQUATE <<DIRECTION>>                                                 15942000
          IN=0,                                                         15944000
          OUT=3, <<SPOOFLING ON + OUTPUT SPOOLING>>                     15946000
          EITHER = -1;                                                  15948000
   INTEGER DIRECTION := EITHER;                                         15950000
   <<CI/SPOOLER DIRECTIVE>>                                             15952000
   EQUATE NODIRECTIVE = %100000;                                        15954000
   INTEGER NEWDIRECTIVE := NODIRECTIVE;                                 15956000
   DEFINE PROCDIRECTIVE = NEWDIRECTIVE.(8:4)#,                          15958000
          FILEDIRECTIVE = NEWDIRECTIVE.(12:4)#;                         15960000
   INTEGER SPOOLERPCB,SAVESIR;                                          15962000
   INTEGER ARRAY DEVINFO(0:8) = Q;                                      15964000
   INTEGER INFO;                                                        15966000
   LOGICAL REPLY := [8/3,8/2]; <<MAXSTRING LEN 3,STRING>>               15968000
   LOGICAL ARRAY OFFSET(0:8) = Q;                                       15970000
   BYTE ARRAY BOFFSET(*) = OFFSET(1);                                   15972000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                                      15974000
   INTEGER SPOOFLING;                                                   15976000
   EQUATE SHUT = 0,                                                     15978000
          OPEN = 1,                                            <<04833>>15980000
          UNCHANGED = 2;                                       <<04833>>15982000
      INTEGER ARRAY CLASSNAME(0:8);                            <<04833>>15984000
      BYTE ARRAY B'CLASSNAME(*) = CLASSNAME;                   <<04833>>15986000
      INTEGER ARRAY GETCLASSBUF(0:130);                        <<04833>>15988000
      BYTE ARRAY LDEVS(*) = GETCLASSBUF(3);                    <<04833>>15990000
      INTEGER ASS'USER;                                        <<04833>>15992000
   LOGICAL ARRAY SPOOLINFO(0:3);                               <<04833>>15994000
                                                                        15996000
      SUBROUTINE C'RESETSQ; <<RESET SPOOL QUEUE BITS IN DCT>>  <<04833>>15998000
                                                               <<04833>>16000000
      BEGIN                                                    <<04833>>16002000
         @DEVP := GETCLASSBUF;                                 <<04833>>16004000
         EXCHANGEDB(LDTDST);                                   <<04833>>16006000
         DEVP(DC'SQ) := 0;                                     <<04833>>16008000
         EXCHANGEDB(0);                                        <<04833>>16010000
      END;  <<SUBROUTINE C'RESETSQ>>                           <<04833>>16012000
                                                               <<04833>>16014000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         16016000
   SUBROUTINE DEF'MOVETODSEG;                                           16018000
                                                                        16020000
                                                                        16022000
   LOGIMAGE( M'STOPSPOOL, PARMSP );  << LOG OP COMMAND >>      <<04833>>16024000
   MYCOMMAND(PARMSP,DL',3,NUMPARMS,PARM);                      <<04833>>16026000
   ERRNUM := PARMNUM := 0;                                     <<04833>>16028000
   IF NUMPARMS = 0 THEN <<MUST HAVE AT LEAST 1 PARM>>          <<04833>>16030000
   BEGIN                                                       <<04833>>16032000
      CIERR(ERRNUM := -EXP1OFLDEVOROPENQ,PARMSP);              <<04833>>16034000
      RETURN;                                                  <<04833>>16036000
   END                                                         <<04833>>16038000
   ELSE                                                        <<04833>>16040000
   IF LEN=0 THEN                                               <<04833>>16042000
   BEGIN                                                       <<04833>>16044000
      PARMNUM := 1;                                            <<04833>>16046000
      CIERR(ERRNUM := EXPLDEVBAD,FIRSTPARM);                   <<04833>>16048000
      RETURN;                                                  <<04833>>16050000
   END                                                         <<04833>>16052000
   ELSE                                                        <<04833>>16054000
   IF NUMPARMS > 2 THEN                                        <<04833>>16056000
   BEGIN                                                       <<04833>>16058000
      PARMNUM := 2;                                            <<04833>>16060000
      CIERR(ERRNUM := STOPSP2PARM,TRDPARM);                    <<04833>>16062000
      RETURN;                                                  <<04833>>16064000
   END;                                                        <<04833>>16066000
   IF NUMPARMS = 2 THEN <<MAXIMUM NUMBER OF PARMS>>            <<04833>>16068000
   BEGIN                                                       <<04833>>16070000
      IF PARM1.DELIMITER <> SEMICOLON THEN                     <<04833>>16072000
      <<MUST HAVE SEMICOLON SEPARATION>>                       <<04833>>16074000
      BEGIN                                                    <<04833>>16076000
         PARMNUM := 2;                                         <<04833>>16078000
         CIERR(ERRNUM := EXPSEMICOLON,FIRSTPARM(LEN));    <<SP.36>>     16080000
      END                                                      <<04833>>16082000
      ELSE                                                     <<04833>>16084000
        <<IS OPENQ SPECIFIED?>>                                <<04833>>16086000
      BEGIN                                                    <<04833>>16088000
         IF LEN2 <> 5 OR SNDPARM <> "OPENQ" THEN             <<SP.36>>  16090000
         BEGIN                                                 <<04833>>16092000
            PARMNUM := 2;                                      <<04833>>16094000
            CIERR(ERRNUM := EXPOPENQ,SNDPARM);                 <<04833>>16096000
            RETURN;                                            <<04833>>16098000
         END                                                   <<04833>>16100000
         ELSE                                                  <<04833>>16102000
         OPENQ := TRUE;                                        <<04833>>16104000
      END;                                                     <<04833>>16106000
   END;                                                        <<04833>>16108000
   IF ERRNUM <> 0 THEN RETURN;                                 <<04833>>16110000
                                                               <<04833>>16112000
                                                               <<04833>>16114000
      LDEV := BINARY(FIRSTPARM,LEN);                           <<04833>>16116000
      IF < THEN                                                <<04833>>16118000
      BEGIN  <<TRY CLASS>>                                     <<04833>>16120000
         IF LEN > 8 THEN                                       <<04833>>16122000
         BEGIN  << CLASSNAME TOO LONG>>                        <<04833>>16124000
            PARMNUM := 1;                                      <<04833>>16126000
            CIERR(ERRNUM := EXPDEVCLASSLONG,FIRSTPARM);        <<04833>>16128000
            RETURN;                                            <<04833>>16130000
         END;                                                  <<04833>>16132000
         <<DETERMINE IF DEVCLASS IS ACCESSIBLE>>               <<04833>>16134000
         MOVE B'CLASSNAME := FIRSTPARM,(8);                    <<04833>>16136000
         MOVE B'CLASSNAME := B'CLASSNAME WHILE ANS,1;          <<04833>>16138000
         MOVE * := "       ";                                  <<04833>>16140000
         ASS'USER := ASSOC'CLASS(CLASSNAME);                   <<04833>>16142000
         IF ASS'USER = -1 THEN                                 <<04833>>16144000
         BEGIN                                                 <<04833>>16146000
            PARMNUM := 1;                                      <<04833>>16148000
            CIERR(ERRNUM := BADCLASSNAME,FIRSTPARM);           <<04833>>16150000
            RETURN;                                            <<04833>>16152000
         END;                                                  <<04833>>16154000
        SAVESIR := GETSIR(LDTSIR);                             <<04833>>16156000
        IF VERIFY'MASTEROP'C(CLASSNAME) THEN                   <<04833>>16158000
           BEGIN                                               <<04833>>16160000
              RELSIR(LDTSIR,SAVESIR);                          <<04833>>16162000
              RETURN;                                          <<04833>>16164000
           END;                                                <<04833>>16166000
         GETCLASS(GETCLASSBUF,TRUE,,,CLASSNAME);               <<04833>>16168000
         LDEV := GETCLASSBUF(3).(8:8); <<FIRST LDEV IN CLASS>> <<04833>>16170000
         << IS REQUESTOR ASSOCIATOR OF THIS CLASS?>>           <<04833>>16172000
         IF CHECKASS'CLASS(,B'CLASSNAME) OR                    <<04833>>16174000
            CHECKALLOW(M'STARTSPOOL) THEN                      <<04833>>16176000
         <<USER HAS ACCESS>>                                   <<04833>>16178000
         ELSE                                                  <<04833>>16180000
         BEGIN                                                 <<04833>>16182000
            PARMNUM := 1;                                      <<04833>>16184000
            RELSIR(LDTSIR,SAVESIR);                            <<04833>>16186000
            CIERR(ERRNUM := USERNOACC2CLASS,PARMSP);           <<04833>>16188000
            RETURN;                                            <<04833>>16190000
         END;                                                  <<04833>>16192000
                                                               <<04833>>16194000
         <<USER HAS ACCESS>>                                   <<04833>>16196000
         << TO CLASS      >>                                   <<04833>>16198000
         IF NOT LOGICAL(C'SQ) THEN                             <<04833>>16200000
         BEGIN  <<DEVICECLASS NOT SPOOLED>>                    <<04833>>16202000
            PARMNUM := 1;                                      <<04833>>16204000
            RELSIR(LDTSIR,SAVESIR);                            <<04833>>16206000
            CIERR(ERRNUM := CLASSNOTSPOOLED,FIRSTPARM);        <<04833>>16208000
            RETURN;                                            <<04833>>16210000
         END;                                                  <<04833>>16212000
                                                               <<04833>>16214000
         IF NUMPARMS > 1 THEN                                  <<04833>>16216000
         BEGIN  <<CANNOT SPECIFY "OPENQ" WITH >>               <<04833>>16218000
                <<DEVICECLASS>>                                <<04833>>16220000
            PARMNUM := 2;                                      <<04833>>16222000
            RELSIR(LDTSIR, SAVESIR);                           <<04833>>16224000
            CIERR(ERRNUM := CLASSXPARMS, SNDPARM);             <<04833>>16226000
            RETURN;                                            <<04833>>16228000
         END;                                                  <<04833>>16230000
         <<NOW WE CAN RESET THE SPOOLING BIT IN >>             <<04833>>16232000
         << THE DEVICE CLASS ENTRY>>                           <<04833>>16234000
         C'RESETSQ;                                            <<04833>>16236000
         RELSIR(LDTSIR,SAVESIR);                               <<04833>>16238000
      END                                                      <<04833>>16240000
      ELSE                                                     <<04833>>16242000
   BEGIN                                                                16244000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);               16246000
      IF < THEN RETURN;                                                 16248000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>16250000
      IF CHECKASS(LDEV) OR                                              16252000
         CHECKALLOW(M'STOPSPOOL) THEN <<USER HAS ACCESS>>               16254000
      BEGIN                                                             16256000
      PROCDIRECTIVE := QUITSPOOLING;                                    16258000
      FILEDIRECTIVE := RELINKFILE; <<CAUSES IMMEDIATE STOP>>   <<04833>>16260000
      DIRECTION := EITHER;                                              16262000
      @DEVP := LDEV * LDTSIZE;                                          16264000
      SAVESIR := GETSIR( LDTSIR );                             <<04833>>16266000
      MOVEFROMDSEG(  LDT, LDTDST, @DEVP, LDTSIZE );            <<04833>>16268000
      IF LDT(LD'SP) = NOSPOOLER THEN                                    16270000
      BEGIN     <<NOT A SPOOLED DEVICE>>                                16272000
         PARMNUM := 1;                                                  16274000
         RELSIR(LDTSIR,SAVESIR);                                        16276000
         CIERR(ERRNUM := DEVICENOTSPOOLED,FIRSTPARM);                   16278000
         RETURN;                                                        16280000
      END                                                               16282000
      ELSE                                                              16284000
      BEGIN       <<A SPOOLER>>                                         16286000
         IF LDT(LD'SP) = INPUTSPOOLER THEN                     <<04833>>16288000
         BEGIN <<INPUT SPOOLER>>                               <<04833>>16290000
            SPOOFLING := UNCHANGED;                            <<04833>>16292000
            IF NUMPARMS > 1 THEN                               <<04833>>16294000
            BEGIN <<OPENQ SPECIFIED FOR INPUT SPOOLEE>>        <<04833>>16296000
               PARMNUM := 2;                                   <<04833>>16298000
               RELSIR(LDTSIR,SAVESIR);                         <<04833>>16300000
               CIERR(ERRNUM := OPENQINPUT,SNDPARM);            <<04833>>16302000
               RETURN;                                         <<04833>>16304000
            END;                                               <<04833>>16306000
         END;  <<INPUT SPOOLER>>                               <<04833>>16308000
                                                               <<04833>>16310000
         IF LDT(LD'SP) = OUTPUTSPOOLER THEN <<OPEN/SHUT QUEUE>><<04833>>16312000
         SPOOFLING := OPENQ; <<OPEN/SHUT THE SPOOLER QUEUE ON DEVICE>>  16314000
         IF NOT SENDSPOOLERMSG(LDEV,NEWDIRECTIVE,SPOOFLING,             16316000
                SPOOLINFO,                                     <<04833>>16318000
                ERRNUM,PARMNUM) THEN                                    16320000
         BEGIN                                                          16322000
            RELSIR(LDTSIR,SAVESIR);                                     16324000
            CIERR(ERRNUM,FIRSTPARM);                                    16326000
            RETURN;                                                     16328000
         END;                                                           16330000
         RELSIR(LDTSIR,SAVESIR);                                        16332000
      END;                                                              16334000
   END                                                                  16336000
   ELSE                                                                 16338000
      BEGIN                                                             16340000
         PARMNUM:=1;                                                    16342000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                           16344000
      END;                                                              16346000
   END;                                                                 16348000
END;   << CXSTOPSPOOL >>                                       <<04833>>16350000
$PAGE "SUSPENDSPOOL EXECUTOR"                                  <<04833>>16352000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>16354000
                                                                        16356000
<< Note:  Procedure CXSUSPENDSPOOL was moved unchanged from >> <<04833>>16358000
<< OPCOMMAND to SPOOLCOMS as part of this enhancement.  Its >> <<04833>>16360000
<< fix number(s) were not changed.                          >> <<04833>>16362000
                                                                        16364000
PROCEDURE CXSUSPENDSPOOL EXECUTORHEAD;                                  16366000
BEGIN                                                                   16368000
   <<COMMENT                                                            16370000
      THE SYNTAX OF THIS COMMAND IS:                                    16372000
         SUSPENDSPOOL LDEV [;FINISH]                                    16374000
         WHERE LDEV IS ANY REAL LOGICAL DEVICE                          16376000
         FINISH INDICATES SUSPEND AFTER CURRENTLY ACTIVE                16378000
         SPOOLFILE IS FINISHED PRINTING                                 16380000
                                                                        16382000
   ; >>                                                                 16384000
   DOUBLE DL := [8/",", 8/";", 8/%15, 8/0]D;                            16386000
   BYTE ARRAY DL'(*)=DL;                                                16388000
   DOUBLE ARRAY PARM(0:2)=Q;                                            16390000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2, TRDPARM = PARM+4;       16392000
   BYTE FIRSTLEN=PARM+1,SNDLEN=PARM+3;                                  16394000
   LOGICAL LDEV;                                                        16396000
   INTEGER PARM1=PARM+1,PARM2=PARM+3;                                   16398000
   EQUATE COMMA = 0,                                                    16400000
          SEMICOLON = 1;                                                16402000
   LOGICAL FINISH := FALSE;                                             16404000
   INTEGER NUMPARMS;                                                    16406000
   INTEGER POINTER DEVP;                                                16408000
   EQUATE <<DIRECTION>>                                                 16410000
          IN=0,                                                         16412000
          OUT=3, <<SPOOFLING ON + OUTPUT SPOOLING>>                     16414000
          EITHER = -1;                                                  16416000
   INTEGER DIRECTION := EITHER;                                         16418000
   <<CI/SPOOLER DIRECTIVE>>                                             16420000
   EQUATE NODIRECTIVE = %100000;                                        16422000
   INTEGER NEWDIRECTIVE := NODIRECTIVE;                                 16424000
   DEFINE PROCDIRECTIVE = NEWDIRECTIVE.(8:4)#,                          16426000
          FILEDIRECTIVE = NEWDIRECTIVE.(12:4)#;                         16428000
   INTEGER SPOOLERPCB,SAVESIR;                                          16430000
   INTEGER ARRAY DEVINFO(0:8) = Q;                                      16432000
   INTEGER INFO;                                                        16434000
   LOGICAL REPLY := [8/3,8/2]; <<MAXSTRING LEN 3,STRING>>               16436000
   LOGICAL ARRAY OFFSET(0:8) = Q;                                       16438000
   BYTE ARRAY BOFFSET(*) = OFFSET(1);                                   16440000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                                      16442000
   INTEGER SPOOFLING;                                                   16444000
   EQUATE SHUT = 0,                                                     16446000
          OPEN = 1,                                            <<04833>>16448000
          UNCHANGED = 2;                                       <<04833>>16450000
   LOGICAL ARRAY SPOOLINFO(0:3);                               <<04833>>16452000
                                                                        16454000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         16456000
   SUBROUTINE DEF'MOVETODSEG;                                           16458000
                                                                        16460000
                                                                        16462000
   LOGIMAGE( M'SUSPENDSPOOL, PARMSP );  << LOG OP COMMAND >>   <<04833>>16464000
   MYCOMMAND(PARMSP,DL',3,NUMPARMS,PARM);                               16466000
   ERRNUM := PARMNUM := 0;                                              16468000
   IF NUMPARMS = 0 THEN <<MUST HAVE AT LEAST 1 PARM>>                   16470000
   BEGIN                                                                16472000
      CIERR(ERRNUM := -EXP1OFLDEVORFIN,PARMSP);                         16474000
      RETURN;                                                           16476000
   END                                                                  16478000
   ELSE                                                                 16480000
   IF FIRSTLEN=0 THEN                                          <<04833>>16482000
   BEGIN                                                       <<04833>>16484000
      PARMNUM := 1;                                            <<04833>>16486000
      CIERR(ERRNUM := EXPLDEVBAD,FIRSTPARM);                   <<04833>>16488000
      RETURN;                                                  <<04833>>16490000
   END                                                         <<04833>>16492000
   ELSE                                                        <<04833>>16494000
   IF NUMPARMS > 2 THEN                                                 16496000
   BEGIN                                                                16498000
      PARMNUM := 2;                                                     16500000
      CIERR(ERRNUM := SUSPENDSP2PARM,TRDPARM);                          16502000
      RETURN;                                                           16504000
   END;                                                                 16506000
   IF NUMPARMS = 2 THEN <<MAXIMUM NUMBER OF PARMS>>                     16508000
   BEGIN                                                                16510000
      IF PARM1.DELIMITER <> SEMICOLON THEN                              16512000
      <<MUST HAVE SEMICOLON SEPARATION>>                                16514000
      BEGIN                                                             16516000
         PARMNUM := 2;                                                  16518000
         CIERR(ERRNUM := EXPSEMICOLON,FIRSTPARM(FIRSTLEN));             16520000
      END                                                               16522000
      ELSE                                                              16524000
      IF SNDLEN <> 0 THEN <<FINISH SPECIFIED?>>                         16526000
      BEGIN                                                             16528000
         IF SNDLEN <> 6 OR SNDPARM <> "FINISH" THEN                     16530000
         BEGIN                                                          16532000
            PARMNUM := 2;                                               16534000
            CIERR(ERRNUM := EXPFINISH,SNDPARM);                         16536000
            RETURN;                                                     16538000
         END                                                            16540000
         ELSE                                                           16542000
         FINISH := TRUE;                                                16544000
      END;                                                              16546000
   END;                                                                 16548000
   IF ERRNUM <> 0 THEN RETURN;                                          16550000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,FIRSTLEN,ERRNUM,PARMNUM,1);          16552000
      IF < THEN RETURN;                                                 16554000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>16556000
      IF CHECKASS(LDEV) OR                                              16558000
         CHECKALLOW(M'SUSPENDSPOOL) THEN <<USER HAS ACCESS>>            16560000
      BEGIN                                                             16562000
      PROCDIRECTIVE := WAITSPOOLING;                                    16564000
      DIRECTION := OUT;                                                 16566000
      @DEVP := LDEV * LDTSIZE;                                          16568000
      SAVESIR := GETSIR( LDTSIR );                             <<04833>>16570000
      MOVEFROMDSEG(  LDT, LDTDST, @DEVP, LDTSIZE );            <<04833>>16572000
      IF LDT(LD'SP) = NOSPOOLER THEN                                    16574000
      BEGIN     <<NOT A SPOOLED DEVICE>>                                16576000
         PARMNUM := 1;                                                  16578000
         RELSIR(LDTSIR,SAVESIR);                                        16580000
         CIERR(ERRNUM := DEVICENOTSPOOLED,FIRSTPARM);                   16582000
         RETURN;                                                        16584000
      END                                                               16586000
      ELSE                                                              16588000
      IF LDT(LD'SP) = INPUTSPOOLER THEN <<INPUT SPOOLER>>               16590000
      BEGIN                                                             16592000
         PARMNUM := 1;                                                  16594000
         RELSIR(LDTSIR,SAVESIR);                                        16596000
         CIERR(ERRNUM := DEVICENOTOUTSPOOL,FIRSTPARM);                  16598000
         RETURN;                                                        16600000
      END                                                               16602000
      ELSE                                                              16604000
      BEGIN       <<A SPOOLER>>                                         16606000
         SPOOFLING := UNCHANGED; <<LEAVE  SPOOL QUEUE >>       <<04833>>16608000
         IF NOT FINISH THEN FILEDIRECTIVE := RELINKFILE;                16610000
         IF NOT SENDSPOOLERMSG(LDEV,NEWDIRECTIVE,SPOOFLING,             16612000
                SPOOLINFO,                                     <<04833>>16614000
                ERRNUM,PARMNUM) THEN                                    16616000
         BEGIN                                                          16618000
            RELSIR(LDTSIR,SAVESIR);                                     16620000
            CIERR(ERRNUM,FIRSTPARM);                                    16622000
            RETURN;                                                     16624000
         END;                                                           16626000
         RELSIR(LDTSIR,SAVESIR);                                        16628000
      END;                                                              16630000
   END                                                                  16632000
   ELSE                                                                 16634000
      BEGIN                                                             16636000
         PARMNUM:=1;                                                    16638000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                           16640000
      END;                                                              16642000
END;   << CXSUSPENDSPOOL >>                                    <<04833>>16644000
$PAGE "RESUMESPOOL EXECUTOR"                                   <<04833>>16646000
$CONTROL SEGMENT=SPOOLCOMS2                                    <<04833>>16648000
                                                                        16650000
<< Note:  Procedure CXRESUMESPOOL was moved unchanged  from >> <<04833>>16652000
<< OPCOMMAND to SPOOLCOMS as part of this enhancement.  Its >> <<04833>>16654000
<< fix number(s) were not changed.                          >> <<04833>>16656000
                                                                        16658000
PROCEDURE CXRESUMESPOOL EXECUTORHEAD;                                   16660000
BEGIN                                                                   16662000
<<                                                             ((MPEIV))16664000
   COMMENT                                                              16666000
      THE SYNTAX OF THIS COMMAND IS:                                    16668000
         RESUMESPOOL LDEV [; {BACK}              {nnn FILES} ] ((MPEIV))16670000
                          [; {FORWARD}           {nnn[PAGES]}] ((MPEIV))16672000
                          [; {BEGINNING                     }] ((MPEIV))16674000
                                                               ((MPEIV))16676000
         WHERE LDEV IS ANY REAL LOGICAL DEVICE                          16678000
         AND nnn <= 256.                                       ((MPEIV))16680000
   ;                                                                    16682000
>>                                                             <<04833>>16684000
   DOUBLE DL := [8/" ", 8/";", 8/",", 8/%15]D;                 <<04833>>16686000
   INTEGER DLEND := 0;   <<END OF DELIMITERS>>                 <<04833>>16688000
   BYTE ARRAY DL'(*)=DL;                                                16690000
   DOUBLE ARRAY PARM(0:6) = Q;                                 <<04833>>16692000
   BYTE POINTER FIRSTPARM=PARM, SNDPARM=PARM+2;                         16694000
   BYTE POINTER THIRDPARM=PARM+4,FOURTHPARM=PARM+6;            <<04833>>16696000
   BYTE LEN=PARM+1;                                                     16698000
   BYTE LEN2=PARM+3, LEN3=PARM+5,LEN4=PARM+7,LEN5=PARM+9;      <<04833>>16700000
   EQUATE BLANK = 0, SEMICOLON = 1,COMMA = 2, CR = 3;          <<04833>>16702000
   INTEGER PARM1 = PARM+1, PARM2 = PARM+3,                     <<04833>>16704000
           PARM3 = PARM+5, PARM4 = PARM + 7;                   <<04833>>16706000
   LOGICAL LDEV;                                                        16708000
   INTEGER NUMPARMS;                                                    16710000
   INTEGER POINTER DEVP;                                                16712000
   EQUATE <<DIRECTION>>                                                 16714000
          IN=0,                                                         16716000
          OUT=3, <<SPOOFLING ON + OUTPUT SPOOLING>>                     16718000
          EITHER = -1;                                                  16720000
   INTEGER DIRECTION := EITHER;                                         16722000
   <<CI/SPOOLER DIRECTIVE>>                                             16724000
   EQUATE NODIRECTIVE = %100000;                                        16726000
   INTEGER NEWDIRECTIVE := NODIRECTIVE;                                 16728000
   DEFINE PROCDIRECTIVE = NEWDIRECTIVE.(8:4)#,                          16730000
          FILEDIRECTIVE = NEWDIRECTIVE.(12:4)#;                         16732000
   INTEGER SPOOLERPCB,SAVESIR;                                          16734000
   INTEGER SAVEODD;                                            <<04833>>16736000
   INTEGER ARRAY DEVINFO(0:8) = Q;                                      16738000
   INTEGER INFO;                                                        16740000
   LOGICAL REPLY := [8/3,8/2]; <<MAXSTRING LEN 3,STRING>>               16742000
   LOGICAL ARRAY OFFSET(0:8) = Q;                                       16744000
   BYTE ARRAY BOFFSET(*) = OFFSET(1);                                   16746000
   INTEGER ARRAY LDT(0:LDTSIZE-1);                                      16748000
   LOGICAL DFID, ACTIVE;                                       <<04833>>16750000
   INTEGER SPOOFLING;                                                   16752000
   EQUATE SHUT = 0,                                                     16754000
          OPEN = 1,                                            <<04833>>16756000
          UNCHANGED = 2;                                       <<04833>>16758000
   LOGICAL BACK;                                               <<04833>>16760000
   INTEGER PAGES := 0;                                         <<04833>>16762000
   INTEGER FILES := 0;                                         <<04833>>16764000
   BYTE ARRAY BNUMBER(0:3);                                    <<04833>>16766000
   INTEGER BNUMLEN,NUMBER;                                     <<04833>>16768000
   LOGICAL ARRAY SPOOLINFO(0:3);                               <<04833>>16770000
                                                                        16772000
   SUBROUTINE DEF'MOVEFROMDSEG;                                         16774000
   SUBROUTINE DEF'MOVETODSEG;                                           16776000
                                                                        16778000
                                                                        16780000
   LOGIMAGE( M'RESUMESPOOL, PARMSP );  << LOG OP COMMAND >>    <<04833>>16782000
   MYCOMMAND(PARMSP,DL',5,NUMPARMS,PARM);                      <<04833>>16784000
   IF NUMPARMS < 1 THEN                                        <<04833>>16786000
   BEGIN                                                       <<04833>>16788000
      PARMNUM := 1;                                            <<04833>>16790000
      CIERR( ERRNUM := RESUMESPREQ1P,PARMSP);                  <<04833>>16792000
      RETURN;                                                  <<04833>>16794000
   END;                                                        <<04833>>16796000
   IF NUMPARMS = 1 OR LEN2 = 0  THEN                           <<04833>>16798000
   BEGIN     <<RESTART LDEV FROM BEGINNING >>                  <<04833>>16800000
      BACK := TRUE;                                            <<04833>>16802000
      PAGES := 0 ;  <<BEGINNING>>                              <<04833>>16804000
   END                                                         <<04833>>16806000
   ELSE                                                        <<04833>>16808000
   BEGIN     <<MORE THAN ONE PARM>>                            <<04833>>16810000
      IF PARM1.DELIMITER <> SEMICOLON THEN                     <<04833>>16812000
      BEGIN  << EXPECTED SEMICOLON AFTER LDEV>>                <<04833>>16814000
         PARMNUM := 2;                                         <<04833>>16816000
         CIERR(ERRNUM := EXPSEMICOLON,FIRSTPARM(LEN));         <<04833>>16818000
         RETURN;                                               <<04833>>16820000
      END;                                                     <<04833>>16822000
      IF SNDPARM = "BACK" AND LEN2 = 4 THEN                    <<04833>>16824000
         BACK := TRUE                                          <<04833>>16826000
      ELSE                                                     <<04833>>16828000
      IF SNDPARM = "FORWARD"  AND LEN2 = 7 THEN                <<04833>>16830000
         BACK := FALSE                                         <<04833>>16832000
      ELSE                                                     <<04833>>16834000
      IF SNDPARM = "BEGINNING" AND LEN2 = 9 THEN               <<04833>>16836000
      BEGIN           <<BEGINNING>>                            <<04833>>16838000
         BACK := TRUE;                                         <<04833>>16840000
         PAGES := -1; <<BACK TO BEGINNING>>                    <<04833>>16842000
         IF NUMPARMS > 2 AND LEN3 <> 0 THEN                    <<04833>>16844000
         BEGIN                                                 <<04833>>16846000
            PARMNUM := 3;                                      <<04833>>16848000
            CIERR(ERRNUM := RESUMESPBEGINX, THIRDPARM);        <<04833>>16850000
            RETURN;                                            <<04833>>16852000
         END                                                   <<04833>>16854000
         ELSE                                                  <<04833>>16856000
         GO TO LDEVCHECK;                                      <<04833>>16858000
      END                                                      <<04833>>16860000
      ELSE                                                     <<04833>>16862000
      BEGIN          <<ILLEGAL PARM>>                          <<04833>>16864000
         PARMNUM := 2;                                         <<04833>>16866000
         CIERR(ERRNUM := EXPBACKORFORWARD,SNDPARM);            <<04833>>16868000
         RETURN;                                               <<04833>>16870000
      END;                                                     <<04833>>16872000
                                                               <<04833>>16874000
      IF PARM2.DELIMITER <> BLANK THEN                         <<04833>>16876000
      BEGIN  <<EXPECTED BLANK AFTER FORWARD/BACK>>             <<04833>>16878000
         PARMNUM := 3;                                         <<04833>>16880000
         CIERR(ERRNUM := EXPBLANK,SNDPARM(LEN2));              <<04833>>16882000
         RETURN;                                               <<04833>>16884000
      END;                                                     <<04833>>16886000
                                                               <<04833>>16888000
             <<THIRDPARM IS NUMERIC NUMBER OF PAGES/FILES>>    <<04833>>16890000
      MOVE BNUMBER := THIRDPARM WHILE N,1;                     <<04833>>16892000
      BNUMLEN := TOS - @BNUMBER;                               <<04833>>16894000
      IF BNUMLEN<>INTEGER(LEN3) THEN                           <<04833>>16896000
      BEGIN                                                    <<04833>>16898000
         PARMNUM:=3;                                           <<04833>>16900000
         CIERR(ERRNUM:=EXPBLANK, THIRDPARM(BNUMLEN));          <<04833>>16902000
         RETURN;                                               <<04833>>16904000
      END;                                                     <<04833>>16906000
      NUMBER := BINARY(BNUMBER,BNUMLEN);                       <<04833>>16908000
      IF < OR NUMBER = 0 OR NOT (1<=NUMBER<=256) THEN          <<04833>>16910000
      BEGIN                                                    <<04833>>16912000
         PARMNUM := 3;                                         <<04833>>16914000
         CIERR(ERRNUM := EXPNUM1TO256,THIRDPARM);              <<04833>>16916000
         RETURN;                                               <<04833>>16918000
      END;                                                     <<04833>>16920000
      IF PARM3.DELIMITER <> BLANK THEN                         <<04833>>16922000
      BEGIN                                                    <<04833>>16924000
         IF PARM3.DELIMITER <> CR THEN                         <<04833>>16926000
         BEGIN                                                 <<04833>>16928000
            PARMNUM := 3;                                      <<04833>>16930000
            CIERR(ERRNUM := EXPBLANK, THIRDPARM(LEN3));        <<04833>>16932000
            RETURN;                                            <<04833>>16934000
         END                                                   <<04833>>16936000
         ELSE                                                  <<04833>>16938000
         BEGIN      << REACHED CARRIAGE RETURN>>               <<04833>>16940000
            PAGES := NUMBER;                                   <<04833>>16942000
            GO TO LDEVCHECK;                                   <<04833>>16944000
         END;                                                  <<04833>>16946000
      END                                                      <<04833>>16948000
      ELSE IF LEN4 <> 5 AND LEN4 <> 0 THEN                     <<04833>>16950000
      BEGIN <<EXPECTED PAGES OR FILES>>                        <<04833>>16952000
         PARMNUM := 4;                                         <<04833>>16954000
         CIERR(ERRNUM := EXPPAGESORFILES, FOURTHPARM);         <<04833>>16956000
         RETURN;                                               <<04833>>16958000
      END                                                      <<04833>>16960000
      ELSE                                                     <<04833>>16962000
      IF  FOURTHPARM = "PAGES"  THEN                           <<04833>>16964000
          PAGES := NUMBER                                      <<04833>>16966000
      ELSE IF FOURTHPARM = "FILES" THEN FILES := NUMBER        <<04833>>16968000
      ELSE                                                     <<04833>>16970000
      IF LEN4 <> 0 THEN                                        <<04833>>16972000
      BEGIN                                                    <<04833>>16974000
         PARMNUM := 4;                                         <<04833>>16976000
         CIERR(ERRNUM := EXPPAGESORFILES,FOURTHPARM);          <<04833>>16978000
         RETURN;                                               <<04833>>16980000
      END;                                                     <<04833>>16982000
      IF NUMPARMS > 4 THEN                                     <<04833>>16984000
          IF PARM4.DELIMITER <> BLANK OR                       <<04833>>16986000
              LEN5 <> 0 THEN                                   <<04833>>16988000
       <<WE HAVE REACHED THE END OF COMMAND STRING>>           <<04833>>16990000
         BEGIN     <<TOO MANY PARMS>>                          <<04833>>16992000
            PARMNUM := 5;                                      <<04833>>16994000
            CIERR(ERRNUM := EXP4PARMS,FOURTHPARM(LEN4));       <<04833>>16996000
            RETURN;                                            <<04833>>16998000
         END;                                                  <<04833>>17000000
   END;  <<MORE THAN ONE PARM>>                                <<04833>>17002000
LDEVCHECK:                                                     <<04833>>17004000
   BEGIN                                                                17006000
      LDEV:=VERIFY'RLDEV(FIRSTPARM,LEN,ERRNUM,PARMNUM,1);               17008000
      IF < THEN RETURN;                                                 17010000
      IF VERIFY'MASTEROP(LDEV) THEN RETURN;<<MSTEROP MADE INADV. ENTRY>>17012000
      IF CHECKASS(LDEV) OR                                              17014000
         CHECKALLOW(M'RESUMESPOOL) THEN <<USER HAS ACCESS>>             17016000
      BEGIN                                                             17018000
      PROCDIRECTIVE := RESUMESPOOLING;                                  17020000
      DIRECTION := OUT;                                                 17022000
      @DEVP := LDEV * LDTSIZE;                                          17024000
      SAVESIR := GETSIR( LDTSIR );                             <<04833>>17026000
      MOVEFROMDSEG(  LDT, LDTDST, @DEVP, LDTSIZE );            <<04833>>17028000
      IF LDT(LD'SP) = NOSPOOLER THEN                                    17030000
      BEGIN     <<NOT A SPOOLED DEVICE>>                                17032000
         PARMNUM := 1;                                                  17034000
         RELSIR(LDTSIR,SAVESIR);                                        17036000
         CIERR(ERRNUM := DEVICENOTSPOOLED,FIRSTPARM);                   17038000
         RETURN;                                                        17040000
      END                                                               17042000
      ELSE                                                              17044000
      IF LDT(LD'SP) = INPUTSPOOLER THEN  <<INPUT SPOOLER>>              17046000
      BEGIN                                                             17048000
         PARMNUM := 1;                                                  17050000
         RELSIR(LDTSIR,SAVESIR);                                        17052000
         CIERR(ERRNUM := DEVICENOTOUTSPOOL,FIRSTPARM);                  17054000
         RETURN;                                                        17056000
      END                                                               17058000
      ELSE                                                              17060000
      BEGIN       <<A SPOOLER>>                                         17062000
         SAVEODD := GETSIR(ODDSIR);                            <<04833>>17064000
         ACTIVE := SFINDACTIVE(LDEV,DFID);                     <<04833>>17066000
         RELSIR(ODDSIR,SAVEODD);                               <<04833>>17068000
         IF ACTIVE THEN                                        <<04833>>17070000
         BEGIN  <<ATTEMPTED RESUMESPOOL ON ACTIVE LDEV>>       <<04833>>17072000
            RELSIR(LDTSIR,SAVESIR);                            <<04833>>17074000
            CIERR(ERRNUM := DEVICEACTIVE, FIRSTPARM);          <<04833>>17076000
            RETURN;                                            <<04833>>17078000
         END                                                   <<04833>>17080000
         ELSE                                                  <<04833>>17082000
         BEGIN <<OK: WE CAN NOW EXECUTE COMMAND>>              <<04833>>17084000
         SPOOFLING := UNCHANGED; <<LEAVE  SPOOL QUEUE >>       <<04833>>17086000
         SPOOLINFO := BACK;                                    <<04833>>17088000
         SPOOLINFO(1) := PAGES;                                <<04833>>17090000
         SPOOLINFO(2) := FILES;                                <<04833>>17092000
         IF NOT SENDSPOOLERMSG(LDEV,NEWDIRECTIVE,SPOOFLING,             17094000
                SPOOLINFO,                                     <<04833>>17096000
                ERRNUM,PARMNUM) THEN                                    17098000
         BEGIN                                                          17100000
            RELSIR(LDTSIR,SAVESIR);                                     17102000
            CIERR(ERRNUM,FIRSTPARM);                                    17104000
            RETURN;                                                     17106000
         END;                                                           17108000
         RELSIR(LDTSIR,SAVESIR);                                        17110000
         END; <<END OF EXECUTION>>                             <<04833>>17112000
      END;                                                              17114000
   END                                                                  17116000
   ELSE                                                                 17118000
      BEGIN                                                             17120000
         PARMNUM:=1;                                                    17122000
         CIERR(ERRNUM:=USERNOACC2DEV,PARMSP);                           17124000
      END;                                                              17126000
   END;                                                                 17128000
END;   << CXRESUMESPOOL >>                                     <<04833>>17130000
$PAGE "GLOBAL SYMBOL TABLE"                                    <<04833>>17132000
$PAGE                                                          <<04833>>17134000
$CONTROL SEGMENT=MAIN                                          <<04833>>17136000
END.    << SPOOLCOMS (MODULE 80) >>                            <<04833>>17138000
