<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$control uslinit,code,map,define                                        00010000
<< opcommand - module 85>>                                     <<01549>>00015000
<< hp32002c mpe source c.00.00 >>                                       00020000
$copyright     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00025000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00030000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00035000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00040000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00045000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00050000
                                                               <<00635>>00055000
$control main=opcommand                                                 00060000
<< 85 -- opcommand >>                                                   00065000
                                                                        00070000
comment                                                                 00075000
   the following 'set' flags mean:                                      00080000
      x1 -- turns on a debugging mode where this module runs            00085000
            as a program, simulating the c.i. reading commands          00090000
            from $stdin and processing them as directed from debug      00095000
;                                                                       00100000
                                                                        00105000
<< place any sets at this point>>                                       00110000
                                                                        00115000
                                                                        00120000
                                                                        00125000
comment                                                                 00130000
   the theory behind the segmentation used in this module is to         00135000
group the procedures according to their frequency of use, i.e.,         00140000
                                                                        00145000
   oplow -- for low use general & executor procedures                   00150000
   opmed -- for moderate use general & executor procedures              00155000
   ophi  -- for high use general & executor procedures                  00160000
                                                                        00165000
   anyone disagreeing with this grouping or where its found that        00170000
a particular installation's use of commands is different from the       00175000
general use is welcome to change this grouping of procedures.           00180000
;                                                                       00185000
$page                                                                   00190000
begin                                                                   00195000
                                                               <<01649>>00200000
<<    associate dst layout & definitions    >>                 <<01649>>00205000
                                                               <<01649>>00210000
comment                                                        <<01649>>00215000
                                                               <<01649>>00220000
*****************************************                      <<01649>>00225000
|                                       |  0                   <<01649>>00230000
|                                       |  1                   <<01649>>00235000
|                  not                  |  2                   <<01649>>00240000
|                                       |  3                   <<01649>>00245000
|                  used                 |  4                   <<01649>>00250000
|                                       |  5                   <<01649>>00255000
|                                       |  6                   <<01649>>00260000
|***************************************|                      <<01649>>00265000
|                     jmat index        |  7 \                 <<*7850>>00270000
|---------------------------------------|    |                 <<01649>>00275000
|               jit index               |  8 |                 <<*7850>>00280000
|---------------------------------------|    |                 <<01649>>00285000
|  dst rel. index to user's next entry  |  9 |                 <<01649>>00290000
|---------------------------------------|    > ldev #1         <<01649>>00295000
|    class name under which ldev is     | 10 |                 <<01649>>00300000
|    associated ( left justified and    | 11 |                 <<01649>>00305000
|    blank padded -- 8 bytes )          | 12 |                 <<01649>>00310000
|                                       | 13 /                 <<01649>>00315000
|***************************************|                      <<01649>>00320000
|  jmat index to associated user or 0   | 14 \                 <<01649>>00325000
|---------------------------------------|    |                 <<01649>>00330000
|   jit index to associated user or 0   | 15 |                 <<01649>>00335000
|---------------------------------------|    |                 <<01649>>00340000
|   pointer to user's next entry or 0   | 16 |                 <<01649>>00345000
|---------------------------------------|    > ldev #2         <<01649>>00350000
|                                       | 17 |                 <<01649>>00355000
|    class name under which ldev is     | 18 |                 <<01649>>00360000
|       associated or undefined         | 19 |                 <<01649>>00365000
|                                       | 20 /                 <<01649>>00370000
|***************************************|                      <<01649>>00375000
|                                       | 21                   <<01649>>00380000
                                                               <<01649>>00385000
.                   .                   .                      <<01649>>00390000
.                   .                   .                      <<01649>>00395000
.                   .                   .                      <<01649>>00400000
                                                               <<01649>>00405000
|                                       | (7*n)-1              <<01649>>00410000
|***************************************|                      <<01649>>00415000
|                       jmat index      | 7*n \                <<*7850>>00420000
|---------------------------------------|     |                <<01649>>00425000
|                     jit index         |     |                <<*7850>>00430000
|---------------------------------------|     |                <<01649>>00435000
|  dst rel. index to user's next entry  |     |                <<01649>>00440000
|---------------------------------------|     > ldev #n        <<01649>>00445000
|                                       |     |                <<01649>>00450000
|    class name under which ldev is     |     |                <<01649>>00455000
|             associated                |     |                <<01649>>00460000
|                                       |     /                <<01649>>00465000
*****************************************                      <<01649>>00470000
                                                               <<01649>>00475000
"N" is the highest logical device number configured on the     <<01649>>00480000
system.  (same as the highest entry # of the lpdt.)            <<01649>>00485000
                                                               <<01649>>00490000
;                                                              <<01649>>00495000
                                                               <<01649>>00500000
equate ass'sir = 24,  << sir # for association table >>        <<01649>>00505000
       ass'dst = 34,  << dst # for association table >>        <<01649>>00510000
                                                               <<01649>>00515000
       ass'entrysize = 7,  << size of one entry in table >>    <<01649>>00520000
       ass'next      = 2,  << index of pointer word >>         <<01649>>00525000
       ass'class     = 3,  << word index of class name >>      <<04801>>00530000
       b'ass'class   = ass'class * 2;                          <<04801>>00535000
                                                               <<01649>>00540000
define  ass'jmat  = 0#,         << jmat index as per pcbx >>   <<*7850>>00545000
        ass'jit   = 1#;         << jit dst #  >>               <<*7850>>00550000
                                                               <<01649>>00555000
$page                                                                   00560000
comment                                                                 00565000
   the jit for each user contains a one word entry which is an          00570000
   index to the head of the chain of associated device that the         00575000
   user has.  it is a word index into the associate dst.  if zero,      00580000
   it implies that the user hasn't associated any devices.              00585000
;                                                                       00590000
$include incljit                                               <<06924>>00595000
comment                                                                 00600000
   the jit for each user contains a three word entry which is a mask    00605000
   with a bit for each 'operator' type command.  each bit set implies   00610000
   user can user that command.  user's also gain access to certain      00615000
   operator commands by 'assoicate'ing a device.  this gives them       00620000
   access to those 'operator' commands dealing with device for that     00625000
   device only.                                                         00630000
;                                                                       00635000
                                                                        00640000
                                                                        00645000
<< the following equates define the mask bit for each operator command>>00650000
<< the first "M'DEVICE" commands define the operator commands>>         00655000
<< dealing with devices                                      >>         00660000
                                                               <<01527>>00665000
<< when adding a new command to this set of equates, >>        <<01527>>00670000
<< be sure to add a corresponding move statement in  >>        <<01527>>00675000
<< logimage even if the command will not be logged.  >>        <<01527>>00680000
                                                                        00685000
$include inclamsk                                              <<06924>>00690000
$page                                                                   00695000
$include inclcap                                               <<06924>>00700000
integer s0=s-0,                                                         00705000
        s1=s-1,                                                         00710000
        s2=s-2,                                                         00715000
        s3=s-3,                                                         00720000
        x=x;                                                            00725000
                                                                        00730000
integer db0 = db + 0,                                                   00735000
        db1 = db + 1,                                          <<04801>>00740000
        db2 = db + 2,                                          <<04801>>00745000
        db3 = db + 3;                                          <<04801>>00750000
                                                               <<04801>>00755000
logical ls0=s-0,                                                        00760000
        ls1=s-1,                                                        00765000
        ls2=s-2,                                                        00770000
        ls3=s-3,                                                        00775000
        status=q-1;                                                     00780000
                                                                        00785000
byte pointer bps0=s-0,                                                  00790000
             bps1=s-1,                                                  00795000
             bps2=s-2,                                                  00800000
             bps3=s-3;                                                  00805000
                                                                        00810000
integer pointer ps0=s-0,                                                00815000
                ps1=s-1,                                                00820000
                ps2=s-2,                                                00825000
                ps3=s-3,                                       <<04801>>00830000
                pdb0 = db + 0,                                 <<04801>>00835000
                pdb1 = db + 1,                                 <<04801>>00840000
                pdb2 = db + 2,                                 <<04801>>00845000
                pdb3 = db + 3,                                 <<04801>>00850000
                pdb4 = db + 4;                                 <<04801>>00855000
                                                               <<04801>>00860000
double pointer dps0 = s-0;                                     <<04801>>00865000
double         dpdb0 = db+0;                                   <<06220>>00870000
                                                                        00875000
integer array arrdb0(*)=db+0,                                           00880000
              arrdb1(*)=db+1,                                           00885000
              arrdb2(*)=db+2,                                           00890000
              arrdb3(*)=db+3,                                           00895000
              arrdb4(*)=db+4,                                           00900000
              arrdb5(*)=db+5,                                           00905000
              arrdb6(*)=db+6,                                           00910000
              arrdb12(*)=db+12,                                <<04801>>00915000
              arrdb27(*)=db+27;                                         00920000
                                                                        00925000
equate ccg=0,                                                           00930000
       ccl=1,                                                           00935000
       cce=2,                                                           00940000
       ccx=3;                                                           00945000
                                                                        00950000
                                                                        00955000
define cc=status.(6:2)#;                                                00960000
$include inclcis                                               <<04604>>00965000
integer pointer dbp = db + 1;  <<pointer to db from pcbx>>              00970000
                                                                        00975000
                                                                        00980000
$page "MESSAGE SET EQUATES"                                             00985000
<< the following ci error message  equates  (<  3000)  were >> <<04801>>00990000
<< added as part of this fix.                               >> <<04801>>00995000
equate                                                         <<04801>>01000000
   acctexpectalpha  =  550,   <<leading char must be alpha>>   <<04801>>01005000
   acctnamemissing  =  551,   <<expected account name>>        <<04801>>01010000
   acctnametoolong  =  552,   <<acct name > 8 char>>           <<04801>>01015000
   acctexpectnamenotat=553,   <<expected name, found "@">>     <<04801>>01020000
   userexpectalpha  =  590,                                    <<04801>>01025000
   usernamemissing  =  591,                                    <<04801>>01030000
   usernametoolong  =  592,                                    <<04801>>01035000
   userexpectnamenotat=593,                                    <<04801>>01040000
   nosuchldev       = 1033,   <<this ldev not on system   >>   <<*8612>>01045000
   shownodst        = 1127,   <<out of dst's>>                 <<04801>>01050000
   shownovds        = 1128,   <<out of virtual mem for dst>>   <<04801>>01055000
   shownospace      = 1129,   <<out of space in dst>>          <<04801>>01060000
   showsyserr       = 1130,   <<unknow error using dst>>       <<04801>>01065000
   showjobopnerr    =  1495,   <<can't open listfile>>         <<04801>>01070000
   shjbexparmlst    =  1496,   <<ignrd parms past listfile>>   <<04801>>01075000
   showjobclserr    =  1497,   <<can't close listfile>>        <<04801>>01080000
   showjstatsignrd  = 1500,   <<status request ignored>>       <<04801>>01085000
   showjxtranparms  = 1501,   <<extra parms ignored>>          <<04801>>01090000
   showjxpctjob     = 1502,   <<expected job id>>              <<04801>>01095000
   showjxpctats     = 1503,   <<expected "@S">>                <<04801>>01100000
   showjxpctatj     = 1504,   <<expected "@J">>                <<04801>>01105000
   showjunkatx      = 1505,   <<expected either "@S" or "@J">> <<04801>>01110000
   showjjname2long  = 1506,   <<job name > 8 characters long>> <<04801>>01115000
   showjjnxpctalph  = 1507,   <<expected alpha leading char>>  <<04801>>01120000
   showjxpctjn      = 1508,   <<specials embedded in job name>><<04801>>01125000
   showjxpctjsnum   = 1509,   <<expected either j or s>>       <<04801>>01130000
   showjxplctj2mp   = 1510,   <<extra parms ignored>>          <<04801>>01135000
   showjunkkey      = 1511,   <<unknown keyword>>              <<04801>>01140000
   showj2merrors    = 1512,   <<too many errors, parsing stoppe<<04801>>01145000
   showjfserr       = 1513,   <<scratch file error>>           <<04801>>01150000
   showjredndstate  = 1514,   <<inconsistent spec of job state><<04801>>01155000
   showjndinap      = 1515,   <<only with wait state>>         <<04801>>01160000
   showjunkdefr     = 1516,   <<unknown defer state>>          <<04801>>01165000
   showjxpctun      = 1517,   <<embedded specials not allowed>><<04801>>01170000
   showjxpctperiod  = 1518,   <<user.acct>>                    <<04801>>01175000
   showjxpctan      = 1519,   <<embedded specials not allowed>><<04801>>01180000
   showjredundjob   = 1520,   <<job parm redundantly specified><<04801>>01185000
   showjxpctjobeq   = 1521,   <<expected = sign after "JOB">>  <<04801>>01190000
   showfxpctodevfl  = 1530,   <<only outfiles with showout>>   <<04801>>01195000
   showfxpctidevfl  = 1531,   <<only infiles with showin>>     <<04801>>01200000
   showfinvlddfid   = 1532,   <<invalid devicefile id>>        <<04801>>01205000
   showfxtraignord  = 1533,   <<extra parameters inappropriate><<04801>>01210000
   showfunkkey      = 1534,   <<unknown keyword>>              <<04801>>01215000
   showfstatsignrd  = 1535,   <<status parm ignored>>          <<04801>>01220000
   showfxtranparms  = 1536,   <<unidentifiable parameters>>    <<04801>>01225000
   showffserr       = 1537,   <<scratch file filesys error>>   <<04801>>01230000
   showf2merrors    = 1538,   <<too many errors in parse>>     <<04801>>01235000
   showfredndstate  = 1539,   <<state inconsistently specified><<04801>>01240000
   showfinndinap    = 1540,   <<input files cannot be deferred><<04801>>01245000
   showfoutndinap   = 1541,   <<appropriate only for "READY" fi<<04801>>01250000
   showfunkdefr     = 1542,   <<expected "N" or "D">>          <<04801>>01255000
   showfxpctjobeq   = 1543,   <<expected "JOB=">>              <<04801>>01260000
   showfxpctjob     = 1544,   <<invalid job name syntax>>      <<04801>>01265000
   showfxpctats     = 1545,   <<expected @s or @s'>>           <<04801>>01270000
   showfxpctatj     = 1546,   <<expected @j or @j'>>           <<04801>>01275000
   showfunkatx      = 1547,   <<unknown job type>>             <<04801>>01280000
   showfxpctsnum    = 1548,   <<invalid session number>>       <<04801>>01285000
   showfxpctjnum    = 1549,   <<invalid job number>>           <<04801>>01290000
   showfxpctjsnum   = 1550,   <<invalid job id>>               <<04801>>01295000
   showfredundjob   = 1551,   <<redundantly specified>>        <<04801>>01300000
   showfxpctdev     = 1552,   <<expected device>>              <<04801>>01305000
   showfinvlddevsp  = 1553,   <<invalid device specification>> <<04801>>01310000
   showfinptdevcls  = 1554,   <<dev class inappropriate for inp<<04801>>01315000
   showfdaccessdev  = 1555,   <<direct access inappropriate>>  <<04801>>01320000
   showfrdntdev     = 1556,   <<redundant>>                    <<04801>>01325000
   showdv2mp        = 1580,  <<too many parameters to showdev>><<04801>>01330000
   showdvnosuchldn  = 1581,  <<ldn can't be found on system>>  <<04801>>01335000
   showdvinvldclas  = 1582,  <<class name > 8 characters>>     <<04801>>01340000
   showdvnosuchcls  = 1583,  <<can't find device class on sys>><<04801>>01345000
   showfdsdevice    = 1584,  <<ds device inappropriate>>       <<04801>>01350000
   strmnotenabled   =   82,  <<stream disabled>>               <<04801>>01355000
   strmnosysdef     = 1590,  <<sys def file not allowed>>      <<04801>>01360000
   strminvldcolon   = 1591,  <<bad pseudocolon>>               <<04801>>01365000
   strmsyntax       = 1592,  <<bad syntax to command>>         <<04801>>01370000
   strmfileopenerr  = 1596; <<can't open stream file>>         <<04801>>01375000
                                                                        01380000
equate opcommnotallow=3000,    <<user hasn't access to op command>>     01385000
       expldevbad=3001,        <<expected logical device # bad>>        01390000
       ldevnotconfig=3002,     <<logical device not in this config.>>   01395000
       headonreq1p=3003,       <<headon has exactly on parameter, ldev>>01400000
       headoffreq1p=3004,      <<headoff has exactly one parameter>>    01405000
       ldevnotcrprpnch=3005,   <<expected card read, printer, or punch>>01410000
       usernoacc2dev=3006,     <<user has no access to device>>         01415000
       ldevnotreal=3007,       <<logical device is not real>>           01420000
       givereq1p=3008,         <<give requires exactly one param.>>     01425000
       takereq1p=3009,         <<take requires exactly one param.>>     01430000
       ldevinbyf=3010,         <<device in use by system, must be down>>01435000
       ldevalinbydiag=3011,    <<device already in use by diagnostics>> 01440000
       upreq1p=3012,           <<up requires exactly one parameter>>    01445000
       downreq1p=3013,         <<down requires exactly one parameter>>  01450000
       ldevinbydiag=3014,      <<device in use by diagnostics>>         01455000
       ldevalinbyf=3015,       <<device already in use by system>>      01460000
       ldevaldown=3016,        <<device already down>>                  01465000
       ldevaldownp=3017,       <<device already has down pending>>      01470000
       ldevinusedownp=3018,    <<device in use, down pending>>          01475000
       recallheader=3019,      <<the following replies pending:>>       01480000
       noreplypending=3020,    <<no replies pending>>                   01485000
       assbyothers=3021,       <<device already associated by others>>  01490000
       ldevnotindiag=3022,     <<device not in diagnostics>>            01495000
       outfencereq1p=3023,     <<outfence requires one parameter>>      01500000
       expprior1to14=3024,     <<outfence priority expected 1 to 14>>   01505000
       exppriorgt14=3025,      <<priority > 14, 14 used>>               01510000
       exppriorlt1=3026,       <<priority < 1 , 1  used>>               01515000
       abortioreq1p=3027,      <<abortio requires one parameter>>       01520000
       noioqed4dev=3028,       <<no i/o to abort for device>>           01525000
       acceptreq2parm=3029,    <<accept has at most two parms>>         01530000
       refusereq2parm=3030,    <<refuse has at most two parms>>         01535000
       acceptreq1p=3031,       <<accept must have at least 1 parm.>>    01540000
       refusereq1p=3032,       <<accpet must have at least 1 param.>>   01545000
       commaafterdj=3033,      <<comma expected after data or jobs>>    01550000
       firstmustbedj=3034,     <<expected 'data' or 'jobs'>>            01555000
       ldevnotdj=3035,         <<ldev not data or job accepting>>       01560000
       ldevhasnodefout=3036,   <<ldev has not default output device>>   01565000
       welmsgbusy=3037,        <<welcome dst's busy>>                   01570000
       breakjobreq1p=3038,     <<breakjob has exactly one parameter>>   01575000
       resumejobreq1p=3039,    <<resumejob has exactly one parameter>>  01580000
       parmnotjobid=3040,      <<expected job id (#jnnn)>>              01585000
       badjobnum=3041,         <<must be positive integer> 1>>          01590000
       nosuchjob=3042,         <<the specified job does not exist>>     01595000
       jobnotactive=3043,      <<breakjob requires job to be active>>   01600000
       jobnotsuspended=3044,   <<resumejob requires job to be suspend>> 01605000
       suspendjobown=3045,     <<suspend job nnn owns device nnn>>      01610000
       jobinterm=3046,         <<resuming or suspending job in term.>>  01615000
       illegalvalue =3045,     << specified inpri of 0 or 14  ><<04684>>01620000
       notusersjob=3047,       <<user resuming or suspending not his j>>01625000
       replyreq2p=3048,        <<reply has at least two parameters>>    01630000
       replytoomanyp=3049,     <<reply has too many parameters>>        01635000
       invalidpin=3050,        <<invalid pin supplied on reply>>        01640000
       noreq4pin=3051,         <<no reply outstanding for pin>>         01645000
       replyexpyn'num=3052,    <<reply expected yes/no or #>>           01650000
       replyexpyn=3053,        <<reply expected y/n>>                   01655000
       replyexpnumber=3054,    <<reply expected number>>                01660000
       assreq1p=3055,          <<associate has exactly one parameter>>  01665000
       disassreq1p=3056,       <<disassociate has exactly 1 parameter>> 01670000
       userhasdevass=3057,     <<user already has associated device>>   01675000
       usernotass2dev=3058,    <<user can't disass. device not ass. by>>01680000
       usercantassdev=3059,    <<user has no permission to ass. device>>01685000
       replyexp2parm=3060,     <<reply expected two parameters only>>   01690000
       stringtoolong=3061,     <<reply string too long>>                01695000
       jobfencereq1p=3062,     <<jobfence requires exactly 1 parameter>>01700000
       exp0to14=3063,          <<job priority must be >0 and <14>>      01705000
       exppriorlt0=3064,       <<jobfence <0, zero used>>               01710000
       expcommabreplyp=3065,   <<expected comma between reply parm.>>   01715000
       streamsreq1p=3066,      <<streams expects exactly one parameter>>01720000
       cantbeterm=3067,        <<streams device can't be terminal>>     01725000
       devnotdj=3068,          <<streams device must be data & job acc>>01730000
       consolereq1p=3069,      <<console expects exactly one parameter>>01735000
       devnotjob=3070,         <<console device must be job accepting>> 01740000
       exp1ofsorjlimit=3071,   <<expected one of job or session limit>> 01745000
       limithas2parm=3072,     <<limit has at most two parameters>>     01750000
       expcommasj=3073,        <<limit expects comma between parameter>>01755000
       slimitbad=3074,         <<session limit bad>>                    01760000
       jlimitbad=3075,         <<job limit bad>>                        01765000
       expjnumorjname=3076,    <<expected one of jobnum or jobname>>    01770000
       devnotoutput=3077,      <<outdev on altjob must be output dev>>  01775000
       jobnumnootherp=3078,    <<jobnum has no other parameters>>       01780000
       expjorsnum=3079,        <<expected either #jnnn or #snnn>>       01785000
       expuandaname=3080,      <<expected both username and acctname>>  01790000
       uoranamemax8=3081,      <<user and acct name limited to 8 chars>>01795000
       periodexp=3082,         <<period between user and acct name>>    01800000
       jobbeintro=3083,        <<can't abort job being introduced>>     01805000
       expacctname=3084,       <<expected [jobname,]user.name>>         01810000
       uoranamezero=3085,      <<user or acct can't be zero length>>    01815000
       exp1ofinout=3086,       <<keys for altjob must be inpri/outdev>> 01820000
       expsemicolon=3087,      <<keys must be preceded with ";">>       01825000
       expequals=3088,         <<parameter following key must have "=">>01830000
       expjand1parm=3089,      <<altjob must have job & at least 1 key>>01835000
       nosuchdev=3090,         <<no such device or deviceclass>>        01840000
       mustwaitorintro=3091,   <<altjob must be on wait or intro. job>> 01845000
       cantbesysfile=3092,     <<allow/disallow file=cant be system fi>>01850000
       mustbeasnoctl=3093,     <<file=must be ascii/nocctl file>>       01855000
       exp1ofuserfile=3094,    <<expected file= or user.acct;commands=>>01860000
       expusername=3095,       <<expected username>>                    01865000
       commandsepbycomma=3096, <<commands are separated by commas>>     01870000
       expcommands=3097,       <<expected commands=>>                   01875000
       nosuchcommand=3098,     <<unknown operator command>>             01880000
       toomanyparm=3099,       <<allow/disallow too many parameters>>   01885000
       alldisallioerr=3100,    <<i/o on file= file>>                    01890000
       nojobingoodstate=3101,  <<no jobs in execution state>>           01895000
       exp1ofonoff=3102,       <<expected either on/off in vmount>>     01900000
       expall=3103,            <<expected ;all>>                        01905000
       reqsetgrpacct=3104,     <<expected set.group.acct>>              01910000
       lmhas5parms=3105,       <<lmount has at most 5 parms>>           01915000
       ldmexp3parms=3106,      <<ldismount has exactly 3 parms>>        01920000
       badsetname=3107,        <<bad volume set/class name>>            01925000
       setnameperiod=3108,     <<expected period following set name>>   01930000
       groupperiod=3109,       <<expected period following group name>> 01935000
       expgeneration=3110,     <<expected ;gen=>>                       01940000
       badgeneration=3111,     <<invalid generation #>>                 01945000
       monmaxparm=3112,        <<too many parms for mon>>               01950000
       monreqldev=3113,        <<expected ldev for mon>>                01955000
       nosysbuf=3114,          <<no system buffers for monitoring>>     01960000
       monmustbetape=3115,     <<ldev must be tape for monitoring>>     01965000
       tapemustbedown=3116,    <<ldev must be down for monitoring>>     01970000
       expsemi'e'equals=3117,  <<expected ;e=>>                         01975000
       maskcomma=3120,         <<expected comma following mask bit #>>  01980000
       ignorednull=3121,       <<ignored null mask bit #>>              01985000
       badmask=3122,           <<invalid mask bit specified>>           01990000
       nods=3123,              <<no ds subsystem>>                      01995000
       nomp=3124,              <<no multi-point subsystem>>             02000000
       nomrje=3125,            <<no mrje subsystem>>                    02005000
       expauto=3126,           <<expected auto following on parameter>> 02010000
       invalidname=3127,       <<name must be 1-8 chars,alphanumeric>>  02015000
       jobsecurity1parm=3128,  <<jobsecurity has exactly one parameter>>02020000
       exp1ofhighlow=3129,     <<expected either high or low>>          02025000
       ldevmustbeterm=3130,    <<console device must be terminal>>      02030000
       ldevcantbedsterm=3131,  <<console device cant be ds terminal>>   02035000
       devnotass=3132,         <<masterop tried to disass. non-ass. de>>02040000
       ldevwasass=3133,        <<notify masterop about association>>    02045000
       ldevwasdisass=3134,     <<notify masterop about disassociation>> 02050000
       otheruserhasdev=3135,   <<require masterop to verify dev comman>>02055000
       opnotdone=3136,         <<operator not verified>>                02060000
       expfileshow=3137,       <<expected file=formal[;show]>>          02065000
       expshow=3138,           <<expected ;show>>                       02070000
       lastallow=3139,         <<last input line completed was:>>       02075000
       masteropdisass=3140,    <<master op disass. somebody>>           02080000
       nosuchdevclass=3141,     <<no such device class>>                02085000
         assreqsession=3142,   <<associate/disass. avail only tosess>>  02090000
         otheruserhasclass=3143, <<req masterop verify class command>>  02095000
      consolebusy = 3144,     <<console is busy>>              <<00671>>02100000
      consoleswitched = 3145, <<console switched from ldev to ldev>>    02105000
      outfencexp3parms =  3146, <<outfence 3 parms>>           <<00874>>02110000
      expldeveq    =   3147, <<expected "LDEV=">>              <<00874>>02115000
      ldevnotinodd =   3148, <<ldev not in directory>>         <<00874>>02120000
      consoledown =   3149, <<ldev down or pending>>           <<01027>>02125000
      downconsole =   3150, <<attempt to down console>>        <<01027>>02130000
      cant'down'sys'disc = 3151, << attempt to down sysdisc.>> <<04195>>02135000
       cantabortiodisk=3160,   << can't do abortio on disk >>  <<02677>>02140000
      consoleis=3190,     <<tell where console is currently>>  <<00893>>02145000
        conf'error=3819, << confdata.pub.sys error >>          <<01108>>02150000
        abslimitexceeded=3818,<<absolute js limit exceeded>>   <<01108>>02155000
         yyy=1; <<end of operator messages>>                   <<00635>>02160000
                                                                        02165000
<< discrps error numbers >>                                             02170000
equate                                                                  02175000
   expect'two'parms           = 3370,                                   02180000
   expectcomma                = 3371,                                   02185000
   invalid'num'for'ldev       = 3372,                                   02190000
   expect'enable'or'disable   = 3373,                                   02195000
   invalid'delimiter          = 3374,                                   02200000
   iotimeout                  = 3375,                                   02205000
   siofail                    = 3376,                                   02210000
   unitfailure                = 3377,                                   02215000
   channelfailure             = 3378,                                   02220000
   rps'alreadydisabled        = 3379,                                   02225000
   rps'alreadyenabled         = 3380,                                   02230000
   invaliddevice              = 3381,                                   02235000
   rps'notavailable           = 3382,                                   02240000
   noerr                      = 1;                                      02245000
<<spooling error messages>>                                             02250000
                                                                        02255000
equate                                                                  02260000
   expspfname = 3200,     <<expected spoolfile dfid>>                   02265000
   filenumnootherp = 3201,<<expected one parm dfid>>                    02270000
   expoorinum = 3202,     <<expected #onnn or #innn>>                   02275000
   badfilenum = 3203,     <<dfid must be positive integer>1>>           02280000
   nosuchfile = 3204,     <<dfid does not exist>>                       02285000
   wrongstate = 3205,     <<dfid not ready     >>                       02290000
   nopoundsign = 3206,    <<dfid must start with # sign>>               02295000
   cant'delete'stdin = 3227,                                            02300000
   spactldev=3207,        <<spoolfile is active on ldev \>>             02305000
   exponum = 3208,         <<expected dfid of #onnn>>                   02310000
   exp1ofkey = 3209,       <<expect 1 of dev,pri,defer,copies>>         02315000
   exp1to127 = 3210,       <<expect number 1<=copies<=127>>             02320000
   expoand1parm = 3211,    <<expect dfid and one parm>>                 02325000
   expo0to14 = 3212,        <<expects 0 <= pri <= 14 >>                 02330000
   startspreq1p = 3213,     <<startspool requires 1 parm>>              02335000
   invdevclass  = 3214,     <<invalid device class >>                   02340000
   unknowndevcl = 3215,     <<unknown device class >>                   02345000
   expinorout   = 3216,     <<expected in or out in reply>>             02350000
   devtypenotspoolee=3217,  <<device not spoolee type>>                 02355000
   spooleeownedout=3218,    <<device already output spoolee>>           02360000
   spooleeownedin =3219,    <<device already input spoolee>>            02365000
   devownedother = 3220,    <<device owned by another proc>>   <<04801>>02370000
   devnotjobdata = 3221,    <<device not job/data accepting>>           02375000
   devowneddiag = 3222,     <<device owned by diagnostics>>             02380000
   unabletogetstack=3223,   <<unable to get spooler stack>>             02385000
   unabletoprocreate=3224,  <<unable to create spooler proc>>           02390000
   stopspreq1p = 3225,      <<stopspool requires 1 parm>>               02395000
   spoolerbusy = 3226,      <<spooler process busy>>                    02400000
   spoolinorout = 3227,     <<is spooler input or output?>>             02405000
   devicenotspooled = 3228, <<device is not spooled>>                   02410000
   exp1ofldevorfin = 3229,  <<expected 1 of ldev or finish>>            02415000
   suspendsp2parm  = 3230,  <<suspendspool exp max 2 parms>>            02420000
   expfinish = 3231,        <<expected "FINISH" parameter>>             02425000
   resumespreq1p = 3232,    <<resumesp requires 1 parm >>               02430000
   deferoverpri = 3233,      <<defer overrides pri>>                    02435000
   prioverdefer = 3234,      <<pri overrides defer>>                    02440000
   prioverpri = 3235,        <<pri overrides pri>>                      02445000
   spactldevnodel = 3236,    <<spfle active on ldev,not delete>>        02450000
   devicenotoutspool = 3237, <<device not spooled for output>>          02455000
   expbackorforward = 3238,   <<expected "BACK" or "FORWARD">> <<01549>>02460000
   expnum1to256 = 3239,       <<expected range 1 to 256>>      <<01549>>02465000
   exppagesorfiles = 3240,    <<expected "PAGES" or "FILES">>  <<01549>>02470000
   exp4parms = 3241,          <<expected at most 4 parms>>     <<01549>>02475000
   expdevclasslong = 3242,  <<devclass name > 8 chars>>        <<00635>>02480000
   badclassname  = 3243,    <<class not configured>>           <<00635>>02485000
   classalreadyspooled = 3244, <<class already spooled>>       <<00635>>02490000
   classnotspooled = 3245,  <<class not spooled>>              <<00635>>02495000
   cltypenotspoolee = 3246, <<devclasstype not spoolee>>       <<00635>>02500000
   usernoacc2class = 3247, <<user has no access to class>>     <<00635>>02505000
   ldevnotactive = 3248,      <<ldev is not active >>          <<00903>>02510000
   resumespbeginx = 3249,   <<extra parms after "BEGINNING">>  <<01549>>02515000
   expblank       = 3250,    <<expected blank delimiter>>      <<01549>>02520000
   exp1ofldevorshutq = 3251, <<expected ldev;[shutq]>>         <<01088>>02525000
   exp1ofldevoropenq = 3252, <<expected ldev;[openq]>>         <<01088>>02530000
   startsp2parm      = 3253, <<startspool exp 2 parms>>        <<01088>>02535000
   stopsp2parm       = 3254, <<stopspool exp 2 parms>>         <<01088>>02540000
   expshutq          = 3255, <<startspool exp shutq>>          <<01088>>02545000
   expopenq          = 3256, <<stopspool exp openq>>           <<01088>>02550000
   classxparms       = 3257, <<extra parms after class>>       <<01088>>02555000
   deviceactive   = 3258,    <<device is active>>              <<01549>>02560000
   shutqinput     = 3259, <<shutq invalid input spoolee>>      <<01330>>02565000
   openqinput     = 3260, <<openq invalid input spoolee>>      <<01330>>02570000
   devisdown      = 3261, <<dev downed on start spooler>>      <<02609>>02575000
      xxx=1;                                                            02580000
<<download error messages >>                                            02585000
equate                                                                  02590000
   err'wrong'ldev = 3301,   <<invalid ldev for download>>               02595000
   err'numeric'margin = 3302, <<margin not numberic  >>                 02600000
   err'margin'range = 3303,   <<not between 1 and 16>>                  02605000
   err'margin'toomany = 3304, << too many margin parms. >>     <<04197>>02610000
   err'margin'failed = 3305,  <<download of margin failed>>             02615000
   err'too'many = 3306,       <<too manay parameters>>                  02620000
   err'too'few = 3307,        <<too few parameters>>                    02625000
   err'numeric'ldev = 3308,   <<ldev not numeric>>                      02630000
   err'invalid'ldev = 3309,   <<ldev invalid for download>>             02635000
   err'wrong'ldev'2 = 3310,   <<ldev not 2608>>                         02640000
   err'filename'alpha = 3311, <<filename is not alphabetic>>            02645000
   err'fopen = 3312,          <<file sys error>>                        02650000
err'expected'comma = 3313, <<no comma delimiting vfc comment>> <<01878>>02655000
   err'too'few'2  = 3314,     <<too few parameters in vfc>>             02660000
   err'lpi'numeric = 3315,    <<lines per inch not numeric>>            02665000
   err'numlines = 3316,       <<vfc numlines not numeric>>              02670000
   err'too'long = 3317,       <<vfc cannot exceed 127 lines>>           02675000
   err'realign = 3318,        <<warn to realign after reset>>           02680000
   err'vfc'failed = 3319,     <<download vfc failed>>                   02685000
   err'no'sysbufs = 3320,     <<no more system buffers>>       <<01330>>02690000
   err'negative'vfc = 3321,   <<negative length vfc>>          <<02069>>02695000
   exp'vfc'margin = 3322,     <<expect margin or vfc>>         <<02069>>02700000
   vfc'too'few = 3323,        << too few parms for vfc >>      <<04197>>02705000
   err'margin'notfirst = 3324,<< margin not 1st line in vfc >> <<04197>>02710000
   err'vfc'notfirst = 3325,   << vfc not 1st or 2nd line >>    <<04197>>02715000
   err'vfc'delims =3326,      << expected "," delimiters. >>   <<04197>>02720000
   exp'ldn'comma = 3327,      << expected "," after ldn.  >>   <<04197>>02725000
   bad'vfc'line = 3328,       << unexpected char in vfc def. >><<04197>>02730000
   using'6'lpi = 3329,        << lines/in. <> 6 or 8 or " ". >><<04197>>02735000
   extra'lines'ignored = 3330,<< extra lines in file ignored.>><<04390>>02740000
   err'can't'do'mode = 3331,  << device can't handle mode.   >><<04390>>02745000
   err'mode'toomany = 3332,   << too many parms for mode.    >><<04390>>02750000
   err'mode'notfirst = 3333,  << mode in wrong place in file.>><<04390>>02755000
   err'one'per'vfc = 3334,    << one mode, margin, vfc/file. >><<04390>>02760000
   err'mode'margin'first = 3335,<< mode, margin before vfc.  >><<07180>>02765000
   streams'outdev'0      = 3383,<<streams outdev cant be 0>>   << 8204>>02770000
                                                               << 8204>>02775000
   dummyeq = 0                << to make insertions easy. >>   <<*8944>>02780000
       ;                                                                02785000
                                                               << 8204>>02790000
<< the following equates are used for message generation   >>  << 8204>>02795000
<< for the job scheduling commands.                        >>  << 8204>>02800000
equate                                                         << 8204>>02805000
   sysgenset                    = 7,                           << 8204>>02810000
   showschedcurrtime            = 62,                          << 8204>>02815000
   showschedhead                = 90;                          << 8204>>02820000
                                                                        02825000
<< log command errors>>                                                 02830000
                                                                        02835000
equate logexp2parm=3810,           <<log has exactly 2 parameters>>     02840000
       logmustbe1to8=3811,         <<logid is 1 to 8 characters>>       02845000
       log1stcharalpha=3812,       <<logid 1st character is alpha>>     02850000
       logidmustbean=3813,         <<logid must be alphanumeric>>       02855000
       lognotactive=3814,          <<not active log process for id>>    02860000
       exp1ofssr=3815,             <<expected stop,start,restart>>      02865000
       logidactive=3816,           <<log process alreay active>>        02870000
       noinitlog=3817;             <<unable to initiate log process>>   02875000
                                                               <<00575>>02880000
<< foreign command error messages>>                            <<01115>>02885000
                                                               <<01115>>02890000
equate mustbedisc=3850,  <<ldev must be device type disc>>     <<01115>>02895000
       foreignreq1p=3851,<<foreign expects exactly 1 parm>>    <<01115>>02900000
       alreadyforeign=3852,<<volume is already foreign>>       <<01115>>02905000
       volmustbemtd=3853,  <<volume must be spinning>>         <<01115>>02910000
       inusepv=3854,       <<volume is an in-use pv>>          <<01115>>02915000
       inuseserdisc=3855,  <<volume is an in-use ser disc>>    <<01115>>02920000
       ldevinsysdomain=3856, <<ldev is in sys domain>>         <<03713>>02925000
       cantmakeforeign=3857 <<cant make disc foreign >>        <<03713>>02930000
       ;                                                       <<01115>>02935000
equate expminclockcycle=3460,   <<at least one param, clockcycle>>      02940000
       tunehas16parms=3461,     <<:tune has at most 16 parms>> <<01549>>02945000
       expnumberforclock=3463,  <<expected number for clockcycle>>      02950000
       queuehas4parms=3464,     <<only 4 queue descriptor parms>>       02955000
       relationshipbad=3465,    <<queue parms relationship bad>>        02960000
       expectatleast1qparm=3466,<<expect at least 1 queue parameter>>   02965000
       expect1ofcqdqeq=3467,    <<expect one of cq, dq, eq>>   <<01549>>02970000
       expectbefore=3468,       <<expected ! before parameter>><<01549>>02975000
       expectafter=3469,        <<expected ! after parameter>> <<01549>>02980000
       duplicatequeue=3470,     <<duplicatedly specified queue>>        02985000
       expectnumber=3471,       <<queue descriptor must be number>>     02990000
       queuebaselimit=3472,     <<queue base must be between 150 & 250>>02995000
       zzz=1;                                                  <<01549>>03000000
                                                               <<00575>>03005000
<< measio / sysmon messages  >>                                <<00575>>03010000
                                                               <<00575>>03015000
equate sysmonenabled=3400,     <<sysmon already enabled>>      <<00575>>03020000
       cantenablemio=3401,     <<could not enable measio>>     <<00575>>03025000
       cantgetbuf=3402,        <<cant get dseg buffer>>        <<00575>>03030000
       notsysmon=3403,         <<sysmon was not enabled>>      <<00575>>03035000
       tapeerror=3404,         <<tape error during measio>>    <<00575>>03040000
       endoftape=3405,         <<end of tape encountered>>     <<00575>>03045000
       monenabled=3406,        <<successful cxmon>>            <<00575>>03050000
       cantlockmio=3407,       <<cant lock mio code seg.>>     <<00575>>03055000
       cantunloadmio=3408,     <<cant unloadproc measio>>      <<00575>>03060000
       cantloadmioin=3409,     <<cant load mio'init>>          <<00575>>03065000
       measioerror=3410,       <<error returned from measio>>  <<00575>>03070000
       cantloadmiore=3411,     <<cant load mio'reset>>         <<00575>>03075000
       controllerunav=3412,    <<controller unavailable>>      <<00575>>03080000
       syserror=3413,          <<internal table error>>        <<00575>>03085000
       badstatus=3414,         <<bad status from measio>>      <<00575>>03090000
       cantloadmio=3415,       <<cant loadproc measio>>        <<00575>>03095000
       enablemio=3416,         <<measio enabled>>              <<00575>>03100000
       devicesdisabled=3417,   <<devices disabled>>            <<00575>>03105000
       disablemio=3418,        <<measio disabled>>             <<00575>>03110000
       devicesenabled=3419,    <<devices enabled>>             <<00575>>03115000
       ldevreqrd=3420,         <<ldev required>>               <<00575>>03120000
       maxparams=3421,         <<max # params exceeded>>       <<00575>>03125000
       ldevunavail=3422,       <<ldev unavailable >>           <<00575>>03130000
       labeledtape=3423,        <<labeled tape on ldev>>       <<00575>>03135000
       notape=3424,            <<no tape mounted>>             <<00575>>03140000
       illegalldev=3425,       <<bad ldev specified>>          <<00575>>03145000
       ldevmustbetape=3426,    <<ldev must be tape>>           <<00575>>03150000
       ldevmustbe7970x=3435,   <<ldev must be a 7970x>>        <<02513>>03155000
       deviceateot=3427,       <<ldev @ eot >>                 <<00575>>03160000
       devicenowring=3428,     <<ldev has no write ring>>      <<00575>>03165000
       devicenotonline=3429,   <<ldev not on line>>            <<00575>>03170000
       devicenotatlp=3430,     <<ldev not @ load pt>>          <<00575>>03175000
       deviceinvalid=3431,     <<ldev invalid>>                <<00575>>03180000
       deviceerror=3432,       <<ldev error>>                  <<00575>>03185000
       mondisabled=3433,       <<successful cxmoff>>           <<00575>>03190000
       sysmonrun=3434;         <<system monitor running>>      <<00575>>03195000
                                                               <<0726>> 03200000
<< disc caching message numbers. >>                            <<06928>>03205000
equate                                                         <<06928>>03210000
   startcachereq1p     = 4410,  << requires one parameter.>>   <<06928>>03215000
   stopcachereq1p      = 4411,  << ditto.                 >>   <<06928>>03220000
   nocachedst          = 4412,  << no cache dst found.    >>   <<06928>>03225000
   cacheinternalerr    = 4413,  << internal error detected>>   <<06928>>03230000
   ldevalreadycached   = 4414,  << disc already cached.   >>   <<06928>>03235000
   toomanydisccachereq = 4415,  << overflow data structs. >>   <<06928>>03240000
   devnotcachable      = 4416,  << device not cachable.   >>   <<06928>>03245000
   sysnotcachable      = 4417,  << caching not enabled.   >>   <<06928>>03250000
   ldevnotcached       = 4418,  << disc not cached.       >>   <<06928>>03255000
   cachenotenabled     = 4419,  <<                        >>   <<06928>>03260000
   cachecantallow      = 4420,  << caching can't :allow.  >>   <<06928>>03265000
                                                               <<06928>>03270000
   startcacheok        = 4000,  << caching enabled msg.   >>   <<06928>>03275000
   stopcacheok         = 4001;  << caching off message.   >>   <<06928>>03280000
                                                               <<06928>>03285000
                                                               <<06928>>03290000
<< showallow error messages>>                                  <<0726>> 03295000
                                                               <<0726>> 03300000
equate userheader=3901,                                        <<0726>> 03305000
       userhasallow=3902,                                      <<0726>> 03310000
       noqualifyusers=3903,                                    <<0726>> 03315000
       usernoallow=3904,                                       <<0726>> 03320000
       globalallow=3905,                                       <<0726>> 03325000
       noglobalallow=3906,                                     <<0726>> 03330000
       need'sm'or'masterop=971,                                <<01683>>03335000
       need'am'or'masterop=969,                                <<01683>>03340000
       badname=3909,                                           <<0726>> 03345000
       exp0or2parms=3900;                                      <<0726>> 03350000
                                                               << 8229>>03355000
<< welcome error messages >>                                   << 8229>>03360000
equate can't'open'mfile=3366,    << error on mess file open >> << 8229>>03365000
       too'many'wparms =3362,    << too many welcome params >> << 8229>>03370000
       invalid'recfm   =3363,    << file record format not  >> << 8229>>03375000
                                 << fixed record length     >> << 8229>>03380000
       file'not'ascii  =3364,    << message file not ascii  >> << 8229>>03385000
       warn'recsize'too'large=3365,                            << 8229>>03390000
       welcreaderr=3367,                                       << 8229>>03395000
       welc'dst'full=3368;                                     << 8229>>03400000
                                                               <<02345>>03405000
<< misc. errors  >>                                            <<02345>>03410000
equate expcomma   =  1254,   << comma expected >>              <<02345>>03415000
       extradelim =  1397;   << extra trailing delim. ignored ><<02345>>03420000
                                                               <<02345>>03425000
equate cigeneralmsgset=7,      <<ci's general message set>>    <<00575>>03430000
       cierrmsgset=2,          <<ci's error message set>>      <<00575>>03435000
       generalset=1,           <<general message set>>         <<00575>>03440000
       filesysmsgset=8,              <<file system's error message set>>03445000
       mounterrs=253,                <<vmount errors>>                  03450000
       parmsignored = 165,                                     <<04535>>03455000
       norepending = 166,                                      <<04535>>03460000
       errstdineof=900,              << eof on $stdin >>       <<01649>>03465000
       errstdinio=901,               << i/o error on $stdin >> <<01649>>03470000
       num'queued = 163,    << prints num. of queued entries >><<04803>>03475000
       warnxparmsignored=1670;       <<extra parameters ignored>>       03480000
equate                                                         <<07283>>03485000
  ccontrol'same'parm                     = 4445,               <<07283>>03490000
  ccontrol'cache'not'enabled             = 4446,               <<07283>>03495000
  ccontrol'exp'between'1'and'96          = 4447,               <<07283>>03500000
  ccontrol'invalid'number                = 4448,               <<07283>>03505000
  ccontrol'not'enabled                   = 4449,               <<07283>>03510000
  ccontrol'bad'keyword                   = 4450,               <<07283>>03515000
  ccontrol'expect'equalsign              = 4451,               <<07283>>03520000
  ccontrol'has'only'x'parms              = 4452,               <<07283>>03525000
  ccontrol'exp'yes'or'no                 = 4453,               <<07283>>03530000
  ccontrol'needs'1'or'more'parms         = 4454;               <<07283>>03535000
                                                               <<07283>>03540000
equate                                                         <<07283>>03545000
   equalsign        = 1,                                       <<07283>>03550000
   maximumparms     = 6;                                       <<07283>>03555000
                                                               <<07283>>03560000
define                                                         <<07283>>03565000
   len'ext   = (0:8)#,                                         <<07283>>03570000
   delim'ext = (11:5)#;                                        <<07283>>03575000
                                                               <<07283>>03580000
$page "MISC. EQUATES"                                                   03585000
equate sysglob=%1000;    <<absolute location of system global area>>    03590000
equate nocache'onsystem   = 4421;                              <<06928>>03595000
equate consldev=sysglob+%74;     <<logical device of master operator>>  03600000
equate jobsync=sysglob+%121;      <<job sync. word>>                    03605000
equate vmountcntl=sysglob+%365; <<mount/dismount control>>              03610000
equate dscontrol=sysglob+%341; <<ds control plabel>>                    03615000
equate mpline=sysglob+%374;    <<multi-point plabel>>                   03620000
equate mrjecontrol=sysglob+%375;<<mrje plabel>>                         03625000
equate allowmask=sysglob+%215;                                          03630000
define                                                                  03635000
        sys'console'ldev = absolute(%1074)#; << console dev. >><<06923>>03640000
                                                                        03645000
                                                                        03650000
equate cr=13 <<carriage return>>, lf=10 <<line feed>>;                  03655000
equate ldt'dtype'list=2;    <<listing device type minimum #>>           03660000
equate ucop=2;              <<ucop's pcb #>>                            03665000
                                                                        03670000
$include inclpcb5                                              <<06606>>03675000
logical pointer pcb = syspcbindex;                             <<06606>>03680000
equate oddsir=4, odddst=46, odd'prior'w=4; <<odd outfence word>>        03685000
equate iddsir = 3, idddst = 45;                                         03690000
equate msgsir = %24;                                           <<06370>>03695000
                                                                        03700000
equate jobexec=2,             <<job state is executing>>       <<06607>>03705000
       jobsusp=4,             <<job state is suspended>>                03710000
       jobwait=%40,           <<job state is waiting>>                  03715000
       joberr=%50,                                             <<04801>>03720000
       jobciinit=%60,         <<job being init. by ci>>                 03725000
       jobsched = %70,      << scheduled jobs >>               << 8204>>03730000
       jobintro=1;            <<job state is being introduced>>         03735000
                                                                        03740000
                                                                        03745000
equate acctname'l=4;        <<length of logon account name>>            03750000
equate username'l=4;        <<length of logon user name>>               03755000
                                                                        03760000
equate xdd'entry'size = 30;  <<length of xdd subentry>>                 03765000
<<spooler directives>>                                                  03770000
                                                                        03775000
   equate  priordirective    = 0                 ,                      03780000
           quitspooling      = 1                 ,                      03785000
           waitspooling      = 2                 ,                      03790000
           resumespooling    = 3                 ,                      03795000
           keepspooling      = resumespooling    ,                      03800000
           finishfile        = 0                 ,                      03805000
           deletefile        = 1                 ,                      03810000
           deferfile         = 2                 ,                      03815000
           relinkfile        = 3                 ;                      03820000
$page "DEFINES"                                                         03825000
define readyflag=(13:1)#;         <<ready flag in job sync. word>>      03830000
                                                                        03835000
                                                                        03840000
define abs=absolute#;  <<abbreviation for absolute function>>           03845000
                                                                        03850000
define executorhead= (parmsp,errnum,parmnum);                           03855000
                     byte array parmsp;                                 03860000
                     integer errnum, parmnum;                           03865000
                     option privileged,uncallable #;                    03870000
                                                                        03875000
define disable=assemble(sed 0)#,           <<disable interrupts>>       03880000
       enable=assemble(sed 1)#,            <<enable interrupts>>        03885000
       pseudodisable=assemble(psdb)#,      <<disable process switching>>03890000
       pseudoenable=assemble(pseb)#;       <<enable process switching>> 03895000
                                                                        03900000
define def'movefromdseg=                                                03905000
movefromdseg(target,dstn,offset,count);                                 03910000
value target,dstn,offset,count;                                         03915000
logical target,dstn,offset,count;                                       03920000
begin                                                                   03925000
   x:=tos;     <<save return addr>>                                     03930000
   assemble(mfds 0);                                                    03935000
   tos:=x;     <<restore return addr>>                                  03940000
end#,                                                                   03945000
                                                                        03950000
       def'movetodseg=                                                  03955000
movetodseg(dstn,offset,source,count);                                   03960000
value dstn,offset,source,count;                                         03965000
logical dstn,offset,source,count;                                       03970000
begin                                                                   03975000
   x:=tos;                                                              03980000
   assemble(mtds 0);                                                    03985000
   tos:=x;     <<restore return addr>>                                  03990000
end#;                                                                   03995000
                                                                        04000000
<< ldt field descriptions>>                                             04005000
                                                                        04010000
$include inclldt5                                              <<06604>>04015000
                                                               <<06604>>04020000
define                                                         <<06604>>04025000
   ldtsir   =  ldt'sir#,                                       <<06604>>04030000
   ldtdst   =  ldt'dst#,                                       <<06604>>04035000
   ldtsize  =  size'of'ldt'entry#;                             <<06604>>04040000
$include incldct                                               <<06604>>04045000
                                                                        04050000
define                                                                  04055000
   << prefix >>                                                         04060000
           ldt'hientry       = db0.(0:8)         #,                     04065000
           ldt'entrysize     = db0.(8:8)         #,                     04070000
           ldt'dctp          = pdb1              #,                     04075000
           ldt'numclass      = db2               #,                     04080000
           ldt'dctsize       = db3               #,                     04085000
           ldt'streamdev     = db4.(8:8)         #,                     04090000
   << entry >>                                                          04095000
              printer        = 32                #,                     04100000
              cardpunch      = 33                #,                     04105000
              readerpunch    = 20                #,                     04110000
              cardreader     = 8                 #,                     04115000
              magtape        = 24                #,                     04120000
              terminal       = 16                #, <<sp.09>>           04125000
              disc           = 0                 #;            <<06604>>04130000
                                                               <<03519>>04135000
   << volume table definitions >>                              <<03519>>04140000
                                                               <<03519>>04145000
   equate                                                      <<03519>>04150000
      vtab'dst = 29,                                           <<03519>>04155000
      vtab'entry'size = 14;                                    <<03519>>04160000
                                                               <<03519>>04165000
   define                                                      <<03519>>04170000
      vtab'unreadable = 12).(13:1#,                            <<03519>>04175000
      vtab'non'sys'domain = 12).(14:1#,                        <<03519>>04180000
      vtab'scratch = 12).(15:1#,                               <<03519>>04185000
      vtab'ldev = 12).(0:8#;                                   <<03519>>04190000
                                                               <<03519>>04195000
<< odd layout description>>                                             04200000
                                                                        04205000
   define  c'sq               = getclassbuf(2).(8:1)  #,       <<00635>>04210000
           c'devtype          = getclassbuf(2).(10:6) #;       <<00635>>04215000
define odd'prior=(12:4)#,          <<outfence field>>                   04220000
       not'odd'prior=(0:12)#;      <<part of word other than outfence>> 04225000
define                                                                  04230000
<< device class table - dct >>                                          04235000
   << entry >>                                                          04240000
           dc'classname      = 0                 #,                     04245000
           dc'classname'b    = 0                 #,                     04250000
           dc'cyclicalp      = 4).(1:7           #,                     04255000
               dc'sq           = 4).(8:1               #,      <<00635>>04260000
           dc'classtype      = 4).(10:6          #,                     04265000
           dc'basictype      = 4).(10:3          #,                     04270000
           dc'numdevs        = 5).(0:8           #,                     04275000
           dc'firstdev       = 5).(8:8           #,                     04280000
           dc'firstdev'b     = 11                #;                     04285000
$page "***   COMMON FIELDS OF JMAT, IDD, ODD   ***"                     04290000
define                                                                  04295000
   << prefix >>                                                         04300000
           tbl'maxsize       = db0.(0:8)         #,                     04305000
           tbl'cursize       = db0.(8:8)         #,                     04310000
              tblquantum     = 128               #,                     04315000
           tbl'entrysize     = db1.(8:8)         #,                     04320000
           tbl'entryareap    = pdb2              #,                     04325000
comment                                                                 04330000
           << chains defined by "HEAD" pointer,                         04335000
              immediately followed by "TAIL" pointer.                   04340000
              each points to wd 0 of entry.                             04345000
              null chain:  head = 0,  tail = @head.                     04350000
              chain terminated by 0 link.                               04355000
           >>                                                           04360000
           ;                                                            04365000
           ttchainend        = 0                 #,                     04370000
           tt'inuseword      = 0                 #,                     04375000
              freeentry      = 0                 #,                     04380000
           tt'jtype          = 1).(0:2           #,                     04385000
              sessiontype    = 1                 #,                     04390000
              batchtype      = 2                 #,                     04395000
           tt'jnum           = 1).(2:14          #,                     04400000
           tt'jobnum         = 1                 #,                     04405000
           tt'uname          = 2                 #,                     04410000
           tt'aname          = 6                 #,                     04415000
           tt'jname          = 10                #,                     04420000
           tt'linkp'w        = 25                #,                     04425000
           tt'linkp          = tt'linkp'w        #;                     04430000
$page "***   DEVICE DIRECTORIES: GENERAL - XDD   ***"                   04435000
<< device directories: general - xdd >>                                 04440000
$include inclxdd5                                              <<06927>>04445000
                                                                        04450000
$include incllpdt                                              <<06221>>04455000
                                                                        04460000
$set x8=off                                                    <<06607>>04465000
$include incljmat                                              <<06607>>04470000
                                                               <<06607>>04475000
define                                                         <<06607>>04480000
   jobsecurity'low  = 3#,<< job owners can use job commands >> <<06607>>04485000
   jobsecurity'high = 0#,<< don't let 'em.  >>                 <<06607>>04490000
                                                               <<06607>>04495000
   jobtype'job      = 2#, <<  its a job  >>                    <<06607>>04500000
   jobtype'session  = 1#; <<  its a session  >>                <<06607>>04505000
                                                               <<06607>>04510000
                                                                        04515000
<< pcb layout description >>                                            04520000
                                                                        04525000
equate replydone = 3;                                          <<06606>>04530000
                                                               <<00575>>04535000
equate citype = 2;           <<ptype of ci>>                   <<00874>>04540000
                                                                        04545000
                                                                        04550000
$include inclrit                                               <<04803>>04555000
$include pcbfincl                                              <<06605>>04560000
$include inclpxg              ;                                <<06605>>04565000
<< pcbx global area>>                                                   04570000
                                                                        04575000
                                                                        04580000
<< mycommand parameter description area layout>>                        04585000
                                                                        04590000
define delimiter=(11:5)#, special'char=(10:1)#,                         04595000
       alpha'char=(8:1)#, numerical'char=(9:1)#;                        04600000
                                                                        04605000
<< vmount control layout>>                                              04610000
                                                                        04615000
define onoffflg=(15:1)#,       <<on/off flag>>                          04620000
       autoflg=(13:1)#,        <<auto flag>>                            04625000
       allflg=(14:1)#;         <<all flag>>                             04630000
                                                                        04635000
<< dit layout>>                                                         04640000
                                                                        04645000
define dit'iltp=5#;            <<ilt pointer>>                          04650000
define dit'lplevel = 8).(13:3#;  <<dmodem control a>>          <<00671>>04655000
                                                                        04660000
<< associate file entry layout >>                                       04665000
                                                                        04670000
define asf'username=0#,                <<username>>                     04675000
       asf'acctname=4#,                <<acctname>>                     04680000
       asf'class=8#,                  <<device class name>>             04685000
       asf'nextentry=12#,              <<record # of next entry>>       04690000
       asf'entrysize=13#;              <<size of associate file entry>> 04695000
$include inclmift                                              <<04111>>04700000
$page "EXTERNAL DECLARATIONS"                                           04705000
intrinsic fopen,fcheck,fgetinfo,fclose,fread,print,search;              04710000
intrinsic fwrite;                                              <<04801>>04715000
intrinsic who;                                                 <<04801>>04720000
intrinsic freedseg, getdseg;                                   <<04801>>04725000
intrinsic freaddir;                                                     04730000
intrinsic terminate,readx;                                              04735000
intrinsic loadproc,unloadproc;                                 <<00575>>04740000
                                                                        04745000
integer procedure allocateproc(procname);                      <<00575>>04750000
byte array procname;                                           <<00575>>04755000
option external;                                               <<00575>>04760000
                                                               <<00575>>04765000
integer procedure deallocateproc(procname);                    <<00575>>04770000
byte array procname;                                           <<00575>>04775000
option external;                                               <<00575>>04780000
                                                               <<00575>>04785000
logical procedure getsir(n);                                            04790000
value n; logical n;                                                     04795000
option external;                                                        04800000
                                                                        04805000
procedure relsir(n,t);                                                  04810000
value n,t; logical n,t;                                                 04815000
option external;                                                        04820000
                                                                        04825000
integer procedure getdataseg(a,b);                             <<00575>>04830000
value a,b; integer a,b;                                        <<00575>>04835000
option external;                                               <<00575>>04840000
                                                               <<00575>>04845000
procedure reldataseg(a);                                       <<00575>>04850000
value a; integer a;                                            <<00575>>04855000
option external;                                               <<00575>>04860000
                                                               <<00575>>04865000
integer procedure iotableinfo(a,b,c);                          <<00575>>04870000
value a,b,c; integer a,b,c;                                    <<00575>>04875000
option external;                                               <<00575>>04880000
                                                               <<00575>>04885000
procedure cxmioenable executorhead;                            <<00575>>04890000
option forward;                                                <<00575>>04895000
                                                               <<00575>>04900000
procedure cxmiodisable executorhead;                           <<00575>>04905000
option forward;                                                <<00575>>04910000
                                                               <<00575>>04915000
procedure cxmiomonoff executorhead;                            <<00575>>04920000
option forward;                                                <<00575>>04925000
                                                               <<00575>>04930000
procedure help;                                                <<00575>>04935000
option external;                                               <<00575>>04940000
                                                               <<00575>>04945000
procedure tgetinfo(ldev,fbuf,itemnum);                         <<02677>>04950000
value ldev,itemnum;                                            <<02677>>04955000
integer ldev,itemnum;                                          <<02677>>04960000
array fbuf;                                                    <<02677>>04965000
option external;                                               <<02677>>04970000
                                                               <<02677>>04975000
procedure cierr(a,b,c,d);                                               04980000
value a,c,d; integer a,c,d;                                             04985000
byte array b;                                                           04990000
                                                               <<00575>>04995000
option external,variable;                                               05000000
                                                                        05005000
integer procedure genmsg(a,b,c,d,e,f,g,h,i,j,k,l,m);                    05010000
value a,b,c,d,e,f,g,h,i,j,k,l,m;                                        05015000
logical a,b,c,d,e,f,g,h,i,j,k,l,m;                                      05020000
option variable,external;                                               05025000
                                                                        05030000
procedure awake(a,b,c);                                                 05035000
value a,b,c; integer a,b,c;                                             05040000
option external;                                                        05045000
                                                                        05050000
integer procedure sysproc(a);                                           05055000
value a; logical a;                                                     05060000
option external;                                                        05065000
                                                                        05070000
intrinsic mycommand,binary,ascii;                                       05075000
procedure srooster(a);                                                  05080000
value a; integer a;                                                     05085000
option external;                                                        05090000
                                                                        05095000
procedure abortio(a);                                                   05100000
value a; logical a;                                                     05105000
option external;                                                        05110000
                                                                        05115000
integer procedure altdsegsize(a,b);                                     05120000
value a,b; integer a,b;                                                 05125000
option external;                                                        05130000
                                                                        05135000
logical procedure exchangedb(a);                                        05140000
value a; logical a;                                                     05145000
option external;                                                        05150000
                                                               <<02319>>05155000
logical procedure setcritical;                                 <<02319>>05160000
option external;                                               <<02319>>05165000
                                                               <<02319>>05170000
procedure resetcritical(crit);                                 <<02319>>05175000
value crit; logical crit;                                      <<02319>>05180000
option external;                                               <<02319>>05185000
                                                                        05190000
double procedure attachio(a,b,c,d,e,f,g,h,i);                           05195000
value a,b,c,d,e,f,g,h,i; integer a,b,c,d,e,f,g,h,i;                     05200000
option external;                                                        05205000
                                                                        05210000
integer procedure family(a,b);                                          05215000
value a,b; integer a,b;                                                 05220000
option external;                                                        05225000
                                                                        05230000
procedure queueproc(pcbpt,queuename,location);                 <<06606>>05235000
value pcbpt,queuename,location;                                <<06606>>05240000
integer pcbpt,queuename,location;                              <<06606>>05245000
option external;                                               <<01549>>05250000
                                                                        05255000
procedure delink'jmat(i);                                      <<06607>>05260000
value i; integer i;                                            <<06607>>05265000
option external;                                               <<06607>>05270000
                                                               << 8204>>05275000
procedure delinksched( i );                                    << 8204>>05280000
   value   i;                                                  << 8204>>05285000
   integer i;                                                  << 8204>>05290000
option external;                                               << 8204>>05295000
                                                                        05300000
procedure schedulejob(a);                                               05305000
value a; integer pointer a;                                             05310000
option external;                                                        05315000
                                                                        05320000
integer procedure getdevinfo(a,b);                                      05325000
byte array a;                                                           05330000
integer array b;                                                        05335000
option external;                                                        05340000
                                                                        05345000
logical procedure deletejob(a);                                         05350000
value a; integer pointer a;                                             05355000
option privileged, uncallable, forward;                        <<04801>>05360000
                                                               <<04801>>05365000
procedure writedseg(en);                                       <<00716>>05370000
value en;                                                      <<00716>>05375000
integer en;                                                    <<00716>>05380000
option external;                                               <<00716>>05385000
                                                               <<00716>>05390000
procedure scheddaytime( out, time );                           << 8204>>05395000
   byte array out;                                             << 8204>>05400000
   integer array time;                                         << 8204>>05405000
option external;                                               << 8204>>05410000
                                                                        05415000
integer procedure checkfilename'(a,b,c,d);                              05420000
value a;                                                                05425000
logical b,c,d;                                                          05430000
double a;                                                               05435000
option external;                                                        05440000
                                                                        05445000
procedure mount(a,b,c,d,e,f,g);                                <<00775>>05450000
value e,g;                                                     <<00775>>05455000
integer d,e,f,g;                                               <<00775>>05460000
byte array a,b,c;                                                       05465000
option variable,external;                                               05470000
                                                                        05475000
procedure dismount(a,b,c,d,e,f);                               <<00775>>05480000
value e,f;                                                     <<00775>>05485000
integer d,e,f;                                                 <<00775>>05490000
byte array a,b,c;                                                       05495000
option variable,external;                                               05500000
                                                                        05505000
integer procedure setsysdb;                                             05510000
option external;                                                        05515000
                                                                        05520000
logical procedure initlog(a,b);                                <<00601>>05525000
value b; integer b; byte array a;                              <<00601>>05530000
option external;                                               <<00601>>05535000
                                                               <<00601>>05540000
logical procedure findlog(a,b);                                <<00601>>05545000
integer b; byte array a;                                       <<00735>>05550000
option external;                                               <<00601>>05555000
                                                               <<00601>>05560000
logical procedure stoplog(a);                                  <<00601>>05565000
byte array a;                                                  <<00601>>05570000
option external;                                               <<00601>>05575000
                                                               <<04803>>05580000
logical procedure rem'queued'entry(pin);                       <<04803>>05585000
value pin; integer pin;                                        <<04803>>05590000
option external,privileged,uncallable,variable;                <<04803>>05595000
                                                               <<04803>>05600000
                                                               <<04803>>05605000
procedure resetdb(a);                                                   05610000
value a; integer a;                                                     05615000
option external;                                                        05620000
                                                                        05625000
procedure returnsysbuf(a);                                              05630000
value a; integer a;                                                     05635000
option external;                                                        05640000
                                                                        05645000
                                                                        05650000
integer procedure fgetsysbuf(a,b);                                      05655000
value a,b;                                                              05660000
integer a;                                                              05665000
logical b;                                                              05670000
option external;                                                        05675000
                                                                        05680000
procedure set'psif(pcbpt,flag);                                <<01986>>05685000
value pcbpt,flag;                                              <<01986>>05690000
integer pcbpt;                                                 <<01986>>05695000
logical flag;                                                  <<01986>>05700000
option external;                                               <<01986>>05705000
                                                               <<01986>>05710000
procedure clear'psif(pcbpt,flag);                              <<01986>>05715000
value pcbpt,flag;                                              <<01986>>05720000
integer pcbpt;                                                 <<01986>>05725000
logical flag;                                                  <<01986>>05730000
option external;                                               <<01986>>05735000
                                                               <<01986>>05740000
logical procedure validdevtype(ldev,function,flag);                     05745000
   value ldev,function;                                                 05750000
   integer ldev,function,flag;                                          05755000
   option external;                                                     05760000
                                                                        05765000
integer procedure getsysbuf(num,iflg);                                  05770000
   value num,iflg;                                                      05775000
   integer num ;                                                        05780000
   logical iflg;                                                        05785000
   option external;                                                     05790000
                                                                        05795000
integer procedure deletedevfile(parm,flags);                            05800000
   value parm,flags;                                                    05805000
   integer parm;                                                        05810000
   logical flags;                                                       05815000
   option external;                                                     05820000
                                                               <<04801>>05825000
integer procedure pvolid (ldev, buf);                          <<04801>>05830000
   value ldev;                                                 <<04801>>05835000
   integer ldev;                                               <<04801>>05840000
   byte array buf;                                             <<04801>>05845000
   option privileged, uncallable, external;                    <<04801>>05850000
                                                                        05855000
procedure mmstat'(event,p1,p2,p3,p4,p5,p6);                    <<06931>>05860000
value p1,p2,p3,p4,p5,p6,event;                                 <<06931>>05865000
integer event,p1,p2,p3,p4,p5,p6;                               <<06931>>05870000
option external;                                                        05875000
                                                                        05880000
logical procedure calendar;                                             05885000
option external;                                                        05890000
                                                                        05895000
double procedure clock;                                                 05900000
option external;                                                        05905000
                                                                        05910000
procedure ferror'(a,b);                                                 05915000
value a;                                                                05920000
integer a,b;                                                            05925000
option external;                                                        05930000
                                                                        05935000
logical procedure requestservice;                                       05940000
option external;                                                        05945000
                                                                        05950000
procedure cdt'display'ldevs(reset,stat);                       <<06928>>05955000
value reset;                                                   <<06928>>05960000
logical reset;                                                 <<06928>>05965000
integer stat;                                                  <<06928>>05970000
option privileged,external,uncallable;                         <<06928>>05975000
                                                               <<06928>>05980000
procedure cdt'set'seq(parm,stat);                              <<07283>>05985000
value parm;                                                    <<07283>>05990000
integer parm,stat;                                             <<07283>>05995000
option external;                                               <<07283>>06000000
                                                               <<07283>>06005000
procedure cdt'set'rnd(parm,stat);                              <<07283>>06010000
value parm;                                                    <<07283>>06015000
integer parm,stat;                                             <<07283>>06020000
option external;                                               <<07283>>06025000
                                                               <<07283>>06030000
procedure cdt'set'post(parm,stat);                             <<07283>>06035000
value parm;                                                    <<07283>>06040000
integer parm,stat;                                             <<07283>>06045000
option external;                                               <<07283>>06050000
                                                               <<07283>>06055000
integer procedure ldevtotype(ldev);                            <<01115>>06060000
   value ldev;                                                 <<01115>>06065000
   integer ldev;                                               <<01115>>06070000
   option external;                                            <<02319>>06075000
                                                               <<01115>>06080000
integer procedure ldevtosubtype(ldev);                         <<03713>>06085000
   value ldev;                                                 <<03713>>06090000
   integer ldev;                                               <<03713>>06095000
   option external;                                            <<03713>>06100000
                                                               <<03713>>06105000
double procedure reqstatus(ldev);                              <<01115>>06110000
   value ldev; integer ldev;                                   <<01115>>06115000
   option external;                                            <<02319>>06120000
                                                               <<01115>>06125000
integer procedure foreign(ldev);                               <<01115>>06130000
   value ldev; integer ldev;                                   <<01115>>06135000
   option forward;                                             <<01115>>06140000
                                                                        06145000
integer procedure rps'allow(ldev,func);                                 06150000
value ldev, func;                                                       06155000
integer ldev;  integer func;                                            06160000
option external;                                                        06165000
                                                               <<01115>>06170000
logical procedure getclass(a,b,c,d,e);                                  06175000
value b,c,d;                                                            06180000
integer array a,e;                                                      06185000
logical b;                                                              06190000
integer c,d;                                                            06195000
option external,variable;                                               06200000
                                                                        06205000
procedure log15(a,b,c,d);                                               06210000
value a,b,c,d; logical a,b,c,d;                                         06215000
option external;                                                        06220000
                                                                        06225000
logical procedure masterop;                                             06230000
option privileged,uncallable,forward;                                   06235000
                                                                        06240000
procedure abortjob (main);                                     <<04801>>06245000
   value main;                                                 <<04801>>06250000
   integer main;                                               <<04801>>06255000
   option privileged, uncallable, external;                    <<04801>>06260000
                                                               <<04801>>06265000
procedure suddendeath (errnum);                                <<04801>>06270000
   value errnum;                                               <<04801>>06275000
   integer errnum;                                             <<04801>>06280000
   option privileged, uncallable, external;                    <<04801>>06285000
                                                               <<04801>>06290000
procedure deallocate'jmat (entryp);                            <<06607>>06295000
   value entryp;                                               <<04801>>06300000
   integer pointer entryp;                                     <<04801>>06305000
   option privileged, uncallable, external;                    <<04801>>06310000
                                                               <<04801>>06315000
logical procedure it's'a'disc (type);                          <<04801>>06320000
   value type;                                                 <<04801>>06325000
   integer type;                                               <<04801>>06330000
   option privileged, uncallable, external;                    <<04801>>06335000
comment -- determines whether type is a valid disc device.     <<04801>>06340000
;                                                              <<04801>>06345000
                                                               <<04801>>06350000
integer procedure devspec (device, bufb);                      <<04801>>06355000
   value device;                                               <<04801>>06360000
   integer device;                                             <<04801>>06365000
   byte array bufb;                                            <<04801>>06370000
   option privileged, uncallable, external;                    <<04801>>06375000
comment -- called with device > 0 (ldev) or < 0 (device  class <<04801>>06380000
table index).  on exit, bufb contains the ascii numeric string <<04801>>06385000
corresponding to ldev, or the ascii alphanumeric string of the <<04801>>06390000
specified dct entry. the result is the length of either string <<04801>>06395000
with trailing blanks suppressed.  bufb must be at least  eight <<04801>>06400000
bytes long.  db must be at the stack.                          <<04801>>06405000
;                                                              <<04801>>06410000
                                                               <<04801>>06415000
integer procedure formname (type, target, ba1, ba2,            <<04801>>06420000
                            ba3, ba4);                         <<04801>>06425000
   value type;                                                 <<04801>>06430000
   integer type;                                               <<04801>>06435000
   byte array target, ba1, ba2, ba3, ba4;                      <<04801>>06440000
   option privileged, uncallable, external;                    <<04801>>06445000
                                                               <<04801>>06450000
procedure date'line (string);                                  <<04801>>06455000
   byte array string;                                          <<04801>>06460000
   option external;                                            <<04801>>06465000
                                                               <<04801>>06470000
                                                                        06475000
integer procedure get'dsdevice(ldev);                          <<04167>>06480000
value ldev;                                                    <<04167>>06485000
integer ldev;                                                  <<04167>>06490000
option external;                                               <<04167>>06495000
procedure lockseg(en,test,pinx);                               <<00575>>06500000
   value en,test,pinx;                                         <<00575>>06505000
   integer en,pinx;                                            <<00575>>06510000
   logical test;                                               <<00575>>06515000
   option external;                                            <<00575>>06520000
                                                               <<00575>>06525000
procedure unlockseg(en,test,pinx);                             <<00575>>06530000
   value en,test,pinx;                                         <<00575>>06535000
   integer en,pinx;                                            <<00575>>06540000
   logical test;                                               <<00575>>06545000
   option external;                                            <<00575>>06550000
                                                               <<00707>>06555000
procedure freeze(en,test,pinx);                                <<00707>>06560000
   value en,test,pinx;                                         <<00707>>06565000
   integer en,pinx;                                            <<00707>>06570000
   logical test;                                               <<00707>>06575000
   option external;                                            <<00707>>06580000
                                                               <<00707>>06585000
procedure unfreeze(en,test,pinx);                              <<00707>>06590000
   value en,test,pinx;                                         <<00707>>06595000
   integer en,pinx;                                            <<00707>>06600000
   logical test;                                               <<00707>>06605000
   option external;                                            <<00707>>06610000
                                                               <<00707>>06615000
procedure updatedisccopy(dstentry);                            <<01549>>06620000
value dstentry;                                                <<01549>>06625000
integer dstentry;                                              <<01549>>06630000
option external;                                               <<01549>>06635000
                                                               <<01549>>06640000
integer procedure convextlabeltodeltap(extlabel);              <<01549>>06645000
value extlabel;                                                <<01549>>06650000
integer extlabel;                                              <<01549>>06655000
option external;                                               <<01549>>06660000
                                                               <<01847>>06665000
procedure resetdispq;                                          <<01847>>06670000
option external;                                               <<01847>>06675000
                                                               <<01847>>06680000
procedure fprocterm;                                           <<01258>>06685000
   option external;                                            <<01258>>06690000
                                                               <<03519>>06695000
logical procedure create'dfs'data'seg (ldev, disc'label,       <<03519>>06700000
                        assume'dt'is'dirty, flag'dt'as'dirty); <<03519>>06705000
   value ldev, assume'dt'is'dirty, flag'dt'as'dirty;           <<03519>>06710000
   integer ldev;                                               <<03519>>06715000
   array disc'label;                                           <<03519>>06720000
   logical assume'dt'is'dirty, flag'dt'as'dirty;               <<03519>>06725000
   option external, variable;                                  <<03519>>06730000
                                                               <<03519>>06735000
procedure send'process'dfs'error (ldev, error'status,          <<03528>>06740000
                                  type'of'error);              <<03528>>06745000
   value ldev, error'status, type'of'error;                    <<03519>>06750000
   integer ldev;                                               <<03519>>06755000
   logical error'status;                                       <<03519>>06760000
   integer type'of'error;                                      <<03519>>06765000
   option external;                                            <<03519>>06770000
                                                               <<03519>>06775000
procedure delete'dfs'data'seg (ldev);                          <<03519>>06780000
   value ldev;                                                 <<03519>>06785000
   integer ldev;                                               <<03519>>06790000
   option external;                                            <<03519>>06795000
                                                               <<03519>>06800000
logical procedure deallocate'dfs'data'seg (ldev);              <<03519>>06805000
   value ldev;                                                 <<03519>>06810000
   integer ldev;                                               <<03519>>06815000
   option external;                                            <<03519>>06820000
                                                               <<06928>>06825000
procedure cache'ldev( ldev, stat );                            <<06928>>06830000
   value ldev;                                                 <<06928>>06835000
   integer ldev, stat;                                         <<06928>>06840000
option privileged, uncallable, external;                       <<06928>>06845000
                                                               <<06928>>06850000
procedure uncache'ldev( ldev, stat );                          <<06928>>06855000
   value ldev;                                                 <<06928>>06860000
   integer ldev, stat;                                         <<06928>>06865000
option privileged, uncallable, external;                       <<06928>>06870000
                                                               <<06928>>06875000
                                                               <<03519>>06880000
procedure loadprocedure(err,name,loadid,plabel,                <<06279>>06885000
                        option'nums,options);                  <<06279>>06890000
   byte array name;                                            <<06279>>06895000
   integer err,loadid,plabel;                                  <<06279>>06900000
   logical array options;                                      <<06279>>06905000
   integer array option'nums;                                  <<06279>>06910000
   option external,variable;                                   <<06279>>06915000
                                                               << 8229>>06920000
procedure check'filename(filename,length,iname,error);         << 8229>>06925000
   value filename, length;                                     << 8229>>06930000
   byte pointer filename;                                      << 8229>>06935000
   integer length, iname, error;                               << 8229>>06940000
   option external;                                            << 8229>>06945000
$page "ASSOCIATE TABLE MANIPULATION ROUTINES"                  <<01649>>06950000
$control segment=ophi                                                   06955000
integer procedure assoc'class(classname);                               06960000
integer array classname;                                                06965000
option uncallable,privileged;                                           06970000
begin                                                                   06975000
   integer array local'classname(0:7), assoc(0:ass'entrysize-1);        06980000
   integer array getclassbuf(0:130);                           <<06604>>06985000
   integer array classinfo(0:4); << holds getclass info>>      <<06604>>06990000
   logical pointer                                             <<06604>>06995000
      dct;   << space for array to be built on stack >>        <<06604>>07000000
   integer                                                     <<06604>>07005000
      entrylength;                                             <<06604>>07010000
                                                               <<06607>>07015000
   << ...................................................... >><<06607>>07020000
   <<        declarations for referencing the jmat           >><<06607>>07025000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>07030000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>07035000
   <<               a specific entry), after an exchange db. >><<06607>>07040000
   <<               or 0 if jmatarr is a local array.        >><<06607>>07045000
   << ...................................................... >><<06607>>07050000
   integer       jmatinx;  <<  index into jmatarr  >>          <<06607>>07055000
   integer array jmatarr(0:jmatentrysize-1);<< jmat entry>>    <<06607>>07060000
   byte array blocal'classname(*)=local'classname;                      07065000
   byte array assoc'(*)=assoc;                                          07070000
  integer match := 0;                                          <<06604>>07075000
   integer i:=0;                                                        07080000
   logical savesir;                                            <<01649>>07085000
   subroutine def'movefromdseg;                                         07090000
                                                                        07095000
   comment                                                              07100000
      this routine returns -1, if no such class                         07105000
                            0, if system console (no association)       07110000
                        ldev#, the output device of user associated to  07115000
                               device;                                  07120000
                                                                        07125000
   assoc'class:=-1;                                                     07130000
   move local'classname:=classname,(4);                                 07135000
   move blocal'classname:=blocal'classname while an,1;                  07140000
   move *:="       ";                                                   07145000
   if getclass(classinfo,false,,,local'classname) then         <<06604>>07150000
<< getclass (false) returns the following data structure>>     <<06604>>07155000
<< to classinfo:                                        >>     <<06604>>07160000
<<returnbuf - 0: segment relative address of entry      >>     <<06604>>07165000
<<            1: dct index of entry (entry #)           >>     <<06604>>07170000
<<            2: word 4 (5th word) of dct entry. contains>>    <<06604>>07175000
<<               cyclical ptr., class access type, sq bit>>    <<06604>>07180000
<<            3: mpe4: left byte is # of ldev's is class >>    <<06604>>07185000
<<               right byte is first ldev.               >>    <<06604>>07190000
<<               mpe5: # ldev's in class                 >>    <<06604>>07195000
<<            4: mpe4: see below                         >>    <<06604>>07200000
<<               mpe5: first ldev in class               >>    <<06604>>07205000
<<            4+ (mpe4) or 5+ (mpe5): returned if every- >>    <<06604>>07210000
<<               thing true.  remaining ldev's in class. >>    <<06604>>07215000
<<*******************************************************>>    <<06604>>07220000
                                                               <<06604>>07225000
   begin                                                                07230000
comment -- we need to access the list of ldev's in the         <<06604>>07235000
dct entry. unfortunately, the length of the list is            <<06604>>07240000
arbitrary and varies from entry to entry.  thus to make        <<06604>>07245000
a local copy of the entry, we must build space for it on       <<06604>>07250000
the stack.                                                     <<06604>>07255000
;  << end comment >>                                           <<06604>>07260000
                                                               <<06604>>07265000
<<  ======  build dct entry on stack  =========  >>            <<06604>>07270000
      push(s);                                                 <<06604>>07275000
      @dct := tos + 1;  <<traditions dictates the +1>>         <<06604>>07280000
      assemble (adds 6); <<add 6 words to stack >>             <<06604>>07285000
      movefromdseg(@dct,dct'dst,classinfo,6);<<get length>>    <<06604>>07290000
      entrylength := dct'words'in'entry;                       <<06604>>07295000
      assemble (subs 6);<< take away those 6 words >>          <<06604>>07300000
      tos := entrylength;  << now get whole entry >>           <<06604>>07305000
      assemble(adds 0 ); << hope stack has enough room>>       <<06604>>07310000
      movefromdseg(@dct,dct'dst,classinfo,entrylength);        <<06604>>07315000
<<   ========= now we have entry, point to devices ===== >>    <<06604>>07320000
                                                               <<06604>>07325000
      assoc'class:=0;  <<assume no association>>                        07330000
      savesir := getsir(ass'sir);  << lock assoc. table >>     <<01649>>07335000
      while (i:=i+1)<=integer(dct'num'devices) do <<scan list>><<06604>>07340000
      begin                                                             07345000
         movefromdseg(@assoc,ass'dst,dct(dct'first'ldev-1+i)*  <<06604>>07350000
                   ass'entrysize,                              <<06604>>07355000
            ass'entrysize);                                             07360000
         if assoc(ass'jit)<>0  and <<device is associated>>             07365000
            blocal'classname=assoc'(ass'class*2),(8)  <<same class>>    07370000
         then match:=match+1;                                           07375000
      end;                                                              07380000
      if match = integer(dct'num'devices)  then <<associated>> <<06604>>07385000
      begin                                                             07390000
         jmatinx := 0;  <<  we are grabbing the entry  >>      <<06607>>07395000
         <<  get the jmat entry  >>                            <<06607>>07400000
         movefromdseg(@jmatarr, jmatdst,                       <<06607>>07405000
                      assoc(ass'jmat)*jmatentrysize,           <<06607>>07410000
                      jmatentrysize);                          <<06607>>07415000
         assoc'class := jmatjlistdev;<<get user's output dev>> <<06607>>07420000
      end;                                                              07425000
   << don't release asoc. table until after getting >>         <<01649>>07430000
   << jmat entry to ensure its validity.            >>         <<01649>>07435000
      relsir(ass'sir,savesir);                                 <<01649>>07440000
   end;                                                                 07445000
end;                                                                    07450000
$page                                                          <<01115>>07455000
$control segment=oplow                                         <<01115>>07460000
                                                               <<01115>>07465000
integer procedure foreign(ldev);                               <<01115>>07470000
   value ldev;                                                 <<01115>>07475000
   integer ldev;                                               <<01115>>07480000
option uncallable;                                             <<04685>>07485000
   begin                                                       <<01115>>07490000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>07495000
                                                               <<01115>>07500000
      comment this procedure is called to force the            <<01115>>07505000
              disc volume mounted on device ldev to            <<01115>>07510000
              be recognized as a foreign volume.               <<01115>>07515000
              the value returned is an error code as           <<01115>>07520000
              follows:                                         <<01115>>07525000
                                                               <<01115>>07530000
              error      meaning                               <<01115>>07535000
                                                               <<01115>>07540000
                0        no error                              <<01115>>07545000
                1        volume is already foreign             <<01115>>07550000
                2        device is not a disc (type 0 or 2)    <<01115>>07555000
                3        no volume is mounted                  <<01115>>07560000
                4        volume is an in-use pv                <<01115>>07565000
                5        volume is an in-use serial disc       <<01115>>07570000
                6        ldev is in system domain              <<01115>>07575000
                7        disc can't be made foreign            <<03713>>07580000
                                                               <<01115>>07585000
      ;                                                        <<01115>>07590000
                                                               <<01115>>07595000
      double status;                                           <<01115>>07600000
      logical status1=status,                                  <<01115>>07605000
              status2=status+1;                                <<01115>>07610000
      define nreadyf=(14:1)#;                                  <<01115>>07615000
                                                               <<01115>>07620000
      integer array ldt(0:size'of'ldt'entry-1);                <<06604>>07625000
      integer                                                  <<06604>>07630000
         ldt'index,                                            <<06604>>07635000
         ldtx'index;                                           <<06604>>07640000
      integer array ldtx(0:size'of'ldtx'entry-1);              <<06604>>07645000
      equate linus = 0,       <<type 3,subtype 0 >>            <<03713>>07650000
             hp7911= 1,       <<type 3,subtype 1 >>            <<03713>>07655000
             hp7912= 2;       <<type 3,subtype 2 >>            <<03713>>07660000
                                                               <<03713>>07665000
                                                               <<01115>>07670000
                                                               <<01115>>07675000
      equate nsd=1;   << nsdf value for non-sys domain >>      <<01115>>07680000
                                                               <<01115>>07685000
      integer type,           << device type >>                <<03713>>07690000
              subtype;        << device subtype >>             <<03713>>07695000
subroutine def'movefromdseg;                                   <<06604>>07700000
                                                               <<01115>>07705000
      subroutine getldtxent;                                   <<01115>>07710000
         begin << fetch ldtx entry for ldev >>                 <<01115>>07715000
  <<             go to the ldtx                          >>    <<06604>>07720000
  <<                                                     >>    <<06604>>07725000
         movefromdseg(@ldt,ldt'dst,0,size'of'ldt'entry);       <<06604>>07730000
         tos:=@ldtx;                                          <<<06604>>07735000
         tos:=ldtdst;                                          <<01115>>07740000
         tos:=ldtx'base +                                      <<06604>>07745000
              ldev * size'of'ldtx'entry;                       <<06604>>07750000
         tos:=size'of'ldtx'entry;                              <<06604>>07755000
         assemble(mfds 4);                                     <<01115>>07760000
         end;                                                  <<01115>>07765000
                                                               <<01115>>07770000
       lpdt'index := ldev * size'of'lpdt'entry;                <<07185>>07775000
                                                               <<01115>>07780000
      type:=ldevtotype(ldev);                                  <<01115>>07785000
      subtype := ldevtosubtype(ldev);                          <<03713>>07790000
                                                               <<03713>>07795000
      if type <> 0 and type <> 2 and type <> 3 then            <<03713>>07800000
         begin                                                 <<01115>>07805000
         foreign:=2;  << not a disc device >>                  <<01115>>07810000
         return;                                               <<01115>>07815000
         end;                                                  <<01115>>07820000
                                                               <<01115>>07825000
      if type = 3 and (subtype = linus lor                     <<03713>>07830000
                       subtype = hp7911 lor                    <<03713>>07835000
                       subtype = hp7912) then                  <<03713>>07840000
         begin                                                 <<03713>>07845000
         foreign := 7;  <<cant make disc foreign >>            <<03713>>07850000
         return;                                               <<03713>>07855000
         end;                                                  <<03713>>07860000
                                                               <<03713>>07865000
      if lpdt'non'sys'domain <> nsd then                       <<06221>>07870000
         begin                                                 <<01115>>07875000
         foreign:=6;                                           <<01115>>07880000
         return;                                               <<01115>>07885000
         end;                                                  <<01115>>07890000
                                                               <<01115>>07895000
      status:=reqstatus(ldev);                                 <<01115>>07900000
      if status2.nreadyf then                                  <<01115>>07905000
         begin                                                 <<01115>>07910000
         foreign:=3;  << no volume mounted >>                  <<01115>>07915000
         return;                                               <<01115>>07920000
         end;                                                  <<01115>>07925000
                                                               <<01115>>07930000
      if lpdt'mounted'pv = 1 then                              <<06221>>07935000
         begin                                                 <<01115>>07940000
         foreign:=4;  << in use pv >>                          <<01115>>07945000
         return;                                               <<01115>>07950000
         end;                                                  <<01115>>07955000
                                                               <<01115>>07960000
      getldtxent;                                              <<01115>>07965000
      if ldtx'sdisc'gpt'xds <> 0 and                           <<06604>>07970000
         lpdt'rdy'ser'frn'disc = 1 and                         <<06221>>07975000
         lpdt'serial'or'foreign = 0 then                       <<06221>>07980000
         begin                                                 <<01115>>07985000
           foreign:=5;   << in use serial disc >>              <<01115>>07990000
           return;                                             <<01115>>07995000
         end;                                                  <<01115>>08000000
                                                               <<01115>>08005000
      if lpdt'rdy'ser'frn'disc = 1 and                         <<06221>>08010000
         lpdt'serial'or'foreign = 1 then                       <<06221>>08015000
         begin                                                 <<01115>>08020000
           foreign:=1;   << already foreign >>                 <<01115>>08025000
           return;                                             <<01115>>08030000
         end;                                                  <<01115>>08035000
                                                               <<01115>>08040000
      foreign:=0;    << no error >>                            <<01115>>08045000
      lpdt'rdy'ser'frn'disc:=1;                                <<06221>>08050000
      lpdt'serial'or'foreign:=1;                               <<06221>>08055000
                                                               <<01115>>08060000
   end; <<foreign>>                                            <<01115>>08065000
$page                                                                   08070000
$control segment=ophi                                                   08075000
logical procedure checkass(ldev,assent);                                08080000
value ldev; logical ldev;                                               08085000
integer array assent;                                                   08090000
option privileged,uncallable,variable;                                  08095000
begin                                                                   08100000
   comment                                                              08105000
      this routine checks to see whether the user has "ASSOCIATE"d      08110000
      the device "LDEV".  it returns true if yes, otherwise false.      08115000
      the routine returns the associate table assent if 'assent' is     08120000
      specified, regardless of whether checkass is true or false.       08125000
   ;                                                                    08130000
   integer array ass'entry(0:ass'entrysize-1);                          08135000
   logical pmask=q-4;      <<parameter mask>>                           08140000
   define assent'mask=pmask.(15:1)#; <<assent parameter mask>>          08145000
   logical savesir;                                            <<01649>>08150000
   array qarray(*) = q + 0;                                    <<06605>>08155000
   integer pcbglobloc;                                         <<06605>>08160000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>08165000
   subroutine def'movefromdseg;                                         08170000
                                                                        08175000
   lpdt'index:=ldev*logical(lpdt'entry'size);                  <<06221>>08180000
   checkass:=false;                                                     08185000
   if ldev > logical(lpdt'max'entries) then return;<<bad ldev>><<06221>>08190000
   if ldev < 1 then return;   << bad ldev # >>                 <<01649>>08195000
   savesir := getsir(ass'sir);   << lock assoc. table >>       <<01649>>08200000
   pxglobal;                                                   <<06605>>08205000
tos := pxg'jitdst;                                             <<06605>>08210000
   movefromdseg(@ass'entry,ass'dst,ldev*ass'entrysize,ass'entrysize);   08215000
   if tos=ass'entry(ass'jit) then checkass:=true;                       08220000
   if assent'mask then move assent:=ass'entry,(ass'entrysize);          08225000
   relsir(ass'sir,savesir);      << release table >>           <<01649>>08230000
end;                                                                    08235000
$page                                                                   08240000
$control segment=ophi                                                   08245000
logical procedure addass(jitdstno,jmatinx,ldev,classname);              08250000
value jitdstno,ldev,jmatinx;                                            08255000
logical jitdstno,ldev,jmatinx;                                          08260000
byte array classname;                                                   08265000
option privileged,uncallable;                                           08270000
begin                                                                   08275000
   comment                                                              08280000
      this routines adds an entry to the associate table.               08285000
      'jitdstno' is the user's jit's dst #.                             08290000
      'jmatinx' is the job's jmat index as per pcbx global.             08295000
      'LDEV" IS THE LOGICAL DEVICE TO BE 'ASSOCIATE'D.                  08300000
      addass returns a value of true, if entry successfully built.      08305000
      if it returns false, then the entry was already in use.           08310000
   ;                                                                    08315000
   logical savesir,assinx;                                              08320000
   logical array ass'entry(0:ass'entrysize-1)=q;                        08325000
   byte array ass'entry'(*)=ass'entry;                                  08330000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>08335000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>08340000
   subroutine def'movefromdseg;                                         08345000
   subroutine def'movetodseg;                                           08350000
   lpdt'index:=ldev*logical(lpdt'entry'size);                  <<06221>>08355000
                                                                        08360000
   addass:=false;       <<initialize routine return value>>             08365000
   if ldev > logical(lpdt'max'entries) then return;<<bad ldev>><<06221>>08370000
   if ldev < 1 then return;   << bad ldev # >>                 <<01649>>08375000
   savesir:=getsir(ass'sir); <<obtain associate table's sir>>           08380000
   assinx:=ldev*ass'entrysize;  <<index into associate table new entry>>08385000
   movefromdseg(@ass'entry,ass'dst,assinx,ass'entrysize);               08390000
   if ass'entry=0 then   <<entry is available>>                         08395000
   begin                                                                08400000
      addass:=true;                                                     08405000
      ass'entry(ass'jit):=jitdstno; <<build entry>>                     08410000
      ass'entry(ass'jmat):=jmatinx;                                     08415000
      move ass'entry'(ass'class*2):="        ";                         08420000
      move ass'entry'(ass'class*2):=classname while an;                 08425000
      movefromdseg(@jitarr,jitdstno,0,jit'entry'size);         <<06924>>08430000
      ass'entry(ass'next):=jitassocindex;                      <<06924>>08435000
      jitassocindex:=assinx;                                   <<06924>>08440000
                                                                        08445000
         <<update user's associate chain,starting at jit+5>>            08450000
                                                                        08455000
      movetodseg(jitdstno,0,@jitarr,jit'entry'size);           <<06924>>08460000
      movetodseg(ass'dst,assinx,@ass'entry,ass'entrysize);              08465000
   end;                                                                 08470000
   relsir(ass'sir,savesir);                                             08475000
end;                                                                    08480000
$page                                                                   08485000
$control segment=ophi                                                   08490000
integer procedure delass(assinx,jitinx);                                08495000
value assinx,jitinx;                                                    08500000
logical assinx,jitinx;                                                  08505000
option privileged,uncallable;                                           08510000
begin                                                                   08515000
   comment                                                              08520000
      this routine delete the specific associate entry for the specified08525000
      entry.  the criteria for the deletion are as follows:             08530000
         1) the specified user must own the entry,                      08535000
         2) the specified entry must be on the specified user's         08540000
            associate chain that starts in his jit                      08545000
      'assinx' is the index into the associate table                    08550000
      'jitinx' is the user's jit's dst #                                08555000
      the return value implies the following:                           08560000
         -1 => user does not own entry                                  08565000
         0  => entry deleted is last in user's associate chain          08570000
         >1 => is the associate index to the entry following the        08575000
            deleted entry.                                              08580000
      this routine assumes running on user's stack!                     08585000
   ;                                                                    08590000
   logical savesir,i,j;                                                 08595000
   logical array ass'entry(0:ass'entrysize-1)=q;                        08600000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>08605000
   integer local'delass=delass;                                         08610000
   subroutine def'movefromdseg;                                         08615000
   subroutine def'movetodseg;                                           08620000
                                                                        08625000
   delass:=-1;       <<initialize routine's return value>>              08630000
   savesir:=getsir(ass'sir);  <<get associate table's sir>>             08635000
   movefromdseg(@ass'entry,ass'dst,assinx,ass'entrysize);               08640000
   if ass'entry(ass'jit)=jitinx then   <<delete is user owns it>>       08645000
   begin                                                                08650000
      delass:=ass'entry(ass'next);                                      08655000
      movefromdseg(@jitarr,jitinx,0,jit'entry'size);           <<06924>>08660000
      i:=jitassocindex;                                        <<06924>>08665000
      if i=assinx then  <<entry being deleted is head entry>>           08670000
         begin                                                 <<06924>>08675000
         jitassocindex:=ass'entry(ass'next);                   <<06924>>08680000
         movetodseg(jitinx,0,@jitarr,jit'entry'size);          <<06924>>08685000
         end                                                   <<06924>>08690000
      else                                                              08695000
                                                                        08700000
 <<chase down assoc. chain until find entry pointing at deleted entry>> 08705000
                                                                        08710000
      begin                                                             08715000
         do                                                             08720000
         begin                                                          08725000
            j:=i;                                                       08730000
            movefromdseg(@i,ass'dst,j+ass'next,1);             <<01649>>08735000
         end until i=0 or i=assinx;                                     08740000
         if i<>0 then  movetodseg(ass'dst,j+ass'next,          <<01649>>08745000
                                  @ass'entry(ass'next),1)      <<01649>>08750000
         else delass:=-1;  <<entry not on user's associate chain>>      08755000
      end;                                                              08760000
   end;                                                                 08765000
   if local'delass>=0 then <<has been successfully unlinked, so delete>>08770000
   begin                                                                08775000
   << zero entry up to but not including classname. >>         <<01649>>08780000
      move ass'entry := ass'class(0);                          <<01649>>08785000
      movetodseg(ass'dst,assinx,@ass'entry,ass'entrysize);              08790000
   end;                                                                 08795000
   relsir(ass'sir,savesir); <<release associate table's sir>>           08800000
end;                                                                    08805000
$page                                                                   08810000
$control segment=ophi                                                   08815000
logical procedure chk'ass'security(jitinx,ldev,classname);              08820000
value jitinx,ldev;                                                      08825000
integer jitinx,ldev;                                                    08830000
byte array classname;                                                   08835000
option privileged,uncallable;                                           08840000
begin                                                                   08845000
   comment                                                              08850000
      this routine verifys the user's privilege to associate            08855000
   a particular device.                                                 08860000
      it returns true if he(she) has access otherwise false.            08865000
      'jitinx' is the dst # of his(her) jit.                            08870000
      'ldev' is the logical device # he(she) wishes to associate.       08875000
      as usual must not be called in split stack mode.                  08880000
   ;                                                                    08885000
   array assoc'entry(0:asf'entrysize-1)=q;                              08890000
   byte array assoc'username(*)=assoc'entry(asf'username);              08895000
   byte array assoc'acctname(*)=assoc'entry(asf'acctname);              08900000
   byte array assoc'class(*)=assoc'entry(asf'class);                    08905000
   array username(0:3)=q,acctname(0:3)=q;                               08910000
   byte array username'(*)=username, acctname'(*)=acctname;             08915000
   array assfilename(0:8);                                              08920000
   integer assfile,i;                                                   08925000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>08930000
                                                                        08935000
   subroutine def'movefromdseg;                                         08940000
   logical subroutine matched;                                          08945000
   begin                                                                08950000
      matched:=false;                                                   08955000
      if (assoc'username="@       " or                                  08960000
          assoc'username=username',(8)) and                             08965000
         (assoc'acctname="@       " or                                  08970000
          assoc'acctname=acctname',(8)) and                             08975000
          assoc'class=classname,(8) then matched:=true;                 08980000
   end;                                                                 08985000
                                                                        08990000
   logical subroutine readrec(recno);                                   08995000
   value recno; integer recno;                                          09000000
   begin                                                                09005000
      freaddir(assfile,assoc'entry,asf'entrysize,double(recno));        09010000
      if <> then                                                        09015000
      begin                                                             09020000
         ferror'(assfile,i);                                            09025000
         readrec:=false;                                                09030000
      end                                                               09035000
      else readrec:=true;                                               09040000
   end;                                                                 09045000
$page                                                                   09050000
   chk'ass'security:=false;                                             09055000
   move assfilename:="ASOCIATE.PUB.SYS ";                               09060000
   assfile:=fopen(assfilename,%2001,%306);<<share,execute,no fileq>>    09065000
   if <> then ferror'(assfile,i) <<report open error>>                  09070000
   else                                                                 09075000
   if 1<=ldev<=999 then <<if valid associate file ldev, do serach>>     09080000
   begin                                                                09085000
         movefromdseg(@jitarr,jitinx,0,jit'entry'size);        <<06924>>09090000
         move username(0):=jitusername,(4);                    <<06924>>09095000
         move acctname(0):=jithacctname,(4);                   <<06924>>09100000
      if readrec(ldev) then <<successfully read 1st entry>>             09105000
         if assoc'entry<>0 then <<1st entry has valid association>>     09110000
search:                                                                 09115000
            if not (chk'ass'security:=matched) then <<no match>>        09120000
               if assoc'entry(asf'nextentry)<>0 then <<other entries>>  09125000
               if readrec(assoc'entry(asf'nextentry)) then go to search;09130000
   end;                                                                 09135000
   fclose(assfile,0,0);                                                 09140000
end;                                                                    09145000
$page "VERIFY MASTER OPERATOR STATUS"                                   09150000
$control segment=ophi                                                   09155000
logical procedure masterop;                                             09160000
option privileged,uncallable;                                           09165000
begin                                                                   09170000
   comment                                                              09175000
      this routine returns true if the user is the master operator      09180000
      otherwise it returns false                                        09185000
   ;                                                                    09190000
   array qarray(*) = q + 0;                                    <<06605>>09195000
   integer pcbglobloc;                                         <<06605>>09200000
                                                                        09205000
   pxglobal;                                                   <<06605>>09210000
   masterop:= (pxg'inputldev = sys'console'ldev);              <<06923>>09215000
end;                                                                    09220000
$page "MISCELLANEOUS GENERAL ROUTINES"                                  09225000
$control segment=ophi                                                   09230000
logical procedure checkallow(mask);                                     09235000
value mask; logical mask;                                               09240000
option uncallable,privileged;                                           09245000
begin                                                                   09250000
   comment                                                              09255000
      this routine tells whether or not this user has been 'allowed'    09260000
   to do this command or is the masterop.  it returns true if yes,      09265000
   else false.  'mask' is the operator command mask.                    09270000
   as usual no split stack mode calls, please!                          09275000
   ;                                                                    09280000
   integer array allowmask(0:jit'allow'mask'length-1);         <<06924>>09285000
   array qarray(*) = q + 0;                                    <<06605>>09290000
   integer pcbglobloc;                                         <<06605>>09295000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>09300000
   integer jit'dst;                                            <<06924>>09305000
   subroutine def'movefromdseg;                                         09310000
                                                                        09315000
                                                               <<06928>>09320000
   pxglobal;                                                   <<06924>>09325000
   jit'dst:=pxg'jitdst;                                        <<06924>>09330000
   movefromdseg(@jitarr,jit'dst,0,jit'entry'size);             <<06924>>09335000
   move allowmask(0):=jitallowmask,(jit'allow'mask'length);    <<06924>>09340000
   << the (9:3) field of the mask is the index into the     >> <<06925>>09345000
   << allowmask where the bit for the mask is found.  the   >> <<06925>>09350000
   << number represented by the (12:4) field of the mask is >> <<06925>>09355000
   << the bit in that indexed word of the allowmask showing >> <<06925>>09360000
   << whether or not this user is allowed the command       >> <<06925>>09365000
   if masterop or ((allowmask(mask.(9:3))&lsl(mask.(12:4)))< 0)<<06925>>09370000
      then checkallow:=true;                                   <<06925>>09375000
end;                                                                    09380000
$page                                                          <<00635>>09385000
$control segment=ophi                                          <<00635>>09390000
logical procedure verify'mastop'c(classname);                <<sp.14>>  09395000
integer array classname;                                       <<00635>>09400000
option uncallable,privileged;                                  <<00635>>09405000
begin                                                          <<00635>>09410000
   comment                                                     <<00635>>09415000
      this routine verify that when the masterop uses a command<<00635>>09420000
      dealing with classes and that class is currently associated       09425000
      that the masterop really intends his action by prompting <<00635>>09430000
      the masterop for verification if any ldev in that class is        09435000
      associated.                                              <<00635>>09440000
                                                               <<00635>>09445000
      the routine returns true if masterop and he fails to verify his   09450000
      action.                                                  <<00635>>09455000
**** warning: ldt sir must be locked externally ****           <<04174>>09460000
   ;                                                           <<00635>>09465000
   array ass'entry(0:ass'entrysize-1)=q,username(0:4)=q,acctname(0:4)=q;09470000
   logical                                                     <<01649>>09475000
      savesir;                                                 <<01649>>09480000
   integer                                                     <<01649>>09485000
      errnum;   << error number for stdin error >>             <<01649>>09490000
   logical yesno; byte yesno'=yesno;                           <<00635>>09495000
   byte array username'(*)=username,acctname'(*)=acctname;     <<00635>>09500000
    integer ldev;                                              <<00635>>09505000
    integer array getclassbuf(0:130);                          <<00635>>09510000
    byte array b'classname(*) = classname;                     <<00635>>09515000
    array qarray(*) = q + 0;                                   <<06605>>09520000
    integer pcbglobloc;                                        <<06605>>09525000
<< ******* caution:  change getclass'first'ldev to be  >>      <<06604>>09530000
 <<        defined as getclass1stldev  =  4   #; for   >>      <<06604>>09535000
<<         mpe v.                                      >>      <<06604>>09540000
                                                               <<06604>>09545000
    define getclass1stldev     = 4#;                           <<06604>>09550000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>09555000
                                                               <<00635>>09560000
   subroutine def'movefromdseg;                                <<00635>>09565000
                                                               <<00635>>09570000
   verify'mastop'c :=false;                                    <<00635>>09575000
   if masterop then                                            <<00635>>09580000
   begin                                                       <<00635>>09585000
      pxglobal;                                                <<06605>>09590000
      getclass(getclassbuf,false,,,classname);                 <<06604>>09595000
      ldev := getclassbuf(getclass1stldev);     << 1st ldev>>  <<06604>>09600000
      savesir := getsir(ass'sir);                              <<01649>>09605000
      movefromdseg(@ass'entry,ass'dst,ldev*ass'entrysize,ass'entrysize);09610000
      relsir(ass'sir,savesir);                                 <<01649>>09615000
      if pxg'jitdst<>ass'entry(ass'jit) and ass'entry(ass'jit) <<06605>>09620000
                                            <> 0 then          <<06605>>09625000
      begin                                                    <<00635>>09630000
      movefromdseg(@jitarr,ass'entry(ass'jit),0,               <<06924>>09635000
                           jit'entry'size);                    <<06924>>09640000
      move username(0):=jitusername,(4);                       <<06924>>09645000
      move acctname(0):=jithacctname,(4);                      <<06924>>09650000
         username(4):=acctname(4):=0;                          <<00635>>09655000
         move username':=username' while an,1;                 <<00635>>09660000
         bps0:=0; <<terminate with zero after non-alphanumeric>>        09665000
         move acctname':=acctname' while an,1;                 <<00635>>09670000
         bps0:=0; <<terminate with zero after non-alphanumeric>>        09675000
         ddel;                                                 <<00635>>09680000
                                                               <<00635>>09685000
<< tell masterop about associated user and require y/n response>>       09690000
                                                               <<00635>>09695000
promtop:                                                       <<00635>>09700000
         genmsg(cigeneralmsgset,otheruserhasclass,0,           <<00635>>09705000
               @username',@acctname',@b'classname,,,0,,,,[1/1,15/0]);   09710000
         readx(yesno,-1); <<get y/n>>                          <<00635>>09715000
         if <> then     << error on $stdin >>                  <<01649>>09720000
            begin                                              <<01649>>09725000
            if > then                                          <<01649>>09730000
               errnum := errstdineof                           <<01649>>09735000
            else                                               <<01649>>09740000
               errnum := errstdinio;                           <<01649>>09745000
            print(yesno,0,0);   << generate cr/lf >>           <<01649>>09750000
            genmsg(cierrmsgset,errnum);  << report error  >>   <<01649>>09755000
            verify'mastop'c := true;  << op not confirmed >>   <<01649>>09760000
            genmsg(cigeneralmsgset,opnotdone);                 <<01649>>09765000
            return;                                            <<01649>>09770000
            end;                                               <<01649>>09775000
         if yesno'="Y" or yesno'="y" then return               <<00635>>09780000
         else                                                  <<00635>>09785000
         if yesno'<>"N" and yesno'<>"n" then go to promtop     <<00635>>09790000
         else                                                  <<00635>>09795000
         begin                                                 <<00635>>09800000
            verify'mastop'c:=true;                             <<00635>>09805000
            genmsg(cigeneralmsgset,opnotdone);                 <<00635>>09810000
         end;                                                  <<00635>>09815000
      end;                                                     <<00635>>09820000
   end;                                                        <<00635>>09825000
end;                                                           <<00635>>09830000
$page                                                                   09835000
$control segment=ophi                                                   09840000
logical procedure verify'masterop(ldev);                                09845000
value ldev; integer ldev;                                               09850000
option uncallable,privileged;                                           09855000
begin                                                                   09860000
   comment                                                              09865000
      this routine verify that when the masterop uses a command         09870000
      dealing with devices and that device is currently associated      09875000
      that the masterop really intends his action by prompting          09880000
      the masterop for verification.                                    09885000
                                                                        09890000
      the routine returns true if masterop and he fails to verify his   09895000
      action.                                                           09900000
   ;                                                                    09905000
   array ass'entry(0:ass'entrysize-1)=q,username(0:4)=q,acctname(0:4)=q;09910000
   logical                                                     <<01649>>09915000
      savesir;                                                 <<01649>>09920000
   integer                                                     <<01649>>09925000
      errnum;   << error number for stdin error >>             <<01649>>09930000
   logical yesno; byte yesno'=yesno;                                    09935000
   byte array username'(*)=username,acctname'(*)=acctname;              09940000
   array qarray(*) = q + 0;                                    <<06605>>09945000
   integer pcbglobloc;                                         <<06605>>09950000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>09955000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>09960000
   subroutine def'movefromdseg;                                         09965000
                                                                        09970000
   lpdt'index:=ldev*integer(lpdt'entry'size);                  <<06221>>09975000
   verify'masterop:=false;                                              09980000
<< if ldev is not valid, then no need to prompt operator. >>   <<01649>>09985000
   if ldev > integer(lpdt'max'entries) then return;<<bad ldev>><<06221>>09990000
   if ldev < 1  then return;                                   <<01649>>09995000
                                                               <<01649>>10000000
   if masterop then                                                     10005000
   begin                                                                10010000
      savesir := getsir(ass'sir);                              <<01649>>10015000
      movefromdseg(@ass'entry,ass'dst,ldev*ass'entrysize,ass'entrysize);10020000
      relsir(ass'sir,savesir);                                 <<01649>>10025000
      pxglobal;                                                <<06605>>10030000
      if pxg'jitdst<>ass'entry(ass'jit) and                    <<06605>>10035000
         ass'entry(ass'jit)<>0 then                            <<06605>>10040000
      begin                                                             10045000
         movefromdseg(@jitarr,ass'entry(ass'jit),0,            <<06924>>10050000
                              jit'entry'size);                 <<06924>>10055000
         move username(0):=jitusername,(4);                    <<06924>>10060000
         move acctname(0):=jithacctname,(4);                   <<06924>>10065000
         username(4):=acctname(4):=0;                                   10070000
         move username':=username' while an,1;                          10075000
         bps0:=0; <<terminate with zero after non-alphanumeric>>        10080000
         move acctname':=acctname' while an,1;                          10085000
         bps0:=0; <<terminate with zero after non-alphanumeric>>        10090000
         ddel;                                                          10095000
                                                                        10100000
<< tell masterop about associated user and require y/n response>>       10105000
                                                                        10110000
promtop:                                                                10115000
         genmsg(cigeneralmsgset,otheruserhasdev,[1/0,3/0,3/0,3/1,6/0],  10120000
               @username',@acctname',ldev,,,0,,,,[1/1,15/0]);           10125000
         readx(yesno,-1); <<get y/n>>                                   10130000
         if <> then     << error on $stdin >>                  <<01649>>10135000
            begin                                              <<01649>>10140000
            if > then                                          <<01649>>10145000
               errnum := errstdineof                           <<01649>>10150000
            else                                               <<01649>>10155000
               errnum := errstdinio;                           <<01649>>10160000
            print(yesno,0,0);   << generate cr/lf >>           <<01649>>10165000
            genmsg(cierrmsgset,errnum);   << report error >>   <<01649>>10170000
            verify'masterop := true;  << op not confirmed >>   <<01649>>10175000
            genmsg(cigeneralmsgset,opnotdone);                 <<01649>>10180000
            return;                                            <<01649>>10185000
            end;                                               <<01649>>10190000
         if yesno'="Y" or yesno'="y" then return                        10195000
         else                                                           10200000
         if yesno'<>"N" and yesno'<>"n" then go to promtop              10205000
         else                                                           10210000
         begin                                                          10215000
            verify'masterop:=true;                                      10220000
            genmsg(cigeneralmsgset,opnotdone);                          10225000
         end;                                                           10230000
      end;                                                              10235000
   end;                                                                 10240000
end;                                                                    10245000
$page                                                                   10250000
$control segment=ophi                                                   10255000
integer procedure checkjob(jmatentry,pri);                     <<04684>>10260000
array jmatentry;                                                        10265000
integer pri;               << used with call from cxaltjob  >> <<04684>>10270000
option uncallable,privileged,variable;                         <<04684>>10275000
begin                                                                   10280000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>10285000
   integer jit'dstn;                                           <<06924>>10290000
   integer temppri;                                            <<04684>>10295000
   logical pmap= q-4;      << parameter bit map >>             <<04684>>10300000
   integer array jmatheader(0:jmatheadersize-1);               <<06607>>10305000
                                                               <<06607>>10310000
   << ...................................................... >><<06607>>10315000
   <<        declarations for referencing the jmat           >><<06607>>10320000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>10325000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>10330000
   <<               a specific entry), after an exchange db. >><<06607>>10335000
   <<               or 0 if jmatarr is a local array.        >><<06607>>10340000
   << ...................................................... >><<06607>>10345000
   integer       jmatinx;  << index into jmatarr  >>           <<06607>>10350000
   integer array jmatarr(*);<< array for jmat access>>         <<06607>>10355000
   logical notequal;                                           <<06924>>10360000
   logical array ucapptr(0:1);                                 <<06924>>10365000
   logical array acctname(0:3);                                <<06924>>10370000
   logical array username(0:3);                                <<06924>>10375000
   integer i;                                                           10380000
   array qarray(*) = q + 0;                                    <<06605>>10385000
   integer pcbglobloc;                                         <<06605>>10390000
   comment                                                              10395000
      this procedure check to see if the user is the 'owner' of the     10400000
   job specified by the jmatentry.  'owner' means the same account if   10405000
   the user has 'am' capability and same account & user if otherwise.   10410000
    the routine returns 0 if if he is the owner and the        <<04684>>10415000
    jobsecurity is low, it returns 2 if it is the same         <<04684>>10420000
    account and user but has an inpri of 0 or 14 without him   <<04684>>10425000
    having am capability and returns a 1 otherwise.            <<04684>>10430000
                                                               <<06607>>10435000
      fix note:  note that jmatarr is used to index            <<06607>>10440000
                 into two different arrays in this procedure.  <<06607>>10445000
                 first it is equivalenced to jmatheader then to<<06607>>10450000
                 jmatentry. this is necessary since the include<<06607>>10455000
                 file for the jmat exclusively references      <<06607>>10460000
                 jmatarr.                                      <<06607>>10465000
   ;                                                                    10470000
   subroutine def'movefromdseg;                                         10475000
logical subroutine samename(a,b);                              <<06607>>10480000
value a,b; integer pointer a,b;                                <<06607>>10485000
begin                                                          <<06607>>10490000
  comment                                                      <<06607>>10495000
    this subroutine will return true if the two input four word<<06607>>10500000
    strings pointed to by a and b are equal.  otherwise it retu<<06607>>10505000
    false.                                                     <<06607>>10510000
  ;                                                            <<06607>>10515000
   i:=-1;                                                      <<06607>>10520000
   samename := true;                                           <<06607>>10525000
   while (i := i+1) < 4 do                                     <<06607>>10530000
     if a(i) <> b(i) then                                      <<06607>>10535000
     begin                                                     <<06607>>10540000
       samename := false;                                      <<06607>>10545000
       return;                                                 <<06607>>10550000
     end;                                                      <<06607>>10555000
end; << samename >>                                            <<06607>>10560000
                                                               <<06607>>10565000
   checkjob := 1;                                              <<04684>>10570000
   if not pmap.(15:1)<<true if parameter pri wasnt passed in >><<04684>>10575000
      then temppri := 8<<dummy value that will have no effect>><<04684>>10580000
      else temppri := pri;                                     <<04684>>10585000
   jmatinx := 0; <<  we have only one entry  >>                <<06607>>10590000
   @jmatarr := @jmatheader;<< jmatarr indexes into header >>   <<06607>>10595000
   movefromdseg(@jmatarr, jmatdst, 0, jmatheadersize);         <<06607>>10600000
   if jmatjobsec <> jobsecurity'low   then return;             <<06607>>10605000
   pxglobal;                                                   <<06605>>10610000
   jit'dstn:=pxg'jitdst;                                       <<06924>>10615000
   movefromdseg(@jitarr,jit'dstn,0,jit'entry'size);            <<06924>>10620000
   move ucapptr:=jitusercaps,(2);                              <<06924>>10625000
   @jmatarr := @jmatentry;    << jmatarr indexes into entry >> <<06607>>10630000
   if samename(jithacctname,jmatacctname)                      <<06924>>10635000
   then    << it is the same account >>                        <<06607>>10640000
   if ucapam then checkjob := 0 <<has am capability>>                   10645000
   else                                                                 10650000
   begin                                                                10655000
      if samename(jitusername,jmatusername)                    <<06924>>10660000
         then if 1<= temppri <= 13                             <<04684>>10665000
                 then checkjob := 0                            <<04684>>10670000
                 else checkjob := 2                            <<04684>>10675000
         else checkjob := 1;                                   <<04684>>10680000
   end;                                                                 10685000
end;                                                                    10690000
$page                                                                   10695000
$control segment=ophi                                                   10700000
integer procedure verify'rldev(parm,len,errnum,parmnum,parameternum);   10705000
value parameternum,len;                                                 10710000
integer errnum,parmnum,parameternum,len;                                10715000
byte array parm;                                                        10720000
option uncallable,privileged;                                           10725000
begin                                                                   10730000
   comment                                                              10735000
      this routine verifys that the ascii string contained in 'parm'    10740000
   is a 'real' device in this configuration of the operating system.    10745000
   'parm' is a byte array containing an ascii string of length 'len'.   10750000
   'errnum' is set to the error num, if an error is found.              10755000
   'parmnum' is set to 'parameternum' if an error is found.             10760000
   the condition code is set equal if ok, otherwise less than.          10765000
   as usual split stack mode is not allowed!                            10770000
   ;                                                                    10775000
   integer ldev=verify'rldev;                                           10780000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>10785000
                                                                        10790000
   cc:=ccl;                                                             10795000
   verify'rldev:=binary(parm,len);  <<convert string to binary>>        10800000
   if <> or ldev< 1 then <<not valid logical device #>>                 10805000
   begin                                                                10810000
      parmnum:=parameternum;                                            10815000
      cierr(errnum:=expldevbad,parm); <<report bad logical dev #>>      10820000
   end                                                                  10825000
   else                                                                 10830000
   if ldev > integer(lpdt'max'entries) then                    <<06221>>10835000
   begin                                                                10840000
      parmnum:=parameternum;                                            10845000
      cierr(errnum:=ldevnotconfig,parm,%10000,                          10850000
             lpdt'max'entries);                                <<06221>>10855000
   end                                                                  10860000
   else                                                                 10865000
   begin                                                       <<06221>>10870000
   lpdt'index:=ldev*integer(lpdt'entry'size);                  <<06221>>10875000
   if lpdt'virtual'device = 1 then << ldev not real >>         <<06221>>10880000
   begin                                                                10885000
      parmnum:=parameternum;                                            10890000
      cierr(errnum:=ldevnotreal,parm,%10000,ldev);                      10895000
   end                                                                  10900000
   else                                                        <<*8612>>10905000
   if lpdt'dit'ptr = 0 then  << not configured >>              <<*8612>>10910000
      begin                                                    <<*8612>>10915000
      parmnum := parameternum;                                 <<*8612>>10920000
      cierr(errnum := nosuchldev,parm);                        <<*8612>>10925000
      end                                                      <<*8612>>10930000
   else cc:=cce                                                <<06221>>10935000
   end; << begin >>                                            <<06221>>10940000
end;                                                                    10945000
$page "CHECK'IF'SYS'DISC'OR'PV"                                <<03519>>10950000
$control segment=oplow                                         <<03519>>10955000
integer procedure check'if'sys'disc'or'pv (ldev,               <<03519>>10960000
                                           ldt);               <<06604>>10965000
   value ldev;                                                          10970000
   integer ldev;                                                        10975000
   array ldt;                                                  <<06604>>10980000
                                                                        10985000
<<=============================================================         10990000
                                                                        10995000
      this procedure determines if a device is a system disc            11000000
   or a private volume.                                                 11005000
                                                                        11010000
   parameters:                                                          11015000
      ldev - logical device number of the device.                       11020000
      ldt'entry - logical device table entry for the device.            11025000
                                                                        11030000
   returns:                                                             11035000
      0 - not a system disc of private volume.                          11040000
      1 - system disc.                                                  11045000
      2 - private volume.                                               11050000
                                                                        11055000
                                                                        11060000
   assumptions on entry:                                                11065000
      db is at the stack.                                               11070000
                                                                        11075000
   exit conditions:                                                     11080000
      db is unchanged.                                                  11085000
                                                                        11090000
   globals:                                                             11095000
                                                                        11100000
      input:                                                            11105000
         lpdt                                                           11110000
                                                                        11115000
      equates:                                                          11120000
         vtab'dst                                                       11125000
         vtab'entry'size                                                11130000
                                                                        11135000
      defines:                                                          11140000
         def'movefromdseg                                               11145000
         ldt'dtype                                                      11150000
         ld'vtabx                                                       11155000
         vtab'non'sys'domain                                            11160000
         lpdt'pv                                                        11165000
         lpdt'sd                                                        11170000
         vtab'scratch                                                   11175000
         vtab'unreadable                                                11180000
         vtab'ldev                                                      11185000
                                                                        11190000
   externals:                                                           11195000
      none.                                                             11200000
                                                                        11205000
   intrinsics:                                                          11210000
      none.                                                             11215000
                                                                        11220000
   callers:                                                             11225000
      cxup (cxdown)                                                     11230000
                                                                        11235000
   fix id:                                                              11240000
         this procedure was added as part of the new disc               11245000
      free space map changes.  the fix number on the                    11250000
      procedure header applies to the whole procedure.                  11255000
                                                                        11260000
   changes:                                                             11265000
                                                                        11270000
                                                                        11275000
==============================================================>>        11280000
                                                                        11285000
begin                                                                   11290000
                                                                        11295000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>11300000
   integer vtab'index;  << index into volume table >>                   11305000
integer                                                        <<06604>>11310000
   ldt'index := 0;                                             <<06604>>11315000
   array vtab'entry (0:vtab'entry'size-1);  << entry in vtab >>         11320000
                                                                        11325000
   integer return'value = check'if'sys'disc'or'pv;                      11330000
                                                                        11335000
   subroutine def'movefromdseg;                                         11340000
                                                                        11345000
   << - - - - - - - - - - >>                                            11350000
                                                                        11355000
   << first check if it is a disc >>                                    11360000
                                                                        11365000
   lpdt'index:=ldev*integer(lpdt'entry'size);                  <<06221>>11370000
   if ldt'device'type >= 8 then                                <<06604>>11375000
      return'value := 0  << not a disc >>                               11380000
                                                                        11385000
   else                                                                 11390000
      begin  << a disc >>                                               11395000
                                                                        11400000
         << get volume table entry >>                                   11405000
                                                                        11410000
         vtab'index := ldt'volume'tbl'index;                   <<06604>>11415000
                                                                        11420000
         movefromdseg (@vtab'entry, vtab'dst,                           11425000
               vtab'index * vtab'entry'size, vtab'entry'size);          11430000
                                                                        11435000
         if vtab'entry (vtab'ldev) = 0 then                             11440000
            return'value := 0   << drive off-line >>                    11445000
                                                                        11450000
         else                                                           11455000
            if vtab'entry (vtab'non'sys'domain) = 0 then                11460000
               return'value := 1  << a system disc >>                   11465000
                                                                        11470000
            else                                                        11475000
               if lpdt'non'sys'domain   = 1 and                <<06221>>11480000
                  lpdt'rdy'ser'frn'disc  = 0 and               <<06221>>11485000
               vtab'entry (vtab'scratch) = 0 and                        11490000
               vtab'entry (vtab'unreadable) = 0 then                    11495000
                  return'value := 2  << private volume >>               11500000
                                                                        11505000
               else                                                     11510000
                  return'value := 0;  << who knows >>                   11515000
                                                                        11520000
      end;   << a disc >>                                               11525000
                                                                        11530000
end;  << check'if'sys'disc'or'pv >>                                     11535000
$page                                                          <<01258>>11540000
$control segment=ophi                                          <<01258>>11545000
procedure close'files;                                         <<01258>>11550000
option privileged,uncallable;                                  <<01258>>11555000
begin                                                          <<01258>>11560000
   << procedure to close any open files a process might have >><<01258>>11565000
   << before being adopted by progen.  procedure adopt       >><<01258>>11570000
   << builds a stack marker on the adoptee's stack which     >><<01258>>11575000
   << forces the adoptee to execute this procedure before    >><<01258>>11580000
   << adoption is complete and adopt returns to its caller.  >><<01258>>11585000
                                                               <<01258>>11590000
  logical pcbpt;                                               <<06606>>11595000
   equate fatherwait = 1,   sonwait = 2;                       <<01258>>11600000
   fprocterm;     << fclose any open standard files >>         <<01258>>11605000
                                                               <<01258>>11610000
   pcbpt := curprc;                                            <<06606>>11615000
   pcbpt := spcbfatherinfo;                                    <<06606>>11620000
                                                               <<01258>>11625000
   awake(pcbpt,sonwait,fatherwait);                            <<06606>>11630000
end << close'files >>;                                         <<01258>>11635000
$control segment=ophi                                                   11640000
$page "ADOPT -- ADOPT CREATED PROCESS TO ANOTHER PROCESS"               11645000
integer procedure adopt(adoptee,adopter);                               11650000
value adoptee,adopter;                                                  11655000
integer adoptee,adopter;                                                11660000
option privileged,uncallable;                                           11665000
begin                                                                   11670000
   equate sysprogenpcbpt=%1141,                                <<01549>>11675000
          progen=3;                                            <<01549>>11680000
   define                                                      <<01673>>11685000
      progeninx = absolute(sysprogenpcbpt)#,                   <<01673>>11690000
      progenpin = progeninx/pcbsize#;                          <<06933>>11695000
                                                                        11700000
                                                                        11705000
<<  adoptee's pcbx global & fixed area>>                                11710000
                                                                        11715000
   integer array a'pcbx(0:pxg'size+fixedsize-1);               <<06605>>11720000
   integer array a'pcbxglob(*)=a'pcbx;                                  11725000
   integer array a'pcbxfixed(*)=a'pcbx(pxg'size);              <<06605>>11730000
                                                                        11735000
<<  progen's pcbx global & fixed area>>                                 11740000
                                                                        11745000
   integer array p'pcbx(0:pxg'size+fixedsize-1);               <<06605>>11750000
   integer array p'pcbxglob(*)=p'pcbx;                                  11755000
   integer array p'pcbxfixed(*)=p'pcbx(pxg'size);              <<06605>>11760000
                                                                        11765000
                                                                        11770000
   integer stk,i,new'father,adtinx,old'father,index,oldindex;           11775000
                                                               <<01258>>11780000
   double stack'db;  <<db bank & db address in stack>>         <<01258>>11785000
   integer db'bank = stack'db,                                 <<01258>>11790000
           db'addr = stack'db + 1,                             <<01258>>11795000
           dbptr,                                              <<01258>>11800000
           srel'value;                                         <<01258>>11805000
                                                               <<01258>>11810000
   logical cstnum;                                             <<01258>>11815000
   integer jnumandtype;                                        <<06605>>11820000
                                                               <<01258>>11825000
   logical array stk'marker(0:5);                              <<01258>>11830000
   equate fatherwait = 1,   sonwait = 2;                       <<01258>>11835000
                                                                        11840000
   define pdisable=assemble(psdb)#,  <<pseudo disable>>                 11845000
          penable=assemble(pseb)#;   <<pseudo enable>>                  11850000
                                                                        11855000
   integer x=x;                                                         11860000
                                                                        11865000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>11870000
                                                                        11875000
   equate jxrefdst=50;              <<job xref table dst #>>            11880000
   array qarray(*);                                            <<06605>>11885000
   integer pcbglobloc,pxfixedloc;                              <<06605>>11890000
                                                                        11895000
   subroutine movefromdseg(target,dstn,offset,count);                   11900000
   value target,dstn,offset,count;                                      11905000
   logical target,dstn,offset,count;                                    11910000
   begin                                                                11915000
      x:=tos;                                                           11920000
      assemble(mfds 0);                                                 11925000
      tos:=x;                                                           11930000
   end;                                                                 11935000
                                                                        11940000
   subroutine movetodseg(dstn,offset,source,count);                     11945000
   value dstn,offset,source,count;                                      11950000
   logical dstn,offset,source,count;                                    11955000
   begin                                                                11960000
      x:=tos;                                                           11965000
      assemble(mtds 0);                                                 11970000
      tos:=x;                                                           11975000
   end;                                                                 11980000
                                                                        11985000
   pxfixedloc:=0;                                              <<06935>>11990000
   pcbglobloc := 0;                                            <<06605>>11995000
   adopt:=0;        <<initialize return value>>                         12000000
   <<progen's pin is no longer 3. calling procedures should>>  <<01549>>12005000
   <<be changed to look up progen's pin as is done here. for>> <<01549>>12010000
   <<now, a kludge.>>                                          <<01549>>12015000
   if adopter = progen then                                    <<01673>>12020000
      adopter := progenpin     << this is the kludge. >>       <<01673>>12025000
   else                                                        <<01673>>12030000
      if adopter <> progenpin then                             <<01673>>12035000
      begin  << for now, only legal adopter is progen >>       <<01673>>12040000
         adopt := 1;                                           <<01673>>12045000
         return;                                               <<01673>>12050000
      end;                                                     <<01673>>12055000
                                                               <<01673>>12060000
   new'father := adopter * pcbsize; << newfather pcb index >>  <<06606>>12065000
   adtinx := adoptee * pcbsize; << adoptee pcb index >>        <<06606>>12070000
   pdisable;                                                            12075000
   old'father := lpcb(adtinx+fatherinfowordnum);               <<06606>>12080000
if old'father = new'father then                                << 9088>>12085000
   begin        << already a father & son >>                   << 9088>>12090000
   penable;                                                    << 9088>>12095000
   return;      << no need to do anything further >>           << 9088>>12100000
   end;                                                        << 9088>>12105000
   stk := lpcb(adtinx+stkinfowordnum).stkdstfield;             <<06935>>12110000
   if lpcb(old'father + procstatewordnum).systemprocflag <> 0  <<06606>>12115000
   then begin << old father is a system process >>             <<06606>>12120000
      adopt := 2; penable; return;                                      12125000
   end;                                                                 12130000
   penable;                                                    <<01258>>12135000
                                                               <<01258>>12140000
                                                               <<01258>>12145000
<< if adopter process is system process, need to have >>       <<01258>>12150000
<< adoptee process close open standard files, if they >>       <<01258>>12155000
<< are open                                           >>       <<01258>>12160000
   if lpcb(new'father + procstatewordnum).systemprocflag <> 0  <<06606>>12165000
   then begin << new father is a system process >>             <<06606>>12170000
      <<get db bank, db address, & s rel ptr from adoptee stk>><<01258>>12175000
      movefromdseg(@dbptr,stk,pxg'reldb'offset,1);             <<06605>>12180000
      movefromdseg(@srel'value,stk,pxg'size+relsoffset,1);     <<06605>>12185000
      movefromdseg(@stack'db,stk,dbptr+srel'value,2);          <<01258>>12190000
                                                               <<01258>>12195000
      <<build stack marker to close'files>>                    <<01258>>12200000
      cstnum := @close'files.(8:8);                            <<01258>>12205000
      stk'marker(0) := 0;                  <<x reg>>           <<01258>>12210000
      stk'marker(1) := convextlabeltodeltap(@close'files);     <<01549>>12215000
      stk'marker(2) := %160000 lor cstnum; <<status reg>>      <<01258>>12220000
      stk'marker(3) := 4;                  <<delta q>>         <<01258>>12225000
      stk'marker(4) := db'bank;            <<db bank for ixit>><<01258>>12230000
      stk'marker(5) := db'addr;            <<db addr for ixit>><<01258>>12235000
                                                               <<01258>>12240000
      <<put stack marker on adoptee's stack & adjust srel>>    <<01258>>12245000
      movetodseg(stk, dbptr+srel'value-1, @stk'marker, 6);     <<01258>>12250000
      srel'value := srel'value + 4;                            <<01258>>12255000
      movetodseg(stk,pxg'size+relsoffset,@srel'value,1);       <<06605>>12260000
                                                               <<01258>>12265000
      <<allow adoptee to close open standard files before    >><<01258>>12270000
      <<continuing adoption.                                 >><<01258>>12275000
      awake(adoptee * pcbsize,fatherwait,sonwait);             <<06606>>12280000
   end;                                                        <<01258>>12285000
                                                               <<01258>>12290000
   pdisable;                                                   <<01258>>12295000
   index := lpcb(old'father+soninfowordnum);                   <<06606>>12300000
<<  remote adoptee from his old father's process tree>>                 12305000
   if index=adtinx then <<adoptee is father's 1st son>>                 12310000
      lpcb(old'father+soninfowordnum) :=                       <<06606>>12315000
      lpcb(adtinx+brotherinfowordnum)                          <<06606>>12320000
   else                                                                 12325000
   begin   <<adoptee is a brother of father's 1st son>>                 12330000
      do index := lpcb((oldindex := index)+brotherinfowordnum) <<06606>>12335000
      until index=adtinx;  <<scan brother chain until adoptee found>>   12340000
      lpcb(oldindex + brotherinfowordnum) :=                   <<06606>>12345000
        lpcb(adtinx + brotherinfowordnum);                     <<06606>>12350000
   end;                                                                 12355000
   penable;                                                             12360000
                                                                        12365000
   movefromdseg(@a'pcbx,stk,0,pxg'size+                        <<06605>>12370000
               fixedsize);<< adoptee's pcbxglob and fixed >>   <<06605>>12375000
                                                                        12380000
   movefromdseg(@p'pcbx,lpcb(new'father+stkinfowordnum)        <<06606>>12385000
               .stkdstfield,0,pxg'size+                        <<06935>>12390000
                fixedsize); << progen's pcbxglob and fixed >>  <<06605>>12395000
                                                                        12400000
   << update process creation count in jit>>                            12405000
                                                                        12410000
   @qarray := @a'pcbxglob;                                     <<06605>>12415000
   movefromdseg(@jitarr,pxg'jitdst,0,jit'entry'size);          <<06924>>12420000
   if jitnumcreations <> 0 then                                <<06924>>12425000
   begin                                                                12430000
      jitnumcreations:=jitnumcreations-1;                      <<06924>>12435000
      movetodseg(pxg'jitdst,0,@jitarr,jit'entry'size);         <<06924>>12440000
   end;                                                                 12445000
   @qarray := @p'pcbxglob;                                     <<06605>>12450000
   movefromdseg(@jitarr,pxg'jitdst,0,jit'entry'size);          <<06924>>12455000
   jitnumcreations:=jitnumcreations+1;                         <<06924>>12460000
   movetodseg(pxg'jitdst,0,@jitarr,jit'entry'size);            <<06924>>12465000
                                                                        12470000
<< update job cross reference table>>                                   12475000
                                                                        12480000
   @qarray := @p'pcbxfixed;                                    <<06935>>12485000
   jnumandtype := pxfxjobnum;                                  <<06935>>12490000
   jnumandtype.(0:2) := pxfxjobtype;                           <<06935>>12495000
   movetodseg(jxrefdst,adoptee,@jnumandtype,1);                <<06935>>12500000
                                                                        12505000
<< update job process count table >>                                    12510000
                                                                        12515000
   <<no code is here as the table isn't currently being maintained>>    12520000
   <<by mpe.>>                                                          12525000
                                                                        12530000
<< update job#/job type in adoptee's pcbxfixed area>>                   12535000
                                                                        12540000
   jnumandtype := pxfxjobnum;                                  <<06605>>12545000
   jnumandtype.(0:2) := pxfxjobtype;                           <<06605>>12550000
   @qarray := @a'pcbxfixed;                                    <<06605>>12555000
   pxfxjobnum := jnumandtype;                                  <<06605>>12560000
                                                                        12565000
<< update adoptee's pcbxglob area to reflect adopter's job>>            12570000
                                                                        12575000
   move a'pcbxglob(2) := p'pcbxglob(2),(pxg'size-2);           <<06605>>12580000
                                                                        12585000
<< if adopter process is system process, need to make this new>>        12590000
<< son a system process>>                                      <<01200>>12595000
                                                                        12600000
   if lpcb(new'father+procstatewordnum).systemprocflag <> 0    <<06606>>12605000
      then begin << system process >>                          <<06606>>12610000
      lpcb(adtinx+procstatewordnum).systemprocflag:= 1;        <<06606>>12615000
   end;                                                                 12620000
                                                                        12625000
<< now ready to link the adoptee into adopter process structure>>       12630000
                                                                        12635000
   movetodseg(stk,0,@a'pcbx,pxg'size+fixedsize);               <<06605>>12640000
   pdisable;                                                            12645000
   lpcb(adtinx+brotherinfowordnum) :=                          <<06606>>12650000
   lpcb(new'father+soninfowordnum);                            <<06606>>12655000
   lpcb(new'father+soninfowordnum):=adoptee * pcbsize;         <<06606>>12660000
   lpcb(adtinx+fatherinfowordnum) := adopter * pcbsize;        <<06606>>12665000
   penable;                                                             12670000
                                                                        12675000
<< at this point everything is done.>>                                  12680000
<< this process cannot be activated by the creating process,>>          12685000
<< but rather must be awaken via awake(adoptee,1)>>                     12690000
                                                                        12695000
   end;                                                                 12700000
                                                                        12705000
$page "MISCELLANEOUS GENERAL ROUTINES"                                  12710000
$control segment=ophi                                                   12715000
procedure suspendjob(mainpin,errnum);                                   12720000
value mainpin;                                                          12725000
integer mainpin,errnum;                                                 12730000
option uncallable,privileged;                                           12735000
begin                                                                   12740000
   comment                                                              12745000
      this procedure takes all the processes related to a job in or     12750000
   out of hybernation depending on whether we're suspending or          12755000
   resuming the job                                                     12760000
   ;                                                                    12765000
   entry resumejob;                                                     12770000
   logical suspend:=true;                                               12775000
equate dispq=1,                                                <<01549>>12780000
       endofclass=0;                                           <<01549>>12785000
logical pcbpt;                                                 <<06606>>12790000
double savedb;                                                 <<01549>>12795000
   integer nextpin;                                                     12800000
                                                                        12805000
<<suspendjob entry point>>                                              12810000
   go to maincode;                                                      12815000
                                                                        12820000
<<resumejob entry point>>                                               12825000
resumejob:                                                              12830000
   suspend:=false;                                                      12835000
                                                                        12840000
maincode:                                                               12845000
   nextpin:=mainpin;                                                    12850000
   pseudodisable;     <<disallow process switching>>                    12855000
tos:=%1000d;                                                   <<01549>>12860000
assemble(xchd);                                                <<01549>>12865000
savedb:=tos;                                                   <<01549>>12870000
   pcbpt := mainpin * pcbsize;                                 <<06606>>12875000
   if procstate.aliveflag = 0 then errnum := jobinterm         <<06606>>12880000
   else                                                                 12885000
   begin                                                                12890000
      if spcbsoninfo <> 0 then                                 <<06606>>12895000
      while (nextpin:=family(nextpin,mainpin))<>mainpin                 12900000
      do begin                                                 <<06606>>12905000
      pcbpt := nextpin * pcbsize;                              <<06606>>12910000
      if procstate.aliveflag = 1 or not suspend then           <<06606>>12915000
      begin                                                             12920000
                                                                        12925000
<< change its progeny's state and put him on ready list if resuming>>   12930000
                                                                        12935000
         if suspend then  set'psif(pcbpt,4) <<hybernate proc>> <<06606>>12940000
         else clear'psif(pcbpt,4); << awaken ci >>             <<06606>>12945000
      end;                                                              12950000
                                                                        12955000
     end;                                                      <<06606>>12960000
<< change main pin's state and put him on ready list if resuming>>      12965000
                                                                        12970000
      if suspend then set'psif(mainpin*pcbsize,4) <<hybernate ci>>      12975000
      else clear'psif(mainpin*pcbsize,4); <<awaken ci>>        <<01986>>12980000
   end;                                                                 12985000
   tos:=savedb;                                                <<01549>>12990000
   assemble(xchd;ddel);                                        <<01549>>12995000
   pseudoenable;                                                        13000000
end;                                                                    13005000
$page                                                                   13010000
$control segment=ophi                                                   13015000
logical procedure findjob(jmatentry,entryp,jobnum,job,jname,uname,aname 13020000
                          ,sir);                                        13025000
value jobnum,job;                                                       13030000
integer array jmatentry,jname,uname,aname;                              13035000
integer jobnum,sir,entryp;                                              13040000
logical job;                                                            13045000
option privileged,uncallable,variable;                                  13050000
begin                                                                   13055000
   comment                                                              13060000
      this routine searches the jmat for the specified job.             13065000
      the job may be specified in several ways:                         13070000
         1) the job # or session # may be specified                     13075000
         2) the jobname, username, and account name may be specified.   13080000
      the routine leaves the sir locked on the jmat if the specified    13085000
      job is found and returns a value of true.  if not found the       13090000
      jmat sir is released and a value of false is returned.            13095000
      additionally the jmat entry is returned in the calling parameter  13100000
      'jmatentry'                                                       13105000
                                                                        13110000
      ***warning***                                                     13115000
      while this routine is option variable, it makes no validity       13120000
      check on the consistency of which parameters are specified.       13125000
      if the search is a type 1) search then the following should be    13130000
      specified:                                                        13135000
         jmatentry,entryrp,jobnum,job                                   13140000
      if the search is a type 2) search, then the following should be   13145000
      specified:                                                        13150000
         jmatentry,entryp,jname,uname,aname                             13155000
      the search type is differentiated by whether 'jobnum' is specified13160000
                                                               <<06607>>13165000
      fix note:  note that jmatarr is used to index            <<06607>>13170000
                 into two different arrays in this procedure.  <<06607>>13175000
                 first it is equivalenced to jmatheader then to<<06607>>13180000
                 jmatentry. this is necessary since the include<<06607>>13185000
                 file for the jmat exclusively references      <<06607>>13190000
                 jmatarr.                                      <<06607>>13195000
   ;                                                                    13200000
   logical parmmask=q-4;   <<parameter mask>>                           13205000
   define jobnummask=(11:1)#;                                           13210000
   logical local'findjob=findjob;                                       13215000
                                                               <<06607>>13220000
   << ...................................................... >><<06607>>13225000
   <<        declarations for referencing the jmat           >><<06607>>13230000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>13235000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>13240000
   <<               a specific entry), after an exchange db. >><<06607>>13245000
   <<               or 0 if jmatarr is a local array.        >><<06607>>13250000
   << ...................................................... >><<06607>>13255000
                                                               <<06607>>13260000
   integer       jmatinx;                                      <<06607>>13265000
   integer array jmatheader(0:jmatheadersize-1);                        13270000
   integer array jmatarr(*);<< array for jmat access >>        <<06607>>13275000
   integer lastp;                                                       13280000
   integer i;                                                  <<00654>>13285000
   subroutine def'movefromdseg;                                         13290000
logical subroutine samename(a,b);                              <<06607>>13295000
value a,b; integer pointer a,b;                                <<06607>>13300000
begin                                                          <<06607>>13305000
  comment                                                      <<06607>>13310000
    this subroutine will return true if the two input four word<<06607>>13315000
    strings pointed to by a and b are equal.  otherwise it retu<<06607>>13320000
    false.                                                     <<06607>>13325000
  ;                                                            <<06607>>13330000
   i:=-1;                                                      <<06607>>13335000
   samename := true;                                           <<06607>>13340000
   while (i := i+1) < 4 do                                     <<06607>>13345000
     if a(i) <> b(i) then                                      <<06607>>13350000
     begin                                                     <<06607>>13355000
       samename := false;                                      <<06607>>13360000
       return;                                                 <<06607>>13365000
     end;                                                      <<06607>>13370000
end; << samename >>                                            <<06607>>13375000
                                                               <<06607>>13380000
   findjob:=false;                                                      13385000
   @jmatarr := @jmatheader;<< index into the jmat header >>    <<06607>>13390000
   sir:=getsir(jmatsir);                                                13395000
   jmatinx := 0;  <<  we have only one entry  >>               <<06607>>13400000
   movefromdseg(@jmatarr,jmatdst,0,jmatheadersize);            <<06607>>13405000
   entryp := jmatentryptr; << pointer to first jmat entry >>   <<06607>>13410000
   lastp :=   jmatcursize * 128                                <<06607>>13415000
            - jmatentrysize; << pointer to last entry >>       <<06607>>13420000
   do                                                                   13425000
   begin     <<begin scan of jmat entries>>                             13430000
      @jmatarr := @jmatentry; << index into jmat entry >>      <<06607>>13435000
      movefromdseg(@jmatarr, jmatdst, entryp, jmatentrysize);  <<06607>>13440000
      if jmatarr <> 0 then <<valid entry>>                     <<06607>>13445000
      if parmmask.jobnummask then <<search by jobnum>>                  13450000
         if jobnum = integer(jmatjsno) then <<correct #>>      <<06607>>13455000
            if job then <<searching for job>>                           13460000
               if jmatjstype = jobtype'job then findjob:=true  <<06607>>13465000
               else                                                     13470000
            else        <<searching for session>>                       13475000
               if jmatjstype = jobtype'session then            <<06607>>13480000
                  findjob:=true                                         13485000
               else                                                     13490000
         else                                                           13495000
      else <<searching by jobname,accountname, username>>               13500000
      begin                                                    <<00664>>13505000
      findjob:=true;                                           <<00654>>13510000
      if not (samename(jmatusername, uname))    or             <<06607>>13515000
         not (samename(jmatacctname, aname))    or             <<06607>>13520000
         not (jname(0)="  ")                    and            <<06607>>13525000
         not (samename(jmatjobname, jname))                    <<06607>>13530000
      then findjob:=false;                                     <<00654>>13535000
      end;                                                     <<00664>>13540000
   end                                                                  13545000
   until local'findjob or                                               13550000
      (entryp:=entryp + jmatentrysize) > lastp;                <<06607>>13555000
   if not local'findjob then relsir(jmatsir,sir);                       13560000
end;                                                                    13565000
$control segment=oplow                                         <<07283>>13570000
procedure cxcachecontrol executorhead;                         <<07283>>13575000
                                                               <<07283>>13580000
<<                                                          >> <<07283>>13585000
<< this is the command executor for cachecontrol.  the      >> <<07283>>13590000
<< syntax of the command is:                                >> <<07283>>13595000
<<                                                          >> <<07283>>13600000
<<                {blockonwrite={yes/no}}                   >> <<07283>>13605000
<<  :cachecontrol {sequential=n         } [;...[;...]]      >> <<07283>>13610000
<<                {random=n             }                   >> <<07283>>13615000
<<  where n is between 1 and 96                             >> <<07283>>13620000
<<                                                          >> <<07283>>13625000
                                                               <<07283>>13630000
begin                                                          <<07283>>13635000
                                                               <<07283>>13640000
integer                                                        <<07283>>13645000
   stat,         << status from cachecontrol executors >>      <<07283>>13650000
   rndval,       << value for random fetch             >>      <<07283>>13655000
   seqval,       << value for sequential fetch         >>      <<07283>>13660000
   i,            << counter and index for loop         >>      <<07283>>13665000
   curlen,       << length of current parm             >>      <<07283>>13670000
   curdelim,     << index number of current delimiter  >>      <<07283>>13675000
   numparms;     << number of parameter found          >>      <<07283>>13680000
                                                               <<07283>>13685000
logical                                                        <<07283>>13690000
   postval,      << if true, wants to block on write   >>      <<07283>>13695000
   rnd,          << true if random parm is specified   >>      <<07283>>13700000
   post,         << true if blockonwrite parm is spec. >>      <<07283>>13705000
   seq;          << true is sequential parm is spec.   >>      <<07283>>13710000
                                                               <<07283>>13715000
byte pointer                                                   <<07283>>13720000
   curptr;       << pointer to current parameter       >>      <<07283>>13725000
                                                               <<07283>>13730000
double array                                                   <<07283>>13735000
   parm(0:maximumparms);                                       <<07283>>13740000
                                                               <<07283>>13745000
logical array                                                  <<07283>>13750000
   parml(*) = parm;                                            <<07283>>13755000
                                                               <<07283>>13760000
                                                               <<07283>>13765000
subroutine set'parm'info(i);                                   <<07283>>13770000
value i;                                                       <<07283>>13775000
integer i;                                                     <<07283>>13780000
begin                                                          <<07283>>13785000
<< this subroutine sets the cur variables to access the     >> <<07283>>13790000
<< next parameter as specified in the return array from     >> <<07283>>13795000
<< mycommand.                                               >> <<07283>>13800000
<< i is the logical index to the array returned by mycommand>> <<07283>>13805000
<< since the array returned by mycommand is a double, i must>> <<07283>>13810000
<< be 2 * the parameter number that is currently being      >> <<07283>>13815000
<< processed.                                               >> <<07283>>13820000
                                                               <<07283>>13825000
   @curptr := parml(i*2);                                      <<07283>>13830000
   curdelim := parml((i*2)+1).delim'ext;                       <<07283>>13835000
   curlen := parml((i*2)+1).len'ext;                           <<07283>>13840000
end;  << set'parm'info >>                                      <<07283>>13845000
                                                               <<07283>>13850000
                                                               <<07283>>13855000
subroutine do'sequential(i);                                   <<07283>>13860000
value i;                                                       <<07283>>13865000
integer i;                                                     <<07283>>13870000
begin                                                          <<07283>>13875000
  if seq  << already called >>                                 <<07283>>13880000
     then cierr(errnum:=-ccontrol'same'parm,curptr);           <<07283>>13885000
  set'parm'info(i+1);                                          <<07283>>13890000
  seqval := binary(curptr,curlen);                             <<07283>>13895000
  if <> then                                                   <<07283>>13900000
  begin                                                        <<07283>>13905000
    parmnum := i;                                              <<07283>>13910000
    cierr(errnum := ccontrol'invalid'number,curptr);           <<07283>>13915000
    end;                                                       <<07283>>13920000
  if errnum <= 0 and (seqval < 1 or seqval > 96) then          <<07283>>13925000
  begin                                                        <<07283>>13930000
    parmnum := i;                                              <<07283>>13935000
    cierr(errnum := ccontrol'exp'between'1'and'96,parmsp);     <<07283>>13940000
  end;                                                         <<07283>>13945000
  seq := true;                                                 <<07283>>13950000
end; << do'sequential >>                                       <<07283>>13955000
                                                               <<07283>>13960000
subroutine do'random(i);                                       <<07283>>13965000
value i;                                                       <<07283>>13970000
integer i;                                                     <<07283>>13975000
begin                                                          <<07283>>13980000
  if rnd << already called >>                                  <<07283>>13985000
  then cierr(errnum:=-ccontrol'same'parm,curptr);              <<07283>>13990000
  set'parm'info(i+1);                                          <<07283>>13995000
  rndval := binary(curptr,curlen);                             <<07283>>14000000
  if <> then                                                   <<07283>>14005000
  begin                                                        <<07283>>14010000
    parmnum := i;                                              <<07283>>14015000
    cierr(errnum := ccontrol'invalid'number,curptr);           <<07283>>14020000
    end;                                                       <<07283>>14025000
  if errnum <= 0 and (rndval < 1 or rndval > 96) then          <<07283>>14030000
  begin                                                        <<07283>>14035000
    parmnum := i;                                              <<07283>>14040000
    cierr(errnum := ccontrol'exp'between'q'and'96,parmsp);     <<07283>>14045000
  end;                                                         <<07283>>14050000
  rnd := true;                                                 <<07283>>14055000
end; << do'random >>                                           <<07283>>14060000
                                                               <<07283>>14065000
subroutine do'blockonwrite(i);                                 <<07283>>14070000
value i;                                                       <<07283>>14075000
integer i;                                                     <<07283>>14080000
begin                                                          <<07283>>14085000
  if post then  << already called >>                           <<07283>>14090000
     begin                                                     <<07283>>14095000
       cierr(errnum:=-ccontrol'same'parm,curptr);              <<07283>>14100000
       return;                                                 <<07283>>14105000
     end;                                                      <<07283>>14110000
  set'parm'info(i+1);                                          <<07283>>14115000
  if curlen = 2 and curptr ="NO"                               <<07283>>14120000
     then postval := 0                                         <<07283>>14125000
  else                                                         <<07283>>14130000
  if curlen = 3 and curptr = "YES"                             <<07283>>14135000
     then postval := -1                                        <<07283>>14140000
  else                                                         <<07283>>14145000
  begin                                                        <<07283>>14150000
    parmnum := i;                                              <<07283>>14155000
    cierr(errnum:=ccontrol'exp'yes'or'no,curptr);              <<07283>>14160000
    return;                                                    <<07283>>14165000
  end;                                                         <<07283>>14170000
  post := true;                                                <<07283>>14175000
end; << do'blockonwrite >>                                     <<07283>>14180000
                                                               <<07283>>14185000
                                                               <<07283>>14190000
                                                               <<07283>>14195000
<< initializations >>                                          <<07283>>14200000
seq := false;                                                  <<07283>>14205000
rnd := false;                                                  <<07283>>14210000
post := false;                                                 <<07283>>14215000
errnum := 0;                                                   <<07283>>14220000
                                                               <<07283>>14225000
seqval := 0;                                                   <<07283>>14230000
rndval := 0;                                                   <<07283>>14235000
postval := false;                                              <<07283>>14240000
                                                               <<07283>>14245000
  mycommand(parmsp,,maximumparms+1,numparms,parm);             <<07283>>14250000
                                                               <<07283>>14255000
  << must have at least 1 parameter >>                         <<07283>>14260000
  if numparms < 1 then                                         <<07283>>14265000
  begin                                                        <<07283>>14270000
    cierr(errnum:=ccontrol'needs'1'or'more'parms,parmsp);      <<07283>>14275000
    return;                                                    <<07283>>14280000
  end;                                                         <<07283>>14285000
                                                               <<07283>>14290000
  << can't have more than x parms >>                           <<07283>>14295000
  if numparms > maximumparms then                              <<07283>>14300000
  begin                                                        <<07283>>14305000
    @parmsp := parml(maximumparms*2);                          <<07283>>14310000
    parmnum := maximumparms;                                   <<07283>>14315000
    cierr(errnum:=ccontrol'has'only'x'parms,parmsp);           <<07283>>14320000
    return;                                                    <<07283>>14325000
  end;                                                         <<07283>>14330000
                                                               <<07283>>14335000
  << set up counter for loop >>                                <<07283>>14340000
  i := -2;                                                     <<07283>>14345000
                                                               <<07283>>14350000
  << this procedure is written assuming that there will be  >> <<07283>>14355000
  << more parameters added in the future.  for each paramter>> <<07283>>14360000
  << added later, add the check to see if the parm matches  >> <<07283>>14365000
  << keyword name.  then add the subroutine to process that >> <<07283>>14370000
  << parameter.                                             >> <<07283>>14375000
  while (errnum <= 0) and ((i := i + 2) < numparms) do         <<07283>>14380000
  << we add 2 to i each time because we process 2 parms each>> <<07283>>14385000
  << time through the loop.                                 >> <<07283>>14390000
                                                               <<07283>>14395000
  begin                                                        <<07283>>14400000
                                                               <<07283>>14405000
    set'parm'info(i);                                          <<07283>>14410000
                                                               <<07283>>14415000
    << the only valid delimiter between the keyword and the >> <<07283>>14420000
    << value is an equal "=" sign.                          >> <<07283>>14425000
    if curdelim <> equalsign then                              <<07283>>14430000
    begin                                                      <<07283>>14435000
      parmnum := i+1;                                          <<07283>>14440000
      cierr(errnum:=ccontrol'expect'equalsign,curptr);         <<07283>>14445000
      return;                                                  <<07283>>14450000
    end;                                                       <<07283>>14455000
                                                               <<07283>>14460000
    << lets see if the first parm is good.  if it is then   >> <<07283>>14465000
    << try to process it.                                   >> <<07283>>14470000
    if curptr = "SEQUENTIAL" and curlen = 10                   <<07283>>14475000
       then do'sequential(i)                                   <<07283>>14480000
    else if curptr = "RANDOM" and curlen = 6                   <<07283>>14485000
       then do'random(i)                                       <<07283>>14490000
    else if curptr = "BLOCKONWRITE" and curlen = 12            <<07283>>14495000
       then do'blockonwrite(i)                                 <<07283>>14500000
    else                                                       <<07283>>14505000
    begin                                                      <<07283>>14510000
      << bad keyword >>                                        <<07283>>14515000
      parmnum := 1;                                            <<07283>>14520000
      cierr(errnum:=ccontrol'bad'keyword,curptr);              <<07283>>14525000
      return;                                                  <<07283>>14530000
    end;                                                       <<07283>>14535000
  end;  << while (i:=i+2) < numparms >>                        <<07283>>14540000
                                                               <<07283>>14545000
if errnum > 0 then return;                                     <<07283>>14550000
                                                               <<07283>>14555000
<< since we don't want to change any of the parameters      >> <<07283>>14560000
<< unless they all are correct, the changes will be made now>> <<07283>>14565000
<< if we get here, then the string was correct.             >> <<07283>>14570000
                                                               <<07283>>14575000
stat := 0;                                                     <<07283>>14580000
<< the caching procedures return either a 1 or a 0 for stat.>> <<07283>>14585000
<< 0 - caching is enabled on this system.                   >> <<07283>>14590000
<< 1 - caching not enabled on the system.                   >> <<07283>>14595000
<< if an invalid value were to be passed in, the caching    >> <<07283>>14600000
<< procedures would use the default value.  this should     >> <<07283>>14605000
<< never happen.                                            >> <<07283>>14610000
                                                               <<07283>>14615000
                                                               <<07283>>14620000
if seq                                                         <<07283>>14625000
   then cdt'set'seq(seqval,stat);                              <<07283>>14630000
                                                               <<07283>>14635000
if rnd and stat = 0                                            <<07283>>14640000
   then cdt'set'rnd(rndval,stat);                              <<07283>>14645000
                                                               <<07283>>14650000
if post and stat = 0                                           <<07283>>14655000
   then cdt'set'post(postval,stat);                            <<07283>>14660000
                                                               <<07283>>14665000
if stat <> 0                                                   <<07283>>14670000
   then cierr(errnum:=ccontrol'cache'not'enabled);             <<07283>>14675000
                                                               <<07283>>14680000
end; << cxcachecontrol >>                                      <<07283>>14685000
$control segment=ophi                                                   14690000
procedure logimage(type,parmsp);                               <<01527>>14695000
value type;  integer type;                                     <<01527>>14700000
byte array parmsp;                                             <<01527>>14705000
option privileged,uncallable;                                  <<01527>>14710000
begin                                                          <<01527>>14715000
   integer length,            << total length of image >>      <<01527>>14720000
           data'length,       << length of data in buffer >>   <<01527>>14725000
           parm'length,       << length of parameters >>       <<01527>>14730000
           command'length;    << length of command name >>     <<01527>>14735000
   byte array buff(0:cis'bcombuflen-1);                        <<04604>>14740000
      << although programmatic commands are not limited   >>   <<01527>>14745000
      << in size, at the time this code was put in, the   >>   <<01527>>14750000
      << maximum size of a log record was only 200 bytes. >>   <<01527>>14755000
                                                               <<01527>>14760000
   << test for illegal type >>                                 <<01527>>14765000
   if type >= no'of'opcommands then type := -1;                <<01527>>14770000
                                                               <<01527>>14775000
   case type+1 of                                              <<01527>>14780000
      begin                                                    <<01527>>14785000
                                                               <<01527>>14790000
      move buff := "UNKNOWN COMMAND TYPE;PARMS=",2;            <<01527>>14795000
      move buff := "ABORTIO",2;                                <<01527>>14800000
      move buff := "ACCEPT",2;                                 <<01527>>14805000
      move buff := "DOWN",2;                                   <<01527>>14810000
      move buff := "GIVE",2;                                   <<01527>>14815000
      move buff := "HEADOFF",2;                                <<01527>>14820000
      move buff := "HEADON",2;                                 <<01527>>14825000
      move buff := "REFUSE",2;                                 <<01527>>14830000
      move buff := "REPLY",2;                                  <<01527>>14835000
      move buff := "STARTSPOOL",2;                             <<01527>>14840000
      move buff := "TAKE",2;                                   <<01527>>14845000
      move buff := "UP",2;                                     <<01527>>14850000
      move buff := "MPLINE",2;                                 <<01527>>14855000
      move buff := "DSCONTROL",2;                              <<01527>>14860000
      move buff := "ABORTJOB",2;                               <<01527>>14865000
      move buff := "ALLOW",2;                                  <<01527>>14870000
      move buff := "ALTSPOOLFILE",2;                           <<01527>>14875000
      move buff := "ALTJOB",2;                                 <<01527>>14880000
      move buff := "BREAKJOB",2;                               <<01527>>14885000
      move buff := "DELETESPOOLFILE",2;                        <<01527>>14890000
      move buff := "DISALLOW",2;                               <<01527>>14895000
      move buff := "JOBFENCE",2;                               <<01527>>14900000
      move buff := "LIMIT",2;                                  <<01527>>14905000
      move buff := "STOPSPOOL",2;                              <<01527>>14910000
      move buff := "SUSPENDSPOOL",2;                           <<01527>>14915000
      move buff := "OUTFENCE",2;                               <<01527>>14920000
      move buff := "RECALL",2;                                 <<01527>>14925000
      move buff := "RESUMEJOB",2;                              <<01527>>14930000
      move buff := "RESUMESPOOL",2;                            <<01527>>14935000
      move buff := "STREAMS",2;                                <<01527>>14940000
      move buff := "CONSOLE",2;                                <<01527>>14945000
      move buff := "WARN",2;                                   <<01527>>14950000
      move buff := "WELCOME",2;                                <<01527>>14955000
      move buff := "MON",2;                                    <<01527>>14960000
      move buff := "MOFF",2;                                   <<01527>>14965000
      move buff := "VMOUNT",2;                                 <<01527>>14970000
      move buff := "LMOUNT",2;                                 <<01527>>14975000
      move buff := "LDISMOUNT",2;                              <<01527>>14980000
      move buff := "MRJECONTROL",2;                            <<01527>>14985000
      move buff := "JOBSECURITY",2;                            <<01527>>14990000
      move buff := "DOWNLOAD",2;                               <<01527>>14995000
      move buff := "MIOENABLE",2;                              <<01527>>15000000
      move buff := "MIODISABLE",2;                             <<01527>>15005000
      move buff := "LOG",2;                                    <<01527>>15010000
      move buff := "FOREIGN",2;                                <<01527>>15015000
      move buff := "IMFCONTROL",2;                             <<06926>>15020000
      move buff := "SHOWCOM",2;                                <<01527>>15025000
      move buff := "OPENQ",2;                                  <<06926>>15030000
      move buff := "SHUTQ",2;                                  <<06926>>15035000
<<    move buff := "STARTCACHE",2; >>                          <<06926>>15040000
<<    move buff := "STOPCACHE",2;  >>                          <<06926>>15045000
      move buff := "DISCRPS",2;                                <<06926>>15050000
<<    move buff := "NRJECONTROL",2;     >>                     <<06926>>15055000
<<    move buff := "SNACONTROL",2;      >>                     <<06926>>15060000
<<    move buff := "LINKCONTROL",2;     >>                     <<06926>>15065000
<<    move buff := "NETCONTROL",2;     >>                      <<06926>>15070000
                                                               <<01527>>15075000
      end;  << of command name into buffer >>                  <<01527>>15080000
                                                               <<01527>>15085000
   << set lengths >>                                           <<01527>>15090000
   command'length := tos - @buff;                              <<01527>>15095000
   scan parmsp until cr,1;                                     <<01527>>15100000
   parm'length := tos - @parmsp;                               <<01527>>15105000
   data'length := length := parm'length + command'length;      <<01527>>15110000
                                                               <<01527>>15115000
   << ensure that don't overflow buffer >>                     <<01527>>15120000
   if length > cis'bcombuflen then                             <<04604>>15125000
      begin                                                    <<01527>>15130000
      data'length := cis'bcombuflen;                           <<04604>>15135000
      parm'length := cis'bcombuflen - command'length;          <<04604>>15140000
      end;                                                     <<01527>>15145000
                                                               <<01527>>15150000
   << move in parameter string >>                              <<01527>>15155000
   move buff(command'length) := parmsp,(parm'length);          <<01527>>15160000
                                                               <<01527>>15165000
   log15(-length,@buff,data'length,15);                        <<01527>>15170000
                                                               <<01527>>15175000
end; << of logimage >>                                         <<01527>>15180000
$page "PRINTALLOW -- PRINT SPECIFIED ALLOW MASK"               <<0726>> 15185000
procedure printallow(mask,found,notfound);                     <<0726>> 15190000
value found,notfound;                                          <<0726>> 15195000
array mask;                                                    <<0726>> 15200000
integer found,notfound;                                        <<0726>> 15205000
option uncallable;                                             <<01549>>15210000
begin                                                          <<0726>> 15215000
   logical printflg:=false;                                    <<0726>> 15220000
   integer i,length,perline:=0;                                <<0726>> 15225000
   integer j; << used for ptr'table2 >>                        <<06926>>15230000
   array printbuf'(0:10);                                      <<0726>> 15235000
   byte array printbuf(*)=printbuf';                           <<0726>> 15240000
                                                               <<06926>>15245000
goto body;                                                     <<06926>>15250000
                                                               <<06926>>15255000
<< this is the start of the creation of ptr'table2.  all new >><<06926>>15260000
<< allowable will be placed in the next two assemble         >><<06926>>15265000
<< statements.   ptr'table (at the end of the procedure) is  >><<06926>>15270000
<< full, by spl telling us that it is out of range branch    >><<06926>>15275000
<< we add to it.  in both ptr'table and ptr'table2, we are   >><<06926>>15280000
<< intializing the pb area with command names so we can      >><<06926>>15285000
<< print them.                                               >><<06926>>15290000
                                                               <<06926>>15295000
assemble(                                                      <<06926>>15300000
openq:            con "OPENQ";                                 <<06926>>15305000
shutq:            con "SHUTQ";                                 <<06926>>15310000
<<startcache:       con "STARTCACHE"; >>                       <<06926>>15315000
<<stopcache:        con "STOPCACHE";   >>                      <<06926>>15320000
discrps:          con "DISCRPS";                               <<06926>>15325000
<<nrjecontrol:      con "NRJECONTROL"; >>                      <<06926>>15330000
<<snacontrol:       con "SNACONTROL"; >>                       <<06926>>15335000
<<linkcontrol:      con "LINKCONTROL";  >>                     <<06926>>15340000
<<netcontrol:       con "NETCONTROL";   >>                     <<06926>>15345000
end'tab'2: );                                                  <<06926>>15350000
<< here's the second table of constants.  all new commands >>  <<06926>>15355000
<< will be added to the "quoted list above and added here  >>  <<06926>>15360000
assemble(                                                      <<06926>>15365000
ptr'table2: con                                                <<06926>>15370000
     openq,                                                    <<06926>>15375000
     shutq,                                                    <<06926>>15380000
<<   startcache,   >>                                          <<06926>>15385000
<<   stopcache,    >>                                          <<06926>>15390000
     discrps,                                                  <<06926>>15395000
<<   nrjecontrol,    >>                                        <<06926>>15400000
<<   snacontrol,     >>                                        <<06926>>15405000
<<   linkcontrol,    >>                                        <<06926>>15410000
<<   netcontrol,     >>                                        <<06926>>15415000
     end'tab'2);                                               <<06926>>15420000
                                                               <<06926>>15425000
body: << start of the routine  no'of'opcommands value is from ><<06926>>15430000
      << the base of the list of operator masks in the front  ><<06926>>15435000
      << of the module                                        ><<06926>>15440000
                                                               <<06926>>15445000
   for i:=0 until no'of'opcommands-1 do                        <<0726>> 15450000
   begin                                                       <<0726>> 15455000
   if requestservice then return;                              <<01683>>15460000
      if mask(i.(9:3))&csl(i.(12:4)+1) then << bit is set >>   <<06925>>15465000
      begin                                                    <<0726>> 15470000
         if not printflg then <<need to print the header>>     <<0726>> 15475000
         begin                                                 <<0726>> 15480000
            printflg:=true;                                    <<0726>> 15485000
            genmsg(cigeneralmsgset,found);                     <<0726>> 15490000
         end;                                                  <<0726>> 15495000
         printbuf':="  ";                                      <<0726>> 15500000
         move printbuf'(1):=printbuf',(9); <<initialize buffer><<0726>> 15505000
         tos:=@printbuf;                                       <<0726>> 15510000
         if i > 45 then                                        <<06926>>15515000
         begin << 45 is the # constants in ptr'table >>        <<06926>>15520000
             j:=i-46;                                          <<06926>>15525000
             assemble(ldx j; incx; load ptr'table2,x;          <<06926>>15530000
                      lra ptr'table2,x;  add,decx;             <<06926>>15535000
                      load ptr'table2,x; lra ptr'table2,x;     <<06926>>15540000
                      add,dup; cab,sub;);                      <<06926>>15545000
         end                                                   <<06926>>15550000
         else                                                  <<06926>>15555000
         begin                                                 <<06926>>15560000
             assemble(ldx i; incx; load ptr'table,x;           <<06926>>15565000
                     lra ptr'table,x; add, decx;               <<06926>>15570000
                     load ptr'table,x; lra ptr'table,x;        <<06926>>15575000
                     add,dup; cab,sub;);                       <<06926>>15580000
         end;                                                  <<06926>>15585000
         length:=-tos&asl(1);                                  <<0726>> 15590000
         tos:=tos&asl(1);                                      <<0726>> 15595000
         move *:=*pb,(length);                                 <<0726>> 15600000
         if perline<3 then <<print with no cr,lf>>             <<0726>> 15605000
         begin                                                 <<0726>> 15610000
            perline:=perline+1;                                <<0726>> 15615000
            print(printbuf',-18,%320);                         <<0726>> 15620000
         end                                                   <<0726>> 15625000
         else                                                  <<0726>> 15630000
         begin                                                 <<0726>> 15635000
            perline:=0;                                        <<0726>> 15640000
            print(printbuf',-18,0);                            <<0726>> 15645000
         end;                                                  <<0726>> 15650000
      end;                                                     <<0726>> 15655000
   end;                                                        <<0726>> 15660000
   print(printbuf',0,0);                                       <<0726>> 15665000
   if not printflg then                                        <<0726>> 15670000
   begin <<user has no allow mask>>                            <<0726>> 15675000
      genmsg(cigeneralmsgset,notfound);                        <<0726>> 15680000
      print(perline,0,%60); <<double space>>                   <<0726>> 15685000
   end                                                         <<0726>> 15690000
   else print(printbuf',0,if perline=0 then 0 else %60);       <<0726>> 15695000
   return;                                                     <<0726>> 15700000
                                                               <<0726>> 15705000
   assemble(                                                   <<0726>> 15710000
abortio:          con "ABORTIO";                               <<0726>> 15715000
accept:           con "ACCEPT";                                <<0726>> 15720000
down:             con "DOWN";                                  <<0726>> 15725000
give:             con "GIVE";                                  <<0726>> 15730000
headoff:          con "HEADOFF";                               <<0726>> 15735000
headon:           con "HEADON";                                <<0726>> 15740000
refuse:           con "REFUSE";                                <<0726>> 15745000
reply:            con "REPLY";                                 <<0726>> 15750000
startspool:       con "STARTSPOOL";                            <<0726>> 15755000
take:             con "TAKE";                                  <<0726>> 15760000
up:               con "UP";                                    <<0726>> 15765000
mplin:            con "MPLINE";                                <<0726>> 15770000
dscontrl:         con "DSCONTROL";                             <<0726>> 15775000
abortjob:         con "ABORTJOB";                              <<0726>> 15780000
allow:            con "ALLOW";                                 <<0726>> 15785000
altspoolfile:     con "ALTSPOOLFILE";                          <<0726>> 15790000
altjob:           con "ALTJOB";                                <<0726>> 15795000
breakjob:         con "BREAKJOB";                              <<0726>> 15800000
deletespoolfile:  con "DELETESPOOLFILE";                       <<0726>> 15805000
disallow:         con "DISALLOW";                              <<0726>> 15810000
jobfence:         con "JOBFENCE";                              <<0726>> 15815000
limit:            con "LIMIT";                                 <<0726>> 15820000
stopspool:        con "STOPSPOOL";                             <<0726>> 15825000
suspendspool:     con "SUSPENDSPOOL";                          <<0726>> 15830000
outfence:         con "OUTFENCE";                              <<0726>> 15835000
recall:           con "RECALL";                                <<0726>> 15840000
resumejob:        con "RESUMEJOB";                             <<0726>> 15845000
resumespool:      con "RESUMESPOOL";                           <<0726>> 15850000
streams:          con "STREAMS";                               <<0726>> 15855000
console:          con "CONSOLE";                               <<0726>> 15860000
warn:             con "WARN";                                  <<0726>> 15865000
welcome:          con "WELCOME";                               <<0726>> 15870000
mon:              con "MON";                                   <<0726>> 15875000
moff:             con "MOFF";                                  <<0726>> 15880000
vmount:           con "VMOUNT";                                <<0726>> 15885000
lmount:           con "LMOUNT";                                <<0726>> 15890000
ldismount:        con "LDISMOUNT";                             <<0726>> 15895000
mrjecontrl:       con "MRJECONTROL";                           <<0726>> 15900000
jobsecurity:      con "JOBSECURITY";                           <<0726>> 15905000
download:         con "DOWNLOAD";                              <<0726>> 15910000
mioenable:        con "MIOENABLE";                             <<0726>> 15915000
miodisable:       con "MIODISABLE";                            <<0726>> 15920000
log:              con "LOG";                                   <<00792>>15925000
foreign:          con "FOREIGN";                               <<00792>>15930000
imfcontrol:       con "IMFCONTROL";                            <<06926>>15935000
showcom:          con "SHOWCOM";                                        15940000
end'of'table: );                                               <<00792>>15945000
                                                               <<0726>> 15950000
assemble(                                                      <<0726>> 15955000
ptr'table:                                                     <<0726>> 15960000
con abortio,accept,down,give,headoff,headon,refuse,reply,      <<0726>> 15965000
     startspool,take,up,mplin,dscontrl,abortjob,allow,         <<0726>> 15970000
     altspoolfile,altjob,breakjob,deletespoolfile,disallow,    <<0726>> 15975000
     jobfence,limit,stopspool,suspendspool,outfence,recall,    <<0726>> 15980000
     resumejob,resumespool,streams,console,warn,welcome,       <<0726>> 15985000
     mon,moff,vmount,lmount,ldismount,mrjecontrl,jobsecurity,  <<0726>> 15990000
     download,mioenable,miodisable,log,foreign,imfcontrol,     <<06926>>15995000
     showcom,                                                  <<06926>>16000000
     end'of'table);                                            <<0726>> 16005000
end;                                                           <<0726>> 16010000
$page "SHOWALLOW EXECUTOR"                                     <<0726>> 16015000
procedure cxshowallow executorhead;                            <<0726>> 16020000
comment                                                        <<0726>> 16025000
      the command executer for the :showallow command.         <<06607>>16030000
                                                               <<06607>>16035000
      this command lists the commands allowed for the specified<<06607>>16040000
      user(s).  the syntax of the :showallow command is:       <<06607>>16045000
                                                               <<06607>>16050000
      :showallow    [ {user | @} . {acct | @} ]                <<06607>>16055000
                                                               <<06607>>16060000
                                                               <<06607>>16065000
      fix note:  note that jmatarr is used to index            <<06607>>16070000
                 into two different arrays in this procedure.  <<06607>>16075000
                 first it is equivalenced to jmatheader then to<<06607>>16080000
                 jmatentry. this is necessary since the include<<06607>>16085000
                 file for the jmat exclusively references      <<06607>>16090000
                 jmatarr.                                      <<06607>>16095000
;                                                              <<0726>> 16100000
begin                                                          <<0726>> 16105000
   equate gamask = %103;                                       <<06925>>16110000
   logical pointer sysglobext  = %377;                         <<06925>>16115000
   array mask(0:jit'allow'mask'length-1);                      <<06924>>16120000
   logical array jitarr(0:jit'entry'size-1);                   <<06924>>16125000
   logical found,jit'dst;                                      <<06924>>16130000
   double dl:=[8/";",8/".",8/cr,8/0]d;                         <<0726>> 16135000
                                                               <<06607>>16140000
   << ...................................................... >><<06607>>16145000
   <<        declarations for referencing the jmat           >><<06607>>16150000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>16155000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>16160000
   <<               a specific entry), after an exchange db. >><<06607>>16165000
   <<               or 0 if jmatarr is a local array.        >><<06607>>16170000
   << ...................................................... >><<06607>>16175000
                                                               <<06607>>16180000
   integer       jmatinx;                                      <<06607>>16185000
   integer array jmatheader(0:jmatheadersize-1);               <<0726>> 16190000
   integer array jmatentry(0:jmatentrysize-1);                 <<0726>> 16195000
   integer array jmatarr(*);<<  jmat entry and header array >> <<06607>>16200000
   byte array jmatentry'(*)=jmatentry;                         <<0726>> 16205000
   byte array curruser(0:8),curracct(0:8);                     <<0726>> 16210000
   byte array currjobname(0:8), currjobnum(0:8);               <<02342>>16215000
   byte array dl'(*)=dl;                                       <<0726>> 16220000
   double array parm(0:2)=q;                                   <<0726>> 16225000
   byte pointer firstparm=parm, sndparm=parm+2, trdparm=parm+4;<<0726>> 16230000
   byte len=parm+1, sndlen=parm+3;                             <<0726>> 16235000
   integer i,entryp,lastp,savesir,numparms;                    <<0726>> 16240000
   logical parm1=parm+1,parm2=parm+3;                          <<0726>> 16245000
   array username(0:4),acctname(0:4);                          <<0726>> 16250000
   integer array pcbxglob(0:pxg'size-1);                       <<06605>>16255000
   logical pcbpt;                                              <<06606>>16260000
   byte array username'(*)=username,acctname'(*)=acctname;     <<0726>> 16265000
   integer array logon'account(0:3),logon'user(0:3);           <<00906>>16270000
   byte array logon'account'(*)=logon'account;                 <<00906>>16275000
   byte array logon'user'(*)=logon'user;                       <<00906>>16280000
   double dcapability;                                         <<06924>>16285000
   array qarray(*);                                            <<06605>>16290000
   integer pcbglobloc;                                         <<06605>>16295000
   logical array ucapptr(*) = dcapability;                     <<06924>>16300000
   equate period=1;                                            <<0726>> 16305000
   equate notlogon'sm'or'masterop=970,                         <<01683>>16310000
          notlogon'am'or'masterop=968;                         <<01683>>16315000
   equate nocrlf = -2;  <<no crlf in genmsg>>                  <<02342>>16320000
   << sm'or'mop'cap is true if user has system manager or    >><<01683>>16325000
   << is the master operator                                 >><<01683>>16330000
   define sm'or'mop'cap=((ucapsm = 1)lor(masterop = true))#;   <<06924>>16335000
   << am'or'mop'cap is true if user has account manager or   >><<01683>>16340000
   << is the master operator                                 >><<01683>>16345000
   define am'or'mop'cap=((ucapam = 1)lor(masterop = true))#;   <<06924>>16350000
   subroutine def'movefromdseg;                                <<0726>> 16355000
logical subroutine name(a,b);                                  <<0726>> 16360000
value a,b; integer pointer a,b;                                <<0726>> 16365000
begin                                                          <<0726>> 16370000
   comment this subroutine true if the four word entries       <<0726>> 16375000
      pointed to by 'a' and 'b' are equal, otherwise false     <<0726>> 16380000
   ;                                                           <<0726>> 16385000
   i:=-1;                                                      <<0726>> 16390000
   name:=true;                                                 <<0726>> 16395000
   while (i:=i+1)<4 do if a(i)<>b(i) then name:=false;         <<0726>> 16400000
end;                                                           <<0726>> 16405000
   pcbglobloc := 0;                                            <<06605>>16410000
   << no log of showallow. >>                                  <<01527>>16415000
   who(,dcapability,,logon'user',,logon'account');             <<00906>>16420000
   mycommand(parmsp,dl',3,numparms,parm);                      <<0726>> 16425000
   if numparms=2 then <<user & acct both specified>>           <<0726>> 16430000
   begin                                                       <<0726>> 16435000
      if len>8 then <<username to long>>                       <<0726>> 16440000
      begin                                                    <<0726>> 16445000
         parmnum:=1;                                           <<0726>> 16450000
         cierr(errnum:=uoranamemax8,firstparm);                <<0726>> 16455000
         return;                                               <<0726>> 16460000
      end                                                      <<0726>> 16465000
      else                                                     <<0726>> 16470000
      if len=0 then <<no username specified>>                  <<0726>> 16475000
      begin                                                    <<0726>> 16480000
         parmnum:=1;                                           <<0726>> 16485000
         cierr(errnum:=expusername,firstparm);                 <<0726>> 16490000
         return;                                               <<0726>> 16495000
      end                                                      <<0726>> 16500000
      else                                                     <<0726>> 16505000
      if parm1.delimiter<>period then << no period between name<<0726>> 16510000
      begin                                                    <<0726>> 16515000
         parmnum:=1;                                           <<0726>> 16520000
         cierr(errnum:=periodexp,firstparm(len));              <<0726>> 16525000
         return;                                               <<0726>> 16530000
      end;                                                     <<0726>> 16535000
      if sndlen>8 then <<acct name too long>>                  <<0726>> 16540000
      begin                                                    <<0726>> 16545000
         parmnum:=2;                                           <<0726>> 16550000
         cierr(errnum:=uoranamemax8,sndparm);                  <<0726>> 16555000
         return;                                               <<0726>> 16560000
      end                                                      <<0726>> 16565000
      else                                                     <<0726>> 16570000
      if sndlen=0 then <<no acctname>>                         <<0726>> 16575000
      begin                                                    <<0726>> 16580000
         parmnum:=2;                                           <<0726>> 16585000
         cierr(errnum:=expacctname,sndparm);                   <<0726>> 16590000
         return;                                               <<0726>> 16595000
      end;                                                     <<0726>> 16600000
      username:="  ";                                          <<0726>> 16605000
      username(4):=0;                                          <<0726>> 16610000
      move username(1):=username,(3);                          <<0726>> 16615000
      move acctname:=username,(5); <<initialized username,acctn<<0726>> 16620000
      move username':=firstparm,(len);                         <<0726>> 16625000
      move acctname':=sndparm,(sndlen);                        <<0726>> 16630000
      if sndlen=1 and acctname'="@       " then                <<0726>> 16635000
      begin                                                    <<0726>> 16640000
                                                               <<00906>>16645000
      if not sm'or'mop'cap then                                <<01683>>16650000
         begin                                                 <<0726>> 16655000
            parmnum:=2;                                        <<0726>> 16660000
             cierr(errnum:=need'sm'or'masterop,sndparm);       <<01683>>16665000
            return;                                            <<0726>> 16670000
         end;                                                  <<0726>> 16675000
      end                                                      <<0726>> 16680000
      else                                                     <<0726>> 16685000
      if sndparm<>alpha or parm2.special'char then             <<0726>> 16690000
      begin                                                    <<0726>> 16695000
         parmnum:=2;                                           <<0726>> 16700000
         cierr(errnum:=badname,sndparm);                       <<0726>> 16705000
         return;                                               <<0726>> 16710000
      end                                                      <<0726>> 16715000
      else                                                     <<0726>> 16720000
      if acctname'<>logon'account',(8) and                     <<00906>>16725000
      not sm'or'mop'cap then                                   <<01683>>16730000
      begin                                                    <<00906>>16735000
         parmnum:=2;                                           <<00906>>16740000
          cierr(errnum:=notlogon'sm'or'masterop,sndparm);      <<01683>>16745000
         return;                                               <<00906>>16750000
      end;                                                     <<00906>>16755000
      if len=1 and username'="@       " then                   <<0726>> 16760000
      begin                                                    <<0726>> 16765000
                                                               <<00906>>16770000
      if not am'or'mop'cap then                                <<01683>>16775000
         begin                                                 <<0726>> 16780000
            parmnum:=1;                                        <<0726>> 16785000
          cierr(errnum:=need'am'or'masterop,firstparm);        <<01683>>16790000
            return;                                            <<0726>> 16795000
         end;                                                  <<0726>> 16800000
      end                                                      <<0726>> 16805000
      else                                                     <<0726>> 16810000
      if firstparm<>alpha or parm1.special'char then           <<0726>> 16815000
      begin                                                    <<0726>> 16820000
         parmnum:=1;                                           <<0726>> 16825000
         cierr(errnum:=badname,firstparm);                     <<0726>> 16830000
         return;                                               <<0726>> 16835000
         end                                                   <<00906>>16840000
         else                                                  <<00906>>16845000
         if username'<>logon'user',(8) and                     <<00906>>16850000
         not am'or'mop'cap then                                <<01683>>16855000
         begin                                                 <<00906>>16860000
            parmnum:=1;                                        <<00906>>16865000
          cierr(errnum:=notlogon'am'or'masterop,firstparm);    <<01683>>16870000
            return;                                            <<00906>>16875000
         end;                                                  <<00906>>16880000
   end                                                         <<0726>> 16885000
   else if numparms=0 then <<use logon user & acct>>           <<0726>> 16890000
      who(,,,username',,acctname')                             <<0726>> 16895000
   else                                                        <<0726>> 16900000
   begin <<must have zero or two parameters>>                  <<0726>> 16905000
      parmnum:=1;                                              <<0726>> 16910000
      cierr(errnum:=exp0or2parms);                             <<0726>> 16915000
      return;                                                  <<0726>> 16920000
   end;                                                        <<0726>> 16925000
$page                                                          <<0726>> 16930000
                                                               <<0726>> 16935000
<< have user & acct names.  now scan jmat for users who >>     <<0726>> 16940000
<< qualify under the inputted names>>                          <<0726>> 16945000
                                                               <<0726>> 16950000
   jmatinx := 0;  <<  we only deal with one entry  >>          <<06607>>16955000
   @jmatarr := @jmatheader;<<  index into jmat header  >>      <<06607>>16960000
   movefromdseg(@jmatarr, jmatdst, 0, jmatheadersize);         <<06607>>16965000
   entryp := jmatentryptr; << first jmat entry >>              <<06607>>16970000
   lastp  :=   jmatcursize * 128                               <<06607>>16975000
             - jmatentrysize; << pointer to last entry >>      <<06607>>16980000
   savesir:=getsir(jmatsir);                                   <<0726>> 16985000
   found:=false;                                               <<0726>> 16990000
   do <<print allow mask for each qualified user>>             <<0726>> 16995000
   begin                                                       <<0726>> 17000000
      if requestservice then                                   <<01683>>17005000
         begin                                                 <<01683>>17010000
           relsir(jmatsir,savesir);                            <<01683>>17015000
           return;                                             <<01683>>17020000
           end;                                                <<01683>>17025000
      @jmatarr := @jmatentry;<<  index into jmat entries >>    <<06607>>17030000
      movefromdseg(@jmatarr, jmatdst, entryp, jmatentrysize);  <<06607>>17035000
      if jmatarr <> 0   then <<got valid entry>>               <<06607>>17040000
      begin                                                    <<0726>> 17045000
         if (username'="@       " or                           <<0726>> 17050000
             name(username, jmatusername)) and                 <<06607>>17055000
            (acctname'="@       " or                           <<0726>> 17060000
             name(acctname, jmatacctname)) and                 <<06607>>17065000
            jmatjobstate = jobexec   then <<  have a match >>  <<06607>>17070000
         begin                                                 <<0726>> 17075000
            found:=true; <<found at least qualifying entry>>   <<0726>> 17080000
            tos:=@pcbxglob;                                    <<0726>> 17085000
            pcbpt := jmatmainpin * pcbsize;                    <<06607>>17090000
            tos := spcbstkdst;                                 <<06606>>17095000
            movefromdseg(*,*,0,pxg'size); << set pcbxglob >>   <<06605>>17100000
            @qarray := @pcbxglob;                              <<06605>>17105000
            jit'dst:=pxg'jitdst;        << get users jit >>    <<06924>>17110000
            movefromdseg(@jitarr,jit'dst,0,jit'entry'size);    <<06924>>17115000
            move mask(0):=jitallowmask,(jit'allow'mask'length);<<06924>>17120000
            move currjobnum:= 8(" ");                          <<02342>>17125000
             if jmatjstype = jobtype'job                       <<06607>>17130000
              then  move currjobnum:="#J"                      <<02342>>17135000
             else  move currjobnum:="#S";                      <<02342>>17140000
             ascii(jmatjsno, 10, currjobnum(2));               <<06607>>17145000
             currjobnum(8):=currjobname(8):=0;                 <<02342>>17150000
             genmsg(nocrlf,@currjobnum);                       <<02342>>17155000
            move curruser:=jmatentry'(jmatusernameoff*2),(8);  <<06607>>17160000
            move curracct:=jmatentry'(jmatacctnameoff*2),(8);  <<06607>>17165000
            curruser(8):=curracct(8):=0;                       <<0726>> 17170000
            move curruser:=curruser while an,1;                <<0726>> 17175000
            bps0:=0; <<terminate user name with zero byte>>    <<0726>> 17180000
            move curracct:=curracct while an,1;                <<0726>> 17185000
            bps0:=0;                                           <<0726>> 17190000
            ddel;                                              <<0726>> 17195000
            move currjobname:=jmatentry'(jmatjobnameoff*2),(8);<<06607>>17200000
            if currjobname <> "        "  then                 <<02342>>17205000
             begin                                             <<02342>>17210000
                move currjobname:=currjobname while an,1;      <<02342>>17215000
                bps0:=",";   <<separate from uname>>           <<02342>>17220000
                bps0(1):=0;  <<term with zero byte>>           <<02342>>17225000
                del;                                           <<02342>>17230000
                genmsg(nocrlf,@currjobname);                   <<02342>>17235000
             end;                                              <<02342>>17240000
            genmsg(cigeneralmsgset,userheader,[1/0,3/0,3/0,9/0],        17245000
               @curruser,@curracct);                           <<0726>> 17250000
            printallow(mask,userhasallow,usernoallow);         <<0726>> 17255000
         end;                                                  <<0726>> 17260000
      end;                                                     <<0726>> 17265000
   end                                                         <<0726>> 17270000
   until (entryp := entryp+jmatentrysize) > lastp;             <<06607>>17275000
   relsir(jmatsir,savesir);                                    <<0726>> 17280000
   if not found then <<no qualifying users>>                   <<0726>> 17285000
   begin                                                       <<0726>> 17290000
      parmnum:=1;                                              <<0726>> 17295000
      cierr(errnum:=noqualifyusers);                           <<0726>> 17300000
   end;                                                        <<0726>> 17305000
   if requestservice then return;                              <<01683>>17310000
   << get global allow mask from the sysglob extension area>>  <<06925>>17315000
   i:=-1;                                                      <<06925>>17320000
   while(i:=i+1) < jit'allow'mask'length                       <<06925>>17325000
        do mask(i):=sysglobext(gamask+i);                      <<06925>>17330000
   printallow(mask,globalallow,noglobalallow);                 <<0726>> 17335000
end;                                                           <<0726>> 17340000
$page "HEADON/HEADOFF EXECUTORS"                                        17345000
$control segment=oplow                                                  17350000
procedure cxheadon executorhead;                                        17355000
begin                                                                   17360000
   entry cxheadoff;                                                     17365000
   comment                                                              17370000
      the syntax of these commands is:                                  17375000
         headon  ldev                                                   17380000
         headoff ldev                                                   17385000
      where ldev is a real configured device                            17390000
   ;                                                                    17395000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  17400000
   byte array dl'(*)=dl;   <<delimiters for scan>>                      17405000
   double array parm(0:1)=q;     <<parameter descriptor array>>         17410000
   byte pointer firstparm=parm, sndparm=parm+2; <<ptr to 1st & 2nd par>>17415000
   byte firstlen=parm+1;   <<length of 1st parameter>>                  17420000
   integer savesir,numparms;                                            17425000
   logical ldev,on:=true, dtype;                                        17430000
integer                                                        <<06604>>17435000
   ldt'index := 0;                                             <<06604>>17440000
   array ldt(0:ldtsize-1);                                              17445000
                                                                        17450000
   subroutine def'movefromdseg;                                         17455000
   subroutine def'movetodseg;                                           17460000
                                                                        17465000
<<cxheadon entry point>>                                                17470000
   go to maincode;                                                      17475000
                                                                        17480000
<<cxheadoff entry point>>                                               17485000
cxheadoff:                                                              17490000
   on:=false;                                                           17495000
                                                                        17500000
maincode:                                                               17505000
   logimage( ( if on                                           <<01527>>17510000
                  then m'headon                                <<01527>>17515000
                  else m'headoff ), parmsp );                  <<01527>>17520000
   mycommand(parmsp,dl',2,numparms,parm); <<decode command>>            17525000
   if numparms<>1 then                                                  17530000
   begin                                                                17535000
      tos:=errnum:=if on then headonreq1p else headoffreq1p;            17540000
      parmnum:=if numparms<1 then 1 else 2;                             17545000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     17550000
      cierr(*,*);                                                       17555000
   end                                                                  17560000
   else                                                                 17565000
   begin                                                                17570000
      ldev:=verify'rldev(firstparm,firstlen,errnum,parmnum,1);          17575000
      if < then return;                                                 17580000
      if verify'masterop(ldev) then return;<<msterop made inadv. entry>>17585000
      if checkass(ldev) <<has user associated device ?>>                17590000
         or checkallow(if on then m'headon else m'headoff) then         17595000
      begin                                                             17600000
         savesir:=getsir(ldtsir);  <<lock ldt>>                         17605000
         movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize); <<get ldt>>    17610000
         dtype:=ldt'device'type;    <<get device type>>        <<06604>>17615000
         if dtype=readerpunch or dtype=printer or                       17620000
            dtype=cardpunch or dtype=terminal then <<output spoolee>>   17625000
         begin   <<valid device>>                                       17630000
            ldt'header:=not on;  <<set the header/trailer bit>><<06604>>17635000
            movetodseg(ldtdst,ldev*ldtsize,@ldt,ldtsize);               17640000
         end                                                            17645000
         else errnum:=ldevnotcrprpnch;                                  17650000
         relsir(ldtsir,savesir);   <<unlock ldt>>                       17655000
         if errnum<>0 then <<not valid device>>                         17660000
         begin                                                          17665000
            parmnum:=1;                                                 17670000
            cierr(errnum,parmsp);                                       17675000
         end;                                                           17680000
      end                                                               17685000
      else                                                              17690000
      begin                                                             17695000
         parmnum:=1;                                                    17700000
         cierr(errnum:=usernoacc2dev,parmsp);                           17705000
      end;                                                              17710000
   end;                                                                 17715000
end;                                                                    17720000
$page "CXTUNE -- :TUNE COMMAND EXECUTOR"                       <<01549>>17725000
$control segment=oplow                                         <<01549>>17730000
procedure cxtune executorhead;                                 <<01549>>17735000
begin                                                          <<01549>>17740000
$include inclics                                               <<01552>>17745000
   <<                                                          ((mpeiv))17750000
      they syntax of the :tune command is:                     ((mpeiv))17755000
      tune [clockcyle][;cq=cbase,climit,cmin,cmax]             ((mpeiv))17760000
                      [;dq=dbase,dlimit,dmin,dmax]             ((mpeiv))17765000
                      [;eq=ebase,elimit,emin,emax]             ((mpeiv))17770000
      each of the base,limit,emin,emax are optional.           ((mpeiv))17775000
      >>                                                       <<01549>>17780000
   logical pointer sysics=%7;  << sysglob pointer to ics >>    <<06923>>17785000
   equate no'of'parms=16,     <<maximum # of parms for command>>        17790000
          comma=0, semicolon=1, equals=2, carriage=3; <<separators>>    17795000
   double dl:=[8/",",8/";",8/"=",8/cr]d;                       <<01549>>17800000
   byte array dl'(*)=dl;                                       <<01549>>17805000
   double array parm(0:no'of'parms)=q;                         <<01549>>17810000
   byte pointer parm17=parm+32;                                <<01549>>17815000
                                                               <<01549>>17820000
<< current parameter descriptor variables>>                    <<01549>>17825000
                                                               <<01549>>17830000
   integer i,numparms,last'delimiter,current'delimiter,parm'length;     17835000
   logical l; <<work variable>>                                <<01549>>17840000
   byte pointer queueptr,parmptr;                              <<01549>>17845000
   integer queue'index; <<0=cq, 1=dq, 2=eq>>                   <<01549>>17850000
   long char':=[8/",",8/0,8/";",8/0,8/"=",24/0]l;              <<01549>>17855000
   byte array char(*)=char';                                   <<01549>>17860000
   integer scan'state:=0;<<scanning for 0=;cq, ;dq, ;eq >>     <<01549>>17865000
                         <<             1= queuebase    >>     <<01549>>17870000
                         <<             2= queuelimit   >>     <<01549>>17875000
                         <<             3= queuemin     >>     <<01549>>17880000
                         <<             4= queuemax     >>     <<01549>>17885000
   integer array last(0:4)=pb:=semicolon,equals,comma,comma,comma;      17890000
   integer array current(0:4)=pb:=equals,comma,comma,comma,semicolon;   17895000
                                                               <<01549>>17900000
<<  variables to contain the values set by the command>>       <<01549>>17905000
                                                               <<01549>>17910000
   logical array flag(0:2),minquantum(0:2)=q,maxquantum(0:2)=q;<<01549>>17915000
   logical minclockcycle;                                      <<01549>>17920000
   integer array base(0:2)=q,limit(0:2)=q;                     <<01549>>17925000
   logical clockflag:=false;                                   <<01549>>17930000
   equate base'min=150, base'max=255, limit'min=150, limit'max=255;     17935000
                                                               <<06923>>17940000
equate                                                         <<06923>>17945000
  cqmin = -ics'mincfiltercell, cqmax   = -ics'maxcfiltercell,  <<06923>>17950000
  cqbase= -ics'cschedbasecell, cqlimit = -ics'worstcpricell,   <<06923>>17955000
  dqmin = -ics'curdfiltercell, dqmax   = -ics'curdfiltercell,  <<06923>>17960000
  dqbase= -ics'dschedbasecell, dqlimit = -ics'worstdpricell,   <<06923>>17965000
  eqmin = -ics'curefiltercell, eqmax   = -ics'curefiltercell,  <<06923>>17970000
  eqbase= -ics'eschedbasecell, eqlimit = -ics'worstepricell;   <<06923>>17975000
         <<sysglob relative offsets into ics>>                 <<01549>>17980000
  equate clockcycle=%1353;                                     <<01549>>17985000
                                                               <<01549>>17990000
   logical subroutine getnext;                                 <<01549>>17995000
   begin                                                       <<01549>>18000000
      parmnum:=parmnum+1;                                      <<01549>>18005000
      if parmnum<numparms then <<more parameters to look at>>  <<01549>>18010000
      begin                                                    <<01549>>18015000
         getnext:=true;                                        <<01549>>18020000
         last'delimiter:=current'delimiter;                    <<01549>>18025000
         tos:=parm(parmnum); <<get current parameter descriptor>>       18030000
         current'delimiter:=s0.delimiter;                      <<01549>>18035000
         parm'length:=tos&lsr(8);  <<get current parameter length>>     18040000
         @parmptr:=tos;      <<get byte pointer to current parameter>>  18045000
      end else getnext:=false; <<no more parameters>>          <<01549>>18050000
   end;                                                        <<01549>>18055000
                                                               <<01549>>18060000
$page                                                          <<01549>>18065000
   mycommand(parmsp,dl',no'of'parms+1,numparms,parm);<<parse parms>>    18070000
   if numparms<1 then <<expect at least one parameter>>        <<01549>>18075000
   begin                                                       <<01549>>18080000
      cierr(errnum:=-expminclockcycle,parmsp);                 <<01549>>18085000
      return;                                                  <<01549>>18090000
      end                                                      <<01549>>18095000
   else                                                        <<01549>>18100000
   if numparms>no'of'parms then <<too many parameters>>        <<01549>>18105000
   begin                                                       <<01549>>18110000
      parmnum:=no'of'parms;                                    <<01549>>18115000
      cierr(errnum:=tunehas16parms,parm17);                    <<01549>>18120000
      return;                                                  <<01549>>18125000
   end;                                                        <<01549>>18130000
                                                               <<01549>>18135000
<< now ready to start syntax and semantic analysis of command>><<01549>>18140000
                                                               <<01549>>18145000
   minclockcycle := absolute(clockcycle+1);                    <<06923>>18150000
   current'delimiter:=0;                                       <<01549>>18155000
   parmnum:=-1;                                                <<01549>>18160000
   getnext; <<we have already checked for at least one parameter>>      18165000
   if parm'length<>0 then <<minclockcyle specified>>           <<01549>>18170000
   begin                                                       <<01549>>18175000
      minclockcycle:=binary(parmptr,parm'length);              <<01549>>18180000
      if <> then                                               <<01549>>18185000
      begin     <<got bad number for clockcyle>>               <<01549>>18190000
         cierr(errnum:=expnumberforclock,parmptr);             <<01549>>18195000
         return;                                               <<01549>>18200000
      end                                                      <<01549>>18205000
      else clockflag:=true;  <<have valid number>>             <<01549>>18210000
   end;                                                        <<01549>>18215000
   flag:=flag(1):=flag(2):=false;                              <<01549>>18220000
<<>>                                                           <<01549>>18225000
<< get old values from ics q-area>>                            <<01549>>18230000
<<>>                                                           <<01549>>18235000
   disable;                                                    <<01549>>18240000
   minquantum    := sysics(cqmin);                             <<06923>>18245000
   minquantum(1) := sysics(dqmin);                             <<06923>>18250000
   minquantum(2) := sysics(eqmin);                             <<06923>>18255000
   maxquantum    := sysics(cqmax);                             <<06923>>18260000
   maxquantum(1) := sysics(dqmax);                             <<06923>>18265000
   maxquantum(2) := sysics(eqmax);                             <<06923>>18270000
   base          := sysics(cqbase);                            <<06923>>18275000
   base(1)       := sysics(dqbase);                            <<06923>>18280000
   base(2)       := sysics(eqbase);                            <<06923>>18285000
   limit         := sysics(cqlimit);                           <<06923>>18290000
   limit(1)      := sysics(dqlimit);                           <<06923>>18295000
   limit(2)      := sysics(eqlimit);                           <<06923>>18300000
   enable;                                                     <<01549>>18305000
                                                               <<01549>>18310000
                                                               <<01549>>18315000
<< major parse loop >>                                         <<01549>>18320000
                                                               <<01549>>18325000
   while getnext do                                            <<01549>>18330000
   begin                                                       <<01549>>18335000
      if scan'state>4 then <<too many queue parameters>>       <<01549>>18340000
      begin                                                    <<01549>>18345000
         cierr(errnum:=queuehas4parms,parmptr(-1));            <<01549>>18350000
         return;                                               <<01549>>18355000
      end;                                                     <<01549>>18360000
      if last'delimiter<>last(scan'state) then                 <<01549>>18365000
      begin                                                    <<01549>>18370000
         cierr(errnum:=expectbefore,parmptr(-1),               <<01549>>18375000
               1,@char(last(scan'state)*2));                   <<01549>>18380000
         return;                                               <<01549>>18385000
      end;                                                     <<01549>>18390000
      if current'delimiter<>carriage and current'delimiter<>   <<01549>>18395000
         semicolon and current'delimiter<>current(scan'state) then      18400000
      begin                                                    <<01549>>18405000
         cierr(errnum:=expectafter,parmptr(parm'length),1,     <<01549>>18410000
               @char(current(scan'state)*2));                  <<01549>>18415000
         return;                                               <<01549>>18420000
      end;                                                     <<01549>>18425000
      case scan'state of                                       <<01549>>18430000
      begin                                                    <<01549>>18435000
         <<>>                                                  <<01549>>18440000
         << state 0 -- looking for ;cq, ;dq, ;eq>>             <<01549>>18445000
         <<>>                                                  <<01549>>18450000
         begin                                                 <<01549>>18455000
            queue'index:=parmptr-"C"; <<0=cq, 1=dq, 2=eq >>    <<01549>>18460000
            if parm'length<>2 or parmptr(1)<>"Q"               <<01549>>18465000
               or not (0<=queue'index<=2) then <<bad queue parm>>       18470000
            begin                                              <<01549>>18475000
               cierr(errnum:=expect1ofcqdqeq,parmptr);         <<01549>>18480000
               return;                                         <<01549>>18485000
            end;                                               <<01549>>18490000
            if flag(queue'index) then <<duplicately specified queues>>  18495000
            begin                                              <<01549>>18500000
               cierr(errnum:=duplicatequeue,parmptr);          <<01549>>18505000
               return;                                         <<01549>>18510000
            end;                                               <<01549>>18515000
            flag(queue'index):=true;                           <<01549>>18520000
            @queueptr:=@parmptr;                               <<01549>>18525000
         end;  <<end state 0>>                                 <<01549>>18530000
         <<>>                                                  <<01549>>18535000
         << scan state 1 -- scanning for queuebase>>           <<01549>>18540000
         <<>>                                                  <<01549>>18545000
         if parm'length<>0 then <<parameter not skipped>>      <<01549>>18550000
         begin                                                 <<01549>>18555000
            i:=binary(parmptr,parm'length);                    <<01549>>18560000
            if <> then <<bad queue base #>>                    <<01549>>18565000
            begin                                              <<01549>>18570000
               cierr(errnum:=expectnumber,parmptr);            <<01549>>18575000
               return;                                         <<01549>>18580000
            end;                                               <<01549>>18585000
            if not (base'min<=i<=base'max) then                <<01549>>18590000
            begin                                              <<01549>>18595000
               cierr(errnum:=queuebaselimit,parmptr);          <<01549>>18600000
               return;                                         <<01549>>18605000
            end;                                               <<01549>>18610000
            base(queue'index):=i;                              <<01549>>18615000
         end;                                                  <<01549>>18620000
         <<>>                                                  <<01549>>18625000
         << scan state 2 -- scan for queuelimit>>              <<01549>>18630000
         <<>>                                                  <<01549>>18635000
         if parm'length<>0 then <<parameter not skipped>>      <<01549>>18640000
         begin                                                 <<01549>>18645000
            i:=binary(parmptr,parm'length);                    <<01549>>18650000
            if <> then                                         <<01549>>18655000
            begin                                              <<01549>>18660000
               cierr(errnum:=expectnumber,parmptr);            <<01549>>18665000
               return;                                         <<01549>>18670000
            end;                                               <<01549>>18675000
            if not (limit'min<=i<=limit'max) then              <<01549>>18680000
            begin                                              <<01549>>18685000
               cierr(errnum:=queuebaselimit,parmptr);          <<01549>>18690000
               return;                                         <<01549>>18695000
            end;                                               <<01549>>18700000
            limit(queue'index):=i;                             <<01549>>18705000
         end;                                                  <<01549>>18710000
         <<>>                                                  <<01549>>18715000
         << scan state 3 -- scanning for queuemin>>            <<01549>>18720000
         <<>>                                                  <<01549>>18725000
         if parm'length<>0 then <<parameter not skipped>>      <<01549>>18730000
         begin                                                 <<01549>>18735000
            l:=binary(parmptr,parm'length);                    <<01549>>18740000
            if <> then                                         <<01549>>18745000
            begin                                              <<01549>>18750000
               cierr(errnum:=expectnumber,parmptr);            <<01549>>18755000
               return;                                         <<01549>>18760000
            end;                                               <<01549>>18765000
            minquantum(queue'index):=l;                        <<01549>>18770000
         end;                                                  <<01549>>18775000
         <<>>                                                  <<01549>>18780000
         << scan state 4 -- scanning for queuemax>>            <<01549>>18785000
         <<>>                                                  <<01549>>18790000
         if parm'length<>0 then <<parameter not skipped>>      <<01549>>18795000
         begin                                                 <<01549>>18800000
            l:=binary(parmptr,parm'length);                    <<01549>>18805000
            if <> then                                         <<01549>>18810000
            begin                                              <<01549>>18815000
               cierr(errnum:=expectnumber,parmptr);            <<01549>>18820000
               return;                                         <<01549>>18825000
            end;                                               <<01549>>18830000
            maxquantum(queue'index):=l;                        <<01549>>18835000
         end;                                                  <<01549>>18840000
      end;                                                     <<01549>>18845000
      scan'state:=scan'state+1;                                <<01549>>18850000
      if current'delimiter=semicolon or current'delimiter=carriage then 18855000
      begin  <<have end of queue desciption>>                  <<01549>>18860000
         if scan'state<2 then <<must get at least queue descriptor>>    18865000
         begin                                                 <<01549>>18870000
            cierr(errnum:=expectatleast1qparm,parmptr(parm'length));    18875000
            return;                                            <<01549>>18880000
         end;                                                  <<01549>>18885000
         if base(queue'index)>limit(queue'index)               <<01549>>18890000
            or minquantum(queue'index)>maxquantum(queue'index) then     18895000
         begin                                                 <<01549>>18900000
            cierr(errnum:=relationshipbad,queueptr);           <<01549>>18905000
            return;                                            <<01549>>18910000
         end;                                                  <<01549>>18915000
         scan'state:=0;                                        <<01549>>18920000
      end;                                                     <<01549>>18925000
   end;                                                        <<01549>>18930000
   <<>>                                                        <<01549>>18935000
   <<  load new values back onto ics q- area>>                 <<01549>>18940000
   <<>>                                                        <<01549>>18945000
   disable;                                                    <<01549>>18950000
   sysics(cqmin)   := minquantum;                              <<06923>>18955000
   sysics(dqmin)   := minquantum(1);                           <<06923>>18960000
   sysics(eqmin)   := minquantum(2);                           <<06923>>18965000
   sysics(cqmax)   := maxquantum;                              <<06923>>18970000
   sysics(dqmax)   := maxquantum(1);                           <<06923>>18975000
   sysics(eqmax)   := maxquantum(2);                           <<06923>>18980000
   sysics(cqbase)  := base;                                    <<06923>>18985000
   sysics(dqbase)  := base(1);                                 <<06923>>18990000
   sysics(eqbase)  := base(2);                                 <<06923>>18995000
   sysics(cqlimit) := limit;                                   <<06923>>19000000
   sysics(dqlimit) := limit(1);                                <<06923>>19005000
   sysics(eqlimit) := limit(2);                                <<06923>>19010000
   absolute(clockcycle+1) := minclockcycle;                    <<06923>>19015000
   enable;                                                     <<01549>>19020000
   resetdispq; <<initialize the dispatching q >>               <<01847>>19025000
end;                                                           <<01549>>19030000
$page "GIVE & TAKE EXECUTORS"                                           19035000
$control segment=oplow                                                  19040000
procedure cxgive executorhead;                                          19045000
begin                                                                   19050000
   entry cxtake;                                                        19055000
   comment                                                              19060000
      the syntax of the give & take commands is:                        19065000
         give ldn                                                       19070000
         take ldn                                                       19075000
      the commands either give a 'down'ed device to diagnostics or      19080000
   take a device from diagnostics.                                      19085000
   ;                                                                    19090000
   logical ldev,give:=true;                                             19095000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  19100000
   byte array dl'(*)=dl;                                                19105000
   integer savesir,numparms;                                            19110000
   double array parm(0:1)=q;                                            19115000
   byte pointer firstparm=parm, sndparm=parm+2;                         19120000
   byte len=parm+1;                                                     19125000
   integer                                                     <<06604>>19130000
      ldt'index := 0;                                          <<06604>>19135000
                                                               <<06604>>19140000
   array ldt(0:ldtsize-1);                                              19145000
                                                                        19150000
   subroutine def'movefromdseg;                                         19155000
   subroutine def'movetodseg;                                           19160000
                                                                        19165000
<< cxgive entry point>>                                                 19170000
   go to maincode;                                                      19175000
                                                                        19180000
<< cxtake entry point>>                                                 19185000
cxtake:                                                                 19190000
   give:=false;                                                         19195000
                                                                        19200000
maincode:                                                               19205000
   logimage( ( if give                                         <<01527>>19210000
                  then m'give                                  <<01527>>19215000
                  else m'take ), parmsp );                     <<01527>>19220000
   mycommand(parmsp,dl',2,numparms,parm); <<parse input>>               19225000
   if numparms<>1 <<must have 1>> then                                  19230000
   begin                                                                19235000
      tos:=errnum:=if give then givereq1p else takereq1p;               19240000
      parmnum:=if numparms<1 then 1 else 2;                             19245000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     19250000
      cierr(*,*);                                                       19255000
      return;                                                           19260000
   end;                                                                 19265000
   ldev:=verify'rldev(firstparm,len,errnum,parmnum,1);                  19270000
   if < then return;                                                    19275000
   if verify'masterop(ldev) then return; <<masterop made inadv. entry>> 19280000
   if checkass(ldev) or                                                 19285000
      checkallow(if give then m'give else m'take) then <<user has acc>> 19290000
   begin                                                                19295000
      savesir:=getsir(ldtsir);     <<lock ldt >>                        19300000
      movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize);<<get ldt 4 ldev>> 19305000
      if give then                                                      19310000
         if ldt'avail'to'sys then errnum:=ldevinbyf <<in use by<<06604>>19315000
         else                                                  <<06604>>19320000
            if ldt'avail'to'diag then errnum:=-ldevalinbydiag  <<06604>>19325000
              else ldt'avail'to'diag:=true <<set device down>> <<06604>>19330000
      else if ldt'avail'to'diag then                           <<06604>>19335000
           ldt'avail'to'diag := false <<take out of diag>>     <<06604>>19340000
           else errnum:=ldevnotindiag; <<ldev not in diagnostics>>      19345000
      if errnum=0 <<successfully did give or take>>                     19350000
      then movetodseg(ldtdst,ldev*ldtsize,@ldt,ldtsize);                19355000
      relsir(ldtsir,savesir); <<unlock ldt>>                            19360000
      if errnum<>0 then <<need to issue a warning or error msg>>        19365000
      begin                                                             19370000
         parmnum:=1;                                                    19375000
         cierr(errnum,parmsp,%10000,ldev);                              19380000
      end;                                                              19385000
   end                                                                  19390000
   else                                                                 19395000
   begin  <<user has neither allow or associate access to command>>     19400000
      parmnum:=1;                                                       19405000
      cierr(errnum:=usernoacc2dev,parmsp);                              19410000
   end;                                                                 19415000
end;                                                                    19420000
$page "UP & DOWN EXECUTORS"                                             19425000
$control segment=oplow                                                  19430000
procedure cxup executorhead;                                            19435000
begin                                                                   19440000
   entry cxdown;                                                        19445000
   comment                                                              19450000
      the syntax of the up & down commands is:                          19455000
         up   ldn                                                       19460000
         down ldn                                                       19465000
      the commands either return the device to use by the system (up)   19470000
      or remove it from the system's domain (down).                     19475000
   ;                                                                    19480000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  19485000
   byte array dl'(*)=dl;                                                19490000
   double array parm(0:1)=q;                                            19495000
integer                                                        <<06604>>19500000
   ldt'index := 0;                                             <<06604>>19505000
   byte pointer firstparm=parm, sndparm=parm+2;                         19510000
   array ldt(0:ldtsize-1);                                              19515000
   integer numparms,savesir'lpdt,savesir'ldt;                           19520000
   byte len=parm+1;                                                     19525000
   logical ldev,up:=true;                                               19530000
   integer sys'or'pv;                                          <<03519>>19535000
   logical dfs'stat;                                           <<03519>>19540000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>19545000
   define                                                      <<04195>>19550000
      dev'is'disc = ( ldt'device'type < 8 ) #,                 <<06604>>19555000
      sys'disc   = (lpdt'non'sys'domain = 0)#;                 <<06221>>19560000
   subroutine def'movefromdseg;                                         19565000
   subroutine def'movetodseg;                                           19570000
                                                                        19575000
<< cxup entry point>>                                                   19580000
   go to maincode;                                                      19585000
                                                                        19590000
<<cxdown entry point>>                                                  19595000
cxdown:                                                                 19600000
   up:=false;                                                           19605000
                                                                        19610000
maincode:                                                               19615000
   logimage( ( if up                                           <<01527>>19620000
                  then m'up                                    <<01527>>19625000
                  else m'down ), parmsp );                     <<01527>>19630000
   mycommand(parmsp,dl',2,numparms,parm); <<parse parameters>>          19635000
   if numparms<>1 <<must have 1>> then                                  19640000
   begin                                                                19645000
      parmnum:=if numparms<1 then 1 else 2;                             19650000
      tos:=errnum:=if up then upreq1p else downreq1p;                   19655000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     19660000
      cierr(*,*);                                                       19665000
   end                                                                  19670000
   else                                                                 19675000
   begin                                                                19680000
      ldev:=verify'rldev(firstparm,len,errnum,parmnum,1);               19685000
      if < then return;                                                 19690000
      if verify'masterop(ldev) then return;<<msterop made inadv. entry>>19695000
      if checkass(ldev) or                                              19700000
         checkallow(if up then m'up else m'down) then                   19705000
      begin                                                             19710000
         lpdt'index:=ldev*logical(lpdt'entry'size);            <<06221>>19715000
         savesir'ldt:=getsir(ldtsir); <<lock ldt>>                      19720000
         movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize);<<get ldt4 dev>>19725000
         if up then <<process up command>>                              19730000
            if ldt'avail'to'diag then errnum := -ldevinbydiag  <<06604>>19735000
            else if ldt'avail'to'sys and not ldt'down'pending  <<06604>>19740000
                 then errnum:=-ldevalinbyf <<already up>>               19745000
                 else <<set the device up>>                             19750000
                 if ldt'down'pending then  << down pending? >> <<06604>>19755000
                    ldt'down'pending := false   << clear >>    <<06604>>19760000
                 else                                          <<03519>>19765000
                 begin                                                  19770000
                    ldt'down'pending:=false; <<clr dwn pending <<06604>>19775000
                    ldt'avail'to'sys := true;<<set dev in use>><<06604>>19780000
                                                               <<03519>>19785000
                    << if this is a system disc or pv then >>  <<03519>>19790000
                    << then set up disc free space data    >>  <<03519>>19795000
                    << segment.                            >>  <<03519>>19800000
                                                               <<03519>>19805000
                    sys'or'pv := check'if'sys'disc'or'pv (ldev,<<03519>>19810000
                                                      ldt);    <<03519>>19815000
                                                               <<03519>>19820000
                    if sys'or'pv > 0 then                      <<03519>>19825000
                       begin  << needs free space dst >>       <<03519>>19830000
                                                               <<03519>>19835000
                          dfs'stat := create'dfs'data'seg (    <<03519>>19840000
                                ldev, ,, if sys'or'pv = 1 then <<03519>>19845000
                                true else false);              <<03519>>19850000
                                                               <<03519>>19855000
                          if not dfs'stat then                 <<03519>>19860000
                             send'process'dfs'error (ldev,     <<03528>>19865000
                                   dfs'stat, 0);               <<03528>>19870000
                                                               <<03519>>19875000
                       end;   << needs free space dst >>       <<03519>>19880000
                                                               <<03519>>19885000
                 end                                                    19890000
         else <<process down command>>                                  19895000
         begin                                                          19900000
            savesir'lpdt:=getsir(lpdt'sir); << lock lpdt >>    <<06221>>19905000
            lpdt'index:=ldev*logical(lpdt'entry'size);         <<06221>>19910000
            if ldev = sys'console'ldev then                    <<06923>>19915000
              errnum := downconsole  <<can't down console!!>>  <<01027>>19920000
            else                                               <<01027>>19925000
            if dev'is'disc  and  sys'disc                      <<04195>>19930000
               then errnum := cant'down'sys'disc               <<04195>>19935000
            else                                               <<04195>>19940000
            if lpdt'dev'own'state = lpdt'not'owned             <<06221>>19945000
               and ldt'file'use'cnt=0 then <<dev not in use>>  <<06604>>19950000
               if ldt'avail'to'sys then                        <<06604>>19955000
                  begin  << down device >>                     <<03519>>19960000
                                                               <<03519>>19965000
                     ldt'avail'to'sys := false;                <<06604>>19970000
                                                               <<03519>>19975000
                     << if it is a sys disc or pv then >>      <<03519>>19980000
                     << deallocate and delete the disc >>      <<03519>>19985000
                     << free space data segement.      >>      <<03519>>19990000
                                                               <<03519>>19995000
                     sys'or'pv := check'if'sys'disc'or'pv (    <<03519>>20000000
                                     ldev, ldt);               <<03519>>20005000
                                                               <<03519>>20010000
                     if sys'or'pv > 0 then                     <<03519>>20015000
                        begin  << has free space dst >>        <<03519>>20020000
                                                               <<03519>>20025000
                           deallocate'dfs'data'seg (ldev);     <<03519>>20030000
                                                               <<03519>>20035000
                           delete'dfs'data'seg (ldev);         <<03519>>20040000
                                                               <<03519>>20045000
                        end;   << has free space dst >>        <<03519>>20050000
                                                               <<03519>>20055000
                  end    << down device >>                     <<03519>>20060000
               else errnum:=-ldevaldown <<device already down>>         20065000
            else if ldt'down'pending then errnum:=-ldevaldownp <<06604>>20070000
                 else                                                   20075000
                 begin <<make down pending>>                            20080000
                    ldt'down'pending:=true;                    <<06604>>20085000
                    errnum:=-ldevinusedownp; <<in use, down pending>>   20090000
                 end;                                                   20095000
            relsir(lpdt'sir,savesir'lpdt);                     <<06221>>20100000
         end;                                                           20105000
         if errnum<=0 then movetodseg(ldtdst,ldev*ldtsize,@ldt,ldtsize);20110000
         relsir(ldtsir,savesir'ldt); <<unlock ldt>>                     20115000
         if up and errnum=0                                             20120000
<< caution: this next line must be changed for mpev >>         <<06604>>20125000
            and ldt'access'type >=ldt'dtype'list then          <<06604>>20130000
            awake(sysproc(ucop),%20,0); <<awaken ucop to try sched>>    20135000
         if errnum<>0 then <<need to give use diag. or warning>>        20140000
         begin                                                          20145000
            parmnum:=1;                                                 20150000
            cierr(errnum,parmsp);                                       20155000
         end;                                                           20160000
      end                                                               20165000
      else                                                              20170000
      begin                                                             20175000
         parmnum:=1;  <<use has neither allow or associate to command>> 20180000
         cierr(errnum:=usernoacc2dev,parmsp);                           20185000
      end;                                                              20190000
   end;                                                                 20195000
end;                                                                    20200000
$page "FOREIGN COMMAND EXECUTOR"                               <<01115>>20205000
$control segment=oplow                                         <<01115>>20210000
procedure cxforeign executorhead;                              <<01115>>20215000
begin                                                          <<01115>>20220000
   double array parm(0:1)=q;                                   <<01115>>20225000
   byte pointer firstparm=parm, sndparm=parm+2;                <<01115>>20230000
   byte firstlen=parm+1;                                       <<01115>>20235000
   integer numparms,ldev;                                      <<01115>>20240000
   subroutine def'movefromdseg;                                <<01115>>20245000
                                                               <<01115>>20250000
                                                               <<01115>>20255000
cxforeign:                                                     <<01115>>20260000
   logimage( m'foreign, parmsp );  << log op command >>        <<01527>>20265000
   mycommand(parmsp,,2,numparms,parm); <<parse command>>       <<01115>>20270000
   if numparms<>1 then <<expected disc ldev #>>                <<01115>>20275000
   begin                                                       <<01115>>20280000
      parmnum:=if numparms<1 then 1 else 2;                    <<01115>>20285000
      tos:=errnum:=foreignreq1p;                               <<01115>>20290000
      tos:=if parmnum=1 then @parmsp else @sndparm;            <<01115>>20295000
      cierr(*,*);                                              <<01115>>20300000
   end                                                         <<01115>>20305000
   else                                                        <<01115>>20310000
   begin                                                       <<01115>>20315000
      ldev:=verify'rldev(firstparm,firstlen,errnum,parmnum,1); <<01115>>20320000
      if < then return; <<invalid ldev # specified>>           <<01115>>20325000
      if verify'masterop(ldev) then return;<<inadvertent operator<<fdf>>20330000
      if checkass(ldev) or                                     <<01115>>20335000
         checkallow(m'foreign) then <<validate legal use of comma<<fdf>>20340000
      begin                                                    <<01115>>20345000
         case foreign(ldev) of                                 <<01115>>20350000
           begin                                               <<01115>>20355000
             errnum:=0;                 <<case 0>>             <<01115>>20360000
             errnum:=-alreadyforeign;   <<case 1>>             <<01115>>20365000
             errnum:=mustbedisc;        <<case 2>>             <<01115>>20370000
             errnum:=volmustbemtd;      <<case 3>>             <<01115>>20375000
             errnum:=inusepv;           <<case 4>>             <<01115>>20380000
             errnum:=inuseserdisc;      <<case 5>>             <<01115>>20385000
             errnum:=ldevinsysdomain;   <<case 6>>             <<01115>>20390000
             errnum := cantmakeforeign;   <<case 7>>           <<03713>>20395000
           end;                                                <<01115>>20400000
                                                               <<01115>>20405000
         if errnum<>0 then                                     <<01115>>20410000
           begin                                               <<01115>>20415000
             parmnum:=1;                                       <<01115>>20420000
             cierr(errnum, firstparm);                         <<01115>>20425000
           end;                                                <<01115>>20430000
      end                                                      <<01115>>20435000
      else                                                     <<01115>>20440000
      begin                                                    <<01115>>20445000
         parmnum:=1;                                           <<01115>>20450000
         cierr(errnum:=usernoacc2dev,parmsp);                  <<01115>>20455000
      end;                                                     <<01115>>20460000
   end;                                                        <<01115>>20465000
end;                                                           <<01115>>20470000
$page "RECALL EXECUTOR"                                        <<01649>>20475000
$control segment=ophi                                          <<04535>>20480000
procedure recall(errnum);                                      <<04535>>20485000
 integer errnum;                                               <<04535>>20490000
option privileged,uncallable;                                  <<04535>>20495000
begin                                                          <<04535>>20500000
   comment                                                     <<04535>>20505000
      this procedure will display all pending replies          <<04535>>20510000
   ;                                                           <<04535>>20515000
   array rit(0:rit'size) =q; << rit entry, pad for genmsg >>   <<04803>>20520000
   byte array rit'(*)=rit;                                     <<04535>>20525000
   integer maxinx,i;                                           <<04535>>20530000
   integer numqueued;                                          <<04803>>20535000
   logical not'printheader:=true;                              <<04535>>20540000
   subroutine def'movefromdseg;                                <<04535>>20545000
                                                               <<04535>>20550000
   movefromdseg(@maxinx,rit'dst,1,1); <<get max. # of entries>><<04803>>20555000
   <<calculate max index into rit dst>>                        <<04535>>20560000
   maxinx:=(maxinx)*rit'size+rit'headsize;                     <<04803>>20565000
   i:=rit'headsize-rit'size;<<init entry ptr before 1st entry>><<04803>>20570000
   while (i:=i+rit'size)<maxinx do <<examine each rit entry>>  <<04803>>20575000
   begin                                                       <<04535>>20580000
      movefromdseg(@rit,rit'dst,i,rit'size);<<get a rit entry>><<04803>>20585000
      if rit<>0 then <<rit in use>>                            <<04535>>20590000
      begin                                                    <<04535>>20595000
         if not'printheader then <<print leading header>>      <<04535>>20600000
         begin                                                 <<04535>>20605000
            not'printheader:=false;                            <<04535>>20610000
            genmsg(cigeneralmsgset,recallheader);              <<04535>>20615000
         end;                                                  <<04535>>20620000
         rit'(rit(rit'msglen)+rit'msgbase*2):=0;               <<04535>>20625000
<< genmsg requires a zero byte terminator on messages>>        <<04535>>20630000
         genmsg(-1,@rit'(rit'msgbase*2));                      <<04535>>20635000
      end;                                                     <<04535>>20640000
   end;                                                        <<04535>>20645000
   if not'printheader then errnum:=-noreplypending;            <<04535>>20650000
   movefromdseg(@numqueued,rit'dst,queued'entries,1);          <<04803>>20655000
   if numqueued > 0                                            <<04803>>20660000
      then genmsg(generalset,num'queued,%10000,numqueued);     <<04803>>20665000
end;                                                           <<04535>>20670000
$control segment=ophi                                          <<04535>>20675000
 procedure cxrecall executorhead;                              <<04535>>20680000
 option privileged,uncallable;                                 <<04535>>20685000
 << this will execute a recall from the ci                   >><<04535>>20690000
<< the syntax of this command is:                            >><<04535>>20695000
<<                               recall                      >><<04535>>20700000
<<  this procedure will also print a warning message if there>><<04535>>20705000
<<  are extra parameters and a message if there are no       >><<04535>>20710000
<<  replies pending                                          >><<04535>>20715000
 begin                                                         <<04535>>20720000
   byte pointer addr;                                          <<04535>>20725000
   errnum := 0;                                                <<04535>>20730000
   scan parmsp while[8/cr,8/" "],1; << check for extra parms>> <<04535>>20735000
   if nocarry then                                             <<04535>>20740000
      begin                                                    <<04535>>20745000
        @addr := tos;                                          <<04535>>20750000
        cierr(-warnxparmsignored,addr);                        <<04535>>20755000
        end                                                    <<04535>>20760000
      else del;                                                <<04535>>20765000
   recall(errnum);                                             <<04535>>20770000
   if errnum = -noreplypending                                 <<04535>>20775000
      then cierr(errnum);                                      <<04535>>20780000
 end; << cxrecall >>                                           <<04535>>20785000
$control segment=ophi                                          <<04535>>20790000
 logical procedure consrecall(parmsp);                         <<04535>>20795000
 byte array parmsp;                                            <<04535>>20800000
 option privileged,uncallable;                                 <<04535>>20805000
 << this procedure will execute a =recall from the console   >><<04535>>20810000
 << not the ci                                               >><<04535>>20815000
<< the syntax of this command is:                            >><<04535>>20820000
<<                               (cntl/a)recall              >><<04535>>20825000
<<  this procedure will also print a warning message if there>><<04535>>20830000
<<  are extra parameters and a message if there are no       >><<04535>>20835000
<<  replies pending                                          >><<04535>>20840000
 begin                                                         <<04535>>20845000
   intrinsic print;                                            <<04535>>20850000
   logical array buf(0:35);<<progen will only read 70 chars>>  <<04535>>20855000
   byte array bbuf(*) = buf;                                   <<04535>>20860000
   integer i;                                                  <<04535>>20865000
   integer errnum;                                             <<04535>>20870000
   errnum := 0;                                                <<04535>>20875000
   bbuf(0) :=" ";                                              <<04535>>20880000
   move bbuf(1) := bbuf(0),(70);                               <<04535>>20885000
   << check for extra parameters >>                            <<04535>>20890000
   scan parmsp while [8/cr,8/" "],1;                           <<04535>>20895000
   if nocarry  << there are extra parameters >>                <<04535>>20900000
      then begin                                               <<04535>>20905000
             i := (tos-@parmsp)+7;<< add 7 for "RECALL" >>     <<04535>>20910000
             bbuf(i) := "^";                                   <<04535>>20915000
             print(buf,-(i+1),%0);                             <<04535>>20920000
             genmsg(generalset,parmsignored);                  <<04535>>20925000
             end                                               <<04535>>20930000
       else del; << decrement top of stack >>                  <<04535>>20935000
   recall(errnum);                                             <<04535>>20940000
   if errnum = -noreplypending                                 <<04535>>20945000
      then genmsg(generalset,norepending);                     <<04535>>20950000
   consrecall := true;                                         <<04535>>20955000
 end; << consrecall >>                                         <<04535>>20960000
$page "LOG COMMAND EXECUTOR"                                   <<00601>>20965000
$control segment=oplow                                         <<00601>>20970000
procedure cxlog executorhead;                                  <<00601>>20975000
begin                                                          <<00601>>20980000
<<                                                      >>     <<02345>>20985000
<< command executeor for the :log command.              >>     <<02345>>20990000
<< syntax:                                              >>     <<02345>>20995000
<<     :log logid,{start,restart,stop}                  >>     <<02345>>21000000
<<                                                      >>     <<02345>>21005000
   double array parm(0:2)=q;                                   <<00601>>21010000
   array parms(*) = parm;                                      <<02345>>21015000
   byte pointer firstparm=parm, sndparm=parm+2;                <<00601>>21020000
   byte firstlen=parm+1, sndlen=parm+3;                        <<00601>>21025000
   byte array logname(0:8);                                    <<00601>>21030000
   integer numparms,len,target:=0;                             <<00601>>21035000
                                                               <<00601>>21040000
   define                                                      <<02345>>21045000
      firstdelim  =  parms(1).(11:5)#,                         <<02345>>21050000
      snddelim    =  parms(3).(11:5)#;                         <<02345>>21055000
                                                               <<02345>>21060000
   equate                                                      <<02345>>21065000
      comma  = 0,                                              <<02345>>21070000
      cr     = 3;                                              <<02345>>21075000
                                                               <<02345>>21080000
   subroutine start;                                           <<00601>>21085000
   begin                                                       <<00601>>21090000
      if findlog(logname,len) then <<log process already active>>       21095000
      begin                                                    <<00601>>21100000
         parmnum:=1;                                           <<00601>>21105000
         cierr(errnum:=logidactive,firstparm);                 <<00601>>21110000
      end                                                      <<00601>>21115000
      else                                                     <<00601>>21120000
      if not initlog(logname,target) then <<unable to start log >>      21125000
      begin                                                    <<00601>>21130000
         parmnum:=1;                                           <<00601>>21135000
         cierr(errnum:=noinitlog,firstparm);                   <<00601>>21140000
      end;                                                     <<00601>>21145000
   end;                                                        <<00601>>21150000
                                                               <<00601>>21155000
   logimage( m'log, parmsp );  << log op command >>            <<01527>>21160000
   mycommand(parmsp,,2,numparms,parm);                         <<00601>>21165000
   if numparms<>2 then <<must have exactly 2 parameters>>      <<00601>>21170000
   begin                                                       <<00601>>21175000
      parmnum:=if numparms<2 then 1 else 2;                    <<00601>>21180000
      cierr(errnum:=logexp2parm);                              <<00601>>21185000
      return;                                                  <<00601>>21190000
   end                                                         <<00601>>21195000
   else                                                        <<00601>>21200000
   if not (1<=integer(firstlen)<=8) then <<log id 1 to 8 chars>>        21205000
   begin                                                       <<00601>>21210000
      parmnum:=1;                                              <<00601>>21215000
      cierr(errnum:=logmustbe1to8,firstparm);                  <<00601>>21220000
      return;                                                  <<00601>>21225000
   end                                                         <<00601>>21230000
   else                                                        <<00601>>21235000
   if firstparm<>alpha then <<logid must start with alpha char>>        21240000
   begin                                                       <<00601>>21245000
      parmnum:=1;                                              <<00601>>21250000
      cierr(errnum:=log1stcharalpha,firstparm);                <<00601>>21255000
      return;                                                  <<00601>>21260000
   end                                                         <<00601>>21265000
   else                                                        <<00601>>21270000
   begin                                                       <<00601>>21275000
      move logname:="         "; <<initialize log id string>>  <<01549>>21280000
      move logname:=firstparm,(firstlen); <<log id local copy>>         21285000
      move logname:=logname while an,1;                        <<00601>>21290000
      len:=tos-@logname; <<length of log id>>                  <<00601>>21295000
      if len<>integer(firstlen) then <<non-alphanumeric char. in id>>   21300000
      begin                                                    <<00601>>21305000
         parmnum:=1;                                           <<00601>>21310000
         cierr(errnum:=logidmustbean,firstparm(len-1));        <<00601>>21315000
         return;                                               <<00601>>21320000
      end;                                                     <<00601>>21325000
   end;                                                        <<00601>>21330000
   if firstdelim <> comma then                                 <<02345>>21335000
   begin                                                       <<02345>>21340000
      parmnum := 1;                                            <<02345>>21345000
      cierr(errnum:=expcomma,firstparm(integer(firstlen)));    <<02345>>21350000
      return;                                                  <<02345>>21355000
   end;                                                        <<02345>>21360000
                                                               <<02345>>21365000
   if sndlen=7 and sndparm="RESTART" then                      <<00601>>21370000
   begin                                                       <<00601>>21375000
      target:=[8/5,8/0];                                       <<00601>>21380000
      start;  <<do restart>>                                   <<00601>>21385000
   end                                                         <<00601>>21390000
   else                                                        <<00601>>21395000
   if sndlen=5 and sndparm="START" then start <<do start>>     <<00601>>21400000
   else                                                        <<00601>>21405000
   if sndlen=4 and sndparm="STOP" then <<do stop>>             <<00601>>21410000
   begin                                                       <<00601>>21415000
      if not findlog(logname,len) or not stoplog(logname) then <<00601>>21420000
      begin                                                    <<00601>>21425000
         parmnum:=1;                                           <<00601>>21430000
         cierr(errnum:=lognotactive,sndparm);<<no such log process>>    21435000
      end;                                                     <<00601>>21440000
   end                                                         <<00601>>21445000
   else                                                        <<00601>>21450000
   begin                                                       <<00601>>21455000
      parmnum:=2;                                              <<00601>>21460000
      cierr(errnum:=exp1ofssr,sndparm);                        <<00601>>21465000
   end;                                                        <<00601>>21470000
                                                               <<02345>>21475000
   if snddelim <> cr then                                      <<02345>>21480000
   begin                                                       <<02345>>21485000
      parmnum := 2;                                            <<02345>>21490000
      cierr(errnum:=-extradelim,sndparm(integer(sndlen)));     <<02345>>21495000
   end;                                                        <<02345>>21500000
                                                               <<02345>>21505000
end;                                                           <<00601>>21510000
$page "OUTFENCE/JOBFENCE COMMAND PROCESSOR"                             21515000
$control segment=opmed                                                  21520000
procedure cxoutfence executorhead;                                      21525000
begin                                                                   21530000
   entry cxjobfence;                                                    21535000
   comment                                                              21540000
      the syntax of this command is:                                    21545000
         outfence priority                                              21550000
         where 1<=priority<=14 sets the priority of output fence        21555000
   ;                                                                    21560000
   double dl:=[8/",",8/";",8/"=",8/cr]d;                       <<00874>>21565000
   byte array dl'(*)=dl;                                                21570000
   double array parm(0:4) = q;                                 <<00874>>21575000
   byte pointer firstparm=parm, sndparm=parm+2;                         21580000
   byte pointer trdparm = parm + 4;                            <<00874>>21585000
   byte len=parm+1;                                                     21590000
   byte sndlen = parm + 3, trdlen = parm + 5;                  <<00874>>21595000
   integer delim, ldev, headentry;                             <<00874>>21600000
   logical alldevs := true;                                    <<00874>>21605000
   integer array xdd'head(0:size'of'xdd'head-1);               <<06927>>21610000
integer                                                        <<06604>>21615000
   ldt'index := 0;                                             <<06604>>21620000
   integer array ldt(0:ldtsize-1);                             <<04216>>21625000
   integer array xdd(0:size'of'xdd0-1);                        <<06927>>21630000
   equate comma = 0,                                           <<00874>>21635000
          equals = 2,                                          <<04216>>21640000
          semicolon = 1;                                       <<00912>>21645000
   equate ldt'nrje'rdr = 22;                                   <<06927>>21650000
   integer savesir,numparms,priority,oldpriority,minpri:=1;             21655000
   integer saveldt;                                            <<04216>>21660000
integer lpdt'index := 0;                                       <<06927>>21665000
   logical outfence:=true;                                              21670000
                                                               <<06607>>21675000
   << ...................................................... >><<06607>>21680000
   <<        declarations for referencing the jmat           >><<06607>>21685000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>21690000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>21695000
   <<               a specific entry), after an exchange db. >><<06607>>21700000
   <<               or 0 if jmatarr is a local array.        >><<06607>>21705000
   << ...................................................... >><<06607>>21710000
                                                               <<06607>>21715000
   integer       jmatinx;                                      <<06607>>21720000
   integer array jmatarr(0:jmatheadersize-1);<<holds header>>  <<06607>>21725000
   subroutine def'movefromdseg;                                         21730000
   subroutine def'movetodseg;                                           21735000
<<cxoutfence entry point>>                                              21740000
   go to maincode;                                                      21745000
                                                                        21750000
<<cxjobfence entry point>>                                              21755000
cxjobfence:                                                             21760000
   outfence:=false;                                                     21765000
   minpri:=0;                                                           21770000
                                                                        21775000
maincode:                                                               21780000
                                                                        21785000
   logimage( ( if outfence                                     <<01527>>21790000
                  then m'outfence                              <<01527>>21795000
                  else m'jobfence ), parmsp );                 <<01527>>21800000
   mycommand(parmsp,dl',4,numparms,parm); <<parse command>>    <<00874>>21805000
   if not outfence and numparms <> 1 then                      <<00902>>21810000
     <<must have 1 parm>>                                      <<00902>>21815000
   begin                                                                21820000
      parmnum:=if numparms<1 then 1 else 2;                             21825000
      tos:=errnum:=jobfencereq1p;                              <<00874>>21830000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     21835000
      cierr(*,*);                                                       21840000
      return;                                                  <<00902>>21845000
   end                                                         <<00902>>21850000
   else                                                        <<00874>>21855000
   if outfence then                                            <<00902>>21860000
   begin  <<  outfence >>                                      <<00874>>21865000
      if numparms < 1 then                                     <<00874>>21870000
      begin                                                    <<00874>>21875000
         parmnum := 1;                                         <<00874>>21880000
         return;                                               <<00902>>21885000
      end                                                      <<00874>>21890000
      else                                                     <<00874>>21895000
      if numparms > 3 then                                     <<00874>>21900000
      begin                                                    <<00874>>21905000
         parmnum := 3;                                         <<00874>>21910000
         cierr(errnum := outfencexp3parms, trdparm);           <<00874>>21915000
         return;                                               <<00902>>21920000
      end                                                      <<00874>>21925000
   end;                                                        <<00902>>21930000
      priority:=binary(firstparm,len); <<get binary of outfence>>       21935000
      if <> then <<bad characters in priority>>                         21940000
      begin                                                             21945000
         parmnum:=1;                                                    21950000
         cierr(errnum:=if outfence then expprior1to14 else exp0to14,    21955000
            firstparm);                                                 21960000
      end                                                               21965000
      else                                                              21970000
      begin                                                             21975000
         if priority>14 then                                            21980000
         begin                                                          21985000
            priority:=14;    <<priority to high, use max.>>             21990000
            errnum:=-exppriorgt14;<<warn user>>                         21995000
         end                                                            22000000
         else if priority<minpri then                                   22005000
              begin                                                     22010000
                 priority:=minpri;     <<priority to low, use min.>>    22015000
                errnum:=if outfence then -exppriorlt1 else -exppriorlt0;22020000
              end;                                                      22025000
         if errnum<>0 then <<issue any necessary warnings>>             22030000
         begin                                                          22035000
            parmnum:=1; <<cierr will return if warning>>                22040000
            cierr(errnum,firstparm);                                    22045000
         end;                                                           22050000
         if outfence then                                      <<00902>>22055000
         begin                                                 <<00902>>22060000
         <<see if ldev specified>>                             <<00874>>22065000
         if numparms > 1 then                                  <<00874>>22070000
         begin                                                 <<00874>>22075000
            tos := parm;                                       <<00912>>22080000
            delim := s0.delimiter;                             <<00874>>22085000
            len := tos &lsr(8);                                <<00874>>22090000
            del;                                               <<00874>>22095000
            if delim <> semicolon then                         <<00874>>22100000
            begin                                              <<00874>>22105000
               parmnum := 1;                                   <<00874>>22110000
               cierr(errnum := expsemicolon, firstparm(len));  <<00874>>22115000
               return;                                         <<00874>>22120000
            end;                                               <<00874>>22125000
            tos := parm(1);  << get second parm,ldev >>        <<04216>>22130000
            delim := s0.delimiter;  << get equal sign delim >> <<04216>>22135000
            len := tos&lsr(8);  <<length of parm>>             <<04216>>22140000
            del;   <<delete parm off top of stack>>            <<04216>>22145000
            if sndparm <> "LDEV" or len <> 4 or                <<04216>>22150000
               delim <> equals then                            <<04216>>22155000
            begin                                              <<00874>>22160000
               parmnum := 2;                                   <<00874>>22165000
               cierr(errnum := expldeveq,sndparm);             <<00874>>22170000
               return;                                         <<00874>>22175000
            end                                                <<00874>>22180000
            else                                               <<00874>>22185000
            begin                                              <<00874>>22190000
               ldev := verify'rldev(trdparm,trdlen,errnum,     <<00874>>22195000
                          parmnum,1);                          <<00874>>22200000
               if < then return;                               <<00874>>22205000
               if verify'masterop(ldev) then return;           <<00874>>22210000
               if checkass(ldev) or checkallow(m'outfence)     <<00874>>22215000
               then <<user has access>>                        <<00874>>22220000
               alldevs := false                                <<00874>>22225000
               else                                            <<00874>>22230000
               begin <<user does not have access>>             <<00874>>22235000
                  parmnum := 1;                                <<00874>>22240000
                  cierr(errnum := usernoacc2dev, parmsp);      <<00874>>22245000
                  return;                                      <<00874>>22250000
               end                                             <<00874>>22255000
            end;                                               <<00874>>22260000
<<>>                                                           <<00874>>22265000
            saveldt:=getsir(ldtsir); <<lock ldt>>              <<04216>>22270000
            savesir:=getsir(odd'sir); <<lock odd>>             <<06927>>22275000
            movefromdseg(@xdd,odd'dst,0,size'of'xdd0);         <<06927>>22280000
            if not alldevs then <<outfence to be set for>>     <<00874>>22285000
            begin               << a particular ldev>>         <<00874>>22290000
               headentry := 8 ; <<beginning of head odd>>      <<00874>>22295000
               do                                              <<00874>>22300000
               begin                                           <<00874>>22305000
                  movefromdseg(@xdd'head,odd'dst,headentry,    <<06927>>22310000
                        xdd0'head'length);                     <<06927>>22315000
               end                                             <<00874>>22320000
               until (ldev = xddh'ldev) or                     <<06927>>22325000
                     (headentry := headentry +                 <<06927>>22330000
                     xdd0'head'length) >= xdd0'subentry'area;  <<06927>>22335000
               if ldev = xddh'ldev then                        <<06927>>22340000
               begin                                           <<00874>>22345000
               movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize); <<04216>>22350000
               lpdt'index := ldev * size'of'lpdt'entry;        <<06927>>22355000
               << if spooler doesn't own (ld'sp=0) and >>      <<04630>>22360000
               << spooling enable bit (ld'sq) = 0 then >>      <<04630>>22365000
               << don't change outfence.  else go      >>      <<04630>>22370000
               << and try.                             >>      <<04630>>22375000
               if((ldt'spool'state=ldt'not'spooled)land        <<06604>>22380000
                   (ldt'spool'queues = 0))                     <<06604>>22385000
                  then                                         <<04630>>22390000
<< check to see if the device is an nrje reader (type 22,  >>  <<06927>>22395000
<< subtype 2 ). if it is allow the outfence to go ahead and >> <<06927>>22400000
<< execute.  this is done because the nrje reader does not  >> <<06927>>22405000
<< have a spooler assocciated with it & outfence would fail.>> <<06927>>22410000
<< *** note *** this fix is somewhat of a kludge to give    >> <<06927>>22415000
<< nrje support.  we do not desire or encourage checking for>> <<06927>>22420000
<< individual devices.  it should be avoided if at all      >> <<06927>>22425000
<< possible!                                                >> <<06927>>22430000
                  if not ((ldt'device'type = ldt'nrje'rdr)     <<06927>>22435000
                     land (lpdt'subtype = 2)) then             <<06927>>22440000
                  begin    << print error >>                   <<06927>>22445000
                     parmnum := 1;                             <<04216>>22450000
                     relsir(odd'sir,savesir);                  <<06927>>22455000
                     relsir(ldtsir,saveldt);<<release ldt sir>><<06927>>22460000
                     cierr(errnum:=devicenotspooled,trdparm);  <<04216>>22465000
                     return;                                   <<04216>>22470000
                  end;                                         <<04216>>22475000
                  oldpriority := xddh'dev'outfence;            <<06927>>22480000
                  xddh'dev'outfence := priority;               <<06927>>22485000
                  movetodseg(odd'dst,headentry,@xdd'head,      <<06927>>22490000
                      xdd0'head'length);                       <<06927>>22495000
                  if oldpriority = 0 then                      <<00874>>22500000
                  begin                                        <<00874>>22505000
                     oldpriority := xdd0'system'outfence;      <<06927>>22510000
                  end;                                         <<00874>>22515000
               end                                             <<00874>>22520000
               else                                            <<00874>>22525000
               begin  <<ldev not found in odd>>                <<00874>>22530000
                  parmnum := 1;                                <<00874>>22535000
                  relsir(odd'sir,savesir);                     <<06927>>22540000
                  relsir(ldtsir,saveldt);                      <<04216>>22545000
                  cierr(errnum := ldevnotinodd,trdparm);       <<00874>>22550000
                  return;                                      <<00874>>22555000
               end;                                            <<00874>>22560000
             end;                                              <<00874>>22565000
               relsir(odd'sir,savesir);                        <<06927>>22570000
               relsir(ldtsir,saveldt);                         <<04216>>22575000
            end                                                <<00874>>22580000
            else                                               <<00874>>22585000
            begin          <<reset all outfences>>             <<00874>>22590000
            if not checkallow(m'outfence) then                 <<04174>>22595000
               begin                                           <<04174>>22600000
               parmnum := 0;                                   <<04174>>22605000
               cierr(errnum := opcommnotallow);                <<04174>>22610000
               return;                                         <<04174>>22615000
               end;                                            <<04174>>22620000
            savesir := getsir(odd'sir);                        <<06927>>22625000
            movefromdseg(@xdd,odd'dst,0,size'of'xdd0);         <<06927>>22630000
                                                                        22635000
            <<get old priority & mask in new priority>>                 22640000
                                                                        22645000
            priority.not'odd'prior:=xdd(4).not'odd'prior;      <<06927>>22650000
  << move the upper 12 bits into priority from the outfence wrd<<06927>>22655000
  << move new priority word to xdd system outfence word >>     <<06927>>22660000
            xdd(4) := priority;                                <<06927>>22665000
            movetodseg(odd'dst,0,@xdd,size'of'xdd0);           <<06927>>22670000
            headentry := 8;                                    <<00874>>22675000
            do                                                 <<00874>>22680000
            begin                                              <<00874>>22685000
               movefromdseg(@xdd'head,odd'dst,headentry,       <<06927>>22690000
                        size'of'xdd'head);                     <<06927>>22695000
               xddh'dev'outfence := 0;  <<reset fence>>        <<06927>>22700000
                <<if ldev entry = 0 then global outfence used>><<00874>>22705000
               movetodseg(odd'dst,headentry,@xdd'head,         <<06927>>22710000
                        size'of'xdd'head);                     <<06927>>22715000
            end                                                <<00874>>22720000
            until ((headentry:= headentry +                    <<06927>>22725000
              xdd0'head'length ) >= xdd0'subentry'area);       <<06927>>22730000
               relsir(odd'sir,savesir); <<unlock odd>>         <<06927>>22735000
         end;                                                  <<00874>>22740000
                                                                        22745000
            <<if new fence < old fence, potentially deferred>>          22750000
            <<output files could be printed, so use 'srooster'>>        22755000
            <<to awake any output spoolers>>                            22760000
                                                                        22765000
               srooster(0);                                             22770000
         end;                                                  <<00874>>22775000
      end;                                                     <<00902>>22780000
         if not outfence then                                  <<00874>>22785000
         begin    << :jobfence >>                              <<06607>>22790000
            jmatinx := 0;<< jmatarr is local  >>               <<06607>>22795000
            savesir:=getsir(jmatsir); <<lock jmat>>                     22800000
            movefromdseg(@jmatarr, jmatdst, 0, jmatheadersize);<<06607>>22805000
            oldpriority := jmatjobfence;                       <<06607>>22810000
            jmatjobfence := priority;                          <<06607>>22815000
            movetodseg(jmatdst, 0, @jmatarr, jmatheadersize);  <<06607>>22820000
            relsir(jmatsir,savesir);                                    22825000
            if oldpriority>priority then <<need to do some scheduling>> 22830000
            begin                                                       22835000
               disable;                                                 22840000
               absolute(jobsync).readyflag:=true;                       22845000
               enable;                                                  22850000
               awake(sysproc(ucop),%20,0);                              22855000
            end;                                                        22860000
         end;                                                           22865000
end;                                                                    22870000
$page "ABORTIO EXECUTOR"                                                22875000
$control segment=ophi                                                   22880000
procedure cxabortio executorhead;                                       22885000
begin                                                                   22890000
   comment                                                              22895000
      the syntax of this command is:                                    22900000
         abortio ldev                                                   22905000
         where ldev is any real logical device                          22910000
   ;                                                                    22915000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  22920000
   byte array dl'(*)=dl;                                                22925000
   double array parm(0:1)=q;                                            22930000
   byte pointer firstparm=parm, sndparm=parm+2;                         22935000
   byte len=parm+1;                                                     22940000
   logical ldev;                                                        22945000
   integer numparms;                                                    22950000
                                                                        22955000
   logimage( m'abortio, parmsp );  << log op command >>        <<01527>>22960000
   mycommand(parmsp,dl',2,numparms,parm);                               22965000
   if numparms<>1 <<must have 1>> then                                  22970000
   begin                                                                22975000
      parmnum:=if numparms<1 then 1 else 2;                             22980000
      tos:=errnum:=abortioreq1p;                                        22985000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     22990000
      cierr(*,*);                                                       22995000
   end                                                                  23000000
   else                                                                 23005000
   begin                                                                23010000
      ldev:=verify'rldev(firstparm,len,errnum,parmnum,1);               23015000
      if < then return;                                                 23020000
      if verify'masterop(ldev) then return;<<msterop made inadv. entry>>23025000
      if checkass(ldev) or checkallow(m'abortio) then <<user has acc.>> 23030000
      begin                                                             23035000
         parmnum := 1;   << in case abortio fails. >>          <<02677>>23040000
         abortio(ldev);                                                 23045000
                                                               <<02677>>23050000
         << abortio returns ccl if device is a disk, and ccg >><<02677>>23055000
         << if there is no i/o pending for the device. >>      <<02677>>23060000
                                                               <<02677>>23065000
         if < then                                             <<02677>>23070000
            cierr(errnum:=cantabortiodisk,firstparm)           <<02677>>23075000
         else if > then                                        <<02677>>23080000
            cierr(errnum:=-noioqed4dev,firstparm,%10000,ldev); <<02677>>23085000
      end                                                               23090000
      else                                                              23095000
      begin                                                             23100000
         parmnum:=1;                                                    23105000
         cierr(errnum:=usernoacc2dev,parmsp);                           23110000
      end;                                                              23115000
   end;                                                                 23120000
end;                                                                    23125000
$page "ACCEPT & REFUSE EXECUTORS"                                       23130000
$control segment=oplow                                                  23135000
procedure cxaccept executorhead;                                        23140000
begin                                                                   23145000
   comment                                                              23150000
      the syntax of the accept and refuse commands is:                  23155000
         accept  [jobs,] ldev                                           23160000
         refuse  [data,] ldev                                           23165000
      these commands enable or disable the capability of a              23170000
   device to accept jobs or data or both.                               23175000
      as always this procedure assumes db set to user's stack.          23180000
   ;                                                                    23185000
   entry cxrefuse;                                                      23190000
   logical accept:=true,ldev,job:=true,data:=true;                      23195000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  23200000
   byte array dl'(*)=dl;                                                23205000
   double array parm(0:2)=q;                                            23210000
   byte pointer firstparm=parm,sndparm=parm+2,trdparm=parm+4;           23215000
   byte firstlen=parm+1,sndlen=parm+3;                                  23220000
   logical firstdesc=parm+1,snddesc=parm+3;                             23225000
   integer savesir,numparms;                                            23230000
integer                                                        <<06604>>23235000
   ldt'index := 0;                                             <<06604>>23240000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>23245000
   array ldt(0:ldtsize-1);                                              23250000
   define firstdel=firstdesc.(11:5)#;                                   23255000
   equate comma=0,semicolon=1;                                          23260000
   subroutine def'movefromdseg;                                         23265000
                                                                        23270000
<<cxaccept entry point>>                                                23275000
   go to maincode;                                                      23280000
                                                                        23285000
<<cxrefuse entry point>>                                                23290000
cxrefuse:                                                               23295000
   accept:=false;                                                       23300000
                                                                        23305000
maincode:                                                               23310000
   logimage( ( if accept                                       <<01527>>23315000
                  then m'accept                                <<01527>>23320000
                  else m'refuse ), parmsp );                   <<01527>>23325000
   mycommand(parmsp,dl,3,numparms,parm); <<parse parameters>>           23330000
   if numparms>2 then <<too many parameters>>                           23335000
   begin                                                                23340000
      parmnum:=3;                                                       23345000
      cierr(errnum:=if accept then acceptreq2parm else refusereq2parm,  23350000
            trdparm);                                                   23355000
      return;                                                           23360000
   end                                                                  23365000
   else                                                                 23370000
   if numparms<1 then <<not enough parameters>>                         23375000
   begin                                                                23380000
      parmnum:=1;                                                       23385000
      cierr(errnum:=if accept then acceptreq1p else refusereq1p,parmsp);23390000
      return;                                                           23395000
   end                                                                  23400000
   else                                                                 23405000
   if > then <<two parameters>>                                         23410000
   begin                                                                23415000
      if firstdel<>comma then                                           23420000
      begin <<bad syntax, must be comma after 1st parameter>>           23425000
         parmnum:=1;                                                    23430000
         cierr(errnum:=commaafterdj,firstparm(firstlen));               23435000
         return;                                                        23440000
      end                                                               23445000
      else                                                              23450000
      if firstlen=4 then                                                23455000
         if firstparm="JOBS" then data:=false                           23460000
         else if firstparm="DATA" then job:=false                       23465000
              else errnum:=firstmustbedj                                23470000
      else errnum:=firstmustbedj;                                       23475000
      if errnum<>0 then                                                 23480000
      begin                                                             23485000
         parmnum:=1;                                                    23490000
         cierr(errnum,firstparm);                                       23495000
         return;                                                        23500000
      end;                                                              23505000
      parm:=parm(1); <<move 2nd param. descr. to 1st param. desc.>>     23510000
   end;                                                                 23515000
   ldev:=verify'rldev(firstparm,firstlen,errnum,parmnum,numparms);      23520000
   if < then return;                                                    23525000
   if verify'masterop(ldev) then return;<<masterop made inadvert. entr>>23530000
   if checkass(ldev) or                                                 23535000
      checkallow(if accept then m'accept else m'refuse) then            23540000
   begin                                                                23545000
      movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize);                   23550000
      if not (1<=integer(ldt'access'type)<=3) then<<not da/job <<06604>>23555000
      begin                                                             23560000
         parmnum:=numparms;                                             23565000
         cierr(errnum:=ldevnotdj,firstparm);                            23570000
      end                                                               23575000
      else                                                              23580000
      if job and ldt'dflt'out'dev =0 then <<no default out dev><<06604>>23585000
      begin                                                             23590000
         parmnum:=numparms;                                             23595000
         cierr(errnum:=ldevhasnodefout,firstparm);                      23600000
      end                                                               23605000
      else                                                              23610000
      begin                                                             23615000
         savesir:=getsir(lpdt'sir);                            <<06221>>23620000
         lpdt'index:=ldev*logical(lpdt'entry'size);            <<06221>>23625000
         disable;  << disable so we have lpdt alone >>         <<*8415>>23630000
         if job then lpdt'job'accept:=accept;                  <<06221>>23635000
         if data then lpdt'data'accept:=accept;                <<06221>>23640000
         enable; <<enable all interrupts >>                    <<*8415>>23645000
         relsir(lpdt'sir,savesir);                             <<06221>>23650000
      end;                                                              23655000
   end                                                                  23660000
   else                                                                 23665000
   begin                                                                23670000
      parmnum:=1;                                                       23675000
      cierr(errnum:=usernoacc2dev,parmsp);                              23680000
   end;                                                                 23685000
end;                                                                    23690000
$page "WELCOME EXECUTOR"                                                23695000
$control segment=oplow                                                  23700000
procedure cxwelcome executorhead;                                       23705000
begin                                                                   23710000
   comment                                                              23715000
      this command takes a file name as a parameter (optional).<< 8229>>23720000
      welcome message is loaded from the file specified.  if omitted    23725000
      the executor prompts with a "#" and reads the message from        23730000
      $stdin.                                                           23735000
                                                               << 8229>>23740000
      as always this executor expects the db to be at the user's stack. 23745000
                                                                        23750000
      this procedure is different from most other code in this module   23755000
   because it uses exchangedb instead of movefromdseg and movetodseg.   23760000
   this is because the code be very gross to write or read if written   23765000
   otherwise.                                                           23770000
                                                                        23775000
      the action of this executor is to place the logon message into one23780000
   of two permanently allocated extra data segments.  the layout of this23785000
   these data segments is as follows:                                   23790000
                                                                        23795000
         ______________________________________                         23800000
       0 !c!                  !user count     ! 0                       23805000
         --------------------------------------                         23810000
       1 ! length of dst in words             ! 2                       23815000
         --------------------------------------                         23820000
       2 !     "#"        !byte length of line! 4                       23825000
         --------------------------------------                         23830000
       3 !          1 st line                 ! 6                       23835000
         .                .                   .                         23840000
         .                .                   .                         23845000
         .                .-------------------.                         23850000
         !                !byte length of line!                         23855000
         --------------------------------------                         23860000
         !         subsequent line            !                         23865000
         .                .                   .                         23870000
         .                .                   .                         23875000
         .                .-------------------.                         23880000
         !                !        -1         !                         23885000
         --------------------------------------                         23890000
   ;                                                                    23895000
array welcome(*)=db+0;                                                  23900000
integer welcome'length=welcome+1;                                       23905000
byte welcome'prompt=welcome+2;                                          23910000
define welcome'current=welcome.(0:1)#, <<current welcome message flag>> 23915000
       welcome'usecnt=welcome.(10:6)#; <<user count>>                   23920000
equate welcome'first=3;                <<offset to first line>>         23925000
equate welcome'dst1=%57;               <<dst # of 1st welcome dst>>     23930000
equate welcomedst=sysglob+%277;        <<dst # of current welcome dst>> 23935000
equate welcomesir=%27;                 <<welcome sir>>                  23940000
equate welcome'prompt'w=2;             <<word containing prompt>>       23945000
$page                                                                   23950000
integer wdst,                    << welcome dst >>             << 8229>>23955000
        savesir,                 << old welcome sir >>         << 8229>>23960000
        total := 0,              << total size of welc. msg.>> << 8229>>23965000
        iocount;                 << length of curr. line >>    << 8229>>23970000
integer                                                        <<01523>>23975000
   curr'wdst,       << current wdst before executing command >><<02319>>23980000
   mess'file,          << input message file >>                << 8229>>23985000
   stdlist  := 2;                                              <<01523>>23990000
logical                                                        <<02319>>23995000
   crit'state;      << old critical state >>                   <<02319>>24000000
logical pointer l'prompt;                                      <<01523>>24005000
logical is'interact, is'dup;                                   <<01523>>24010000
logical pointer  inbuf;      << input buffer >>                << 8229>>24015000
   byte pointer nextline;                                               24020000
array qarray(*) = q + 0;                                       <<06605>>24025000
integer pcbglobloc;                                            <<06605>>24030000
integer numparms,            << number of parameters >>        << 8229>>24035000
       readlength,           << maximum read length.  >>       << 8229>>24040000
        parm'length,         << length of file name >>         << 8229>>24045000
        iname,               << which file name is checked >>  << 8229>>24050000
        errcode,                                               << 8229>>24055000
        recsize,             << record size of file >>         << 8229>>24060000
        msglen;                                                << 8229>>24065000
                                                               << 8229>>24070000
logical set'foptions,        << foptions of open msg file >>   << 8229>>24075000
        file'specified;      << true if file is specified >>   << 8229>>24080000
                                                               << 8229>>24085000
byte pointer parm'start;     << points to file name >>         << 8229>>24090000
                                                               << 8229>>24095000
double array parms(0:1)=q;                                     << 8229>>24100000
logical array l'parms(*)=parms,                                << 8229>>24105000
              l'msgbuff(0:39);                                 << 8229>>24110000
                                                               << 8229>>24115000
equate foptions = %002005, << ascii, old, disallow feq's >>             24120000
       aoptions = 0,                                                    24125000
       message'offset=3350-3170,                               << 8229>>24130000
                             << offset from error code ret->>  << 8229>>24135000
                             << urned by check'filename    >>  << 8229>>24140000
                             << to message numbers         >>  << 8229>>24145000
       name'ok=0;            << normal return code >>          << 8229>>24150000
                                                                        24155000
intrinsic  fread, fwrite, fopen, fclose,                       << 8229>>24160000
      fcheck, ffileinfo, ferrmsg;                              << 8229>>24165000
                                                               << 8229>>24170000
<<------------------------>>                                   << 8229>>24175000
                                                               << 8229>>24180000
integer subroutine getparm(parameter);                         << 8229>>24185000
   comment: gets paramater from command input stream           << 8229>>24190000
            returns - length of parameter, 0 if not specified, << 8229>>24195000
                      -1 if could not get parameter            << 8229>>24200000
            parameters: parameter - returned - address of first<< 8229>>24205000
                                  character of parm.           << 8229>>24210000
            globals: parmsp (unchanged)                        << 8229>>24215000
                     numparms (changed)                        << 8229>>24220000
                     parms, l'parms (changed);                 << 8229>>24225000
   byte pointer parameter;    << first char of parm >>         << 8229>>24230000
                                                               << 8229>>24235000
begin                                                          << 8229>>24240000
   mycommand(parmsp,,1,numparms,parms);                        << 8229>>24245000
   if <> then                                                  << 8229>>24250000
      begin                                                    << 8229>>24255000
      cierr(errnum := too'many'wparms);                        << 8229>>24260000
      getparm := -1;                                           << 8229>>24265000
      end                                                      << 8229>>24270000
   else begin                                                  << 8229>>24275000
      @parameter := l'parms(0);  << starting address >>        << 8229>>24280000
      if numparms = 0 then                                     << 8229>>24285000
         getparm := 0            << length of parm = 0 >>      << 8229>>24290000
      else                                                     << 8229>>24295000
         getparm := l'parms(1).(0:8); << size of parm >>       << 8229>>24300000
   end;                                                        << 8229>>24305000
end;                                                           << 8229>>24310000
                                                               << 8229>>24315000
<<----------------------->>                                    << 8229>>24320000
                                                               << 8229>>24325000
logical subroutine open'file(file'name,length,record'length);  << 8229>>24330000
   comment: opens the message file                             << 8229>>24335000
            returns: true if successful, false otherwise       << 8229>>24340000
            parameters: file'name - input - array containing   << 8229>>24345000
                                    ascii name of file         << 8229>>24350000
                        length - input - length of filename    << 8229>>24355000
                        record'length - output - readlength    << 8229>>24360000
                                        of file                << 8229>>24365000
            globals: iname (changed), errcode (changed),       << 8229>>24370000
                     l'msgbuff (changed), msglen (changed),    << 8229>>24375000
                     set'f'options (changed), recsize (chngd); << 8229>>24380000
                                                               << 8229>>24385000
   value file'name, length;                                    << 8229>>24390000
   byte pointer file'name;                                     << 8229>>24395000
   integer length,             << length of file'name >>       << 8229>>24400000
           record'length;      << read length of file >>       << 8229>>24405000
                                                               << 8229>>24410000
begin                                                          << 8229>>24415000
   open'file := true;                                          << 8229>>24420000
   if length > 0 then          << file name not null >>        << 8229>>24425000
      begin                                                    << 8229>>24430000
      iname := 1;                                              << 8229>>24435000
      check'filename(file'name,length,iname,errcode);          << 8229>>24440000
      if errcode <> name'ok then                               << 8229>>24445000
         begin                                                 << 8229>>24450000
         cierr(errnum := errcode + message'offset);            << 8229>>24455000
         open'file := false;                                   << 8229>>24460000
         goto error'exit;                                      << 8229>>24465000
         end;                                                  << 8229>>24470000
      mess'file := fopen(file'name,foptions,aoptions);         << 8229>>24475000
      if <> then   << could not open message file >>           << 8229>>24480000
         begin                                                 << 8229>>24485000
         fcheck(,errcode);                                     << 8229>>24490000
         ferrmsg(errcode,l'msgbuff,msglen);                    << 8229>>24495000
                              << print out error message >>    << 8229>>24500000
         fwrite(stdlist,l'msgbuff,-msglen," ");                << 8229>>24505000
         cierr(errnum := can't'open'mfile);                    << 8229>>24510000
         open'file := false;                                   << 8229>>24515000
         goto error'exit;                                      << 8229>>24520000
         end;                                                  << 8229>>24525000
      << check file for proper attributes >>                   << 8229>>24530000
      ffileinfo(mess'file,2,set'foptions,4,recsize);           << 8229>>24535000
      if set'foptions.(8:2) <> 0 then <<bad record format >>   << 8229>>24540000
         begin                                                 << 8229>>24545000
         fclose(mess'file,0,0);                                << 8229>>24550000
         cierr(errnum := invalid'recfm);                       << 8229>>24555000
         open'file := false;                                   << 8229>>24560000
         goto error'exit;                                      << 8229>>24565000
         end;                                                  << 8229>>24570000
      if set'foptions.(13:1) <> 1 then  << not ascii >>        << 8229>>24575000
         begin                                                 << 8229>>24580000
         fclose(mess'file,0,0);                                << 8229>>24585000
         cierr(errnum := file'not'ascii);                      << 8229>>24590000
         open'file := false;                                   << 8229>>24595000
         goto error'exit;                                      << 8229>>24600000
         end;                                                  << 8229>>24605000
      if recsize < -80 then        << record size > 80 b. >>   << 8229>>24610000
         cierr(errnum := -warn'recsize'too'large);             << 8229>>24615000
      if recsize > -72 then  << readlength = recsize >>        << 8229>>24620000
         record'length := -recsize                             << 8229>>24625000
      else record'length := 72;  << no greater than 72 chars>> << 8229>>24630000
      end                                                      << 8229>>24635000
   else                                                        << 8229>>24640000
      begin                            << default file >>      << 8229>>24645000
      mess'file := fopen(,%44);        << open stdin >>        << 8229>>24650000
      if <> then                      << can't open stdin >>   << 8229>>24655000
         begin                                                 << 8229>>24660000
         cierr(errnum := can't'open'mfile);                    << 8229>>24665000
         open'file := false;                                   << 8229>>24670000
         end;                                                  << 8229>>24675000
      record'length := 72;                                     << 8229>>24680000
      end;                                                     << 8229>>24685000
error'exit:                                                    << 8229>>24690000
end;   << open'file >>                                         << 8229>>24695000
                                                               << 8229>>24700000
<<---------------------------->>                               << 8229>>24705000
                                                               << 8229>>24710000
integer subroutine skip'blanks(string,count);                  << 8229>>24715000
   comment: skips trailing blanks                              << 8229>>24720000
            returns - length of string without tr. blanks      << 8229>>24725000
            parameters - string - pointer to start of string   << 8229>>24730000
                         count - initial length of string;     << 8229>>24735000
                                                               << 8229>>24740000
                                                               << 8229>>24745000
   value string, count;                                        << 8229>>24750000
   byte pointer string;                                        << 8229>>24755000
   integer      count;          << length of string >>         << 8229>>24760000
                                                               << 8229>>24765000
begin                                                          << 8229>>24770000
   count := count - 1;         << account for 0 based ptr >>   << 8229>>24775000
   while (string(count) = " ") and (count > 0) do              << 8229>>24780000
      count := count - 1;                                      << 8229>>24785000
   skip'blanks := count + 1;                                   << 8229>>24790000
end;  << skip'blanks >>                                        << 8229>>24795000
                                                               << 8229>>24800000
<<--------------------------->>                                << 8229>>24805000
                                                               <<01523>>24810000
                                                               <<01523>>24815000
                                                                        24820000
   @l'prompt := @welcome + welcome'prompt'w;                   <<01523>>24825000
   logimage( m'welcome, parmsp );  << log op command >>        <<01527>>24830000
   parm'length := getparm(parm'start);                         << 8229>>24835000
   if parm'length = -1 then return;  << error on parm read >>  << 8229>>24840000
   if not open'file(parm'start,parm'length,readlength)         << 8229>>24845000
            then return;             << error on open >>       << 8229>>24850000
   pxglobal;                                                   <<06605>>24855000
   is'interact := pxg'interactive;                             <<06605>>24860000
   is'dup := pxg'duplicative;                                  <<06605>>24865000
   savesir:=getsir(welcomesir); <<lock welcome dst's>>                  24870000
<< get current welcome dst number. >>                          <<02319>>24875000
   curr'wdst := wdst := absolute(welcomedst);                  <<02319>>24880000
   wdst:=wdst.(15:1)+welcome'dst1;<<calculate next welcome dst #>>      24885000
   exchangedb(wdst); <<point db at new welcome dst>>                    24890000
   if welcome'usecnt<>0 then <<other one in use>>                       24895000
   begin                                                                24900000
   exchangedb(0);    <<back to user's stack>>                           24905000
      relsir(welcomesir,savesir); <<unlock dst's>>                      24910000
      fclose(mess'file, 0, 0);                                 << 8229>>24915000
      cierr(errnum:=welmsgbusy);                                        24920000
   end                                                                  24925000
   else                                                                 24930000
   begin                                                                24935000
   << cannot abort until finished processing command >>        <<02319>>24940000
   << so that 1) usecount will be decremented and    >>        <<02319>>24945000
   << 2) sysglob cell updated.                       >>        <<02319>>24950000
      crit'state := setcritical;                               <<02319>>24955000
      welcome'usecnt:=1; <<set it in use so one can touch dst>>         24960000
      relsir(welcomesir,savesir); <<unclock dst's>>                     24965000
      if welcome'length>124 then <<one sector, including overhead>>     24970000
         welcome'length:=altdsegsize(wdst,124-welcome'length);          24975000
      @nextline:=welcome'first*2;                                       24980000
      welcome'prompt:="#";  <<initialize prompt character>>             24985000
      errcode := 0;         << initialize error number >>      << 8229>>24990000
readloop:                                                               24995000
      iocount:=readlength;  <<default read length>>                     25000000
      if (welcome'length*2-total-welcome'first*2-1)<readlength << 8229>>25005000
       << if amount of room left in dst < largest read length>><< 8229>>25010000
      then begin   << not enough room in dst for full read >>  << 8229>>25015000
         welcome'length:=altdsegsize(wdst,128);<<add 1 sector>><< 8229>>25020000
         if <> then                                            << 8229>>25025000
            begin                                              << 8229>>25030000
            errcode := -welc'dst'full;                         << 8229>>25035000
            goto exitreadloop;                                 << 8229>>25040000
            end;                                               << 8229>>25045000
         end;                                                  << 8229>>25050000
      if is'interact and (parm'length <= 0) then               << 8229>>25055000
         fwrite( stdlist, l'prompt, -1, %320 );                <<01523>>25060000
      @inbuf := @nextline&lsr(1);                              <<01523>>25065000
      iocount := fread( mess'file, inbuf, -readlength);        << 8229>>25070000
      if >                             << end of file >>       << 8229>>25075000
         then go exitreadloop                                  <<01523>>25080000
      else if < then                                           <<01523>>25085000
      begin                                                    <<01523>>25090000
                                                               <<01523>>25095000
      << an read error occurred.  quit.   >>                   <<01523>>25100000
         welcome'usecnt := 0;                                  <<01523>>25105000
         resetcritical(crit'state);  << now, can abort >>      <<02319>>25110000
         exchangedb(0);                                        <<01523>>25115000
         fcheck(mess'file,errcode);  << print out reason >>    << 8229>>25120000
         ferrmsg(errcode, l'msgbuff, msglen);                  << 8229>>25125000
         fwrite(stdlist, l'msgbuff, -msglen, " ");             << 8229>>25130000
         fclose( mess'file, 0, 0);                             << 8229>>25135000
         cierr( errnum := welcreaderr );                       <<01523>>25140000
         return;                                               <<01523>>25145000
                                                               <<01523>>25150000
      end                                                      <<01523>>25155000
      else if (iocount = 0) and (parm'length <= 0)             << 8229>>25160000
                         << carriage return alone from $stdin>><< 8229>>25165000
         then go exitreadloop;                                 <<01523>>25170000
      iocount := skip'blanks(inbuf,iocount);                   << 8229>>25175000
      if (not is'dup) or (parm'length > 0) then                << 8229>>25180000
                        << from a file or from non-dup device>><< 8229>>25185000
         fwrite( stdlist, inbuf, -iocount, 0 );                <<01523>>25190000
      if not logical(iocount) then                                      25195000
      begin                                                             25200000
         nextline(iocount):=" "; <<lines are always odd length>>        25205000
         iocount:=iocount+1;                                            25210000
      end;                                                              25215000
      nextline(-1):=iocount;    <<set line length>>                     25220000
      @nextline:=@nextline(iocount+1);                                  25225000
      total:=total+iocount+1;                                           25230000
      go to readloop;                                                   25235000
exitreadloop:                                                           25240000
      if total=0 then wdst:=0 <<kill the welcome message>>              25245000
      else                                                              25250000
      begin                                                             25255000
         welcome'current:=true; <<make this the current welcome messag>>25260000
         nextline(-1):=-1;                                              25265000
      end;                                                              25270000
   << lock data segments while updating sysglob cell >>        <<02319>>25275000
   << and status of both data segments.              >>        <<02319>>25280000
      savesir := getsir(welcomesir);                           <<02319>>25285000
      welcome'usecnt:=0; <<release dst>>                                25290000
      exchangedb(0); <<back to user's stack>>                           25295000
      if wdst <> 0 then                                        <<02319>>25300000
         updatedisccopy(wdst);  << force good copy into vm. >> <<02319>>25305000
      if curr'wdst <> 0 then   << is there a current one? >>   <<02319>>25310000
         begin                                                 <<02319>>25315000
         exchangedb(curr'wdst);                                <<02319>>25320000
         welcome'current := false;  << mark it non-current.  >><<02319>>25325000
         updatedisccopy(curr'wdst); << force it out to disk. >><<02319>>25330000
         exchangedb(0);                                        <<02319>>25335000
         end;                                                  <<02319>>25340000
      absolute(welcomedst) := wdst;  << update sysglob cell. >><<02319>>25345000
      relsir(welcomesir,savesir);    << release data segs.   >><<02319>>25350000
      resetcritical(crit'state);     << now, can abort.      >><<02319>>25355000
      fclose(mess'file,0,0);                                   << 8229>>25360000
      if errcode <> 0 then cierr(errnum := errcode);           << 8229>>25365000
           << print out any error messages >>                  << 8229>>25370000
   end;                                                                 25375000
end;                                                                    25380000
$page "BREAKJOB & RESUMEJOB EXECUTORS"                                  25385000
$control segment=oplow                                                  25390000
procedure cxbreakjob executorhead;                                      25395000
begin                                                                   25400000
   comment                                                              25405000
      the syntax of these commands is:                                  25410000
         breakjob  #jnnn                                                25415000
         resumejob #jnnn                                                25420000
      as always, code assumes execution on user's stack.                25425000
   ;                                                                    25430000
   entry cxresumejob;                                                   25435000
   double array parm(0:1)=q;                                            25440000
   byte pointer firstparm=parm,sndparm=parm+2;                          25445000
   byte len=parm+1;                                                     25450000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  25455000
   byte array dl'(*)=dl;                                                25460000
   logical break:=true,entryp;                                          25465000
   integer savesir,numparms,jobnum,n,ldev,lastldev;                     25470000
   equate maxn=10;         <<maximum # of ownded device to be reported>>25475000
   integer array owned(0:maxn-1);                                       25480000
integer                                                        <<06604>>25485000
   ldt'index := 0;                                             <<06604>>25490000
   array ldt(0:ldtsize-1);                                              25495000
                                                               <<06607>>25500000
   << ...................................................... >><<06607>>25505000
   <<        declarations for referencing the jmat           >><<06607>>25510000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>25515000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>25520000
   <<               a specific entry), after an exchange db. >><<06607>>25525000
   <<               or 0 if jmatarr is a local array.        >><<06607>>25530000
   << ...................................................... >><<06607>>25535000
                                                               <<06607>>25540000
   integer       jmatinx;                                      <<06607>>25545000
   array jmatarr(0:jmatentrysize-1);<< holds jmat entry >>     <<06607>>25550000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>25555000
   subroutine def'movefromdseg;                                         25560000
   subroutine def'movetodseg;                                           25565000
                                                                        25570000
<<cxbreakjob entry point>>                                              25575000
   go to maincode;                                                      25580000
                                                                        25585000
<<cxresumejob entry point>>                                             25590000
cxresumejob:                                                            25595000
   break:=false;                                                        25600000
                                                                        25605000
maincode:                                                               25610000
   logimage( ( if break                                        <<01527>>25615000
                then m'breakjob                                <<01527>>25620000
                else m'resumejob ), parmsp );                  <<01527>>25625000
   mycommand(parmsp,dl',2,numparms,parm);<<parse parameters>>           25630000
   if numparms<>1 then <<must be exactly one parameter>>                25635000
   begin                                                                25640000
      parmnum:=if < then 1 else 2;                                      25645000
      tos:=errnum:=if break then breakjobreq1p else resumejobreq1p;     25650000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     25655000
      cierr(*,*);                                                       25660000
   end                                                                  25665000
   else                                                                 25670000
   if len<3 or firstparm<>"#J" then <<expected #jnnn>>                  25675000
   begin                                                                25680000
      parmnum:=1;                                                       25685000
      cierr(errnum:=parmnotjobid,firstparm);                            25690000
   end                                                                  25695000
   else                                                                 25700000
   begin                                                                25705000
      jobnum:=binary(firstparm(2),len-2); <<convert ascii to binary #j>>25710000
      if <> then <<bad job num #>>                                      25715000
      begin                                                             25720000
         parmnum:=1;                                                    25725000
         cierr(errnum:=badjobnum,firstparm(2));                         25730000
      end                                                               25735000
      else                                                              25740000
      begin                                                             25745000
         << ............................................... >> <<06607>>25750000
         <<   findjob will return the jmat entry in jmatarr >> <<06607>>25755000
         <<   if successful, and it will be holding the jmat>> <<06607>>25760000
         <<   sir.  if findjob fails it will release the sir>> <<06607>>25765000
         <<   formerly, the sir was rereleased below.  that >> <<06607>>25770000
         <<   has been rectified with this fix.             >> <<06607>>25775000
         << ............................................... >> <<06607>>25780000
                                                               <<06607>>25785000
         if not findjob(jmatarr,entryp,jobnum,true,,,,savesir) <<06607>>25790000
         then                                                  <<06607>>25795000
         begin                                                          25800000
            parmnum:=1;                                                 25805000
            <<  the  jmat sir has been released by findjob  >> <<06607>>25810000
            cierr(errnum:=nosuchjob,firstparm(2));                      25815000
         end                                                            25820000
         else                                                           25825000
         if (checkjob(jmatarr) = 0) or                         <<06607>>25830000
            checkallow(if break then m'breakjob else m'resumejob) then  25835000
         begin                                                          25840000
            jmatinx := 0;<< jmatarr is local >>                <<06607>>25845000
            if break then <<breakjob>>                                  25850000
               if jmatjobstate <> jobexec then  <<not exec. >> <<06607>>25855000
                  errnum:=jobnotactive                                  25860000
               else suspendjob(jmatmainpin, errnum)            <<06607>>25865000
            else <<resumejob>>                                          25870000
               if jmatjobstate <> jobsusp then << not susp. >> <<06607>>25875000
                  errnum:=jobnotsuspended                               25880000
               else resumejob(jmatmainpin, errnum);            <<06607>>25885000
            if errnum=0 then <<successfully changed job state>>         25890000
            begin                                                       25895000
             jmatjobstate := if break   then jobsusp           <<06607>>25900000
             else jobexec;                                     <<06607>>25905000
             movetodseg(jmatdst,entryp,@jmatarr,jmatentrysize);<<06607>>25910000
            end;                                                        25915000
            relsir(jmatsir,savesir); <<unlock jmat now>>                25920000
            if errnum<>0 then                                           25925000
            begin                                                       25930000
               parmnum:=1;                                              25935000
               cierr(errnum,firstparm);                                 25940000
            end                                                         25945000
            else                                                        25950000
            if break then <<list devices owned by suspended job>>       25955000
            begin                                                       25960000
               n:=-1;                                                   25965000
               savesir:=getsir(ldtsir);  <<lock ldt>>                   25970000
               ldev:=0;                                                 25975000
               lastldev:=lpdt'max'entries;                     <<06221>>25980000
               while ((ldev:=ldev+1)<=lastldev) and (n<maxn) do         25985000
               begin                                                    25990000
                  movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize);       25995000
                  if ldt'device'type >8 <<ownable device>>     <<06604>>26000000
                     and  ldt'main'pin=jmatmainpin             <<06607>>26005000
                     and ldt'file'use'cnt<>0 then              <<06604>>26010000
                           owned(n:=n+1) := ldev;              <<06604>>26015000
               end;                                                     26020000
               relsir(ldtsir,savesir); <<unlock ldt>>                   26025000
               while n>=0 do                                            26030000
               begin  <<inform user of device suspend job owns>>        26035000
               lpdt'index:=owned(n)*integer(lpdt'entry'size);  <<06221>>26040000
               if lpdt'virtual'device = 0 then                 <<06221>>26045000
               genmsg(cigeneralmsgset,suspendjobown,[1/0,3/1,3/1,9/0],  26050000
                         jobnum,owned(n));                              26055000
                  n:=n-1;                                               26060000
               end;                                                     26065000
            end;                                                        26070000
         end                                                            26075000
         else <<it isn't user's job or he has been 'allow'ed>>          26080000
         begin                                                          26085000
            relsir(jmatsir,savesir);                                    26090000
            parmnum:=1;                                                 26095000
            cierr(errnum:=notusersjob,parmsp);                          26100000
         end;                                                           26105000
      end;                                                              26110000
   end;                                                                 26115000
end;                                                                    26120000
$page "ALLOW & DISALLOW EXECUTORS"                                      26125000
$control segment=oplow                                                  26130000
procedure cxallow executorhead;                                         26135000
begin                                                                   26140000
   entry cxdisallow;                                                    26145000
   byte array commandlist(0:1)=pb:=                                     26150000
      10,7,"ABORTIO",m'abortio,                                         26155000
      11,8,"ABORTJOB",m'abortjob,                                       26160000
      9,6,"ACCEPT",m'accept,                                            26165000
      8,5,"ALLOW",m'allow,                                              26170000
      15,12,"ALTSPOOLFILE",m'altspoolfile,                              26175000
      9,6,"ALTJOB",m'altjob,                                            26180000
      11,8,"BREAKJOB",m'breakjob,                                       26185000
      18,15,"DELETESPOOLFILE",m'deletespoolfile,                        26190000
      11,8,"DISALLOW",m'disallow,                                       26195000
      7,4,"DOWN",m'down,                                                26200000
      7,4,"GIVE",m'give,                                                26205000
      10,7,"HEADOFF",m'headoff,                                         26210000
      9,6,"HEADON",m'headon,                                            26215000
      11,8,"JOBFENCE",m'jobfence,                                       26220000
      8,5,"LIMIT",m'limit,                                              26225000
      12,9,"STOPSPOOL",m'stopspool,                                     26230000
      15,12,"SUSPENDSPOOL",m'suspendspool,                              26235000
      11,8,"OUTFENCE",m'outfence,                                       26240000
      9,6,"REFUSE",m'refuse,                                            26245000
      8,5,"REPLY",m'reply,                                              26250000
      12,9,"RESUMEJOB",m'resumejob,                                     26255000
      14,11,"RESUMESPOOL",m'resumespool,                                26260000
      13,10,"STARTSPOOL",m'startspool,                                  26265000
      10,7,"STREAMS",m'streams,                                         26270000
      10,7,"CONSOLE",m'console,                                         26275000
      7,4,"TAKE",m'take,                                                26280000
      5,2,"UP",m'up,                                                    26285000
      7,4,"WARN",m'warn,                                                26290000
      10,7,"WELCOME",m'welcome,                                         26295000
      12,9,"DSCONTROL",m'dscontrol,                                     26300000
      9,6,"MPLINE",m'mpline,                                            26305000
      14,11,"MRJECONTROL",m'mrjecntrl,                         <<06924>>26310000
      6,3,"MON",m'mon,                                                  26315000
      7,4,"MOFF",m'moff,                                                26320000
      9,6,"VMOUNT",m'vmount,                                            26325000
      9,6,"LMOUNT",m'lmount,                                            26330000
      12,9,"LDISMOUNT",m'ldismount,                                     26335000
      12,9,"MIOENABLE",m'mioenable,                            <<00575>>26340000
      13,10,"MIODISABLE",m'miodisable,                         <<00575>>26345000
      11,8,"DOWNLOAD",m'download,                                       26350000
      6,3,"LOG",m'log,                                         <<00601>>26355000
      14,11,"JOBSECURITY",m'jobscrty,                                   26360000
       10,7,"FOREIGN",m'foreign,                               <<01115>>26365000
      13,10,"IMFCONTROL",m'imfcontrol,                         <<06926>>26370000
      10,7,"SHOWCOM",m'showcom,                                         26375000
      8,5,"OPENQ",m'openq,                                     <<06926>>26380000
      8,5,"SHUTQ",m'shutq,                                     <<06926>>26385000
<<    13,10,"STARTCACHE",m'startcache,    >>                   <<06926>>26390000
<<    12,9,"STOPCACHE",m'stopcache,       >>                   <<06926>>26395000
      10,7,"DISCRPS",m'discrps,                                <<06926>>26400000
<<    14,11,"NRJECONTROL",m'nrjecontrol,   >>                  <<06926>>26405000
<<    13,10,"SNACONTROL",m'snacontrol,     >>                  <<06926>>26410000
<<    14,11,"LINKCONTROL",m'linkcontrol,  >>                   <<06926>>26415000
<<    13,10,"NETCONTROL",m'netcontrol,    >>                   <<06926>>26420000
      0;                                                                26425000
                                                                        26430000
equate command'list'l=491;  << length of command list. >>      <<*8944>>26435000
                                                                        26440000
byte array command'dict(0:command'list'l-1); <<command dictionary>>     26445000
logical allow:=true;                                                    26450000
                                                                        26455000
equate maxparms=20, iobufferl=72;                                       26460000
equate comma=0, equal=1, semicolon=2, eol=3;                            26465000
define ascii=(13:1)#, cctl=(7:1)#, default=(10:3)#;                     26470000
logical eof:=false, file:=false, prompt:=false, found;                  26475000
   logical duplicative;                                        <<0726>> 26480000
double array parm(0:maxparms)=q;                                        26485000
byte pointer current'parm;                                              26490000
integer current'length;                                                 26495000
integer current'delimiter;                                              26500000
integer numparms:=0,filenum,length:=0,state,parmstate;                  26505000
array l'iobuffer(0:iobufferl/2);<<extra word for termination char>>     26510000
array caret(0:iobufferl/2);<<room for "^" & 0 characeters>>             26515000
byte array caret'(*)=caret;                                             26520000
byte array iobuffer(*)=l'iobuffer;                                      26525000
integer promptchr:="> ";                                                26530000
byte pointer firstparm=parm, sndparm=parm+2, trdparm=parm+4;            26535000
byte firstlen=parm+1, sndlen=parm+3, trdlen=parm+5;                     26540000
integer parm1=parm+1, parm2=parm+3;                                     26545000
logical show:=false;                                                    26550000
logical aptr', gptr', errptr',foptions;                                 26555000
byte pointer aptr=aptr', gptr=gptr', errptr=errptr';                    26560000
integer array username(0:3),acctname(0:3);                              26565000
byte array username'(*)=username, acctname'(*)=acctname;                26570000
array mask(0:jit'allow'mask'length-1);                         <<06924>>26575000
byte pointer command'descr;                                             26580000
byte pointer acctnameptr;                                               26585000
integer acctnamelength,filetyp;                                         26590000
                                                               <<06607>>26595000
   << ...................................................... >><<06607>>26600000
   <<        declarations for referencing the jmat           >><<06607>>26605000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>26610000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>26615000
   <<               a specific entry), after an exchange db. >><<06607>>26620000
   <<               or 0 if jmatarr is a local array.        >><<06607>>26625000
   << ...................................................... >><<06607>>26630000
                                                               <<06607>>26635000
integer       jmatinx;                                         <<06607>>26640000
integer array jmatarr(0:jmatentrysize-1);                      <<06607>>26645000
integer array pcbxglob(0:pxg'size-1);                          <<06605>>26650000
integer i,entryp,lastp,savesir,jit'dst,offset;                 <<06924>>26655000
integer array jitarr(0:jit'entry'size-1);                      <<06924>>26660000
logical array jitallow(*) = jitallowmask;                      <<06924>>26665000
equate gamask = %103;                                          <<06925>>26670000
logical pointer sysglobext  = %377;                            <<06925>>26675000
double tempd;                                                           26680000
integer tempd2=tempd+1;                                                 26685000
array qarray(*);                                               <<06605>>26690000
array ptr'to'q(*)=q+0;                                         <<06605>>26695000
integer pcbglobloc;                                            <<06605>>26700000
logical pcbpt;                                                 <<06606>>26705000
$page                                                                   26710000
subroutine err(errno);                                                  26715000
value errno; integer errno;                                             26720000
begin                                                                   26725000
   if file then <<need to list line containing err>>                    26730000
   begin                                                                26735000
      fclose(filenum,0,0);                                              26740000
      iobuffer(length):=0;                                              26745000
      if not prompt and not show then genmsg(-1,@iobuffer);             26750000
   end;                                                                 26755000
   errnum:=errno;                                                       26760000
   if file then <<do caret myself, since not in ci's command buffer>>   26765000
   begin                                                                26770000
      offset:=@current'parm-@iobuffer;                                  26775000
      caret:="  ";                                                      26780000
      move caret(1):=caret,(iobufferl/2);                               26785000
      move caret'(offset):=("^",0);                                     26790000
      genmsg(-1,@caret');                                               26795000
      cierr(errnum);                                                    26800000
   end                                                                  26805000
   else cierr(errnum,current'parm);                                     26810000
end;                                                                    26815000
                                                                        26820000
                                                                        26825000
integer subroutine getnextparm;                                         26830000
begin                                                                   26835000
   comment                                                              26840000
      this subroutine gets the next parameter and puts a ptr to it      26845000
   in current'parm, put its length in current'length, and puts its      26850000
   delimiter in current'delimiter.  if the next parameter is on the     26855000
   next line, it does i/o to get the next line.  it returns -1, if      26860000
   at end of command, zero if next parameter on new line, and 1         26865000
   otherwise.                                                           26870000
      ***note*** to initialize input to this routine, parmnum must be   26875000
                 set to the parameter number-1 to be gotten next.       26880000
               for example, if the next parameter is the first on       26885000
                 the line, then parmnum:=-1.                            26890000
      ***note*** to force getnextparm to read the next line before      26895000
                 getting next parameter, set parmnum:=maxparms+1.       26900000
   ;                                                                    26905000
   getnextparm:=-1;                                                     26910000
   if parmnum=numparms then go to getnextline;                          26915000
   parmnum:=parmnum+1;                                                  26920000
   if parmnum<numparms then                                             26925000
   begin                                                                26930000
      tos:=parm(parmnum);                                               26935000
      current'delimiter:=s0.delimiter;                                  26940000
      current'length:=tos&lsr(8);                                       26945000
      @current'parm:=tos;                                               26950000
      getnextparm:=1;                                                   26955000
   end                                                                  26960000
   else                                                                 26965000
   if parmnum=maxparms then <<too many parms>>                          26970000
      err(toomanyparm)                                                  26975000
   else                                                                 26980000
   if parmnum=numparms then getnextparm:=0                              26985000
   else                                                                 26990000
getnextline:                                                            26995000
   if file and not eof then <<get next file record>>                    27000000
   begin                                                                27005000
      if prompt then print(promptchr,-1,%320);<<do prompting>>          27010000
      length:=fread(filenum,l'iobuffer,-iobufferl);                     27015000
      if < then <<i/o error>>                                           27020000
      begin                                                             27025000
         fcheck(filenum,length);                                        27030000
         genmsg(filesysmsgset,length);                                  27035000
         fclose(filenum,0,0);                                           27040000
         cierr(errnum:=alldisallioerr);                                 27045000
      end                                                               27050000
      else                                                              27055000
      if requestservice then <<break has occurred>>                     27060000
      begin                                                             27065000
         @qarray := @ptr'to'q; << qarray points to q now >>    <<06605>>27070000
         pxglobal;                                             <<06605>>27075000
         attachio(pxg'outputldev,0,0,0,25,0,%320,0,1);<<flush>><<06605>>27080000
         eof:=true;                                                     27085000
         fclose(filenum,0,0);                                           27090000
         if not show and not prompt then <<list last completed line>>   27095000
         begin                                                          27100000
            iobuffer(length):=0;  <<genmsg loves zero bytes>>           27105000
            genmsg(cigeneralmsgset,lastallow);                          27110000
            genmsg(-1,@iobuffer);                                       27115000
         end;                                                           27120000
      end                                                               27125000
      else                                                              27130000
         if > then  <<get i/o end of file>>                    <<0726>> 27135000
      begin                                                             27140000
         eof:=true;                                                     27145000
         fclose(filenum,0,0);                                           27150000
      end                                                               27155000
      else                                                              27160000
      begin                                                             27165000
         if (not duplicative land prompt) or                   <<04173>>27170000
            (show land not prompt) then                        <<04173>>27175000
               print(l'iobuffer,-length,0);                    <<0726>> 27180000
         @parmsp:=@iobuffer;                                            27185000
         iobuffer(length):=cr;                                          27190000
         parmnum:=-1;                                                   27195000
         mycommand(parmsp,,maxparms+1,numparms,parm);                   27200000
            if numparms=1 and firstlen=4 and firstparm="EXIT" then      27205000
            begin                                              <<0726>> 27210000
               eof:=true;                                      <<0726>> 27215000
               fclose(filenum,0,0);                            <<0726>> 27220000
            end                                                <<0726>> 27225000
            else                                               <<0726>> 27230000
            begin                                              <<0726>> 27235000
         if numparms<3 then                                             27240000
         begin                                                          27245000
            @current'parm:=@parmsp + (if prompt then 1 else 0);         27250000
            err(exp1ofuserfile);                                        27255000
            return;                                                     27260000
         end;                                                           27265000
         getnextparm:=getnextparm;                                      27270000
            end;                                               <<0726>> 27275000
      end;                                                              27280000
   end;                                                                 27285000
end;                                                                    27290000
                                                                        27295000
logical subroutine name(a,b);                                           27300000
value a,b; integer pointer a,b;                                         27305000
begin                                                                   27310000
   comment                                                              27315000
      this subroutine returns true if the four word entries             27320000
   pointed to by 'a' and 'b' are equal, otherwise false                 27325000
   ;                                                                    27330000
   i:=-1;                                                               27335000
   name:=true;                                                          27340000
   while (i:=i+1)<4 do if a(i)<>b(i) then name:=false;                  27345000
end;                                                                    27350000
                                                                        27355000
subroutine def'movefromdseg;                                            27360000
subroutine def'movetodseg;                                              27365000
$page                                                                   27370000
<<cxallow entry point>>                                                 27375000
   go to maincode;                                                      27380000
                                                                        27385000
<<cxdisallow entry point>>                                              27390000
cxdisallow:                                                             27395000
   allow:=false;                                                        27400000
                                                                        27405000
maincode:                                                               27410000
   logimage( ( if allow                                        <<01527>>27415000
                  then m'allow                                 <<01527>>27420000
                  else m'disallow ), parmsp );                 <<01527>>27425000
   move command'dict:=commandlist,(command'list'l);                     27430000
                                                                        27435000
   mycommand(parmsp,,maxparms+1,numparms,parm);<<parse initial parms>>  27440000
   if numparms=0 then <<act like subsystem>>                            27445000
   begin                                                                27450000
      file:=prompt:=true;                                               27455000
      filenum:=fopen(,%2044,%1300); <<open $stdin>>                     27460000
      if <> then <<unable to open $stdin ????>>                         27465000
      begin                                                             27470000
         cierr(errnum:=alldisallioerr);                                 27475000
         return;                                                        27480000
      end;                                                              27485000
      parmnum:=maxparms+1; <<this forces new read in 'getnextparm'>>    27490000
   end                                                                  27495000
   else                                                                 27500000
   if firstparm="FILE" and firstlen=4 and                               27505000
      parm1.delimiter=equal then <<got a file= parameter>>              27510000
   begin                                                                27515000
      if not (2<=numparms<=3) then <<file= version is 2 or 3 parameter>>27520000
      begin                                                             27525000
         parmnum:=2;                                                    27530000
         cierr(errnum:=expfileshow,sndparm(sndlen));                    27535000
         return;                                                        27540000
      end;                                                              27545000
      file:=true;                                                       27550000
      tempd:=parm(1);  <<get 2nd parameter description>>                27555000
      tempd2:=sndlen;  <<strip off parameter desc, except 4 length>>    27560000
      filetyp:=checkfilename'(tempd,gptr',aptr',errptr');<<check filen>>27565000
      if < then <<invalid file name>>                                   27570000
      begin                                                             27575000
         parmnum:=2;                                                    27580000
         cierr(errnum:=filetyp,errptr);                                 27585000
         return;                                                        27590000
      end                                                               27595000
      else                                                              27600000
      if > and filetyp<>0 then <<system file name>>                     27605000
      begin                                                             27610000
         parmnum:=2;                                                    27615000
         cierr(errnum:=cantbesysfile,sndparm);                          27620000
         return;                                                        27625000
      end;                                                              27630000
      filenum:=fopen(sndparm,3,%300);<<open ascii,read,share,nocctl>>   27635000
      if <> then <<couldn't get user's file open>>                      27640000
      begin                                                             27645000
         parmnum:=2;                                                    27650000
         fcheck(0,length); <<get open error reason>>                    27655000
         genmsg(filesysmsgset,length);                                  27660000
         cierr(errnum:=alldisallioerr,sndparm);                         27665000
         return;                                                        27670000
      end;                                                              27675000
      fgetinfo(filenum,,foptions);<<find out about file>>               27680000
      if not foptions.ascii or foptions.cctl or                         27685000
         (foptions.default<>0 land foptions.default<>4) then            27690000
      begin <<file not ascii, or is cctl, or is not $stdin or file>>    27695000
         fclose(filenum,0,0);                                           27700000
         parmnum:=2;                                                    27705000
         cierr(errnum:=mustbeasnoctl,sndparm);                          27710000
         return;                                                        27715000
      end;                                                              27720000
      if foptions.default=4 then prompt:=true;                          27725000
      if numparms=3 then <<looking for ;show then>>                     27730000
         if parm2.delimiter<>semicolon or trdparm<>"SHOW" or            27735000
            trdlen<>4 then <<didn't find ;show>>                        27740000
         begin                                                          27745000
            parmnum:=3;                                                 27750000
            cierr(errnum:=expshow,trdparm);                             27755000
            return;                                                     27760000
         end                                                            27765000
         else show:=true;                                               27770000
      parmnum:=maxparms+1; <<make getnextparm do a read>>               27775000
   end                                                                  27780000
   else                                                                 27785000
   if numparms<3 then <<improperly formatted command>>                  27790000
   begin                                                                27795000
      parmnum:=numparms;                                                27800000
      tos:=errnum:=exp1ofuserfile;                                      27805000
      tos:=parm(numparms-1);                                            27810000
      del;                                                              27815000
      cierr(*,*);                                                       27820000
      return;                                                           27825000
   end else parmnum:=-1;                                                27830000
$page                                                                   27835000
<<    we are now ready to start scan of allow/disallow command        >>27840000
<<    looking for the following format:                               >>27845000
<<    allow user.acct;commands=comm1,...,commn                        >>27850000
<<    the command's syntax has been checked on, and any fopens        >>27855000
<<    to do indirect reads either as subsystem or file have been done.>>27860000
                                                                        27865000
   who(duplicative);                                           <<0726>> 27870000
   duplicative:=duplicative.(14:1);                            <<0726>> 27875000
   state:=0;                                                            27880000
                                                                        27885000
scanloop:                                                               27890000
   parmstate:=getnextparm; <<get next parameter>>                       27895000
                                                                        27900000
<< state 0 -- processes user.acct>>                                     27905000
                                                                        27910000
   if state=0 then <<looking for 'username.acctname'>>                  27915000
   begin                                                                27920000
      if parmstate<0 then return;                                       27925000
      if current'delimiter<>semicolon then                              27930000
      begin                                                             27935000
         err(expsemicolon);                                             27940000
         return;                                                        27945000
      end;                                                              27950000
      scan current'parm until [8/".",8/";"],1;                          27955000
      @acctnameptr:=tos;                                                27960000
      acctnamelength:=current'length-@acctnameptr+@current'parm-1;      27965000
      if acctnameptr<>"." then                                          27970000
      begin                                                             27975000
         err(periodexp);                                                27980000
         return;                                                        27985000
      end                                                               27990000
      else                                                              27995000
      if (current'length-1-acctnamelength)>8 or acctnamelength>8 then   28000000
      begin                                                             28005000
         err(uoranamemax8);                                             28010000
         return;                                                        28015000
      end;                                                              28020000
      if current'length-acctnamelength-1<=0 then                        28025000
      begin                                                             28030000
         err(expusername);                                              28035000
         return;                                                        28040000
      end;                                                              28045000
      if acctnamelength<=0 then                                         28050000
      begin                                                             28055000
         err(expacctname);                                              28060000
         return;                                                        28065000
      end;                                                              28070000
      username:="  ";                                                   28075000
      move username(1):=username,(3);                                   28080000
      move acctname:=username,(4);                                      28085000
      move username':=current'parm,(current'length-acctnamelength-1);   28090000
      move acctname':=acctnameptr(1),(acctnamelength);                  28095000
      state:=1;                                                         28100000
   end                                                                  28105000
$page                                                                   28110000
                                                                        28115000
<< state 1 -- processes ;command=>>                                     28120000
                                                                        28125000
   else                                                                 28130000
   if state=1 then <<looking for 'commands='>>                          28135000
      if parmstate<1 or current'parm<>"COMMANDS" or                     28140000
         current'length<>8 or current'delimiter<>equal then             28145000
      begin                                                             28150000
         err(expcommands);                                              28155000
         return;                                                        28160000
      end                                                               28165000
      else                                                              28170000
      begin                                                             28175000
      i:=-1;                                                   <<06925>>28180000
      while (i:=i+1) < jit'allow'mask'length                   <<06925>>28185000
            do mask(i):=0;                                     <<06925>>28190000
         state:=2;                                                      28195000
      end                                                               28200000
$page                                                                   28205000
                                                                        28210000
<< state 2 -- processes the command list & end of command>>             28215000
                                                                        28220000
   else  <<looking for operator command names>>                         28225000
   begin                                                                28230000
      if parmstate<=0 then                                              28235000
      begin  <<at end of current line>>                                 28240000
         found:=false;                                                  28245000
         if username'="@       " and acctname'="@       " then          28250000
         begin                                                          28255000
            << set global allow mask, sysglob extension area >><<06925>>28260000
            i:=-1;                                             <<06925>>28265000
            disable;                                                    28270000
            while(i:=i+1)<jit'allow'mask'length do             <<06924>>28275000
            sysglobext(gamask+i):=                             <<06925>>28280000
               if allow then sysglobext(gamask+i) lor mask(i)  <<06925>>28285000
               else sysglobext(gamask+i) land (not mask(i));   <<06925>>28290000
            enable;                                                     28295000
            found:=true;                                                28300000
         end;                                                           28305000
   << .................................................. >>    <<06607>>28310000
   <<   now we loop through the jmat finding matching    >>    <<06607>>28315000
   <<   jobs and updating their allow mask.              >>    <<06607>>28320000
   << .................................................. >>    <<06607>>28325000
                                                               <<06607>>28330000
   jmatinx := 0;<< jmatarr is local >>                         <<06607>>28335000
   savesir := getsir(jmatsir);                                << gdr >> 28340000
   movefromdseg(@jmatarr, jmatdst, 0, jmatheadersize);         <<06607>>28345000
   entryp := jmatentryptr; << first jmat entry >>              <<06607>>28350000
   lastp  :=   jmatcursize * 128                               <<06607>>28355000
             - jmatentrysize; << pointer to last entry >>      <<06607>>28360000
         do <<scan jmat for specified jobs>>                            28365000
         begin                                                          28370000
            movefromdseg(@jmatarr, jmatdst, entryp,            <<06607>>28375000
                         jmatentrysize);<< get an entry >>     <<06607>>28380000
            if jmatarr <> 0 then << got valid entry >>         <<06607>>28385000
            begin                                                       28390000
               if (username'="@       " or                              28395000
                   name(username, jmatusername)) and           <<06607>>28400000
                  (acctname'="@       " or                              28405000
                   name(acctname, jmatacctname)) then          <<06607>>28410000
               begin                                                    28415000
                  tos := jmatjobstate;                         <<06607>>28420000
                  if s0=jobexec or s0=jobsusp or s0=jobciinit then      28425000
                  begin <<have job in good state>>                      28430000
                     found:=true;                                       28435000
                     pcbpt := jmatmainpin * pcbsize;           <<06607>>28440000
                     s0 := spcbstkdst;                         <<06606>>28445000
                     movefromdseg(@pcbxglob,s0,0,pxg'size);    <<06605>>28450000
                     @qarray:=@pcbxglob;                       <<06605>>28455000
                     pcbglobloc := 0; << not pointing at q >>  <<06605>>28460000
                     jit'dst:=pxg'jitdst;                      <<06924>>28465000
                     movefromdseg(@jitarr,jit'dst,0,           <<06924>>28470000
                                   jit'entry'size);            <<06924>>28475000
                     i:=-1;                                             28480000
                     while(i:=i+1)<jit'allow'mask'length do    <<06924>>28485000
                     << alter the allowmask >>                 <<06924>>28490000
                     jitallow(i):=if allow                              28495000
                                  then (jitallow(i) lor mask(i))        28500000
                                  else (jitallow(i) land not mask(i));  28505000
                     movetodseg(jit'dst,0,@jitarr,             <<06924>>28510000
                                   jit'entry'size);            <<06924>>28515000
                  end; <<have updated jit allow mask>>                  28520000
                  del;                                                  28525000
               end;                                                     28530000
            end;                                                        28535000
         end                                                            28540000
         until (entryp:=entryp+jmatentrysize) > lastp;         <<06607>>28545000
         relsir(jmatsir,savesir);                                       28550000
         if not found then <<no jobs that qualify>>                     28555000
         begin                                                          28560000
            @current'parm:=if file then @iobuffer else @parmsp;         28565000
            err(nojobingoodstate);                                      28570000
            return;                                                     28575000
         end;                                                           28580000
         if parmstate<0 then return <<end of command>>                  28585000
         else state:=0;                                                 28590000
      end                                                               28595000
      else                                                              28600000
      begin <<process command name>>                                    28605000
         if current'delimiter<>comma and current'delimiter<>eol then    28610000
         begin                                                          28615000
            err(commandsepbycomma);                                     28620000
            return;                                                     28625000
         end;                                                           28630000
         if search(current'parm,current'length,command'dict,            28635000
                   command'descr)=0 then <<not an operator command>>    28640000
         begin                                                          28645000
            err(nosuchcommand);                                         28650000
            return;                                                     28655000
         end;                                                           28660000
         tos:=mask(command'descr.(9:3));                       <<06925>>28665000
         x:=command'descr.(12:4);                                       28670000
         assemble(tsbc 0,x);                                            28675000
         mask(command'descr.(9:3)):=tos;                       <<06925>>28680000
      end;                                                              28685000
   end;                                                                 28690000
   go to scanloop;                                                      28695000
end;                                                                    28700000
$page "REPLY EXECUTOR"                                                  28705000
$control segment=ophi                                                   28710000
procedure cxreply executorhead;                                         28715000
begin                                                                   28720000
   comment                                                              28725000
      the syntax of this command is:                                    28730000
         reply pinnum,reply[,param]                                     28735000
         where pinnum is the pin number of the process waiting for the  28740000
request. reply is the reply it is waiting for and param is any          28745000
      additional information it may be waiting for.  when three         28750000
      parameters are supplied, both 'reply' and 'param' are treated     28755000
      as strings and are concatentated together with a separating comma 28760000
      and sent to waiting process.                                      28765000
      ;                                                                 28770000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  28775000
   byte array dl'(*)=dl;                                                28780000
   array temphold(0:36); byte array b'temphold(*)=temphold;             28785000
   double array parm(0:3)=q;                                            28790000
   byte pointer firstparm=parm, sndparm=parm+2, trdparm=parm+4,         28795000
                fourthparm=parm+6;                                      28800000
   byte firstlen=parm+1, sndlen=parm+3, trdlen=parm+5;                  28805000
   integer numparms,i,maxinx,savesir,pin,ivalue;                        28810000
   integer len;                                                <<00622>>28815000
   array rit(0:rit'size-1);                                    <<04803>>28820000
   integer savedstn;                                           <<04803>>28825000
   integer array rithead(0:rit'headsize-1)=q;                           28830000
   logical lvalue=ivalue,found;                                         28835000
   integer parm1=parm+1,parm2=parm+3;                                   28840000
   integer jit'dst;                                            <<06924>>28845000
logical pcbpt;                                                 <<06606>>28850000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>28855000
   equate comma=0,semicolon=1;                                          28860000
   array qarray(*) = q + 0;                                    <<06605>>28865000
   integer pcbglobloc;                                         <<06605>>28870000
                                                                        28875000
   subroutine def'movefromdseg;                                         28880000
   subroutine def'movetodseg;                                           28885000
   logical subroutine chkyn;                                            28890000
   begin                                                                28895000
      chkyn:=true;                                                      28900000
      if sndlen=1 then <<check for 'n' or 'y'>>                         28905000
         if sndparm="Y" then lvalue:=true                               28910000
         else if sndparm="N" then lvalue:=false                         28915000
              else chkyn:=false                                         28920000
      else if sndlen=2 and sndparm="NO" then lvalue:=false              28925000
           else if sndlen=3 and sndparm="YES" then lvalue:=true         28930000
                else chkyn:=false;                                      28935000
   end;                                                                 28940000
   logical subroutine chkvalue;                                         28945000
   begin                                                                28950000
      ivalue:=binary(sndparm,sndlen);                                   28955000
      chkvalue:=if <> then false else true;                             28960000
   end;                                                                 28965000
                                                                        28970000
   logimage( m'reply, parmsp );  << log op command >>          <<01527>>28975000
   pxglobal;                                                   <<06924>>28980000
   jit'dst:=pxg'jitdst;                                        <<06924>>28985000
   movefromdseg(@jitarr,jit'dst,0,jit'entry'size);             <<06924>>28990000
   i:=jitassocindex;                                           <<06924>>28995000
   if i=0 and not masterop and not checkallow(m'reply) then<<no access>>29000000
   begin                                                                29005000
      parmnum:=1;                                                       29010000
      cierr(errnum:=usernoacc2dev,parmsp);                              29015000
      return;                                                           29020000
   end;                                                                 29025000
   mycommand(parmsp,dl',4,numparms,parm);  <<parse parameters>>         29030000
   if numparms<2 then <<too few parameters>>                            29035000
   begin                                                                29040000
      parmnum:=1;                                                       29045000
      cierr(errnum:=replyreq2p,parmsp);                                 29050000
   end                                                                  29055000
   else                                                                 29060000
   if parm1.delimiter<>comma then <<bad separator>>                     29065000
   begin                                                                29070000
      parmnum:=1;                                                       29075000
      cierr(errnum:=expcommabreplyp,firstparm(firstlen));               29080000
   end                                                                  29085000
   else                                                                 29090000
   begin                                                                29095000
      pin:=binary(firstparm,firstlen); <<get pin #>>                    29100000
      if <> or not (3<=pin<=1023) then <<bad pin #>>           <<*8657>>29105000
      begin                                                             29110000
         parmnum:=1;                                                    29115000
         cierr(errnum:=invalidpin,firstparm);                           29120000
         return;                                                        29125000
      end;                                                              29130000
      savesir:=getsir(rit'sir); << lock rit table >>           <<04803>>29135000
      movefromdseg(@rithead,rit'dst,0,rit'headsize);           <<04803>>29140000
  << get rit header  >>                                        <<04803>>29145000
      <<max index into rit dst>>                               <<41.mm>>29150000
      maxinx:=(rithead(rit'head'maxent))*rit'size+rit'headsize;<<04803>>29155000
      i:=rit'headsize-rit'size;                                <<04803>>29160000
      found:=false;                                                     29165000
      while not found and (i:=i+rit'size)<maxinx               <<04803>>29170000
  << search for pin  >>                                        <<04803>>29175000
      do                                                                29180000
      begin                                                             29185000
         movefromdseg(@rit,rit'dst,i,rit'size); <<get rit entry<<04803>>29190000
         if pin=integer(rit(rit'pinnum)) then found:=true;              29195000
      end;                                                              29200000
      if not found then <<pin not waiting for reply>>                   29205000
      begin                                                             29210000
         relsir(rit'sir,savesir);                              <<04803>>29215000
         parmnum:=1;                                                    29220000
         cierr(errnum:=noreq4pin,firstparm);                            29225000
      end                                                               29230000
      else                                                              29235000
      if numparms > 3 and                                      <<00622>>29240000
            rit(rit'replytype)<>replytype'onestring then       <<00622>>29245000
      begin                                                    <<00622>>29250000
         relsir(rit'sir,savesir);                              <<04803>>29255000
         parmnum := 4;                                         <<00622>>29260000
         cierr(errnum := replytoomanyp,fourthparm);            <<00622>>29265000
      end                                                      <<00622>>29270000
      else                                                     <<00622>>29275000
      if numparms = 3 then                                     <<00622>>29280000
         if rit(rit'replytype) <> replytype'onestring then     <<00622>>29285000
            if rit(rit'replytype) <> replytype'strings then    <<00622>>29290000
            begin                                              <<00622>>29295000
               relsir(rit'sir,savesir);                        <<04803>>29300000
               parmnum := 3;                                   <<00622>>29305000
               cierr(errnum := replyexp2parm,trdparm);         <<00622>>29310000
            end                                                <<00622>>29315000
            else <<twostrings expected. 2nd delim must be ','>><<00622>>29320000
               if parm2.delimiter <> comma then                <<00622>>29325000
               begin                                           <<00622>>29330000
               relsir(rit'sir,savesir);                        <<04803>>29335000
               parmnum := 2;                                   <<00622>>29340000
               cierr(errnum:=expcommabreplyp,sndparm(sndparm));<<00622>>29345000
               end;                                            <<00622>>29350000
      if errnum>0 then return;                                          29355000
      case rit(rit'replytype) of                                        29360000
      begin                                                             29365000
                                                                        29370000
         <<expecting number>>                                           29375000
         if not chkvalue then <<didn't get a number>>                   29380000
            errnum:=replyexpnumber;                                     29385000
                                                                        29390000
         <<expecting yes/no>>                                           29395000
         if not chkyn then <<didn't get a yes/no>>                      29400000
            errnum:=replyexpyn;                                         29405000
                                                                        29410000
         <<expecting string(s)>>                                        29415000
         begin                                                          29420000
            if integer(sndlen+(if numparms=3 then trdlen+1 else 0))>    29425000
               integer(rit(rit'replylen)) then <<string too long>>      29430000
               errnum:=stringtoolong                                    29435000
            else                                                        29440000
            begin                                                       29445000
               move b'temphold(2):=sndparm,(sndlen),2;         <<00622>>29450000
               if numparms=2 then del else                              29455000
               begin                                                    29460000
                  move *:=",",2;                                        29465000
                  move *:=trdparm,(trdlen);                             29470000
               end;                                                     29475000
               ivalue:=@temphold;                                       29480000
               temphold := sndlen +                            <<00622>>29485000
                          (if numparms=3 then trdlen+1 else 0);<<00622>>29490000
            end;                                                        29495000
         end;                                                           29500000
                                                                        29505000
         <<expecting yes/no or number>>                                 29510000
         if not chkvalue and not chkyn then <<didn't get yes/no or #>>  29515000
            errnum:=replyexpyn'num;                                     29520000
                                                               <<00622>>29525000
         <<expecting one string terminated by cr >>            <<00622>>29530000
         begin                                                 <<00622>>29535000
            scan sndparm until %6415,1;  <<find end of string>><<00622>>29540000
            len := tos - @sndparm;                             <<00622>>29545000
                                                               <<01459>>29550000
            << deblank on right >>                             <<01459>>29555000
            x := len;                                          <<01459>>29560000
            while (len > 0) and (sndparm(x := x-1) = " ")      <<01459>>29565000
               do len := len - 1;                              <<01459>>29570000
                                                               <<01459>>29575000
            if len > integer(rit(rit'replylen)) then           <<00622>>29580000
               errnum := stringtoolong                         <<00622>>29585000
            else                                               <<00622>>29590000
            begin                                              <<00622>>29595000
               temphold := len;                                <<00622>>29600000
               move b'temphold(2) := sndparm,(len);            <<00622>>29605000
               ivalue := @temphold;                            <<00622>>29610000
            end;                                               <<00622>>29615000
         end;                                                  <<00622>>29620000
      end;                                                              29625000
      if errnum<>0 then <<reply had an error>>                          29630000
      begin                                                             29635000
         relsir(rit'sir,savesir);                              <<04803>>29640000
         parmnum:=2;                                                    29645000
         if errnum<>stringtoolong then cierr(errnum,sndparm)            29650000
         else cierr(errnum,sndparm,%10000,rit(rit'replylen));           29655000
         return;                                                        29660000
      end;                                                              29665000
      if (rit(rit'replytype)<>replytype'strings) and           <<00622>>29670000
         (rit(rit'replytype)<>replytype'onestring) then        <<00622>>29675000
     movetodseg(rit(rit'replypin),rit(rit'dstoffset),@ivalue,1)<<04803>>29680000
   else movetodseg(rit(rit'replypin),rit(rit'dstoffset),ivalue,<<04803>>29685000
                      (temphold+1)&asr(1) + 1);                <<00622>>29690000
      rit(rit'pinnum):=0; <<clear pending request>>                     29695000
      movetodseg(rit'dst,i,@rit,rit'size);                     <<04803>>29700000
      rithead(rit'head'ent):=rithead(rit'head'ent)-1;                   29705000
      movetodseg(rit'dst,0,@rithead,rit'headsize);             <<04803>>29710000
  << update header  >>                                         <<04803>>29715000
      relsir(rit'sir,savesir);  <<unlock rit>>                 <<04803>>29720000
      savedstn :=exchangedb(rit'dst);                          <<04803>>29725000
      rem'queued'entry;  << check for queued enries >>         <<04803>>29730000
      exchangedb(savedstn);                                    <<04803>>29735000
      pcbpt := pin * pcbsize;                                  <<06606>>29740000
      piinfo.oafield := replydone;                             <<06606>>29745000
      awake(pcbpt,%40,0); << awaken waiting process >>         <<06606>>29750000
   end;                                                                 29755000
end;                                                                    29760000
$page "ASSOCIATE AND DISASSOCIATE EXECUTORS"                            29765000
$control segment=opmed                                                  29770000
procedure cxassociate executorhead;                                     29775000
begin                                                                   29780000
   comment                                                              29785000
      the syntax of the associate and disassociate commands is:         29790000
         associate ldev                                                 29795000
         disassociate ldev                                              29800000
   ;                                                                    29805000
   equate session=1;  <<session job type>>                              29810000
   entry cxdisassociate;                                                29815000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  29820000
   byte array dl'(*)=dl;                                                29825000
   double array parm(0:1)=q;                                            29830000
   byte pointer firstparm=parm, sndparm=parm+2;                         29835000
   byte len=parm+1;                                                     29840000
   integer oldjmat,numparms,jmat,savesir,match,he,i,they,jit;           29845000
   integer                                                     <<06370>>29850000
      sirnum;      << holds return for msg sir >>              <<06370>>29855000
   logical associate:=true;                                             29860000
   array ass'entry(0:ass'entrysize-1);                                  29865000
   byte array ass'entry'(*)=ass'entry;                                  29870000
   array uname(0:4),aname(0:4);                                         29875000
   byte array uname'(*)=uname,aname'(*)=aname;                          29880000
   << ...................................................... >><<06607>>29885000
   <<        declarations for referencing the jmat           >><<06607>>29890000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>29895000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>29900000
   <<               a specific entry), after an exchange db. >><<06607>>29905000
   <<               or 0 if jmatarr is a local array.        >><<06607>>29910000
   << ...................................................... >><<06607>>29915000
                                                               <<06607>>29920000
   integer       jmatinx;                                      <<06607>>29925000
   array jmatarr(0:jmatentrysize-1);<< holds jmat entry >>     <<06607>>29930000
   logical users;                                                       29935000
   integer array classname(0:4);                                        29940000
   byte array classname'(*)=classname;                                  29945000
   integer array classinfo(0:4); <<holds getclass info. >>     <<06604>>29950000
   integer                                                     <<06604>>29955000
      entrylength;                                             <<06604>>29960000
   pointer dct'i;         << points to devices in dct entry>>  <<*7850>>29965000
   logical pointer                                             <<06604>>29970000
      dct;  << space for array to be built on stack >>         <<06604>>29975000
   array qarray(*) = q + 0;                                    <<06605>>29980000
   integer pcbglobloc;                                         <<06605>>29985000
   integer jit'dst;                                            <<06924>>29990000
   integer array jitarr(0:jit'entry'size-1);                   <<06924>>29995000
   subroutine def'movefromdseg;                                         30000000
                                                                        30005000
<<cxassociate entry point>>                                             30010000
   go to maincode;                                                      30015000
                                                                        30020000
<<cxdisassociate entry point>>                                          30025000
cxdisassociate:                                                         30030000
   associate:=false;                                                    30035000
                                                                        30040000
maincode:                                                               30045000
   mycommand(parmsp,dl',2,numparms,parm);                               30050000
   if numparms<>1 then <<must have exactly one parameter>>              30055000
   begin                                                                30060000
      parmnum:=if numparms<1 then 1 else 2;                             30065000
      tos:=errnum:=if associate then assreq1p else disassreq1p;         30070000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     30075000
      cierr(*,*);                                                       30080000
   end                                                                  30085000
   else                                                                 30090000
   begin                                                                30095000
      move classname:="        ";                                       30100000
      classname'(8):=0; <<terminator for genmsg>>                       30105000
      move classname':=firstparm,(len);                                 30110000
      if not getclass(classinfo,false,,,classname) then        <<06604>>30115000
   <<getclass (false) returns the following data structure>>   <<06604>>30120000
   << to classinfo:                                       >>   <<06604>>30125000
   << returnbuf - 0: segment relative address of entry    >>   <<06604>>30130000
    <<            1: dct index of entry (entry #)         >>   <<06604>>30135000
   <<             2: word 4 (5th word) of dct entry. con- >>   <<06604>>30140000
   <<                tains cyclical pointer, class access >>   <<06604>>30145000
   <<                type, sq bit.                        >>   <<06604>>30150000
   <<             3: mpe4: left byte is # of ldev's is    >>   <<06604>>30155000
   <<                class, right byte is first ldev.     >>   <<06604>>30160000
   <<                mpe5: # ldev's is class              >>   <<06604>>30165000
   <<             4: mpe4: see below                      >>   <<06604>>30170000
   <<                mpe5: first ldev is class            >>   <<06604>>30175000
   <<             4+ (mpe4) or 5+ (mpe5): returned if     >>   <<06604>>30180000
   <<                everything true.  remaining ldev's   >>   <<06604>>30185000
   <<                is class.                            >>   <<06604>>30190000
   <<*****************************************************>>   <<06604>>30195000
                                                               <<06604>>30200000
      begin                                                             30205000
         cierr(errnum:=nosuchdevclass,firstparm);                       30210000
         parmnum:=1;                                                    30215000
         return;                                                        30220000
      end;                                                              30225000
   comment --  we need to access the list of ldev's in the     <<06604>>30230000
   dct entry.  unfortunately, the length of the list is        <<06604>>30235000
   arbitrary and varies from entry to entry.  thus to make     <<06604>>30240000
   a local copy of the entry, we must build space for it on    <<06604>>30245000
   the stack.                                                  <<06604>>30250000
   ;                                                           <<06604>>30255000
                                                               <<06604>>30260000
   <<  =======   build dct entry on stack  ==========  >>      <<06604>>30265000
      push (s);                                                <<06604>>30270000
      @dct := tos + 1;   <<tradition dictates the +1 >>        <<06604>>30275000
      assemble (adds 6); << add 6 words to stack >>            <<06604>>30280000
      movefromdseg(@dct,dct'dst,classinfo,6); <<get length >>  <<06604>>30285000
      entrylength := dct'words'in'entry;                       <<06604>>30290000
      assemble(subs 6); << take away those 6 words>>           <<06604>>30295000
      tos := entrylength;  << now get whole entry >>           <<06604>>30300000
      assemble(adds 0); << hope stack has enough room >>       <<06604>>30305000
      movefromdseg(@dct,dct'dst,classinfo,entrylength);        <<06604>>30310000
      @dct'i := @dct        + dct'first'ldev-1;                <<06604>>30315000
                                                               <<06604>>30320000
      pxglobal;                                                <<06605>>30325000
      if pxg'jobtype <> session then << must be in sess >>     <<06605>>30330000
      begin                                                             30335000
         parmnum:=1;                                                    30340000
         cierr(errnum:=assreqsession);                                  30345000
         return;                                                        30350000
      end;                                                              30355000
      savesir:=getsir(ass'sir);<<lock association table>>               30360000
      match:=he:=i:=they:=0;                                            30365000
      while (i:=i+1)<=integer(dct'i) do <<get ownership of d>> <<06604>>30370000
      if checkass(dct'i(i),ass'entry) then <<users owns devi>> <<06604>>30375000
      begin                                                             30380000
         he:=he+1; <<increment # of devices he owns in class>> <<06604>>30385000
         if classname'=ass'entry'(2*ass'class),(8) then                 30390000
            match:=match+1;<<increment #0f dev in class he own>>        30395000
      end                                                               30400000
      else                                                              30405000
      if ass'entry(ass'jit)<>0 then <<owned by others>>                 30410000
      begin                                                             30415000
         they:=they+1;  <<increment # of devices owned by othe><<06604>>30420000
         oldjmat:=ass'entry(ass'jmat);                                  30425000
         if classname'=ass'entry'(2*ass'class),(8) then                 30430000
            match:=match+1;                                             30435000
      end;                                                              30440000
      if associate then                                                 30445000
         if he<>0 then errnum:=userhasdevass                            30450000
         else                                                           30455000
         if they<>0 then errnum:=assbyothers else                       30460000
      else <<disassociate>>                                             30465000
         if match<integer(dct'i) then <<class not associated>> <<06604>>30470000
         if masterop then errnum:=devnotass                             30475000
         else errnum:=usernotass2dev                                    30480000
         else                                                           30485000
         if not masterop and he<>match then errnum:=assbyothers;        30490000
      if errnum<>0 then                                                 30495000
      begin                                                             30500000
         relsir(ass'sir,savesir);                                       30505000
         parmnum:=1;                                                    30510000
         cierr(errnum,firstparm);                                       30515000
         return;                                                        30520000
      end;                                                              30525000
      uname'(8):=aname'(8):=0; <<insure zero terminator>>               30530000
      pxglobal;                                                <<06924>>30535000
      jit'dst:=pxg'jitdst;                                     <<06924>>30540000
      movefromdseg(@jitarr,jit'dst,0,jit'entry'size);          <<06924>>30545000
      tos := pxg'jitdst;                                       <<06605>>30550000
      move uname(0):=jitusername,(4);                          <<06924>>30555000
      move aname(0):=jithacctname,(4);                         <<06924>>30560000
      move uname':=uname' while an,1;                                   30565000
      bps0:=0; <<force zero terminator for genmsg>>                     30570000
      move aname':=aname' while an,1;                                   30575000
      bps0:=0; <<force zero terminator for genmsg>>                     30580000
      ddel;                                                             30585000
      jit := pxg'jitdst;                                       <<06605>>30590000
      if associate then <<do the association>>                          30595000
      begin                                                             30600000
            << we do the association and when complete >>      <<*8121>>30605000
            << release the ass sir to print any status >>      <<*8121>>30610000
            << type messages                           >>      <<*8121>>30615000
         i:=he:=0; <<init # of device has permission for>>              30620000
         while (i:=i+1)<=integer(dct'i) do                     <<06604>>30625000
         if chk'ass'security(jit,dct'i(i),classname)           <<06604>>30630000
            then he:=he+1;                                              30635000
         if he<integer(dct'i) then                             <<06604>>30640000
         begin                                                          30645000
            parmnum:=1;                                                 30650000
            relsir(ass'sir,savesir);                                    30655000
            cierr(errnum:=usercantassdev,firstparm);                    30660000
         end                                                            30665000
         else <<user may associate device>>                             30670000
         begin                                                          30675000
         pxglobal;                                             <<06605>>30680000
         jmat := pxg'jmatinx;                                  <<06605>>30685000
            i:=0;                                                       30690000
            while (i:=i+1)<=integer(dct'i)                     <<06604>>30695000
               do addass(jit,jmat,dct'i(i),classname');        <<06604>>30700000
            <<  the device association is done, so we can >>   <<*8121>>30705000
            <<  now release the ass sir.  we must do this >>   <<*8121>>30710000
            <<  before the genmsg call to avoid a deadly  >>   <<*8121>>30715000
            <<  embrace with the message sir.             >>   <<*8121>>30720000
               relsir (ass'sir, savesir);                      <<*8121>>30725000
            if not masterop then                                        30730000
               genmsg(cigeneralmsgset,ldevwasass,                       30735000
            [1/0,3/0,3/0,3/0,6/0],@uname',@aname',@classname',          30740000
               ,,sys'console'ldev,,,,1);                       <<06923>>30745000
         end                                                            30750000
      end                                                               30755000
         else <<do disassociate>>                                       30760000
           << we do the disassociate first before printing>>   <<*8121>>30765000
           << any messages.  the ass sir is released first>>   <<*8121>>30770000
           << after we disassociate the device.  then we  >>   <<*8121>>30775000
           << do the notification.                        >>   <<*8121>>30780000
         begin                                                          30785000
         i:=0;                                                 <<*8121>>30790000
         while (i:=i+1)<=integer(dct'i) do                     <<*8121>>30795000
            delass(dct'i(i)*ass'entrysize,ass'entry(ass'jit)); <<*8121>>30800000
            relsir (ass'sir , savesir);                        <<*8121>>30805000
         if masterop and he<integer(dct'i) then                <<06604>>30810000
         begin <<masterop disassociating somebody else>>                30815000
            jmatinx := 0; << jmatarr is local >>               <<06607>>30820000
            movefromdseg(@jmatarr, jmatdst,                    <<06607>>30825000
              oldjmat*jmatentrysize, jmatentrysize);           <<06607>>30830000
            genmsg(cigeneralmsgset,masteropdisass,                      30835000
            [1/0,3/0,12/0],@classname',,,,,                             30840000
               jmatjlistdev,,,,1);<< tell user of disass. >>   <<06607>>30845000
         end;                                                           30850000
         if not masterop then genmsg(cigeneralmsgset,                   30855000
            ldevwasdisass,[1/0,3/0,3/0,3/0,6/0],@uname',@aname',        30860000
            @classname',,,sys'console'ldev,,,,1);              <<06923>>30865000
      end;                                                              30870000
   end;                                                                 30875000
end;                                                                    30880000
$page "STREAMS EXECUTOR"                                                30885000
$control segment=oplow                                                  30890000
procedure cxstreams executorhead;                                       30895000
begin                                                                   30900000
   comment                                                              30905000
      the syntax of this command is:                                    30910000
         streams ldev                                                   30915000
      where ldev is any job & data accepting device other than          30920000
      a terminal                                                        30925000
   ;                                                                    30930000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  30935000
   byte array dl'(*)=dl;                                                30940000
   double array parm(0:1)=q;                                            30945000
   byte pointer firstparm=parm, sndparm=parm+2;                         30950000
   byte len=parm+1;                                                     30955000
   integer numparms,ldev,savesir;                                       30960000
integer                                                        <<06604>>30965000
   ldt'index := 0;                                             <<06604>>30970000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>30975000
   integer array ldt(0:ldtsize-1);                                      30980000
   subroutine def'movefromdseg;                                         30985000
   subroutine def'movetodseg;                                           30990000
   logimage( m'streams, parmsp );  << log op command >>        <<01527>>30995000
   mycommand(parmsp,dl',2,numparms,parm);<<parse parameters>>           31000000
   if numparms<>1 then <<must have exactly one parameter>>              31005000
   begin                                                                31010000
      parmnum:=if numparms<1 then 1 else 2;                             31015000
      tos:=errnum:=streamsreq1p;                                        31020000
      tos:=if parmnum=1 then @parmsp else @sndparm;                     31025000
      cierr(*,*);                                                       31030000
   end                                                                  31035000
   else                                                                 31040000
   begin                                                                31045000
      if len=3 and firstparm="OFF" then ldev:=0                         31050000
      else                                                              31055000
      begin                                                             31060000
         ldev:=verify'rldev(firstparm,len,errnum,parmnum,1);            31065000
         if < then return;                                              31070000
         movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize);<<get ldt entr>>31075000
         lpdt'index:=ldev*integer(lpdt'entry'size);            <<06221>>31080000
         if ldt'device'type=16 then errnum:=cantbeterm         <<06604>>31085000
         else                                                           31090000
         if lpdt'job'accept = 0 and                            <<06221>>31095000
             lpdt'data'accept = 0 then errnum:=devnotdj        <<07180>>31100000
         else                                                  <<07180>>31105000
         if ldt'dflt'out'dev = 0 then << cant be 0 >>          <<07180>>31110000
              errnum := streams'outdev'0;                      <<07180>>31115000
      end;                                                              31120000
      if errnum=0 then <<enable streams>>                               31125000
      begin   << move in head entry >>                         <<06604>>31130000
         savesir:=getsir(ldtsir); <<lock ldt>>                          31135000
         movefromdseg(@ldt,ldtdst,0,ldtsize);<<get ldt header>>         31140000
         ldt'streams'ldev:=ldev;                               <<06604>>31145000
         movetodseg(ldtdst,0,@ldt,ldtsize);                             31150000
         relsir(ldtsir,savesir);                                        31155000
      end                                                               31160000
      else                                                              31165000
      begin                                                             31170000
         parmnum:=1;                                                    31175000
         cierr(errnum,firstparm);                                       31180000
      end;                                                              31185000
   end;                                                                 31190000
end;                                                                    31195000
$page "CONSOLE EXECUTOR"                                                31200000
$control segment=oplow                                                  31205000
procedure cxconsole executorhead;                                       31210000
begin                                                                   31215000
   comment                                                              31220000
      the syntax of this command is:                                    31225000
         console ldev                                                   31230000
         where ldev is any real terminal.                               31235000
   ;                                                                    31240000
integer                                                        <<06604>>31245000
   ldt'index := 0;                                             <<06604>>31250000
   integer array ldt(0:ldtsize-1);                                      31255000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  31260000
   byte array dl'(*)=dl;                                                31265000
   double array parm(0:1)=q;                                            31270000
   byte pointer firstparm=parm, sndparm=parm+2;                         31275000
   byte len=parm+1;                                                     31280000
   double dcapability;                                         <<06924>>31285000
   logical array ucapptr(*) = dcapability;                     <<06924>>31290000
   integer numparms,ldev;                                               31295000
   integer old'console;   << holds old console ldev >>         <<07430>>31300000
   logical pcbpt;                                              <<06606>>31305000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>31310000
   subroutine def'movefromdseg;                                         31315000
                                                                        31320000
   mycommand(parmsp,dl',2,numparms,parm);<<parse the parameters>>       31325000
   if numparms>1 then <<must be 0 or 1 parameters>>            <<00893>>31330000
   begin                                                                31335000
      parmnum:=2;                                              <<00893>>31340000
      cierr(errnum:=consolereq1p,sndparm);                     <<00893>>31345000
   end                                                                  31350000
   else                                                                 31355000
   if numparms=0 then <<just report where console is now>>     <<00893>>31360000
   begin                                                       <<00893>>31365000
      dl'(ascii(sys'console'ldev,10,dl')):=0;                  <<06923>>31370000
      genmsg(cigeneralmsgset,consoleis,0,@dl');                <<00893>>31375000
   end                                                         <<00893>>31380000
   else                                                        <<00893>>31385000
   begin                                                                31390000
      logimage( m'console, parmsp );  << log op command >>     <<01527>>31395000
      who(,dcapability);                                       <<01042>>31400000
      if checkallow(m'console) or ucapsm then                  <<06924>>31405000
      begin   <<user has access to command>>                   <<01042>>31410000
      ldev:=verify'rldev(firstparm,len,errnum,parmnum,1);               31415000
      if < then return;                                                 31420000
      if verify'masterop(ldev) then return;<<msterop made inadv. entry>>31425000
      lpdt'index:=ldev*integer(lpdt'entry'size);               <<06221>>31430000
      if lpdt'job'accept=0 then << device not job accept >>    <<06221>>31435000
      begin                                                             31440000
         parmnum:=1;                                                    31445000
         cierr(errnum:=devnotjob,firstparm);                            31450000
      end                                                               31455000
      else                                                              31460000
      begin                                                             31465000
         movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize);                31470000
         if ldt'device'type<>terminal then <<dev must be term>><<06604>>31475000
         begin                                                          31480000
            parmnum:=1;                                                 31485000
            cierr(errnum:=ldevmustbeterm,firstparm);                    31490000
         end                                                            31495000
        else                                                   <<00874>>31500000
            if lpdt'dev'own'state <> lpdt'not'owned            <<06221>>31505000
           and                    <<    and      >>            <<00874>>31510000
            lpcb(ldt'main'pin*pcbsize+procstatewordnum).       <<06606>>31515000
                ptypefield  <> citype <<not a job or session>> <<06606>>31520000
           then                   <<i.e. ldev is allocated>>   <<00874>>31525000
           begin                  << by a spooler, or son >>   <<00874>>31530000
              parmnum := 1;                                    <<00874>>31535000
              cierr (errnum := devownedother, firstparm);      <<04801>>31540000
           end                                                 <<00874>>31545000
         else                                                           31550000
         if get'dsdevice(ldev) = 3 or << ds terminal >>        <<04167>>31555000
               absolute(lpdt'dit'ptr+sysglob).(0:1)=0 then     <<06221>>31560000
                                         << mp terminal >>     <<06221>>31565000
         begin                                                          31570000
            parmnum:=1;                                                 31575000
            cierr(errnum:=ldevcantbedsterm,firstparm);                  31580000
         end                                                            31585000
         else                                                  <<00671>>31590000
         begin                                                 <<06221>>31595000
         lpdt'index := sys'console'ldev *                      <<06923>>31600000
                             integer(lpdt'entry'size);         <<06221>>31605000
         if absolute(lpdt'dit'ptr                              <<06221>>31610000
               + sysglob + dit'lplevel) = 4 then               <<00671>>31615000
         begin   <<control a on old console>>                  <<00671>>31620000
            parmnum := 1;                                      <<00671>>31625000
            cierr(errnum := consolebusy,firstparm);            <<00671>>31630000
         end                                                   <<00671>>31635000
            else                                               <<01027>>31640000
            if logical(ldt'down'pending) or                    <<06604>>31645000
               not logical(ldt'avail'to'sys) then              <<06604>>31650000
            begin <<down or down pending on device>>           <<01027>>31655000
               parmnum := 1;                                   <<01027>>31660000
               cierr(errnum := consoledown,firstparm);         <<01027>>31665000
            end                                                <<01027>>31670000
         else                                                  <<00671>>31675000
         begin   <<tell old console of switch and complete>>   <<00671>>31680000
                 <<successfully>>                              <<00671>>31685000
            genmsg(cigeneralmsgset,consoleswitched,%11000,     <<00671>>31690000
                   sys'console'ldev, ldev,,,,                  <<06923>>31695000
                   sys'console'ldev,,,,2);                     <<06923>>31700000
            old'console := sys'console'ldev;                   <<07430>>31705000
            sys'console'ldev := ldev;                          <<07430>>31710000
            <<  tell the new console of the switch  >>         <<07430>>31715000
            if old'console <> ldev then                        <<07430>>31720000
            genmsg(cigeneralmsgset,consoleswitched,%11000,     <<07430>>31725000
                   old'console, ldev,,,,                       <<07430>>31730000
                   sys'console'ldev,,,,2);                     <<07430>>31735000
         end;                                                  <<06923>>31740000
         end;                                                  <<06221>>31745000
      end;                                                              31750000
      end                                                      <<01042>>31755000
      else <<user has no access to command>>                   <<01042>>31760000
      begin                                                    <<01042>>31765000
         parmnum:=1;                                           <<01042>>31770000
         cierr(errnum:=opcommnotallow,parmsp);                 <<01042>>31775000
      end;                                                     <<01042>>31780000
   end;                                                                 31785000
end;                                                                    31790000
$page "LIMIT EXECUTOR"                                                  31795000
$control segment=opmed                                                  31800000
procedure getmaxjs(jlimit,slimit,errnum);                      <<01108>>31805000
integer slimit,jlimit,errnum; << passed by reference >>        <<01108>>31810000
option privileged,uncallable;                                  <<01108>>31815000
                                                               <<01108>>31820000
comment                                                        <<01108>>31825000
the following procedure will return the absolute               <<01108>>31830000
number of sessions and jobs allowed on the system.             <<01108>>31835000
those numbers are established at system configuration          <<01108>>31840000
time and are stored in the file "CONFDATA.PUB.SYS" together    <<01108>>31845000
with other system pertinent information.                       <<01108>>31850000
the above system file is also used by "INITIAL" and            <<01108>>31855000
therefor considered "STABLE".;                                 <<01108>>31860000
                                                               <<01108>>31865000
begin                                                          <<01108>>31870000
integer conf'f'num, << file number >>                          <<01108>>31875000
        conf'recsize; << record size >>                        <<01108>>31880000
                                                               <<01108>>31885000
array conf'rec(0:199); << record buffer >>                     <<01108>>31890000
                                                               <<01108>>31895000
intrinsic fopen,fclose,fread,fwrite,fpoint,fgetinfo;           <<01108>>31900000
array conf'data(0:20) ;                                        <<01108>>31905000
define confdata'error = begin                                  <<01108>>31910000
                            ferror'(conf'f'num,errnum);        <<01457>>31915000
                            cierr(errnum := conf'error);       <<01108>>31920000
                            return;                            <<01108>>31925000
                        end#,                                  <<01108>>31930000
       abs'slimit = conf'rec(40)#,                             <<01108>>31935000
       abs'jlimit = conf'rec(41)#,                             <<01108>>31940000
                                                               <<01108>>31945000
       core'size'index = conf'rec(1) + 1#;                     <<01108>>31950000
                                                               <<01108>>31955000
<< main line >>                                                <<01108>>31960000
    << initialize >>                                           <<01108>>31965000
    move conf'data := "CONFDATA.PUB.SYS ";                     <<01108>>31970000
                                                               <<01108>>31975000
                                                               <<01108>>31980000
    << open the file >>                                        <<01108>>31985000
    conf'f'num := fopen(conf'data,%2001,%57);<<r,l,nosecurity>><<01457>>31990000
    if < then confdata'error;                                  <<01108>>31995000
                                                               <<01108>>32000000
    << get the record size >>                                  <<01108>>32005000
    fgetinfo(conf'f'num,,,,conf'recsize);                      <<01108>>32010000
    if < then confdata'error;                                  <<01108>>32015000
                                                               <<01108>>32020000
    << read record zero >>                                     <<01108>>32025000
    freaddir(conf'f'num,conf'rec,conf'recsize,1d);             <<07182>>32030000
    if <> then confdata'error;                                 <<01108>>32035000
    << pull it in >>                                           <<01108>>32040000
    jlimit := abs'jlimit;                                      <<01108>>32045000
    slimit := abs'slimit;                                      <<01108>>32050000
                                                               <<01108>>32055000
    << close the file >>                                       <<01108>>32060000
    fclose(conf'f'num,0,0);                                    <<01108>>32065000
    if <> then confdata'error;                                 <<01108>>32070000
                                                               <<01108>>32075000
                                                               <<01108>>32080000
end; << procedure getmaxjs >>                                  <<01108>>32085000
procedure cxlimit executorhead;                                         32090000
begin                                                                   32095000
   comment                                                              32100000
      the syntax of this command is:                                    32105000
         limit [jlimit][,slimit]                                        32110000
         where jlimit is the job limit and slimit is session limit      32115000
   ;                                                                    32120000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  32125000
   byte array dl'(*)=dl;                                                32130000
   byte array limits(0:11);                                    <<02371>>32135000
   integer len;                                                <<02371>>32140000
   double array parm(0:2)=q;                                            32145000
   byte pointer firstparm=parm, sndparm=parm+2, trdparm=parm+4;         32150000
   byte firstlen=parm+1, sndlen=parm+3;                                 32155000
   integer parm1=parm+1, parm2=parm+3, numparms,jlimit,slimit,savesir;  32160000
                                                               <<06607>>32165000
   << ...................................................... >><<06607>>32170000
   <<        declarations for referencing the jmat           >><<06607>>32175000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>32180000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>32185000
   <<               a specific entry), after an exchange db. >><<06607>>32190000
   <<               or 0 if jmatarr is a local array.        >><<06607>>32195000
   << ...................................................... >><<06607>>32200000
                                                               <<06607>>32205000
   integer       jmatinx;                                      <<06607>>32210000
   integer array jmatarr(0:jmatheadersize-1);                  <<06607>>32215000
integer abs'jlimit,abs'slimit; << absolute limits on number of <<01108>>32220000
                               << jobs and sessions, determined<<01108>>32225000
                               << at configuration time.       <<01108>>32230000
   equate comma=0, semicolon=1;                                         32235000
   subroutine def'movefromdseg;                                         32240000
   subroutine def'movetodseg;                                           32245000
   logimage( m'limit, parmsp );  << log op command >>          <<01527>>32250000
   mycommand(parmsp,dl',3,numparms,parm);<<parse parameters>>           32255000
   if numparms=0 then <<must have at least one parm>>                   32260000
   begin                                                                32265000
      cierr(errnum:=-exp1ofsorjlimit,parmsp);                           32270000
      return;                                                           32275000
   end                                                                  32280000
   else                                                                 32285000
   if numparms>2 then                                                   32290000
   begin                                                                32295000
      parmnum:=2;                                                       32300000
      cierr(errnum:=limithas2parm,trdparm);                             32305000
      return;                                                           32310000
   end;                                                                 32315000
    getmaxjs(abs'jlimit,abs'slimit,errnum);                    <<01108>>32320000
    if errnum <> 0 then return;                                <<01108>>32325000
   move limits := 12(0);                                       <<02371>>32330000
   len := ascii(abs'jlimit,10,limits);                         <<02371>>32335000
   limits(len) := 0;                                           <<02371>>32340000
   len := ascii(abs'slimit,10,limits(len + 1));                <<02371>>32345000
   if numparms=2 then                                                   32350000
   begin                                                                32355000
      if parm1.delimiter<>comma then <<must have comma separator>>      32360000
      begin                                                             32365000
         parmnum:=2;                                                    32370000
         cierr(errnum:=expcommasj,firstparm(firstlen));                 32375000
      end                                                               32380000
      else                                                              32385000
      if sndlen<>0 then                                                 32390000
      begin                                                             32395000
         slimit:=binary(sndparm,sndlen);                                32400000
         if <> or slimit<0 then <<bad session limit specified>>         32405000
         begin                                                          32410000
            parmnum:=2;                                                 32415000
            cierr(errnum:=slimitbad,sndparm);                           32420000
            return;                                                     32425000
         end;                                                           32430000
            if slimit > abs'slimit then                        <<01108>>32435000
            begin                                              <<01108>>32440000
                cierr(errnum := abslimitexceeded,,2,@limits);  <<02371>>32445000
                return;                                        <<01108>>32450000
            end;                                               <<01108>>32455000
      end;                                                              32460000
   end;                                                                 32465000
   if errnum<>0 then return;                                            32470000
   if firstlen<>0 then <<job limit specified>>                          32475000
   begin                                                                32480000
      jlimit:=binary(firstparm,firstlen);                               32485000
      if <> or jlimit<0 then <<badness!>>                               32490000
      begin                                                             32495000
         parmnum:=1;                                                    32500000
         cierr(errnum:=jlimitbad,firstparm);                            32505000
         return;                                                        32510000
      end;                                                              32515000
        if jlimit > abs'jlimit then                            <<01108>>32520000
        begin                                                  <<01108>>32525000
                cierr(errnum := abslimitexceeded,,2,@limits);  <<02371>>32530000
            return;                                            <<01108>>32535000
        end;                                                   <<01108>>32540000
   end;                                                                 32545000
   jmatinx := 0;  << jmatarr is local  >>                      <<06607>>32550000
   savesir:=getsir(jmatsir);<<lock jmat>>                               32555000
   movefromdseg(@jmatarr, jmatdst, 0, jmatheadersize);         <<06607>>32560000
   if firstlen <> 0  then jmatjlimit := jlimit;                <<06607>>32565000
   if numparms=2 and sndlen<>0 then                                     32570000
      jmatslimit := slimit;                                    <<06607>>32575000
   movetodseg(jmatdst, 0, @jmatarr, jmatheadersize);           <<06607>>32580000
   relsir(jmatsir,savesir);                                             32585000
   if firstlen<>0 then <<need to wake up scheduling>>                   32590000
   begin                                                                32595000
      disable;                                                          32600000
      absolute(jobsync).readyflag:=true;                                32605000
      enable;                                                           32610000
      awake(sysproc(ucop),%20,0);                                       32615000
   end;                                                                 32620000
end;                                                                    32625000
$page "ABORTJOB EXECUTOR"                                               32630000
$control segment=ophi                                                   32635000
procedure cxabortjob executorhead;                                      32640000
begin                                                                   32645000
   comment                                                              32650000
      the syntax of this command is:                                    32655000
         abortjob #jnnn                                                 32660000
         abortjob #snnn                                                 32665000
         abortjob [jobname,]username.acctname                           32670000
   ;                                                                    32675000
   double dl:=[8/",",8/".",8/";",8/cr]d;                                32680000
   byte array dl'(*)=dl;                                                32685000
   double array parm(0:3)=q;                                            32690000
   byte pointer firstparm=parm, sndparm=parm+2, trdparm=parm+4,         32695000
                fourthparm=parm+6;                                      32700000
   byte firstlen=parm+1, sndlen=parm+3, trdlen=parm+5;                  32705000
   integer parm1=parm+1, parm2=parm+3, parm3=parm+5;                    32710000
   integer numparms,jobnum,savesir,entryp;                              32715000
                                                               <<06607>>32720000
   << ...................................................... >><<06607>>32725000
   <<        declarations for referencing the jmat           >><<06607>>32730000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>32735000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>32740000
   <<               a specific entry), after an exchange db. >><<06607>>32745000
   <<               or 0 if jmatarr is a local array.        >><<06607>>32750000
   << ...................................................... >><<06607>>32755000
   integer       jmatinx;  << index into jmatarr >>            <<06607>>32760000
   integer array jmatarr(0:jmatentrysize);                     <<06607>>32765000
   integer array jname(0:3),uname(0:3),aname(0:3);                      32770000
   byte array jname'(*)=jname,uname'(*)=uname,aname'(*)=aname;          32775000
   equate comma=0, period=1, semicolon=2;                               32780000
                                                               << 8204>>32785000
   logical                                                     << 8204>>32790000
      delworked,        << flags success of deletexxx.     >>  << 8204>>32795000
      failval;          << indicates why deletexxx failed. >>  << 8204>>32800000
                                                               << 8204>>32805000
<< this fix is for scheduled jobs.  this fix               >>  << 8944>>32810000
<< has modified the return value of these procedures.  the >>  << 8204>>32815000
<< lower eight bits is a logical value that is true if the >>  << 8204>>32820000
<< indicated job is aborted and false if an error was      >>  << 8204>>32825000
<< detected.  the high order eight bits indicate what kind >>  << 8204>>32830000
<< of error was detected if the lower eight bits are       >>  << 8204>>32835000
<< false (the high order eight bits are undefined if the   >>  << 8204>>32840000
<< low order eight bits are true).  the failval have the   >>  << 8204>>32845000
<< following meanings:                                     >>  << 8204>>32850000
<<     0:  the indicated job was in intro state.           >>  << 8204>>32855000
                                                               << 8204>>32860000
   logimage( m'abortjob, parmsp );  << log operator command >> <<*8944>>32865000
   mycommand(parmsp,dl',4,numparms,parm);<<parse parameters>>           32870000
   if numparms=0 then <<need at least one parameter>>                   32875000
   begin                                                                32880000
      parmnum:=1;                                                       32885000
      cierr(errnum:=expjnumorjname,parmsp);                             32890000
   end                                                                  32895000
   else                                                                 32900000
   if firstlen>0 and firstparm="#" then <<jobnum specified>>            32905000
      if numparms<>1 then <<too many parms specified>>                  32910000
      begin                                                             32915000
         parmnum:=2;                                                    32920000
         cierr(errnum:=jobnumnootherp,sndparm);                         32925000
      end                                                               32930000
      else <<parse job num>>                                            32935000
         if (firstlen<3) or                                             32940000
           (not ((firstparm(1)="S") lor (firstparm(1)="J"))) then       32945000
         begin                                                          32950000
            parmnum:=1;                                                 32955000
            cierr(errnum:=expjorsnum,firstparm(1));                     32960000
         end                                                            32965000
         else                                                           32970000
         begin                                                          32975000
            jobnum:=binary(firstparm(2),firstlen-2);                    32980000
            if <> or not (1<=jobnum<=%37777) then <<bad job num>>       32985000
            begin                                                       32990000
               parmnum:=1;                                              32995000
               cierr(errnum:=badjobnum,firstparm(2));                   33000000
            end;                                                        33005000
         end                                                            33010000
   else <<parse [jobname,]username.acctname>>                           33015000
   begin                                                                33020000
      jobnum:=0;                                                        33025000
      jname:="  ";                                                      33030000
      move jname(1):=jname,(3);                                         33035000
      move aname:=jname,(4);                                            33040000
      move uname:=jname,(4);                                            33045000
      if parm1.delimiter=comma then <<job name specified>>              33050000
      begin                                                             33055000
         if numparms<>3 then <<must have exactly 3 parms>>              33060000
         begin                                                          33065000
            parmnum:=numparms;                                          33070000
            cierr(errnum:=expacctname,firstparm(firstlen));             33075000
            return;                                                     33080000
         end;                                                           33085000
         if firstlen>8 then <<jname too long>>                          33090000
         begin                                                          33095000
            parmnum:=1;                                                 33100000
            cierr(errnum:=uoranamemax8,firstparm);                      33105000
            return;                                                     33110000
         end;                                                           33115000
         move jname':=firstparm,(firstlen);                             33120000
         parm:=parm(1); <<finished processing jobname>>                 33125000
         parm(1):=parm(2);<<so act as if it didn't exist>>              33130000
      end                                                               33135000
      else if numparms<>2 then <<expected just username.acctname>>      33140000
      begin                                                             33145000
         parmnum:=3;                                                    33150000
         cierr(errnum:=expuandaname,firstparm(firstlen));      <<00654>>33155000
         return;                                                        33160000
      end;                                                              33165000
      if parm1.delimiter<>period then <<must be period between names>>  33170000
      begin                                                             33175000
         parmnum:=numparms-1;                                           33180000
         cierr(errnum:=periodexp,sndparm);                              33185000
         return;                                                        33190000
      end                                                               33195000
      else                                                              33200000
      if firstlen=0 or sndlen=0 then <<username ad acctname must be sp>>33205000
      begin                                                             33210000
         parmnum:=2;                                                    33215000
         cierr(errnum:=uoranamezero,firstparm(firstlen));               33220000
         return;                                                        33225000
      end                                                               33230000
      else                                                              33235000
      if firstlen>8 or sndlen>8 then <<username or acctname too long>>  33240000
      begin                                                             33245000
         parmnum:=2;                                                    33250000
         cierr(errnum:=uoranamemax8,firstparm(firstlen));               33255000
         return;                                                        33260000
      end                                                               33265000
      else                                                              33270000
      begin                                                             33275000
         move uname':=firstparm,(firstlen);                             33280000
         move aname':=sndparm,(sndlen);                                 33285000
      end;                                                              33290000
   end;                                                                 33295000
   if errnum<>0 then return;                                            33300000
   << ................................................... >>   <<06607>>33305000
   <<  if successful, findjob returns true, the jmat entry>>   <<06607>>33310000
   <<  in jmatarr, and holds on to the jmat sir.  else, it>>   <<06607>>33315000
   <<  returns false and releases the sir.                >>   <<06607>>33320000
   << ................................................... >>   <<06607>>33325000
                                                               <<06607>>33330000
   tos:=if jobnum<>0 then findjob(jmatarr,entryp,jobnum,       <<06607>>33335000
                                 (firstparm(1)="J"),,,,savesir)         33340000
                     else findjob(jmatarr,entryp,,,jname,      <<06607>>33345000
                                  uname,aname,savesir);                 33350000
   if not tos then                                                      33355000
   begin  <<no such job>>                                               33360000
      parmnum:=1;                                                       33365000
      cierr(errnum:=nosuchjob,firstparm);                               33370000
   end                                                                  33375000
   else                                                                 33380000
   if ( checkjob(jmatarr) = 0 )    or                          << 8204>>33385000
      checkallow( m'abortjob )                                 <<*8944>>33390000
   then                                                        << 8204>>33395000
   begin                                                                33400000
      tos:=0;   <<stack parms because deletejob expects>>               33405000
      tos:=entryp;  <<an integer pointer,not an integer>>               33410000
      exchangedb(jmatdst);<<deletejob expects it>>                      33415000
      tos := deletejob( * );                                   << 8944>>33420000
      exchangedb(0);                                                    33425000
      relsir(jmatsir,savesir);                                          33430000
      delworked := tos;                                        << 8204>>33435000
      failval := delworked.(0:8);                              << 8204>>33440000
      if not delworked.(8:8) then  << unable to abort job. >>  << 8204>>33445000
      begin                                                    << 8204>>33450000
         parmnum := 1;                                         << 8204>>33455000
         cierr( errnum := jobbeintro, firstparm );             << 8944>>33460000
      end;                                                     << 8204>>33465000
   end                                                                  33470000
   else                                                                 33475000
   begin <<not user's job>>                                             33480000
      relsir(jmatsir,savesir);                                          33485000
      parmnum:=1;                                                       33490000
      cierr(errnum:=notusersjob,firstparm);                             33495000
   end;                                                                 33500000
end;                                                                    33505000
$page "ALTJOB EXECUTOR"                                                 33510000
$control segment=opmed                                                  33515000
procedure cxaltjob executorhead;                                        33520000
begin                                                                   33525000
   comment                                                     <<06607>>33530000
     the command executor for altjob.                          <<06607>>33535000
                                                               <<06607>>33540000
                                                               <<06607>>33545000
      fix note:  note that jmatarr is used to index            <<06607>>33550000
                 into two different arrays in this procedure.  <<06607>>33555000
                 it is equivalenced to jmatheader and to       <<06607>>33560000
                 jmatentry. this is necessary since the include<<06607>>33565000
                 file for the jmat exclusively references      <<06607>>33570000
                 jmatarr.                                      <<06607>>33575000
;                                                              <<06607>>33580000
                                                               <<06607>>33585000
   equate comma=0, equal=1, semicolon=2;                                33590000
   equate outputdev=4;                                                  33595000
   double array parm(0:5)=q;                                            33600000
   byte pointer firstparm=parm, sndparm=parm+2, trdparm=parm+4,         33605000
                fourthparm=parm+6, fifthparm=parm+8,sixthparm=parm+10;  33610000
   byte firstlen=parm+1, sndlen=parm+3, trdlen=parm+5,                  33615000
        fourtlen=parm+7, fifthlen=parm+9;                               33620000
   integer parm1=parm+1, parm2=parm+3, parm3=parm+5, parm4=parm+7,      33625000
           parm5=parm+9;                                                33630000
   logical class;                                                       33635000
   integer savesir,numparms,entryp,jobnum,pri:=-1,device:=0;            33640000
   byte pointer parmptr;                                                33645000
   byte len,oldbyte;                                                    33650000
   integer checkjob'value;                                     <<04684>>33655000
   integer lastdel,currdel;                                             33660000
                                                               <<06607>>33665000
   << ...................................................... >><<06607>>33670000
   <<        declarations for referencing the jmat           >><<06607>>33675000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>33680000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>33685000
   <<               a specific entry), after an exchange db. >><<06607>>33690000
   <<               or 0 if jmatarr is a local array.        >><<06607>>33695000
   << ...................................................... >><<06607>>33700000
                                                               <<06607>>33705000
   integer       jmatinx;                                      <<06607>>33710000
   integer array jmatentry(0:jmatentrysize-1);                          33715000
   integer array jmatheader(0:jmatheadersize-1);                        33720000
   integer array jmatarr(*);                                   <<06607>>33725000
   integer array devinfo(0:12)=q;                              <<06604>>33730000
   integer array lpdt(*)=devinfo+2;                                     33735000
   integer array ldt(*)=devinfo+4;                             <<*7611>>33740000
   integer ldt'index := 0;                                     <<06604>>33745000
   subroutine def'movefromdseg;                                         33750000
   subroutine def'movetodseg;                                           33755000
   logical subroutine getnext;                                          33760000
   begin                                                                33765000
      parmnum:=parmnum+1;                                               33770000
      if parmnum<numparms then                                          33775000
      begin                                                             33780000
         getnext:=true;                                                 33785000
         lastdel:=currdel;                                              33790000
         tos:=parm(parmnum);                                            33795000
         currdel:=s0.delimiter;                                         33800000
         len:=tos&lsr(8);                                               33805000
         @parmptr:=tos;                                                 33810000
      end else getnext:=false;                                          33815000
   end;                                                                 33820000
$page                                                                   33825000
   logimage( m'altjob, parmsp );  << log op command >>         <<01527>>33830000
   mycommand(parmsp,,6,numparms,parm); <<parse parameters>>             33835000
   if numparms<>3 and numparms<>5 then                                  33840000
   begin                                                                33845000
      tos:=errnum:=expjand1parm;                                        33850000
      if numparms = 0 then tos := @parmsp                               33855000
      else                                                              33860000
      if numparms<6 then                                                33865000
      begin                                                             33870000
         parmnum:=numparms;                                             33875000
         tos:=parm(numparms-1);                                         33880000
         del;                                                           33885000
      end                                                               33890000
      else                                                              33895000
      begin                                                             33900000
         parmnum:=6;                                                    33905000
         tos:=@sixthparm;                                               33910000
      end;                                                              33915000
      cierr(*,*);                                                       33920000
   end                                                                  33925000
   else                                                                 33930000
   begin                                                                33935000
      if firstlen<3 or firstparm<>"#" or                                33940000
      (firstparm(1)<>"J" land firstparm(1)<>"S") then                   33945000
         errnum:=expjorsnum                                             33950000
      else                                                              33955000
      begin                                                             33960000
         jobnum:=binary(firstparm(2),firstlen-2);                       33965000
         if <> or not(1<=jobnum<=%37777) then errnum:=badjobnum;        33970000
      end;                                                              33975000
      if errnum<>0 then                                                 33980000
      begin                                                             33985000
         parmnum:=1;                                                    33990000
         cierr(errnum,firstparm);                                       33995000
         return;                                                        34000000
      end;                                                              34005000
      currdel:=parm1.delimiter;                                         34010000
      parmnum:=0;                                                       34015000
      while getnext do <<process each key>>                             34020000
      begin                                                             34025000
         if parmptr="INPRI" and len=5 then tos:=true                    34030000
         else                                                           34035000
         if parmptr="OUTDEV" and len=6 then tos:=false                  34040000
         else                                                           34045000
         begin                                                          34050000
            cierr(errnum:=exp1ofinout,parmptr);                         34055000
            return;                                                     34060000
         end;                                                           34065000
         if lastdel<>semicolon then                                     34070000
         begin                                                          34075000
            cierr(errnum:=expsemicolon,parmptr);                        34080000
            return;                                                     34085000
         end;                                                           34090000
         if currdel<>equal then                                         34095000
         begin                                                          34100000
            cierr(errnum:=expequals,parmptr);                           34105000
            return;                                                     34110000
         end;                                                           34115000
         getnext; <<get parameter following equals>>                    34120000
         if tos then <<inpri>>                                          34125000
         begin                                                          34130000
            pri:=binary(parmptr,len);                                   34135000
            if <> or not (0<=pri<=14) then                              34140000
            begin                                                       34145000
               cierr(errnum:=exp0to14,parmptr);                         34150000
               return;                                                  34155000
            end;                                                        34160000
         end                                                            34165000
         else <<outdev>>                                                34170000
         begin                                                          34175000
            oldbyte:=parmptr(len);                                      34180000
            parmptr(len):=" "; <<terminate dev with blank>>             34185000
            tos:=getdevinfo(parmptr,devinfo); <<get info on device>>    34190000
            parmptr(len):=oldbyte; <<restore device terminating char.>> 34195000
            if tos<>0 then <<bad device>>                               34200000
            begin                                                       34205000
               cierr(errnum:=nosuchdev,parmptr);                        34210000
               return;                                                  34215000
            end;                                                        34220000
<< we set ldt'index to 2 here because when getdevinfo returns>><<*7611>>34225000
<< information to the array devinfo the ldt entry can either >><<*7611>>34230000
<< start at devinfo + 4 or devinfo+6.  the array ldt has been>><<*7611>>34235000
<< set to start at devinfo+4.  if an ldev # is passed to the >><<*7611>>34240000
<< procedure getdevinfo the ldt starts at devinfo+6 so       >><<*7611>>34245000
<< ldt'index is set to 2 to make up the offset of the two    >><<*7611>>34250000
<< extra words in devinfo string.                            >><<*7611>>34255000
                                                               <<*7611>>34260000
            if devinfo < 0 then ldt'index := 0                 <<*7611>>34265000
               else ldt'index := 2;                            <<*7611>>34270000
            if ldt'access'type   <>outputdev then <<devi not ou<<06604>>34275000
            begin                                                       34280000
               cierr(errnum:=devnotoutput,parmptr);                     34285000
               return;                                                  34290000
            end;                                                        34295000
            if devinfo<0 then <<got device class>>                      34300000
            begin                                                       34305000
               class:=true;                                             34310000
               device:=-devinfo;                                        34315000
            end                                                         34320000
            else  <<got device #>>                                      34325000
            begin                                                       34330000
               class:=false;                                            34335000
               device:=devinfo;                                         34340000
            end;                                                        34345000
         end;                                                           34350000
      end;                                                              34355000
      jmatinx := 0; << jmatarr points to a local array >>      <<06607>>34360000
      @jmatarr := @jmatentry; << index into entry >>           <<06607>>34365000
      << .................................................. >> <<06607>>34370000
      <<    findjob will return the jmatentry in jmatarr    >> <<06607>>34375000
      <<    (actually jmatentry) if successful, and it will >> <<06607>>34380000
      <<    be holding the jmat sir.  if findjob fails it   >> <<06607>>34385000
      <<    will release the sir.                           >> <<06607>>34390000
      << .................................................. >> <<06607>>34395000
                                                               <<06607>>34400000
      if not findjob(jmatarr,entryp,jobnum,(firstparm(1)="J")  <<06607>>34405000
                     ,,,,savesir) then <<no such job>>         <<06607>>34410000
      begin                                                             34415000
         parmnum:=1;                                                    34420000
         cierr(errnum:=nosuchjob,firstparm);                            34425000
         return;                                                        34430000
      end;                                                              34435000
   checkjob'value := checkjob(jmatarr, pri);                   <<06607>>34440000
   if (checkjob'value = 0) or checkallow(m'altjob) then        <<04684>>34445000
      begin                                                             34450000
         if jmatjobstate <> jobwait and                        <<06607>>34455000
            jmatjobstate <> jobsched and                       << 8944>>34460000
            jmatjobstate <> jobintro then                      <<06607>>34465000
         begin                                                          34470000
            relsir(jmatsir,savesir);                                    34475000
            parmnum:=1;                                                 34480000
            cierr(errnum:=mustwaitorintro,firstparm);                   34485000
            return;                                                     34490000
         end;                                                           34495000
         if device<>0 then <<change device>>                            34500000
         begin                                                          34505000
            jmatcbit := class;<< jlist a dev. class index >>   <<06607>>34510000
            jmatjlistdev := device;                            <<06607>>34515000
         end;                                                           34520000
         if pri>=0 then jmatinpri := pri;                      <<06607>>34525000
         movetodseg(jmatdst,entryp,@jmatarr,jmatentrysize);    <<06607>>34530000
         if pri>=0 and jmatjobstate = jobwait then             <<06607>>34535000
         begin  <<must be in correct queue>>                            34540000
            << ............................................. >><<06607>>34545000
            <<   the job's input priority has been changed.  >><<06607>>34550000
            <<   therefore, it must be reinserted in ucop's  >><<06607>>34555000
            <<   queue in the correct position.  first we    >><<06607>>34560000
            <<   delink the jmat and then relink it correctly>><<06607>>34565000
            <<   (a call to schedulejob).                    >><<06607>>34570000
            <<                                               >><<06607>>34575000
            << ............................................. >><<06607>>34580000
                                                               <<06607>>34585000
            << change jmatarr to point to jmatheader >>        <<06607>>34590000
            @jmatarr := @jmatheader;                           <<06607>>34595000
            movefromdseg(@jmatarr,jmatdst,0,jmatheadersize);   <<06607>>34600000
            exchangedb(jmatdst);  << delink'jmat expects jmat>><<06607>>34605000
            delink'jmat(entryp);  << delink the entry >>       <<06607>>34610000
            exchangedb(0);        << i'm back! >>              <<06607>>34615000
            <<  switch jmatarr back to an entry  >>            <<06607>>34620000
            @jmatarr := @jmatentry;                            <<06607>>34625000
           movefromdseg(@jmatarr,jmatdst,entryp,jmatentrysize);<<06607>>34630000
            jmatjobstate := jobintro; <<re-introduce job>>     <<06607>>34635000
            movetodseg(jmatdst,entryp,@jmatarr,jmatentrysize); <<06607>>34640000
            tos:=entryp; <<schedulejob expect integer pointer >>        34645000
            schedulejob(*);<<and entryp is simple integer>>             34650000
         end;                                                           34655000
         if device<>0 and pri<0 then <<force job scheduling>>           34660000
         begin                                                          34665000
            disable;                                                    34670000
            absolute(jobsync).readyflag:=true;                          34675000
            enable;                                                     34680000
            awake(sysproc(ucop),%20,0);                                 34685000
         end;                                                           34690000
      end                                                               34695000
      else                                                              34700000
      begin                                                             34705000
         relsir(jmatsir,savesir);                                       34710000
         parmnum:=1;                                                    34715000
         if checkjob'value = 1                                 <<04684>>34720000
            then cierr(errnum :=notusersjob,firstparm)         <<04684>>34725000
            else cierr(errnum :=illegalvalue,firstparm);       <<04684>>34730000
         return;                                                        34735000
      end;                                                              34740000
      relsir(jmatsir,savesir);                                          34745000
   end;                                                                 34750000
end;                                                                    34755000
$page "VMOUNT EXECUTOR"                                                 34760000
$control segment=opmed                                                  34765000
procedure cxvmount executorhead;                                        34770000
begin                                                                   34775000
                                                                        34780000
<<    the syntax of this command is:                                  >>34785000
<<    vmount on[,auto][;all]                                          >>34790000
<<    vmount off[;all]                                                >>34795000
<<                                                        >>   <<06607>>34800000
<<          the vmount information is stored as follows:  >>   <<06607>>34805000
<<                                                        >>   <<06607>>34810000
<<       bits  0    ...   12    13      14       15       >>   <<06607>>34815000
<<                              auto    all      on/off   >>   <<06607>>34820000
<<                                                        >>   <<06607>>34825000
                                                                        34830000
   double dl:=[8/",",8/";",8/cr,8/0]d;                                  34835000
   byte array dl'(*)=dl;                                                34840000
   double array parm(0:3)=q;                                            34845000
   byte pointer firstparm=parm, sndparm=parm+2, trdparm=parm+4,         34850000
                fourthparm=parm+6;                                      34855000
   byte firstlen=parm+1, sndlen=parm+3, trdlen=parm+5;                  34860000
   equate comma=0, semicolon=1;                                         34865000
   integer numparms,vmount:=0,parm1=parm+1, parm2=parm+3;               34870000
                                                               <<06607>>34875000
   << ...................................................... >><<06607>>34880000
   <<        declarations for referencing the jmat           >><<06607>>34885000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>34890000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>34895000
   <<               a specific entry), after an exchange db. >><<06607>>34900000
   <<               or 0 if jmatarr is a local array.        >><<06607>>34905000
   << ...................................................... >><<06607>>34910000
                                                               <<06607>>34915000
   integer       jmatinx;                                      <<06607>>34920000
   integer array jmatarr(0:jmatentrysize-1);                   <<06607>>34925000
   integer savesir;                                            <<00716>>34930000
   subroutine def'movefromdseg;                                <<00716>>34935000
   subroutine def'movetodseg;                                  <<00716>>34940000
                                                                        34945000
   logimage( m'vmount, parmsp );  << log op command >>         <<01527>>34950000
   mycommand(parmsp,dl',4,numparms,parm);<<parse parameters>>           34955000
   if numparms<1 then <<must have at least on/off>>                     34960000
   begin                                                                34965000
      parmnum:=1;                                                       34970000
      cierr(errnum:=exp1ofonoff,parmsp);                                34975000
      return;                                                           34980000
   end;                                                                 34985000
   if firstlen=2 and firstparm="ON" then <<have on>>                    34990000
   begin                                                                34995000
      vmount.onoffflg:=1;                                               35000000
      if numparms>1 and parm1.delimiter=comma then <<expect "AUTO">>    35005000
      begin                                                             35010000
         if sndlen<>4 or sndparm<>"AUTO" then                           35015000
         begin                                                          35020000
            parmnum:=2;                                                 35025000
            cierr(errnum:=expauto,sndparm);                             35030000
            return;                                                     35035000
            end                                                         35040000
         else                                                           35045000
         begin                                                          35050000
            vmount.autoflg:=1;                                          35055000
            parm(0):=parm(1);                                           35060000
            parm(1):=parm(2);                                           35065000
            numparms:=numparms-1;                                       35070000
         end;                                                           35075000
      end;                                                              35080000
   end                                                                  35085000
   else <<must find "OFF">>                                             35090000
   if firstlen<>3 or firstparm<>"OFF" then <<neither on or off>>        35095000
   begin                                                                35100000
      parmnum:=1;                                                       35105000
      cierr(errnum:=exp1ofonoff,firstparm);                             35110000
      return;                                                           35115000
   end;                                                                 35120000
   if numparms=2 then <<expect ;all>>                                   35125000
      if parm1.delimiter<>semicolon then                                35130000
      begin                                                             35135000
         parmnum:=2;                                                    35140000
         cierr(errnum:=expsemicolon,firstparm(firstlen));               35145000
         return;                                                        35150000
      end                                                               35155000
      else                                                              35160000
         if sndlen<>3 or sndparm<>"ALL" then                            35165000
         begin                                                          35170000
            parmnum:=2;                                                 35175000
            cierr(errnum:=expall,sndparm);                              35180000
            return;                                                     35185000
         end                                                            35190000
         else vmount.allflg:=1                                          35195000
   else                                                                 35200000
   if numparms>2 then                                                   35205000
   begin                                                                35210000
      parmnum:=3;                                                       35215000
      cierr(errnum:=exp1ofonoff,sndparm(sndlen));                       35220000
      return;                                                           35225000
   end;                                                                 35230000
   absolute(vmountcntl):=vmount;                                        35235000
   savesir:=getsir(jmatsir);                                   <<00716>>35240000
   movefromdseg(@jmatarr, jmatdst, 0, jmatentrysize);          <<06607>>35245000
   jmatvmount := vmount;                                       <<06607>>35250000
   movetodseg(jmatdst, 0, @jmatarr, jmatentrysize);            <<06607>>35255000
   writedseg(jmatdst);                                         <<00716>>35260000
   relsir(jmatsir,savesir);                                    <<00716>>35265000
end;                                                                    35270000
$page "LMOUNT & DISMOUNT EXECUTORS"                                     35275000
$control segment=opmed                                                  35280000
procedure cxlmount executorhead;                                        35285000
begin                                                                   35290000
   entry cxldismount;                                                   35295000
                                                                        35300000
<<    the syntax of these commands are:                               >>35305000
<<       lmount setname.group.account[;gen=generation]                >>35310000
<<       lmount *.group.account[;gen=generation]                      >>35315000
<<       ldismount setname.group.account                              >>35320000
<<       ldismount *.group.account                                    >>35325000
                                                                        35330000
   equate period=0, semicolon=1, equal=2, comma=3, eol=4;               35335000
   byte array dl'(0:4);                                                 35340000
   double array parm(0:5)=q;                                            35345000
   logical lmount:=true, alphabetic, numeral, not'alphanumeric;         35350000
   byte array setname(0:8), groupname(0:8), acctname(0:8);              35355000
   integer numparms,generation:=-1,request'type:=4,i;                   35360000
   byte pointer current'parm;                                           35365000
   integer current'length;                                              35370000
   integer current'delimiter;                                           35375000
                                                                        35380000
   logical subroutine checkname;                                        35385000
   begin                                                                35390000
      comment                                                           35395000
         this subroutine returns true if string in current parameter    35400000
      is a valid name (1 to 8 chars with leading alpha and no specials. 35405000
      ;                                                                 35410000
      checkname:=false;                                                 35415000
      if (1<=current'length<=8) and current'parm=alpha                  35420000
         and not not'alphanumeric then checkname:=true                  35425000
      else cierr(errnum:=invalidname,current'parm);                     35430000
   end;                                                                 35435000
                                                                        35440000
<<cxlmount entry point>>                                                35445000
   go to maincode;                                                      35450000
                                                                        35455000
<<cxldismount entry point>>                                             35460000
cxldismount:                                                            35465000
   lmount:=false;                                                       35470000
                                                                        35475000
maincode:                                                               35480000
   logimage( ( if lmount                                       <<01527>>35485000
                  then m'lmount                                <<01527>>35490000
                  else m'ldismount ), parmsp );                <<01527>>35495000
   move dl':=(".;=,",cr);<<set up delimiters>>                          35500000
   mycommand(parmsp,dl',6,numparms,parm);<<parse parameters>>           35505000
   if numparms<3 then <<must have at least setname.group.acct>>         35510000
   begin                                                                35515000
      parmnum:=numparms;                                                35520000
      cierr(errnum:=reqsetgrpacct);                                     35525000
   end                                                                  35530000
   else                                                                 35535000
   if lmount and numparms<>5 and numparms<>3 then                       35540000
   begin                                                                35545000
      parmnum:=4;                                                       35550000
      cierr(errnum:=lmhas5parms);                                       35555000
   end                                                                  35560000
   else                                                                 35565000
   if not lmount and numparms<>3 then                                   35570000
   begin                                                                35575000
      parmnum:=4;                                                       35580000
      cierr(errnum:=ldmexp3parms);                                      35585000
   end                                                                  35590000
   else                                                                 35595000
   begin                                                                35600000
      setname:=" "; <<initialize setname, groupname, acctname>>         35605000
      move setname(1):=setname,(8);                                     35610000
      move groupname:=setname,(9);                                      35615000
      move acctname:=setname,(9);                                       35620000
      i:=-1;                                                            35625000
      while (i:=i+1)<numparms do <<scan thru each parameter>>           35630000
      begin                                                             35635000
         tos:=parm(i);                                                  35640000
         current'delimiter:=s0.delimiter;                               35645000
         not'alphanumeric:=(s0.special'char=1);                         35650000
         numeral:=(s0.numerical'char=1);                                35655000
         alphabetic:=(s0.alpha'char=1);                                 35660000
         current'length:=tos&lsr(8);                                    35665000
         @current'parm:=tos;                                            35670000
         case i of                                                      35675000
         begin                                                          35680000
                                                                        35685000
            <<setname parameter>>                                       35690000
                                                                        35695000
            begin                                                       35700000
               if current'delimiter<>period then                        35705000
               begin                                                    35710000
                  parmnum:=1;                                           35715000
                  cierr(errnum:=setnameperiod,                          35720000
                        current'parm(current'length));                  35725000
                  return;                                               35730000
               end;                                                     35735000
               if not'alphanumeric then <<possible "*">>                35740000
                  if current'parm<>"*" or current'length<>1 then        35745000
                  begin                                                 35750000
                     parmnum:=1;                                        35755000
                     cierr(errnum:=badsetname,current'parm);            35760000
                     return;                                            35765000
                  end                                                   35770000
                  else                                                  35775000
               else                                                     35780000
               if not checkname then return;                            35785000
               move setname:=current'parm,(current'length);             35790000
            end;                                                        35795000
                                                                        35800000
            <<group name>>                                              35805000
                                                                        35810000
            if current'delimiter<>period then                           35815000
            begin                                                       35820000
               parmnum:=2;                                              35825000
               cierr(errnum:=groupperiod,current'parm(current'length)); 35830000
               return;                                                  35835000
            end                                                         35840000
            else                                                        35845000
            if checkname then move groupname:=current'parm,             35850000
               (current'length) else return;                            35855000
                                                                        35860000
            <<acct name>>                                               35865000
                                                                        35870000
            if current'delimiter<>eol and current'delimiter<>semicolon  35875000
            then                                                        35880000
            begin                                                       35885000
               parmnum:=3;                                              35890000
               cierr(errnum:=expsemicolon,current'parm(current'length));35895000
               return;                                                  35900000
            end                                                         35905000
            else                                                        35910000
            if checkname then move acctname:=current'parm,              35915000
               (current'length) else return;                            35920000
                                                                        35925000
            <<;gen=>>                                                   35930000
                                                                        35935000
            if current'length<>3 or current'parm<>"GEN" then            35940000
            begin                                                       35945000
               parmnum:=4;                                              35950000
               cierr(errnum:=expgeneration,current'parm);               35955000
               return;                                                  35960000
            end                                                         35965000
            else                                                        35970000
            if current'delimiter<>equal then                            35975000
            begin                                                       35980000
               parmnum:=4;                                              35985000
               cierr(errnum:=expequals,current'parm(current'length));   35990000
               return;                                                  35995000
            end;                                                        36000000
                                                                        36005000
            <<generation number>>                                       36010000
                                                                        36015000
            begin                                                       36020000
               generation:=binary(current'parm,current'length);         36025000
               if <> then                                               36030000
               begin                                                    36035000
                  parmnum:=5;                                           36040000
                  cierr(errnum:=badgeneration,current'parm);            36045000
                  return;                                               36050000
               end;                                                     36055000
            end;                                                        36060000
         end;                                                           36065000
      end;                                                              36070000
      if lmount then mount(setname,groupname,acctname,                  36075000
                        request'type,generation)                        36080000
      else dismount(setname,groupname,acctname,request'type);           36085000
      if request'type<>0 then <<error during mount/dismount>>           36090000
         genmsg(generalset,mounterrs+(if lmount then 0 else 1),         36095000
                %10000,request'type);                                   36100000
   end;                                                                 36105000
end;                                                                    36110000
$page "DSCONTROL & MPLINE & MRJECONTROL EXECUTORS"                      36115000
$control segment=oplow                                                  36120000
procedure cxdscontrol executorhead;                                     36125000
begin                                                                   36130000
   entry cxmpline,cxmrjecontrol;                                        36135000
   integer array xfer(0:2)=pb:=dscontrol,mpline,mrjecontrol;            36140000
   integer routine;                                                     36145000
   integer array nothere(0:2)=pb:=nods,nomp,nomrje;                     36150000
                                                                        36155000
<<cxdscontrol entry point>>                                             36160000
   routine:=0;                                                          36165000
   go to maincode;                                                      36170000
                                                                        36175000
<<cxmpline entry point>>                                                36180000
cxmpline:                                                               36185000
   routine:=1;                                                          36190000
   go to maincode;                                                      36195000
                                                                        36200000
<<cxmrjecontrol entry point>>                                           36205000
cxmrjecontrol:                                                          36210000
   routine:=2;                                                          36215000
                                                                        36220000
maincode:                                                               36225000
   case *routine of                                            <<01527>>36230000
   begin               << log op command >>                    <<01527>>36235000
                                                               <<01527>>36240000
      logimage( m'dscontrol, parmsp );                         <<01527>>36245000
      logimage( m'mpline, parmsp );                            <<01527>>36250000
      logimage( m'mrjecntrl, parmsp);                          <<06924>>36255000
                                                               <<01527>>36260000
   end;                                                        <<01527>>36265000
                                                               <<01527>>36270000
   if absolute(xfer(routine))=0 then <<subsystem doesn't exist>>        36275000
      cierr(errnum:=nothere(routine))                                   36280000
   else                                                                 36285000
   begin                                                                36290000
      tos:=@parmsp; <<build parameter list for ci executor's>>          36295000
      tos:=@errnum;                                                     36300000
      tos:=@parmnum;                                                    36305000
      tos:=absolute(xfer(routine)); <<plabel for pcal>>                 36310000
      assemble(pcal 0);                                                 36315000
   end;                                                                 36320000
end;                                                                    36325000
$page "MON & MOFF EXECUTORS"                                            36330000
$control segment=oplow                                                  36335000
procedure cxmon executorhead;                                           36340000
begin                                                                   36345000
   entry cxmoff;                                                        36350000
                                                                        36355000
<<    the syntax of this commands are:                                >>36360000
<<       mon ldev[;e=maskbit1,...,maskbitn]                           >>36365000
<<       moff                                                         >>36370000
                                                                        36375000
   integer array mask(0:1)=q;                                           36380000
   integer numparms,ldev,sysbuf1,sysbuf2;                               36385000
                                                                        36390000
   equate maxparms=28; <<ldev, "E=", + 26 maskbits>>                    36395000
                                                                        36400000
   equate comma=0, equal=1, semicolon=2, eol=3;                         36405000
   equate dst=2,dstsize=4;                                     <<00575>>36410000
   double array parm(0:maxparms)=q;                                     36415000
   array buf(0:5);                                             <<00575>>36420000
   byte array mioproc(*)=buf;                                  <<00575>>36425000
   integer parm1=parm+1, parm2=parm+3;                                  36430000
   byte pointer current'parm;                                           36435000
   integer current'length;                                              36440000
   integer current'delimiter;                                           36445000
   integer i,n,size,offset;                                    <<06934>>36450000
   integer savecc =i;                                          <<00575>>36455000
   integer measiocode;                                         <<00575>>36460000
   integer segnum;                                             <<00575>>36465000
   integer ident;                                              <<00575>>36470000
   integer plabel;                                             <<00575>>36475000
   integer err;                                                <<06279>>36480000
   logical array options(0:2) = q;                             <<06279>>36485000
   integer array option'nums(0:2) = q;                         <<06279>>36490000
   integer pointer measbuf;                                    <<00575>>36495000
   byte pointer firstparm=parm, sndparm=parm+2;                         36500000
   byte firstlen=parm+1, sndlen=parm+3;                                 36505000
   double total'linked'memory;                                          36510000
   logical on:=true;                                                    36515000
   define mmstat'enabled = logical(meas'flag.(0:1))#,          <<00575>>36520000
          eot  = logical(meas'flag.(13:1))    #,               <<00575>>36525000
          ioerror = logical(meas'flag.(12:1))#;                <<00575>>36530000
$page                                                                   36535000
   comment                                                              36540000
      a great deal of this procedure executes with db pointing          36545000
   at system global. the following variables are system global          36550000
   relative.                                                            36555000
   ;                                                                    36560000
   integer pointer bank'table=db+%50;                                   36565000
   integer no'of'banks=db+%47;                                          36570000
   integer dfc=db+%32, dfs=db+%33;                                      36575000
   integer updatel = db+%114,                                  <<00575>>36580000
           fixl    = db+%115,                                  <<00575>>36585000
           version = db+%116;                                  <<00575>>36590000
   integer progen=db+%141, mam=db+%142, ucop=db+%143,                   36595000
           pfail=db+%144, devrec=db+%145, drusg=db+%146,                36600000
           stmsg=db+%147, log=db+%150, load=db+%151,                    36605000
           iomessproc=db+%152,sysioproc=db+%153,               <<01362>>36610000
           memlogp=db+%154;                                    <<01362>>36615000
                                                               <<01549>>36620000
                                                               <<01549>>36625000
logical    meas'flag = db+%267;                                <<01549>>36630000
   subroutine def'movefromdseg;                                         36635000
$page                                                                   36640000
<< cxmon entry point>>                                                  36645000
   go to maincode;                                                      36650000
                                                                        36655000
<< cxmoff entry point>>                                                 36660000
cxmoff:                                                                 36665000
   on:=false;                                                           36670000
                                                                        36675000
maincode:                                                               36680000
   logimage( ( if on                                           <<01527>>36685000
                  then m'mon                                   <<01527>>36690000
                  else m'moff ), parmsp );                     <<01527>>36695000
   mycommand(parmsp,,maxparms+1,numparms,parm);<<parse parameter>>      36700000
   if on then                                                           36705000
   begin  << enable >>                                         <<00575>>36710000
      tos := setsysdb;                                         <<00575>>36715000
      if mmstat'enabled then                                   <<00575>>36720000
      begin                                                    <<00575>>36725000
        resetdb(*);                                            <<00575>>36730000
        cierr(errnum:=sysmonenabled);                          <<00575>>36735000
        return;                                                <<00575>>36740000
      end;                                                     <<00575>>36745000
      resetdb(*);                                              <<00575>>36750000
      if numparms>maxparms then <<too many parms>>                      36755000
      begin                                                             36760000
         cierr(errnum:=monmaxparm,,%10000,maxparms-2);                  36765000
         return;                                                        36770000
      end;                                                     <<00575>>36775000
                                                               <<00575>>36780000
      ldev :=verify'rldev(firstparm,firstlen,errnum,parmnum,1);<<00575>>36785000
      if <> then return;                                       <<00575>>36790000
      if verify'masterop(ldev) then return;<<masterop invalid>><<00575>>36795000
      if numparms=0 then <<mon requires at least one parameter>>        36800000
      begin                                                             36805000
         cierr(errnum:=monreqldev);                                     36810000
         return;                                                        36815000
      end;                                                     <<00575>>36820000
      if numparms = 1 then   << default event group mask>>     <<00575>>36825000
      begin                                                    <<00575>>36830000
          mask    := %44020;   <<groups 1,4,11 >>              <<00575>>36835000
          mask(1) := %3001;    <<groups 21,22  >>              <<00575>>36840000
      end                                                               36845000
      else <<go process ;e=>>                                           36850000
      begin                                                             36855000
         if numparms=2 or sndlen<>1 or sndparm<>"E"                     36860000
            or parm2.delimiter<>equal or parm1.delimiter<>semicolon then36865000
            begin                                                       36870000
            parmnum:=2;                                                 36875000
            cierr(errnum:=expsemi'e'equals,sndparm);                    36880000
            return;                                                     36885000
         end;                                                           36890000
         mask:=0;                                                       36895000
         mask(1) := 0;                                         <<00575>>36900000
         i:=2; <<scan the mask bit parameters>>                         36905000
         do                                                             36910000
         begin                                                          36915000
            tos:=parm(i); <<get parameter description>>                 36920000
            current'delimiter:=s0.delimiter;                            36925000
            current'length:=tos&lsr(8);                                 36930000
            @current'parm:=tos;                                         36935000
            if current'delimiter<> comma and current'delimiter<>eol then36940000
            begin                                                       36945000
               parmnum:=i+1;                                            36950000
               cierr(errnum:=maskcomma,current'parm(current'length));   36955000
               return;                                                  36960000
            end;                                                        36965000
            if current'length=0 then                                    36970000
               cierr(errnum:=-ignorednull,current'parm)                 36975000
            else                                                        36980000
            begin                                                       36985000
               n:=binary(current'parm,current'length);                  36990000
               if <> or not(0<=n<=25) then <<bad mask>>                 36995000
               begin                                                    37000000
                  parmnum:=i+1;                                         37005000
                  cierr(errnum:=badmask,current'parm);                  37010000
                  return;                                               37015000
               end;                                                     37020000
               tos:=mask(n.(11:1));                                     37025000
               x:=n.(12:4);                                             37030000
               assemble(tsbc 0,x); <<set mask bit>>                     37035000
               mask(n.(11:1)):=tos;                                     37040000
            end;                                                        37045000
         end                                                            37050000
         until (i:=i+1)>=numparms;                                      37055000
                                                               <<00575>>37060000
      end;                                                     <<00575>>37065000
$page                                                                   37070000
                                                                        37075000
<< have completely parsed the parameters, now start up monitoring >>    37080000
                                                               <<00575>>37085000
                                                               <<00575>>37090000
<< get a data seg. for buffer>>                                <<00575>>37095000
comment :                                                      <<06934>>37100000
   buffering of events to tape enabled via mon is done         <<06934>>37105000
with two adjacent buffers, (read and write for performance     <<06934>>37110000
considerations) each %1000 words long. as of mpev access to the<<06934>>37115000
two buffers changes to sst/lst instead of lsea/ssea. to take   <<06934>>37120000
advantage of sst/lst constructs, the base address has to be    <<06934>>37125000
on a %40 word boundary. (lst/sst expect the bank in the low    <<06934>>37130000
order five bits). since memory regions are allocated on page   <<06934>>37135000
(%200 words) boundaries, but are preceded by headers (%30 words<<06934>>37140000
in mpev) it is necessary to allocate an extra %10 words        <<06934>>37145000
in order to place the base of the two buffers on a %40 words   <<06934>>37150000
boundary.however,if we need an extra %10 words we might as well<<06934>>37155000
another full page (%200 words) .                               <<06934>>37160000
      size := measbufsize * 2 + %200 << one extra page >>;     <<06934>>37165000
      segnum := getdataseg(size,size);                         <<06934>>37170000
      if <> then   <<cant get dseg buffer>>                    <<00575>>37175000
      begin                                                    <<00575>>37180000
         cierr(errnum:=cantgetbuf);                            <<00575>>37185000
         return;                                               <<00575>>37190000
      end;                                                     <<00575>>37195000
                                                               <<00575>>37200000
<< lock the data segment in its bank.  note:  the bank    >>   <<02726>>37205000
<< number in lockseg is ignored (with mpe iv).            >>   <<02726>>37210000
                                                               <<00575>>37215000
      lockseg(segnum,5,0);                                     <<00575>>37220000
      if <> then                                               <<00575>>37225000
      begin                                                    <<00575>>37230000
         reldataseg(segnum);                                   <<00575>>37235000
         cierr(errnum:=cantgetbuf);                            <<00575>>37240000
         return;                                               <<00575>>37245000
      end;                                                     <<00575>>37250000
                                                               <<00707>>37255000
<<  freeze data seg  >>                                        <<00707>>37260000
                                                               <<00707>>37265000
      freeze(segnum,5,0);                                      <<00707>>37270000
                                                               <<00707>>37275000
<< enable measio >>                                            <<00575>>37280000
                                                               <<00575>>37285000
      cxmioenable(parmsp,errnum,parmnum);                      <<00575>>37290000
      if <> then     <<mioenable fail>>                        <<00575>>37295000
      begin                                                    <<00575>>37300000
         unfreeze(segnum,5,0);                                 <<00707>>37305000
         unlockseg(segnum,5,0);                                <<00575>>37310000
         reldataseg(segnum);                                   <<00575>>37315000
         return;                                               <<00575>>37320000
      end;                                                     <<00575>>37325000
                                                               <<00575>>37330000
      option'nums(0) := 1;   << lib search >>                  <<06279>>37335000
      options(0) := 0;       << sys sl     >>                  <<06279>>37340000
      option'nums (1) := 2;  << load domain >>                 <<06279>>37345000
      options(1) := 1;       << phy domain  >>                 <<06279>>37350000
      option'nums (2) := 0;  << terminator  >>                 <<06279>>37355000
      move mioproc := "MEASIO ";                               <<00575>>37360000
      loadprocedure(err,mioproc,ident,plabel,                  <<06279>>37365000
                    option'nums,options);                      <<06279>>37370000
                                                               <<00575>>37375000
<< rewind tape >>                                              <<00575>>37380000
                                                               <<00575>>37385000
      tos := setsysdb;                                         <<00575>>37390000
      tos := 0;  <<set up for result>>                         <<00575>>37395000
      <<set up measio parameters >>                            <<00575>>37400000
      tos := ldev;                                             <<00575>>37405000
      tos := 3;                                                <<00575>>37410000
      assemble(zero;dzro);                                     <<00575>>37415000
      tos := plabel;                                           <<00575>>37420000
      assemble(pcal 0);  << call measio>>                      <<00575>>37425000
      measiocode:=tos;                                         <<00575>>37430000
      push(status);                                            <<00575>>37435000
      savecc := tos.(6:2); <<save cc>>                         <<00575>>37440000
      unloadproc(ident);                                       <<00575>>37445000
      if savecc = ccl then                                     <<00575>>37450000
      begin                                                    <<00575>>37455000
        resetdb(*);                                            <<00575>>37460000
        cierr(deviceerror);                                    <<00575>>37465000
        unfreeze(segnum,5,0);                                  <<00707>>37470000
        unlockseg(segnum,5,0);                                 <<00575>>37475000
        reldataseg(segnum);                                    <<00575>>37480000
        cxmiomonoff(parmsp,ldev,parmnum);                      <<00575>>37485000
        return;                                                <<00575>>37490000
      end;                                                     <<00575>>37495000
                                                                        37500000
<< init sysdb values >>                                        <<00575>>37505000
                                                               <<00575>>37510000
      meas'msk0 := 0;                                          <<00575>>37515000
      meas'msk1 := %1000;   <<temporary>>                      <<00575>>37520000
      meas'ldev := ldev;                                       <<00575>>37525000
      tos := abs(abs(dst) + segnum*dstsize + 2); << bank >>    <<06934>>37530000
      tos := abs(x + 1); << address >>                         <<06934>>37535000
      tos := (tos + %10) land %177740; << mask off low 5 >>    <<06934>>37540000
      abs(sysglob + measbufptr) := tos lor tos;                <<06934>>37545000
      meas'plab := plabel; <<plabel of measio>>                <<00575>>37550000
      meas'idx := 0;  <<init buff index>>                      <<00575>>37555000
      meas'flag  := %100001;  << init flags >>                 <<00575>>37560000
      meas'dstn := segnum;                                     <<00575>>37565000
                                                               <<00575>>37570000
<< calculate total linked memory >>                                     37575000
                                                                        37580000
      << ................................................ >>   <<06923>>37585000
      <<   the total linked memory is no longer easily    >>   <<06923>>37590000
      <<   calculatable.  for the present, a 0 is logged  >>   <<06923>>37595000
      << ................................................ >>   <<06923>>37600000
      total'linked'memory:=0d;                                          37605000
                                                               <<00575>>37610000
<< log events>>                                                <<00575>>37615000
                                                               <<00575>>37620000
      tos := -228;  <<228 instead of 220, cripple monitor>>    <<01575>>37625000
      tos := calendar;                                         <<00575>>37630000
      tos := clock;                                            <<00575>>37635000
      mmstat'(*,*,*,*,0,0,0);  << time stamp>>                 <<06931>>37640000
      mmstat'(-221,mask,mask(1),0,0,0,0);                      <<06931>>37645000
      mmstat'(-222,version,fixl,updatel,0,0,0);                <<06931>>37650000
     mmstat'(-223,dfc,dfs,logical(total'linked'memory&dlsr(4)),<<06931>>37655000
              0,0,0);                                          <<06931>>37660000
                                                               <<06931>>37665000
      mmstat'(-224,progen,mam,ucop,0,0,0);                     <<06931>>37670000
      mmstat'(-225,pfail,devrec,drusg,0,0,0);                  <<06931>>37675000
      mmstat'(-226,stmsg,log,load,0,0,0);                      <<06931>>37680000
      mmstat'(-227,iomessproc,sysioproc,memlogp,0,0,0);        <<06931>>37685000
                                                               <<00575>>37690000
<< reset mask to proper event groups>>                         <<00575>>37695000
                                                               <<00575>>37700000
      meas'msk0 := mask;                                       <<00575>>37705000
      meas'msk1 := mask(1);                                    <<00575>>37710000
      resetdb(*);                                              <<00575>>37715000
      cierr(errnum:=monenabled);                               <<00575>>37720000
   end                                                         <<00575>>37725000
$page                                                          <<00575>>37730000
   else                                                        <<00575>>37735000
<< process monitor off >>                                      <<00575>>37740000
   begin                                                       <<00575>>37745000
      if numparms<>0 then cierr(errnum:=warnxparmsignored);    <<00575>>37750000
      tos := setsysdb;  <<switch db to sysglobal >>            <<00575>>37755000
      ldev := meas'ldev;                                       <<00575>>37760000
      segnum := meas'dstn;  <<save segment number>>            <<00575>>37765000
      plabel := meas'plab;  <<measio plabel>>                  <<00575>>37770000
                                                               <<00575>>37775000
<< verify sysmon enabled >>                                    <<00575>>37780000
                                                               <<00575>>37785000
      if not mmstat'enabled then                               <<00575>>37790000
      begin                                                    <<00575>>37795000
        resetdb(*);                                            <<00575>>37800000
        cierr(errnum:=notsysmon);                              <<00575>>37805000
        return;                                                <<00575>>37810000
      end;                                                     <<00575>>37815000
                                                               <<00575>>37820000
<< check for errors >>                                         <<00575>>37825000
                                                               <<00575>>37830000
      if eot or ioerror then                                   <<00575>>37835000
      begin                                                    <<00575>>37840000
        i := if eot then endoftape else tapeerror;             <<00575>>37845000
        resetdb(*);                                            <<00575>>37850000
        cierr(errnum:=i);                                      <<00575>>37855000
        tos := setsysdb;                                       <<00575>>37860000
      end;                                                     <<00575>>37865000
      if not ioerror then                                      <<00575>>37870000
      begin   <<cleanup>>                                      <<00575>>37875000
                                                               <<00575>>37880000
<< log event 229 >>                                            <<00575>>37885000
                                                               <<00575>>37890000
        meas'msk0 := 0;                                        <<00575>>37895000
        meas'msk1 := %1000;                                    <<00575>>37900000
      mmstat'(-229,0,0,0,0,0,0);                               <<06931>>37905000
                                                               <<00575>>37910000
<< flush buffer and write file mark>>                          <<00575>>37915000
                                                               <<00575>>37920000
        tos := meas'flag; <<leave on stack as result>>         <<00575>>37925000
        assemble(tbc 14);                                      <<00575>>37930000
        offset := if = then 0 else measbufsize;                <<06934>>37935000
        tos := ldev;  <<add parameters>>                       <<00575>>37940000
        tos := 1;                                              <<00575>>37945000
        tos := abs(abs(dst) + segnum*dstsize + 2); << bank >>  <<06934>>37950000
        tos := abs(x + 1) + %10;  << address , see above >>    <<06934>>37955000
        tos := tos + offset; << correct buffer >>              <<06934>>37960000
        tos := meas'idx;                                       <<00575>>37965000
        tos := plabel;                                         <<00575>>37970000
        assemble(pcal 0);  <<call measio>>                     <<00575>>37975000
        tos := ldev;  <<add parameters>>                       <<00575>>37980000
        tos := 2;                                              <<00575>>37985000
        assemble(zero,dzro);                                   <<00575>>37990000
        tos := plabel;                                         <<00575>>37995000
        assemble(pcal 0);  <<call measio>>                     <<00575>>38000000
                                                               <<00575>>38005000
<< rewind and reset >>                                         <<00575>>38010000
                                                               <<00575>>38015000
        tos := ldev;                                           <<00575>>38020000
        tos := 4;                                              <<00575>>38025000
        assemble(zero,dzro);                                   <<00575>>38030000
        tos := plabel;                                         <<00575>>38035000
        assemble(pcal 0); <<call measio>>                      <<00575>>38040000
        del;                                                   <<00575>>38045000
      end;    <<cleanup>>                                      <<00575>>38050000
                                                               <<00575>>38055000
<< reset sysdb words >>                                        <<00575>>38060000
                                                               <<00575>>38065000
      meas'msk0 := 0;                                          <<00575>>38070000
      meas'msk1 := 0;                                          <<00575>>38075000
      meas'ldev := 0;                                          <<00575>>38080000
      abs(sysglob + measbufptr) := 0;                          <<06934>>38085000
      meas'plab := 0;                                          <<00575>>38090000
      meas'idx := 0;                                           <<00575>>38095000
      meas'flag :=0;                                           <<00575>>38100000
      meas'dstn :=0;                                           <<00575>>38105000
      resetdb(*);                                              <<00575>>38110000
                                                               <<00575>>38115000
<< disable measio >>                                           <<00575>>38120000
                                                               <<00575>>38125000
      cxmiomonoff(parmsp,ldev,parmnum);                        <<00575>>38130000
                                                               <<00575>>38135000
<< release and unlock buffer >>                                <<00575>>38140000
                                                               <<00575>>38145000
      unfreeze(segnum,5,0);                                    <<00707>>38150000
      unlockseg(segnum,5,0);                                   <<00575>>38155000
      reldataseg(segnum);                                      <<00575>>38160000
      cierr(errnum:=mondisabled);                              <<00575>>38165000
   end;                                                        <<00575>>38170000
end;                                                           <<00575>>38175000
$page "MIOENABLE & MIODISABLE EXECUTORS"                       <<00575>>38180000
$control segment=oplow                                         <<00575>>38185000
procedure cxmioenable executorhead;                            <<00575>>38190000
                                                               <<00575>>38195000
                                                               <<00575>>38200000
begin                                                          <<00575>>38205000
   entry   cxmiodisable;                                       <<00575>>38210000
   entry cxmiomonoff;  <<special entry for cxmoff>>            <<00575>>38215000
                                                               <<00575>>38220000
   equate maxparms=28; <<ldev, "E=", + 26 maskbits>>           <<00575>>38225000
   equate comma=0, equal=1, semicolon=2, eol=3;                <<00575>>38230000
   equate tape=24;      <<device type for tapes>>              <<00575>>38235000
   double array parm(0:maxparms)=q;                            <<00575>>38240000
integer                                                        <<06604>>38245000
   ldt'index := 0;                                             <<06604>>38250000
   integer array                                               <<00575>>38255000
           ldt(0:ldtsize-1);                                   <<06221>>38260000
   integer i,                                                  <<00575>>38265000
           count,                                              <<00575>>38270000
           device,                                             <<00575>>38275000
           downbitmap:=0,                                      <<01362>>38280000
           tape'info = i,   << return from tgetinfo >>         <<02677>>38285000
           ident,                                              <<00575>>38290000
           ldev,                                               <<00575>>38295000
           measiocode,                                         <<00575>>38300000
           n,                                                  <<00575>>38305000
           numparms,                                           <<00575>>38310000
           parm1=parm+1, parm2=parm+3,                         <<00575>>38315000
           plabel,                                             <<00575>>38320000
           savesir'ldt,                                        <<00575>>38325000
           savesir'lpdt,                                       <<00575>>38330000
           savecc=i,                                           <<00575>>38335000
           segnum,                                             <<00575>>38340000
           unitnum;                                            <<00575>>38345000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>38350000
   byte pointer firstparm=parm, sndparm=parm+2;                <<00575>>38355000
   byte pointer current'parm;                                  <<00575>>38360000
   byte firstlen=parm+1, sndlen=parm+3;                        <<00575>>38365000
   logical on:=true;                                           <<00575>>38370000
   double misc := 0d;                                          <<00575>>38375000
                                                               <<00575>>38380000
   equate                                                      <<02677>>38385000
      << item numbers for tgetinfo >>                          <<02677>>38390000
      label'type  = 7,                                         <<02677>>38395000
      expire'date = 2,                                         <<02677>>38400000
                                                               <<02677>>38405000
      << possible returns for label type >>                    <<02677>>38410000
      not'mounted = 0,                                         <<02677>>38415000
      unlabeled   = 1,                                         <<02677>>38420000
      ansi'label  = 2,                                         <<02677>>38425000
      ibm'label   = 3;                                         <<02677>>38430000
                                                               <<02677>>38435000
<< sysglob defines >>                                          <<00575>>38440000
                                                               <<00575>>38445000
   define sysglobext = %377#;                                  <<00575>>38450000
   define meas'flag = %267#;                                   <<00575>>38455000
   define measiocount=abs(sysglob+abs(sysglob+sysglobext)+%71).(13:3)#; 38460000
   array buf(0:36);                                            <<00575>>38465000
   byte array bbuf(*)=buf;                                     <<00575>>38470000
   define mioproc = bbuf#;                                     <<00575>>38475000
   byte array  asciildev(0:3);                                 <<00575>>38480000
   integer err,ident2;                                         <<06279>>38485000
   logical array options(0:2) = q;                             <<06279>>38490000
   integer array option'nums(0:2) = q;                         <<06279>>38495000
                                                               <<00575>>38500000
   subroutine def'movefromdseg;                                <<00575>>38505000
   subroutine def'movetodseg;                                  <<00575>>38510000
                                                               <<00575>>38515000
subroutine getldevsirs;                                        <<00575>>38520000
  begin                                                        <<00575>>38525000
    savesir'ldt := getsir(ldtsir);                             <<00575>>38530000
    savesir'lpdt:=getsir(lpdt'sir);                            <<06221>>38535000
  end;  <<getldevsirs>>                                        <<00575>>38540000
                                                               <<00575>>38545000
subroutine relldevsirs;                                        <<00575>>38550000
  begin                                                        <<00575>>38555000
    relsir(lpdt'sir,savesir'lpdt);                             <<06221>>38560000
    relsir(ldtsir,savesir'ldt);                                <<00575>>38565000
  end;  <<relldevsirs>>                                        <<00575>>38570000
                                                               <<00575>>38575000
subroutine sendmsg(n);  << message sender >>                   <<00575>>38580000
  value n; integer n;                                          <<00575>>38585000
  begin                                                        <<00575>>38590000
    relldevsirs; <<rel sirs>>                                  <<00575>>38595000
<< message code = n                              >>            <<00575>>38600000
                                                               <<00575>>38605000
    if n < ldevunavail then                                    <<00575>>38610000
       cierr(n)                                                <<00575>>38615000
    else                                                       <<00575>>38620000
       cierr(n,firstparm);                                     <<00575>>38625000
    if (n=enablemio  or  n=disablemio) and misc <> 0d then     <<00575>>38630000
    begin    <<completion message >>                           <<00575>>38635000
       tos := @bbuf;                                           <<00575>>38640000
       while misc <> 0d do                                     <<00575>>38645000
       begin                                                   <<00575>>38650000
          device := logical(misc) land %377;                   <<00575>>38655000
          count  := ascii(device,10,asciildev);                <<00575>>38660000
          move * := asciildev,(count),2;                       <<00575>>38665000
          move * := "  ",2;                                    <<00575>>38670000
          misc := misc&dlsr(8);                                <<00575>>38675000
       end;                                                    <<00575>>38680000
       bps0 := 0;  << genmsg needs this  >>                    <<00575>>38685000
       del;       << buffer pointer   >>                       <<00575>>38690000
       errnum:=n+1;  <<"DEVICES EN/DIS ABLED" message>>        <<00575>>38695000
       genmsg(2,errnum,0,@bbuf);                               <<00575>>38700000
       cc := cce;  <<good status>>                             <<00575>>38705000
    end      <<completion message>>                            <<00575>>38710000
    else                                                       <<00575>>38715000
       cc := ccl;  << error return >>                          <<00575>>38720000
  end;   <<end sendmsg >>                                      <<00575>>38725000
subroutine reset(n); << reset all devices  to orig. state >>   <<00575>>38730000
  value n; integer n;                                          <<00575>>38735000
  begin                                                        <<00575>>38740000
    if downbitmap <> 0 then  << reset devices >>               <<00575>>38745000
    begin                                                      <<00575>>38750000
       lpdt'dev'own'state:=lpdt'not'owned;                     <<06221>>38755000
       downbitmap.(8:8) := 0;                                  <<00575>>38760000
       unitnum := 0;   << init unitnum >>                      <<00575>>38765000
       while downbitmap <> 0 do                                <<00575>>38770000
       begin                                                   <<00575>>38775000
          if downbitmap < 0 then                               <<00575>>38780000
          begin                                                <<00575>>38785000
             device:=iotableinfo(1,lpdt'dit'ptr,unitnum);      <<06221>>38790000
             movefromdseg(@ldt,ldtdst,device*ldtsize,ldtsize); <<06604>>38795000
             ldt'avail'to'sys := 1;      << up device >>       <<06604>>38800000
             movetodseg(ldtdst,device*ldtsize,@ldt,ldtsize);   <<00575>>38805000
             misc := misc&dlsl(8) + double(device);            <<00575>>38810000
          end;                                                 <<00575>>38815000
          downbitmap := downbitmap&lsl(1);                     <<00575>>38820000
          unitnum := unitnum +1;                               <<00575>>38825000
       end;                                                    <<00575>>38830000
    end;                                                       <<00575>>38835000
    sendmsg(n);                                                <<00575>>38840000
  end;  <<reset  >>                                            <<00575>>38845000
subroutine resetmio;                                           <<00575>>38850000
                                                               <<00575>>38855000
  begin                                                        <<00575>>38860000
    move mioproc := "MIO'RESET ";                              <<00575>>38865000
    loadprocedure(err,mioproc,ident,plabel,                    <<06279>>38870000
                  option'nums,options);                        <<06279>>38875000
    if err <> 0 then                                           <<06279>>38880000
    begin                                                      <<00575>>38885000
      reset(cantloadmiore);                                    <<00575>>38890000
      return;                                                  <<00575>>38895000
    end;                                                       <<00575>>38900000
    tos := 0;  <<result>>                                      <<00575>>38905000
    tos := ldev;  <<parameters>>                               <<00575>>38910000
    tos := plabel;                                             <<00575>>38915000
    assemble(pcal 0);  <<call mio'reset>>                      <<00575>>38920000
    downbitmap := tos;                                         <<00575>>38925000
    unloadproc(ident);                                         <<00575>>38930000
  end; <<resetmio>>                                            <<00575>>38935000
                                                               <<00575>>38940000
subroutine statusmio;                                          <<00575>>38945000
  begin                                                        <<00575>>38950000
    move mioproc :="MEASIO ";                                  <<00575>>38955000
    loadprocedure(err,mioproc,ident,plabel,                    <<06279>>38960000
                  option'nums,options);                        <<06279>>38965000
    if err <> 0 then                                           <<06279>>38970000
    begin                                                      <<00575>>38975000
      if measiocount = 0 then deallocateproc(mioproc);         <<00575>>38980000
      resetmio;                                                <<00575>>38985000
      getldevsirs;                                             <<00575>>38990000
      reset(cantloadmio);                                      <<00575>>38995000
      return;                                                  <<00575>>39000000
    end;                                                       <<00575>>39005000
    segnum := integer(logical(plabel) land %100377);           <<06279>>39010000
    tos:=setsysdb;                                             <<00575>>39015000
    tos := 0;          <<result>>                              <<00575>>39020000
    tos := ldev;       <<parameters >>                         <<00575>>39025000
    assemble(dzro,dzro);                                       <<00575>>39030000
    tos:=plabel;                                               <<00575>>39035000
    assemble(pcal 0);  <<call measio,read status>>             <<00575>>39040000
    measiocode:=tos;                                           <<00575>>39045000
    push(status);                                              <<00575>>39050000
    savecc := tos.(6:2); <<save cc>>                           <<00575>>39055000
    resetdb(*);                                                <<00575>>39060000
    unloadproc(ident);                                         <<00575>>39065000
  end;  <<statusmio>>                                          <<00575>>39070000
$page                                                          <<00575>>39075000
<< cxmioenable >>                                              <<00575>>39080000
   go to maincode;                                             <<00575>>39085000
                                                               <<00575>>39090000
<< cxmiomonoff   special entry for cxmoff>>                    <<00575>>39095000
cxmiomonoff:                                                   <<00575>>39100000
   ldev := errnum;                                             <<00575>>39105000
   go to cxmonoff;                                             <<00575>>39110000
                                                               <<00575>>39115000
<< cxmiodisable >>                                             <<00575>>39120000
cxmiodisable:                                                  <<00575>>39125000
   on := false;                                                <<00575>>39130000
                                                               <<00575>>39135000
maincode:                                                      <<00575>>39140000
                                                               <<00575>>39145000
<< verify parameters >>                                        <<00575>>39150000
                                                               <<00575>>39155000
   logimage( ( if on                                           <<01527>>39160000
                  then m'mioenable                             <<01527>>39165000
                  else m'miodisable ), parmsp );               <<01527>>39170000
   mycommand(parmsp,,maxparms+1,numparms,parm);  <<parse>>     <<00575>>39175000
   if numparms=0 then  <<must have ldev num >>                 <<00575>>39180000
   begin                                                       <<00575>>39185000
     cierr(errnum:=ldevreqrd);                                 <<00575>>39190000
     return;                                                   <<00575>>39195000
   end                                                         <<00575>>39200000
   else                                                        <<00575>>39205000
   if numparms <> 1 and sndparm <> "E" then <<call from cxmon>><<00575>>39210000
   begin                                                       <<00575>>39215000
     cierr(errnum:=maxparams,,%10000,maxparms-2);              <<00575>>39220000
     return;                                                   <<00575>>39225000
   end;                                                        <<00575>>39230000
   ldev :=verify'rldev(firstparm,firstlen,errnum,parmnum,1);   <<00575>>39235000
   if <> then return;                                          <<00575>>39240000
   if verify'masterop(ldev) then return;<<masterop invalid>>   <<00575>>39245000
                                                               <<00575>>39250000
<< verify ldev = tape >>                                       <<00575>>39255000
                                                               <<00575>>39260000
   movefromdseg(@ldt,ldtdst,ldev*ldtsize,ldtsize);             <<00575>>39265000
   if ldt'device'type <> tape then                             <<06604>>39270000
   begin                                                       <<00575>>39275000
      getldevsirs;                                             <<00575>>39280000
      reset(ldevmustbetape);                                   <<00575>>39285000
      return;                                                  <<00575>>39290000
   end;                                                        <<00575>>39295000
                                                               <<00575>>39300000
   lpdt'index:=ldev*integer(lpdt'entry'size);                  <<06221>>39305000
   if lpdt'subtype <> 0 then                                   <<06221>>39310000
   begin                                                       <<02513>>39315000
      getldevsirs;                                             <<02513>>39320000
      reset(ldevmustbe7970x);                                  <<02513>>39325000
      return;                                                  <<02513>>39330000
   end;                                                        <<02513>>39335000
                                                               <<02513>>39340000
   if on then                                                  <<00575>>39345000
   begin  <<cxmioenable>>                                      <<00575>>39350000
                                                               <<00575>>39355000
<< verify ldev available >>                                    <<00575>>39360000
                                                               <<00575>>39365000
      getldevsirs; <<get sirs lpdt and ldt>>                   <<00575>>39370000
      if lpdt'dev'own'state <> lpdt'not'owned or << owned >>   <<06221>>39375000
         ldt'file'use'cnt <> 0 or     <<use count>>            <<06604>>39380000
         ldt'avail'to'sys = 0 then                             <<06604>>39385000
         begin                                                 <<00575>>39390000
           reset(ldevunavail);                                 <<00575>>39395000
           return;                                             <<00575>>39400000
         end;                                                  <<00575>>39405000
                                                               <<00575>>39410000
<< check for proper tape disposition >>                        <<00575>>39415000
                                                               <<00575>>39420000
   tgetinfo( ldev, tape'info, label'type );                    <<07439>>39425000
   if = then                                                   <<07439>>39430000
      begin  << the ldev is a labeled tape.  make mounted    >><<07439>>39435000
             << and expiration date checks below.            >><<07439>>39440000
      if tape'info = not'mounted then                          <<07439>>39445000
         begin                                                 <<07439>>39450000
         reset( errnum := notape );                            <<07439>>39455000
         return;                                               <<07439>>39460000
         end;                                                  <<07439>>39465000
                                                               <<07439>>39470000
      << perform expiration date check on labeled tape >>      <<07439>>39475000
      << tape must be expired inorder to write to it   >>      <<07439>>39480000
      tgetinfo( ldev, tape'info, expire'date );                <<07439>>39485000
      if logical( tape'info ) > calendar then                  <<07439>>39490000
         begin    << the labeled tape has not expired  >>      <<07439>>39495000
         reset( errnum := labeledtape );                       <<07439>>39500000
         return;                                               <<07439>>39505000
         end;                                                  <<07439>>39510000
                                                               <<07439>>39515000
      end;  << of ldev being a labeled tape >>                 <<07439>>39520000
                                                               <<07439>>39525000
                                                               <<00575>>39530000
      lpdt'dev'own'state := lpdt'owned; << set device owned >> <<06221>>39535000
                                                               <<00575>>39540000
<< down devices on this controller >>                          <<00575>>39545000
                                                               <<00575>>39550000
      tos := ldev;     <<downbitmap>>                          <<00575>>39555000
      unitnum:=iotableinfo(2,lpdt'dit'ptr,0);                  <<06221>>39560000
                << number of units on this controller>>        <<00575>>39565000
      while (unitnum:=unitnum-1) <> -1 do                      <<00575>>39570000
      begin                                                    <<00575>>39575000
        device:=iotableinfo(1,lpdt'dit'ptr,unitnum);           <<06221>>39580000
        if device <> 0 then                                    <<01575>>39585000
        begin                                                  <<01575>>39590000
          if lpdt'dev'own'state <> lpdt'not'owned and          <<06221>>39595000
             ldev <> device then                               <<01575>>39600000
             begin                                             <<01575>>39605000
               reset(controllerunav);                          <<01575>>39610000
               return;                                         <<01575>>39615000
             end;                                              <<01575>>39620000
          movefromdseg(@ldt,ldtdst,device*ldtsize,ldtsize);    <<01575>>39625000
          if ldt'file'use'cnt <> 0 then                        <<06604>>39630000
          begin                                                <<01575>>39635000
            reset(controllerunav);                             <<01575>>39640000
            return;                                            <<01575>>39645000
          end;                                                 <<01575>>39650000
          if ldt'avail'to'sys <> 0 then                        <<06604>>39655000
          begin                                                <<01575>>39660000
             ldt'avail'to'sys := 0;    <<down device>>         <<06604>>39665000
             movetodseg(ldtdst,device*ldtsize,@ldt,ldtsize);   <<01575>>39670000
             misc := misc&dlsl(8) + double(device);            <<01575>>39675000
             tos := logical(tos) lor (1&lsl(15-unitnum));      <<01575>>39680000
          end;                                                 <<01575>>39685000
        end;                                                   <<01575>>39690000
      end;                                                     <<00575>>39695000
      downbitmap := tos;                                       <<00575>>39700000
                                                               <<00575>>39705000
<< must relsir ldt before calling loadproc >>                  <<00575>>39710000
                                                               <<00575>>39715000
      relldevsirs; <<rel sirs lpdt and ldt>>                   <<00575>>39720000
                                                               <<00575>>39725000
<<  load measio code  >>                                       <<00575>>39730000
                                                               <<00575>>39735000
      option'nums(0) := 1;   << lib search >>                  <<06279>>39740000
      options(0) := 0;       << sys sl     >>                  <<06279>>39745000
      option'nums (1) := 2;  << load domain >>                 <<06279>>39750000
      options(1) := 1;       << phy domain  >>                 <<06279>>39755000
      option'nums (2) := 0;  << terminator  >>                 <<06279>>39760000
      move mioproc := "MIO'INIT ";                             <<00575>>39765000
      loadprocedure(err,mioproc,ident,plabel,                  <<06279>>39770000
                    option'nums,options);                      <<06279>>39775000
      if err <> 0 then                                         <<06279>>39780000
      begin                                                    <<00575>>39785000
       getldevsirs;                                            <<00575>>39790000
        reset(cantloadmioin);                                  <<00575>>39795000
        return;                                                <<00575>>39800000
      end;                                                     <<00575>>39805000
                                                               <<00575>>39810000
<< initialize measurment io system >>                          <<00575>>39815000
                                                               <<00575>>39820000
      tos := downbitmap;                                       <<00575>>39825000
      tos := plabel;                                           <<00575>>39830000
      assemble(pcal 0);  <<call mio'init>>                     <<00575>>39835000
      unloadproc(ident);                                       <<00575>>39840000
      if <> then                                               <<00575>>39845000
      begin                                                    <<00575>>39850000
        resetmio;                                              <<00575>>39855000
        getldevsirs;                                           <<00575>>39860000
        reset(cantunloadmio);                                  <<00575>>39865000
        return;                                                <<00575>>39870000
      end;                                                     <<00575>>39875000
                                                               <<00575>>39880000
<< allocate measio cst entry >>                                <<00575>>39885000
                                                               <<00575>>39890000
      move mioproc := "MEASIO ";                               <<00575>>39895000
      loadprocedure(err,mioproc,ident2,plabel,                 <<06279>>39900000
                    option'nums,options);                      <<06279>>39905000
      if err <> 0 then                                         <<06279>>39910000
      begin                                                    <<00575>>39915000
        resetmio;                                              <<00575>>39920000
        getldevsirs;                                           <<00575>>39925000
        reset(cantloadmio);                                    <<00575>>39930000
        return;                                                <<00575>>39935000
      end;                                                     <<00575>>39940000
                                                               <<00575>>39945000
<< get measio status  >>                                       <<00575>>39950000
                                                               <<00575>>39955000
      statusmio;                                               <<00575>>39960000
      if savecc = ccl then                                     <<00575>>39965000
      begin                                                    <<00575>>39970000
        if measiocount = 0 then deallocateproc(mioproc);       <<00575>>39975000
        resetmio;                                              <<00575>>39980000
        getldevsirs;                                           <<00575>>39985000
        reset(deviceerror);                                    <<00575>>39990000
        return;                                                <<00575>>39995000
      end                                                      <<00575>>40000000
      else                                                     <<00575>>40005000
        if measiocode <> 3 then                                <<00575>>40010000
        begin                                                  <<00575>>40015000
          if measiocode > 7 then errnum := deviceateot         <<00575>>40020000
          else                                                 <<00575>>40025000
            if measiocode > 3 then errnum := devicenowring     <<00575>>40030000
            else                                               <<00575>>40035000
              if measiocode = 2 then errnum := devicenotatlp   <<00575>>40040000
              else                                             <<00575>>40045000
                errnum := devicenotonline;                     <<00575>>40050000
           if measiocount = 0 then deallocateproc(mioproc);    <<00575>>40055000
           resetmio;                                           <<00575>>40060000
           getldevsirs;                                        <<00575>>40065000
           reset(errnum);                                      <<00575>>40070000
           return;                                             <<00575>>40075000
        end;                                                   <<00575>>40080000
                                                               <<00575>>40085000
<< lock and freeze measio segnum >>                            <<00575>>40090000
                                                               <<00575>>40095000
      lockseg(segnum,0,0);                                     <<00575>>40100000
      if <> then                                               <<00575>>40105000
      begin                                                    <<00575>>40110000
         if measiocount = 0 then deallocateproc(mioproc);      <<00575>>40115000
         resetmio;                                             <<00575>>40120000
         getldevsirs;                                          <<00575>>40125000
         reset(cantlockmio);                                   <<00575>>40130000
         return;                                               <<00575>>40135000
      end;                                                     <<00575>>40140000
      freeze(segnum,0,0);                                      <<00707>>40145000
                                                               <<00575>>40150000
<< send "SUCCESSFUL MIOENABLE" message and terminate>>         <<00575>>40155000
                                                               <<00575>>40160000
      measiocount := measiocount+1; <<# contrlrs using measio>><<00575>>40165000
      sendmsg(enablemio);                                      <<00575>>40170000
   end    <<cxmioenable>>                                      <<00575>>40175000
                                                               <<00575>>40180000
<<------------------------    end   consmioenable  ------>>    <<00575>>40185000
                                                               <<00575>>40190000
                                                               <<00575>>40195000
   else                                                        <<00575>>40200000
   begin  <<cxmiodisable>>                                     <<00575>>40205000
                                                               <<00575>>40210000
<< check for system monitor running on this device >>          <<00575>>40215000
                                                               <<00575>>40220000
      if abs(sysglob+meas'flag) < 0 and                        <<00575>>40225000
         integer(meas'ldev) = ldev then                        <<01549>>40230000
      begin                                                    <<00575>>40235000
        cierr(errnum:=sysmonrun);                              <<00575>>40240000
        return;                                                <<00575>>40245000
      end;                                                     <<00575>>40250000
                                                               <<00575>>40255000
<< ldev must be owned by measio >>                             <<00575>>40260000
                                                               <<00575>>40265000
      i:=iotableinfo(3,lpdt'dit'ptr,ldev);                     <<06221>>40270000
      if i = 0 then   <<measio not enabled on this device>>    <<00575>>40275000
      begin                                                    <<00575>>40280000
        cierr(errnum:=deviceinvalid);                          <<00575>>40285000
        return;                                                <<00575>>40290000
      end;                                                     <<00575>>40295000
                                                               <<00575>>40300000
cxmonoff:   <<special entry for cxmoff>>                       <<00575>>40305000
                                                               <<00575>>40310000
<< get measio status >>                                        <<00575>>40315000
                                                               <<00575>>40320000
      statusmio;                                               <<00575>>40325000
      if savecc =ccl then                                      <<00575>>40330000
      begin                                                    <<00575>>40335000
        if measiocode = 1 then                                 <<00575>>40340000
           cierr(deviceinvalid)                                <<00575>>40345000
        else                                                   <<00575>>40350000
           cierr(deviceerror);                                 <<00575>>40355000
        return;                                                <<00575>>40360000
      end;                                                     <<00575>>40365000
                                                               <<00575>>40370000
<< reset measurment io system>>                                <<00575>>40375000
                                                               <<00575>>40380000
      resetmio;                                                <<00575>>40385000
                                                               <<00575>>40390000
<< do not deallocate if measio running elsewhere >>            <<00575>>40395000
                                                               <<00575>>40400000
      if measiocount = 1 then  <<no other measio running >>    <<00575>>40405000
      begin                                                    <<00575>>40410000
                                                               <<00575>>40415000
<< unfreeze measio >>                                          <<01575>>40420000
                                                               <<01575>>40425000
        unfreeze(segnum,0,0);                                  <<01575>>40430000
        unlockseg(segnum,0,0);                                 <<01575>>40435000
                                                               <<01575>>40440000
<< deallocate measio cst>>                                     <<01575>>40445000
                                                               <<01575>>40450000
        unloadproc(ident2);                                    <<06279>>40455000
      end;                                                     <<01575>>40460000
                                                               <<00575>>40465000
<< reset devices,send "SUCCESSFUL MIODISABLE" and terminate>>  <<00575>>40470000
                                                               <<00575>>40475000
      getldevsirs;                                             <<00575>>40480000
      measiocount := measiocount-1; <<contrlrs using measio>>  <<00575>>40485000
      reset(disablemio);                                       <<00575>>40490000
      return;                                                  <<00575>>40495000
      help;                                                    <<00575>>40500000
   end;   <<cxmiodisabled>>                                    <<00575>>40505000
end;                                                           <<00575>>40510000
$page "JOBSECURITY EXECUTOR"                                   <<00575>>40515000
$control segment=oplow                                         <<00575>>40520000
procedure cxjobsecurity executorhead;                          <<00575>>40525000
begin                                                          <<00575>>40530000
   comment                                                              40535000
      the syntax of this command is:                                    40540000
         jobsecurity high                                               40545000
         jobsecurity low                                                40550000
   ;                                                                    40555000
   double array parm(0:1)=q;                                            40560000
   byte pointer firstparm=parm, sndparm=parm+2;                         40565000
   byte firstlen=parm+1;                                                40570000
   integer numparms,savesir,security;                                   40575000
                                                               <<06607>>40580000
   << ...................................................... >><<06607>>40585000
   <<        declarations for referencing the jmat           >><<06607>>40590000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>40595000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>40600000
   <<               a specific entry), after an exchange db. >><<06607>>40605000
   <<               or 0 if jmatarr is a local array.        >><<06607>>40610000
   << ...................................................... >><<06607>>40615000
                                                               <<06607>>40620000
   integer       jmatinx;                                      <<06607>>40625000
   integer array jmatarr(0:jmatheadersize-1);                  <<06607>>40630000
   subroutine def'movefromdseg;                                         40635000
   subroutine def'movetodseg;                                           40640000
                                                                        40645000
   logimage( m'jobscrty, parmsp );  << log op command >>       <<01527>>40650000
   mycommand(parmsp,,2,numparms,parm);<<parse parameters>>              40655000
   if numparms<>1 then <<has exactly one parameter>>                    40660000
   begin                                                                40665000
      parmnum:=if numparms>1 then 1 else 2;                             40670000
      tos:=errnum:=jobsecurity1parm;                                    40675000
      tos:=if parmnum=1 then @sndparm else @parmsp;                     40680000
      cierr(*,*);                                                       40685000
      return;                                                           40690000
   end;                                                                 40695000
   if firstlen=3 and firstparm="LOW" then security:=jobsecurity'low     40700000
   else                                                                 40705000
   if firstlen=4 and firstparm="HIGH" then security:=jobsecurity'high   40710000
   else                                                                 40715000
   begin                                                                40720000
      parmnum:=1;                                                       40725000
      cierr(errnum:=exp1ofhighlow,firstparm);                           40730000
      return;                                                           40735000
   end;                                                                 40740000
   savesir:=getsir(jmatsir); <<lock jmat>>                              40745000
   movefromdseg(@jmatarr,jmatdst,0,jmatheadersize);            <<06607>>40750000
   jmatjobsec := security;                                     <<06607>>40755000
   movetodseg(jmatdst,0,@jmatarr,jmatheadersize);              <<06607>>40760000
   relsir(jmatsir,savesir); <<unlock jmat>>                             40765000
   return;                                                              40770000
end;                                                                    40775000
procedure cxdiscrps executorhead;                                       40780000
begin                                                                   40785000
<< the syntax of this command is:                       >>              40790000
<<                                                      >>              40795000
<<     :discrps ldev,{enable/disable}                   >>              40800000
<<                                                      >>              40805000
   double array parm(0:3)=q;                                            40810000
   array parms(*) = parm;                                               40815000
   byte pointer firstparm=parm, sndparm=parm+2;                         40820000
   byte firstlen=parm+1, sndlen=parm+3;                                 40825000
   byte array logname(0:8);                                             40830000
   integer numparms,len,target:=0;                                      40835000
   integer ldev;                                                        40840000
   integer stat,func;                                                   40845000
   logical turnonsensing;                                               40850000
                                                                        40855000
   define                                                               40860000
      firstdelim  =  parms(1).(11:5)#,                                  40865000
      snddelim    =  parms(3).(11:5)#;                                  40870000
                                                                        40875000
   equate                                                               40880000
      comma  = 0,                                                       40885000
      cr     = 3;                                                       40890000
                                                                        40895000
                                                                        40900000
   logimage( m'discrps, parmsp );  << log op command >>                 40905000
                                                                        40910000
<< at this point, we can not check to see if the user is    >>          40915000
<< access to the command because we do not know the ldev    >>          40920000
<< that will be affected.  even if the user is not the      >>          40925000
<< operator or has not been allowed the command, he could   >>          40930000
<< be associated a device class that contains the ldev.  the>>          40935000
<< end result is that the user will not know that he does   >>          40940000
<< not have access to the command until after he has entered>>          40945000
<< a syntactically correct command.                         >>          40950000
                                                                        40955000
   mycommand(parmsp,,2,numparms,parm);                                  40960000
   if numparms<>2 then <<must have exactly 2 parameters>>               40965000
   begin                                                                40970000
      parmnum:=if numparms<2 then 1 else 2;                             40975000
      cierr(errnum:=expect'two'parms);                                  40980000
      return;                                                           40985000
   end                                                                  40990000
   else                                                                 40995000
   if firstdelim <> comma then                                          41000000
   begin                                                                41005000
      parmnum := 1;                                                     41010000
      cierr(errnum:=expectcomma,firstparm(integer(firstlen)));          41015000
      return;                                                           41020000
   end;                                                                 41025000
                                                                        41030000
<< the check is made now to verify that ldev is an      >>              41035000
<< integer.  after the entire command is parsed and     >>              41040000
<< access to the command is verified, we will make the  >>              41045000
<< necessary checks to determine if the device is a cs80>>              41050000
<< disc.                                                >>              41055000
                                                                        41060000
   ldev := binary(firstparm,firstlen);                                  41065000
   if <> then                                                           41070000
   begin                                                                41075000
     parmnum := 1;                                                      41080000
     cierr(errnum := invalid'num'for'ldev,firstparm);                   41085000
     return;                                                            41090000
   end;                                                                 41095000
   if sndlen=7 and sndparm="DISABLE" then                               41100000
   begin                                                                41105000
      turnonsensing := false;                                           41110000
   end                                                                  41115000
   else                                                                 41120000
   if sndlen=6 and sndparm="ENABLE" then                                41125000
   begin                                                                41130000
   turnonsensing := true;                                               41135000
   end                                                                  41140000
   else                                                                 41145000
   begin                                                                41150000
      parmnum:=2;                                                       41155000
      cierr(errnum:=expect'enable'or'disable,sndparm);                  41160000
      return;                                                           41165000
   end;                                                                 41170000
                                                                        41175000
   if snddelim <> cr then                                               41180000
   begin                                                                41185000
      parmnum := 2;                                                     41190000
      cierr(errnum:=-invalid'delimiter,sndparm(integer(sndlen)));       41195000
   end;                                                                 41200000
                                                                        41205000
<< we will now determine if the user has access to the      >>          41210000
<< command, and if so we will then check to see if the      >>          41215000
<< device is a cs 80 disc.  this is the only check we will  >>          41220000
<< make in determining the validity of the ldev parameter.  >>          41225000
<< all further error checking will be done by the driver    >>          41230000
<< for that particular device.                              >>          41235000
                                                                        41240000
  if verify'masterop(ldev)                                              41245000
     then return;                                                       41250000
  if checkass(ldev) or checkallow (m'discrps) then                      41255000
  begin                                                                 41260000
    if turnonsensing then func := 1                                     41265000
                     else func := 0;                                    41270000
    stat := rps'allow(ldev,func);                                       41275000
    if stat <> noerr then                                               41280000
    begin                                                               41285000
      if stat = %24                                                     41290000
           then errnum := iotimeout                                     41295000
      else if stat = %44                                                41300000
          then errnum := siofail                                        41305000
      else if stat = %54                                                41310000
           then errnum := unitfailure                                   41315000
      else if stat = %144                                               41320000
           then errnum := channelfailure                                41325000
      else if stat = %200                                               41330000
           then errnum := rps'alreadydisabled                           41335000
      else if stat= %201                                                41340000
           then errnum := rps'alreadyenabled                            41345000
      else if stat = %202                                               41350000
           then errnum := invaliddevice                                 41355000
      else if stat = %203                                               41360000
           then errnum := rps'notavailable;                             41365000
      cierr(errnum);                                                    41370000
    end;     << stat <> noerr >>                                        41375000
  end                                                                   41380000
  else cierr(errnum:=usernoacc2dev);                                    41385000
                                                                        41390000
end;                                                                    41395000
$page "DOWNLOAD EXECUTOR"                                               41400000
$control segment=opmed                                                  41405000
procedure cxdownload   executorhead;                                    41410000
<< procedure to download either vfc image from>>                        41415000
<< ascii file designated by user in formsmsg  >>                        41420000
<< and/or margin setting for 2608 type printers>>                       41425000
<< syntax:                                     >>                       41430000
<<          :download ldn ,filename    or         >>           <<04197>>41435000
<<          :download ldn ,margin=nn              >>           <<04197>>41440000
<< where filename contains either vfc or margin control >>              41445000
<< or both as well as vfc image as follows      >>                      41450000
<< >>                                                                   41455000
<<col  1234567890123456   >>                                            41460000
<<>>                                                                    41465000
<<     margin=4         >>  <<sets up left margin to be col 4>>         41470000
                        << this truncates line in last 4 cols>>         41475000
<<     vfc,6,66          >>  <<sets up  6 lines>>                       41480000
                         << per inch and 66 lines per page   >>         41485000
<<     10111111100011111     >> <<ch 1 allowed only in line1>>          41490000
<<     001                   >> <<blanks = 0>>                          41495000
<<     0011                  >> <<channels 3,4 skip to line 3>>         41500000
<<     00101                 >>                                         41505000
<<     00110000000000001     >>                                         41510000
<<       100000000000010     >> <<channel 15 is line 5>>                41515000
<<     00111000000000100     >>                                         41520000
<<          . . .           >>  << etc >>                               41525000
<<     011                  >>  << line 60 has channels 2,3>>           41530000
<<                          >>  << line 61 - 65 are zeroes>>            41535000
<<                          >>  << 62 >>                                41540000
<<                          >>  << 63 >>                                41545000
<<                          >>  << 64 >>                                41550000
<<                          >>  << 65 >>                                41555000
<<                100000    >>  << line 66  is  channel 11>>            41560000
<<>>                                                                    41565000
begin                                                                   41570000
<<parse variables>>                                                     41575000
integer numparms;                                                       41580000
equate       comma=0,                                                   41585000
             marginfunc = %101,                                         41590000
             modefunc =  146,                                  <<04390>>41595000
             transpar = 0,                                     <<04390>>41600000
             feature  = 1,                                     <<04390>>41605000
             equal=1,                                                   41610000
             vfcfunc = %100,                                            41615000
             semi=2,                                                    41620000
                                                                        41625000
             cr=3,                                                      41630000
             vfcmaxparms = 4,  << vfc line ignores comment.>>  <<02069>>41635000
             minparms = 2,                                     <<04197>>41640000
             maxparms = 3;    <<remove "DEFAULT">>             <<00910>>41645000
integer      pnum;                                                      41650000
double array parms(1:maxparms+1);                                       41655000
byte pointer pp;                                                        41660000
byte         plen;                                                      41665000
integer      pdelwd=plen;                                               41670000
double       parm=pp;                                                   41675000
define       pspecial= logical(pdelwd.(10:1))#,                         41680000
             pdel    = pdelwd.(11:5)#,                                  41685000
             pnumeric= logical(pdelwd.(9:1))#,                          41690000
             palpha  = logical(pdelwd.(8:1))#;                          41695000
integer      target,                                                    41700000
             ldn=target;                                                41705000
array        caret(0:9);                                                41710000
byte array   caret'(*) = caret;                                         41715000
integer      offset;                                                    41720000
<<>>                                                                    41725000
<<attachio variables>>                                                  41730000
logical array devinfo(0:8);                                             41735000
byte array   ldnalpha(0:8);                                             41740000
double       dreturn;                                                   41745000
integer      bufindx;                                                   41750000
integer      sreturn=dreturn;                                           41755000
integer      count,p1,p2,flags;                                         41760000
integer      fn,lnth,quotient,remainder,i,j;                            41765000
equate       sysdb = %1000,                                             41770000
             sysbuf = 6,                                                41775000
             sbufdst = 8;                                               41780000
equate       max'vfc'lines = 127;                              <<04197>>41785000
logical      vfc'encountered   << marks the appearence of >>   <<04197>>41790000
                 := false;     << a vfc record in the vfc >>   <<04197>>41795000
                               << file.  once encountered,>>   <<04197>>41800000
                               << no more command sets are>>   <<04197>>41805000
                               << expected in the file.   >>   <<04197>>41810000
                                                               <<04197>>41815000
<<>>                                                                    41820000
<<vfc file parameters and arrays>>                                      41825000
array vfc(0:max'vfc'lines);                                    <<04197>>41830000
array vfcin(0:36);       <<36 words of ascii input>>           <<01878>>41835000
byte array bvfcin(*) = vfcin;                                           41840000
byte array bbuf(0:100);  <<write to operator genmsg buffer>>            41845000
double tempd;                                                           41850000
integer tempd2 = tempd + 1;                                             41855000
integer filetyp;                                                        41860000
logical gptr',aptr',errptr',printvfc;                                   41865000
byte pointer errptr = errptr';                                          41870000
<<>>                                                                    41875000
<<flags>>                                                               41880000
logical      warnflag,continue;                                         41885000
logical     flag;                                                       41890000
logical  margin'in'vfc := false,  mode'in'vfc := false;        <<04390>>41895000
logical vfcline'okay;                                          <<04197>>41900000
integer fopen'err;                                                      41905000
integer lines'in'vfc := 0;   << counts lines in vfcfile. >>    <<04197>>41910000
<<>>                                                                    41915000
integer errf;                                                           41920000
define errn = errnum#;                                                  41925000
                                                                        41930000
integer dbsave;                                                         41935000
                                                                        41940000
subroutine marginset;                                                   41945000
begin                                                                   41950000
<< this subroutine downloads the margin via function=%101>>             41955000
if not validdevtype(ldn,marginfunc,flag) then                           41960000
   begin                                                                41965000
   errn := err'wrong'ldev; errf := ldn;                                 41970000
   parm := parms(pnum := 1      );                                      41975000
    go return1;            <<check ldev validity for function>>         41980000
   end;                                                                 41985000
parm := parms(pnum :=pnum+1);   <<nn>>                                  41990000
p1 := binary( pp, plen );                                      <<04197>>41995000
if <> then                                                     <<04197>>42000000
begin                                                          <<04197>>42005000
   errn := err'numeric'margin;                                 <<04197>>42010000
   go return1;                                                 <<04197>>42015000
end;                                                           <<04197>>42020000
p1 := p1 - 1;  << adjust to zero origin. >>                    <<04197>>42025000
                                                               <<04197>>42030000
<< check the range for validity. >>                            <<04197>>42035000
if not (0<= p1 <= 15) then                                              42040000
   begin                                                                42045000
   errn := err'margin'range;                                            42050000
   go return1;                                                          42055000
   end;                                                                 42060000
                                                               <<04197>>42065000
<< margin passed all validity checks.  do download and >>      <<04197>>42070000
<< check return.                                       >>      <<04197>>42075000
p2 := 0; <<parameter 2 is zero >>                              <<00910>>42080000
dreturn := attachio( ldn, 0, 0, 0, marginfunc,                 <<04197>>42085000
                     0, p1, p2, %13              );            <<04197>>42090000
if sreturn = 0 then                                                     42095000
   begin                                                                42100000
   errn := err'margin'failed; errf := ldn;                              42105000
   go return1;                                                          42110000
   end                                                                  42115000
else                                                                    42120000
end;  <<subroutine marginset>>                                          42125000
                                                                        42130000
subroutine modeset;                                            <<04390>>42135000
begin                                                          <<04390>>42140000
                                                               <<04390>>42145000
   if not validdevtype(ldn,modefunc,flag) then                 <<04390>>42150000
   begin                                                       <<04390>>42155000
      errn := err'can't'do'mode;                               <<04390>>42160000
      errf := ldn;                                             <<04390>>42165000
      parm := parms (pnum := 1);                               <<04390>>42170000
      go return1;                                              <<04390>>42175000
   end;                                                        <<04390>>42180000
   parm:=parms(pnum:=pnum+1);                                  <<04390>>42185000
   if pp="TRANSPARENT" and plen=11                             <<04390>>42190000
      then dreturn:=attachio(ldn,0,0,0,modefunc,               <<04390>>42195000
                             0,transpar,0,0)                   <<04390>>42200000
   else if pp="FEATURE" and plen=7                             <<04390>>42205000
      then dreturn:=attachio(ldn,0,0,0,modefunc,               <<04390>>42210000
                             0,feature,0,0)                    <<04390>>42215000
   else                                                        <<04390>>42220000
   begin                                                       <<04390>>42225000
      errn := exp'vfc'margin;                                  <<04390>>42230000
      parm := parms( pnum:=1 );                                <<04390>>42235000
      go return1;                                              <<04390>>42240000
   end;                                                        <<04390>>42245000
                                                               <<04390>>42250000
end << modeset >>;                                             <<04390>>42255000
                                                               <<04390>>42260000
                                                               <<04378>>42265000
   logimage( m'download, parmsp );  << log op command >>       <<01527>>42270000
errn := errf := 0;                                                      42275000
printvfc := false;                                                      42280000
@pp := @parmsp;                                                         42285000
mycommand(parmsp,,maxparms+1,numparms,parms(1));                        42290000
                                                               <<04197>>42295000
<< first checks:  right number of parameters in command >>     <<04197>>42300000
<<     image.  verify that the target ldev is real.     >>     <<04197>>42305000
if numparms > maxparms then                                             42310000
   begin                                                                42315000
   errn := err'too'many;                                                42320000
   parm := parms( pnum := 2 );                                 <<04197>>42325000
   go return1;                                                          42330000
   end;                                                                 42335000
if numparms < minparms then                                    <<04197>>42340000
   begin                                                                42345000
   pnum := numparms;                                                    42350000
   errn := err'too'few;                                        <<04197>>42355000
   go return1;                                                 <<04197>>42360000
   end;                                                                 42365000
parm := parms(pnum := 1);                                               42370000
move ldnalpha := pp,(plen);                                             42375000
move ldnalpha(plen) := 0;                                               42380000
ldn := verify'rldev(pp,plen,errnum,parmnum,1);                          42385000
if < then return;                                                       42390000
                                                                        42395000
<< make sure user has access to command and device.     >>     <<04197>>42400000
if verify'masterop(ldn) then return;                                    42405000
if checkass(ldn) or checkallow(m'download) then                         42410000
   <<proceed normally, user has access>>                                42415000
   else                                                                 42420000
      begin                                                             42425000
      errn := usernoacc2dev;                                            42430000
      go return1;                                                       42435000
      end;                                                              42440000
                                                                        42445000
<< parse next parameters       >>                                       42450000
<< parse second , third parameters >>                                   42455000
<< filename or margin = nn >>                                  <<02069>>42460000
   if pdel <> comma then                                       <<04197>>42465000
   begin                                                       <<04197>>42470000
      errn := exp'ldn'comma;                                   <<04197>>42475000
      errf := ldn;                                             <<04197>>42480000
      go return1;                                              <<04197>>42485000
   end;                                                        <<04197>>42490000
                                                               <<04197>>42495000
<< ldev okay so far.  check next parameter.  it should  >>     <<04197>>42500000
<< be either "MARGIN=nn" or a vfc file name.  check     >>     <<04197>>42505000
<< margin first.                                        >>     <<04197>>42510000
   parm := parms(pnum := pnum + 1);                                     42515000
   if pdel = equal                                             <<04197>>42520000
      then if pp = "MARGIN" and plen = 6                       <<04197>>42525000
              then marginset                                   <<04197>>42530000
              else                                             <<04197>>42535000
              begin                                            <<04197>>42540000
                 errn := err'too'many;                         <<04197>>42545000
                 go return1;                                   <<04197>>42550000
              end                                              <<04197>>42555000
   else    << not margin.  assume it's a file name   >>        <<04197>>42560000
   begin   << that has been specified.               >>        <<04197>>42565000
                                                               <<04197>>42570000
      << there is an additional parameter specified when   >>  <<04197>>42575000
      << margin is specified.  margin was not specified in >>  <<04197>>42580000
      << this case, so :download can't have the maximum    >>  <<04197>>42585000
      << number of parameters.                             >>  <<04197>>42590000
      if numparms = maxparms then                              <<04197>>42595000
      begin                                                    <<04197>>42600000
         errn := err'too'many;                                 <<04197>>42605000
         go return1;                                           <<04197>>42610000
      end;                                                     <<04197>>42615000
                                                               <<04197>>42620000
      << check and open the vfc file.                   >>     <<04197>>42625000
      if not palpha then                                                42630000
         begin                                                          42635000
         errn := err'filename'alpha; go return1;                        42640000
         end;                                                           42645000
      tempd := parm; <<get 2nd parameter description>>                  42650000
      tempd2 := plen; <<stripoff parameter desc, except len>>           42655000
      filetyp := checkfilename'(tempd,gptr',aptr',errptr');             42660000
      if < then   <<invalid file name>>                                 42665000
         begin                                                          42670000
         errn := filetyp;                                               42675000
         go return1;                                                    42680000
         end                                                            42685000
      else                                                              42690000
         if > and filetyp <> 0 then <<system file name>>                42695000
             begin                                                      42700000
            errn := cantbesysfile;                                      42705000
            go return1;                                                 42710000
            end;                                                        42715000
      fn := fopen(pp,3,0);                                              42720000
      if <> then begin                                                  42725000
                 fcheck(0,fopen'err); errf := fopen'err;                42730000
                 genmsg(filesysmsgset,errf);                            42735000
                 errn := err'fopen; go return1;                         42740000
                 end;                                                   42745000
                                                               <<04197>>42750000
   << the vfc file has been opened okay.  process each  >>     <<04197>>42755000
   << record in the file.                               >>     <<04197>>42760000
      continue := true;                                                 42765000
      while continue do                                                 42770000
                                                               <<04197>>42775000
      << note:  we should not need to travel through    >>     <<04197>>42780000
      << this loop often.  this part of the loop should >>     <<04197>>42785000
      << process the margin record (if there) and the   >>     <<04197>>42790000
      << vfc record (if there).  an inner loop handles  >>     <<04197>>42795000
      << the channel definitions.  the case of multiple >>     <<04197>>42800000
      << vfc definitions in one file doesn't make sense >>     <<04197>>42805000
      << and is not allowed.                            >>     <<04197>>42810000
         begin                                                          42815000
         vfcin := 0;                                                    42820000
         move vfcin(1) := vfcin,(36);  <<zero fill buffer>>    <<01878>>42825000
          printvfc := true;                                             42830000
         lnth := fread(fn,vfcin,36);                           <<01878>>42835000
         if <> then                                                     42840000
             begin                                                      42845000
             continue := false;                                         42850000
             printvfc := false;                                         42855000
             end                                                        42860000
         else                                                           42865000
            begin                                                       42870000
                                                               <<04197>>42875000
         << at this point we expect either a "MARGIN"   >>     <<04197>>42880000
         << or a "VFC" record in the file.              >>     <<04197>>42885000
            lines'in'vfc := lines'in'vfc + 1;                  <<04197>>42890000
                                                               <<04197>>42895000
         << if we have already encountered a vfc record   >>   <<04197>>42900000
         << in the file, any subsequent lines are extra.  >>   <<04197>>42905000
            if vfc'encountered then                            <<04197>>42910000
            begin                                              <<04197>>42915000
               parm := parms( pnum := 1 );                     <<04390>>42920000
               if ( pp = "MARGIN"  land plen = 6 ) or          <<04390>>42925000
                  ( pp = "MODE"    land plen = 4 )             <<04390>>42930000
                  then errn := err'mode'margin'first           <<04390>>42935000
                  else errn := extra'lines'ignored;            <<04390>>42940000
               printvfc := true;                               <<04197>>42945000
               go return1;                                     <<04197>>42950000
            end;                                               <<04197>>42955000
                                                               <<04197>>42960000
            vfcin(36) := %6415; <<carriage returns>>           <<01878>>42965000
            mycommand(bvfcin,,vfcmaxparms,numparms,parms(1));  <<02069>>42970000
            parm := parms( pnum := 1 );                        <<04197>>42975000
            if numparms < minparms then                        <<04197>>42980000
               begin                                                    42985000
               errn := exp'vfc'margin;                         <<02069>>42990000
               go return1;                                              42995000
               end;                                                     43000000
                                                               <<04197>>43005000
            if pp="MARGIN" and pdel=equal and                  <<02069>>43010000
               plen = 6 then                                   <<02069>>43015000
               begin                                                    43020000
               if margin'in'vfc then                           <<04390>>43025000
               begin                                           <<04390>>43030000
                  errn := err'one'per'vfc;                     <<04390>>43035000
                  printvfc := true;                            <<04390>>43040000
                  parm := parms( pnum:=1 );                    <<04390>>43045000
                  go return1;                                  <<04390>>43050000
               end;                                            <<04390>>43055000
                                                               <<04390>>43060000
               margin'in'vfc := true;                          <<04197>>43065000
               if numparms >= maxparms then                    <<00910>>43070000
               begin                                           <<00910>>43075000
                  errn := err'margin'toomany;                  <<04197>>43080000
                  printvfc := true;                            <<00910>>43085000
                  parm := parms(pnum := 3);                    <<02069>>43090000
                  go return1;                                  <<00910>>43095000
               end;                                            <<00910>>43100000
               if lines'in'vfc > 2                             <<04390>>43105000
                  then if not( (lines'in'vfc=2) land           <<04390>>43110000
                                mode'in'vfc         ) then     <<04390>>43115000
               begin    << "MARGIN" must be first line  >>     <<04197>>43120000
                        << in vfc file.                 >>     <<04197>>43125000
                  errn := err'margin'notfirst;                 <<04197>>43130000
                  printvfc := true;                            <<04197>>43135000
                  parm := parms( pnum := 1 );                  <<04197>>43140000
                  go return1;                                  <<04197>>43145000
               end;                                            <<04197>>43150000
               numparms := 2;                                           43155000
               marginset;     <<attachio margin>>                       43160000
               end                                                      43165000
           else if pp="MODE" and pdel=equal and plen=4 then    <<04390>>43170000
           begin                                               <<04390>>43175000
              if mode'in'vfc then                              <<04390>>43180000
              begin                                            <<04390>>43185000
                 errn := err'one'per'vfc;                      <<04390>>43190000
                 printvfc := true;                             <<04390>>43195000
                 parm := parms( pnum:=1 );                     <<04390>>43200000
                 go return1;                                   <<04390>>43205000
              end;                                             <<04390>>43210000
              mode'in'vfc := true;                             <<04390>>43215000
              if numparms > 2 then                             <<04390>>43220000
              begin                                            <<04390>>43225000
                 errn := err'mode'toomany;                     <<04390>>43230000
                 printvfc := true;                             <<04390>>43235000
                 parm := parms(pnum := 3);                     <<04390>>43240000
                 go return1;                                   <<04390>>43245000
              end;                                             <<04390>>43250000
              if lines'in'vfc > 2                              <<04390>>43255000
                 then if not( (lines'in'vfc=2) land            <<04390>>43260000
                               margin'in'vfc       ) then      <<04390>>43265000
                 begin                                         <<04390>>43270000
                    errn := err'mode'notfirst;                 <<04390>>43275000
                    printvfc := true;                          <<04390>>43280000
                    parm := parms(pnum := 1);                  <<04390>>43285000
                    go return1;                                <<04390>>43290000
                 end;                                          <<04390>>43295000
              numparms := 2;                                   <<04390>>43300000
              modeset;                                         <<04390>>43305000
           end                                                 <<04390>>43310000
            else if pp="VFC" and plen=3 then                   <<02069>>43315000
               begin                                                    43320000
               << the vfc line has a lines-per-inch and a >>   <<04197>>43325000
               << lines-per-page parameter (delimed by    >>   <<04197>>43330000
               << commas).  the text after the lines-per- >>   <<04197>>43335000
               << page parm (also delimed by ",") is a    >>   <<04197>>43340000
               << comment and is ignored.                 >>   <<04197>>43345000
                                                               <<04197>>43350000
                 if vfc'encountered then                       <<04390>>43355000
                 begin                                         <<04390>>43360000
                    errn := err'one'per'vfc;                   <<04390>>43365000
                    printvfc := true;                          <<04390>>43370000
                    parm := parms( pnum:=1 );                  <<04390>>43375000
                    go return1;                                <<04390>>43380000
                 end;                                          <<04390>>43385000
                 vfc'encountered := true;                      <<04390>>43390000
                                                               <<04197>>43395000
               << make sure delimiter is a comma.         >>   <<04197>>43400000
                  if pdel <> comma then                        <<04197>>43405000
                  begin                                        <<04197>>43410000
                     errn := err'vfc'delims;                   <<04197>>43415000
                     printvfc := true;                         <<04197>>43420000
                     go return1;                               <<04197>>43425000
                  end;                                         <<04197>>43430000
                                                               <<04197>>43435000
               << check ldev validity for vfc func. >>         <<04197>>43440000
                  if not validdevtype( ldn,vfcfunc,flag ) then <<04197>>43445000
                  begin                                        <<04197>>43450000
                     errf := ldn;                              <<04197>>43455000
                     parm := parms( pnum := 1 );               <<04197>>43460000
                     errn := err'wrong'ldev'2;                 <<04197>>43465000
                     go return1;                               <<04197>>43470000
                  end;                                         <<04197>>43475000
                                                               <<04197>>43480000
               << check last parm (comment) delimed by "," >>  <<04197>>43485000
               << note that this comment is optional.      >>  <<04197>>43490000
                  if numparms > 3 then                         <<02069>>43495000
                  begin                                        <<01878>>43500000
                     parm:=parms(3);                           <<01878>>43505000
                     if pdel <> comma then                     <<02069>>43510000
                     begin                                     <<01878>>43515000
                        errn:=err'expected'comma;              <<01878>>43520000
                        go return1;                            <<01878>>43525000
                     end;                                      <<01878>>43530000
                  end                                          <<02069>>43535000
                  else if numparms < 3 then                    <<02069>>43540000
                  begin                                        <<02069>>43545000
                    errn := vfc'too'few;                       <<02069>>43550000
                    go return1;                                <<02069>>43555000
                  end;                                         <<02069>>43560000
               if not ( lines'in'vfc = (if margin'in'vfc and   <<04390>>43565000
          mode'in'vfc then 3 else if margin'in'vfc or          <<04390>>43570000
                    mode'in'vfc then 2 else 1)) then           <<04390>>43575000
               begin    << "VFC" line must be either the >>    <<04197>>43580000
                        << first or second line in the   >>    <<04197>>43585000
                        << vfc file.                     >>    <<04197>>43590000
                  errn := err'vfc'notfirst;                    <<04197>>43595000
                  printvfc := true;                            <<04197>>43600000
                  parm := parms( pnum := 1 );                  <<04197>>43605000
                  go return1;                                  <<04197>>43610000
               end;                                            <<04197>>43615000
               parm := parms(pnum := pnum + 1);                         43620000
               if pdel <> comma then                           <<04197>>43625000
               begin                                           <<04197>>43630000
                  errn := err'vfc'delims;                      <<04197>>43635000
                  printvfc := true;                            <<04197>>43640000
                  go return1;                                  <<04197>>43645000
               end;                                            <<04197>>43650000
               if plen = 0 or           <<set default 6lpi>>            43655000
               pp = " " then p1 := 6                                    43660000
                                                                        43665000
               else                                                     43670000
                  begin                                                 43675000
                  p1 := binary(pp,plen);                                43680000
                  if <> then                                   <<04197>>43685000
                  begin                                        <<04197>>43690000
                     errn := err'lpi'numeric;                  <<04197>>43695000
                     printvfc := true;                         <<04197>>43700000
                     go return1;                               <<04197>>43705000
                  end;                                         <<04197>>43710000
                                                               <<04197>>43715000
              << any number here <> to 6 or 8 will cause the >><<04197>>43720000
              << lines-per-inch to default to 6.  a warning  >><<04197>>43725000
              << is generated in this case.                  >><<04197>>43730000
                  if p1 <> 6 then if p1 <> 8 then              <<04197>>43735000
                  begin                                        <<04197>>43740000
                     vfcin(lnth) := 0; << genmsg terminator. >><<04197>>43745000
                     genmsg( -1, @bvfcin );                    <<04197>>43750000
                     offset := @pp - @bvfcin;                  <<04197>>43755000
                     caret := "  ";                            <<04197>>43760000
                     move caret(1) := caret, (8);              <<04197>>43765000
                     move caret'(offset) := ("^", 0);          <<04197>>43770000
                     genmsg( -1, @caret' );                    <<04197>>43775000
                     cierr( errn := -using'6'lpi );            <<04197>>43780000
                     p1 := 6;                                  <<04197>>43785000
                  end;                                         <<04197>>43790000
                                                               <<04197>>43795000
                  end;         <<set lines per inch>>                   43800000
               <<number of printlines in vfc>>                          43805000
               parm := parms(pnum := pnum + 1);                         43810000
               bufindx := 0;                                            43815000
               count := binary(pp,plen);                                43820000
               if <> then                                      <<04197>>43825000
               begin                                           <<04197>>43830000
                  errn := err'numlines;                        <<04197>>43835000
                  printvfc := true;                            <<04197>>43840000
                  go return1;                                  <<04197>>43845000
               end;                                            <<04197>>43850000
               if count > max'vfc'lines then                   <<04197>>43855000
                   begin                                                43860000
                   errn := err'too'long;                                43865000
                   printvfc := true;                           <<04197>>43870000
                   go return1;                                          43875000
                   end;                                                 43880000
            if count < 0 then                                  <<01330>>43885000
            begin <<error negative linecount>>                 <<01330>>43890000
               errn := err'negative'vfc;                       <<01330>>43895000
               printvfc := true;                               <<04197>>43900000
               go return1;                                     <<01330>>43905000
            end;                                               <<01330>>43910000
                                                               <<04197>>43915000
         << note:  if count (lines-per-page) equals zero >>    <<04197>>43920000
         <<        here, the lines-per-inch is simply    >>    <<04197>>43925000
         <<        reset.  no channel definition is      >>    <<04197>>43930000
         <<        expected.                             >>    <<04197>>43935000
             if count <> 0 then                                         43940000
             begin                                                      43945000
               tos := count;                                            43950000
               tos := p1;                                               43955000
               assemble(div);                                           43960000
               remainder := tos;                                        43965000
               quotient := tos;                                         43970000
               if remainder = 0 and (quotient = 11 or                   43975000
                            quotient = 12) then                <<sp 03>>43980000
               << for 8 lpi we have 88 lines>>                          43985000
               << for 6 lpi we have 66 lines>>                          43990000
         << european 12 inches>>                                        43995000
         <<  - 96 lines or 72 lines>>                                   44000000
               warnflag := false  <<standard formlength>>               44005000
               else warnflag := true;                                   44010000
               i := 0;                                                  44015000
               vfc := 0;                                                44020000
               move vfc(1) := vfc, (max'vfc'lines);            <<04197>>44025000
               do                                                       44030000
                  begin                                                 44035000
                  vfcin := 0;                                           44040000
                  tos := 0;                                             44045000
                  move  vfcin(1) := vfcin, (7);                         44050000
                  lnth := fread(fn, vfcin,8);                           44055000
                  if > then go vfcread'done;                            44060000
                  lines'in'vfc := lines'in'vfc + 1;            <<04197>>44065000
                                                               <<04197>>44070000
               << check each line for invalid characters. >>   <<04197>>44075000
                  vfcline'okay := true;                        <<04197>>44080000
                  j := 0;                                      <<04197>>44085000
                  do if not  ( bvfcin(j) = " "  lor            <<04197>>44090000
                               bvfcin(j) = "0"  lor            <<04197>>44095000
                               bvfcin(j) = "1"        )        <<04197>>44100000
                     then vfcline'okay := false                <<04197>>44105000
                  until ( (j := j + 1) > 15);                  <<04197>>44110000
                  if not vfcline'okay then                     <<04197>>44115000
                  begin                                        <<04197>>44120000
                     errn := bad'vfc'line;                     <<04197>>44125000
                     printvfc := true;                         <<04197>>44130000
                     go return1;                               <<04197>>44135000
                  end;                                         <<04197>>44140000
                                                               <<04197>>44145000
               << process the vfc line.                 >>     <<04197>>44150000
                                                               <<04197>>44155000
               << first, translate the character string of >>  <<04197>>44160000
               << " "'s, "0"'s, and "1"'s into a logical   >>  <<04197>>44165000
               << value.  a set of logicals, one for each  >>  <<04197>>44170000
               << line in the form, will later be sent to  >>  <<04197>>44175000
               << the device via attachio.                 >>  <<04197>>44180000
                  j := 15;                                     <<04197>>44185000
                  do                                                    44190000
                     begin                                              44195000
                     tos := tos&lsl(1);                                 44200000
                     if bvfcin(j) = " " or bvfcin(j) = "0" then         44205000
                        begin                                           44210000
                        end                                             44215000
                     else                                               44220000
                        tos := tos lor 1;                               44225000
                     end                                                44230000
                  until (j := j-1) < 0 ;                                44235000
                  vfc (i) := tos;                                       44240000
                  end                                                   44245000
               until (i := i+1) >= count   ;                   <<sp.09>>44250000
                                                                        44255000
vfcread'done:                                                           44260000
            << if the definition of channel one has        >>  <<04197>>44265000
            << changed, then the device will have to be    >>  <<04197>>44270000
            << realigned to top of form when the next      >>  <<04197>>44275000
            << printjob is done.  the operator will have   >>  <<04197>>44280000
            << to be informed.                             >>  <<04197>>44285000
            << note:  vfc(i) is true (high order bit on)   >>  <<04197>>44290000
            << if channel one is defined for line i.       >>  <<04197>>44295000
               if not vfc then warnflag := true; <<no ch1>>             44300000
                                     << skip in position 1>>            44305000
               i := 1;tos := 0;                                         44310000
               do                                                       44315000
                  tos := tos lor vfc(i)                                 44320000
               until (i := i+1) >= count -1;                            44325000
               if  logical(tos) then warnflag := true;                  44330000
               if warnflag then                                         44335000
               << warn operator that the next printjob>>                44340000
               << will need realignment   >>                            44345000
               << this is true because ch 1 has changed>>               44350000
               << and printer driver uses ch1 between opens>>           44355000
                  begin                                                 44360000
                  errn := err'realign;                                  44365000
                  printvfc := false;                           <<04197>>44370000
                  errf := ldn;                                          44375000
                                                                        44380000
                  end;                                                  44385000
               <<get system buffer and attachio >>                      44390000
               printvfc := false; <<dont print vfcbuf >>                44395000
               bufindx := getsysbuf(1,false);                           44400000
               if <> then                                               44405000
                  begin                                                 44410000
                  errn := err'no'sysbufs;                               44415000
                  go return1;                                           44420000
                  end;                                                  44425000
               tos := sbufdst;  <<sys buffers>>                         44430000
               tos := bufindx;                                          44435000
               tos := @vfc; <<address of vfc>>                          44440000
               tos := count;                                            44445000
               assemble(mtds 4); <<transfer vfc to buffer>>             44450000
              end;    << if count <>0>>                                 44455000
                                                                        44460000
               p2 := 0;                                        <<04390>>44465000
               dreturn := attachio( ldn, 0, sbufdst, bufindx,  <<04197>>44470000
                             vfcfunc, count, p1, p2, %13     );<<04197>>44475000
               if sreturn = 0 then                                      44480000
                  begin                                                 44485000
                  errn := err'vfc'failed;                               44490000
                  errf := ldn;                                          44495000
                  go return1;                                           44500000
                  end;                                                  44505000
            end                                                <<02069>>44510000
            else                                               <<02069>>44515000
               begin  << no "MARGIN", no "VFC" >>              <<02069>>44520000
                  errn := exp'vfc'margin;                      <<02069>>44525000
                  parm := parms( pnum := 1 );                  <<04197>>44530000
                  printvfc := true;                            <<02069>>44535000
                  go return1;                                  <<02069>>44540000
               end;                                            <<02069>>44545000
        end;                                                            44550000
    end;                                                                44555000
end;                                                                    44560000
return1:                                                                44565000
parmnum := pnum;                                                        44570000
                                                               <<04197>>44575000
<< if a vfc file was opened, then it needs closing.        >>  <<04197>>44580000
if fn <> 0 then fclose(fn,0,0);                                         44585000
                                                               <<04197>>44590000
<< handle any errors that occurred.  note that warnings  >>    <<04197>>44595000
<< that have already been issued are ignored.            >>    <<04197>>44600000
if errn > 0 then                                               <<04197>>44605000
   begin                                                                44610000
   if errn =  err'realign then                                 <<00910>>44615000
   begin                                                       <<00910>>44620000
      errn := -errn;                                           <<00910>>44625000
      @pp := @parmsp;                                          <<04197>>44630000
   end;                                                        <<00910>>44635000
   if printvfc then                                                     44640000
   begin                                                                44645000
      vfcin(lnth) := 0; <<for genmsg terminator>>                       44650000
      genmsg(-1,@bvfcin); <<print vfc buffer>>                          44655000
      offset := @pp-@bvfcin;                                            44660000
      if 0 <= offset <= 15 then                                <<04197>>44665000
      begin                  << caret bounds check. >>         <<04197>>44670000
         caret := "  ";                                        <<04197>>44675000
         move caret(1) := caret, (8);                          <<04197>>44680000
         move caret'(offset) := ("^", 0);                      <<04197>>44685000
         genmsg( -1, @caret' );                                <<04197>>44690000
      end;                                                     <<04197>>44695000
      cierr(errn);                                                      44700000
   end                                                                  44705000
   else                                                                 44710000
   if errf = 0 then                                                     44715000
      cierr(errn,pp)                                                    44720000
   else                                                                 44725000
      cierr(errn,pp,%10000,errf);                                       44730000
   end;                                                                 44735000
end;                                                                    44740000
$page "   ***   SHOWDEV   ***"                                 <<04801>>44745000
$control segment=ophi                                          <<04801>>44750000
                                                                        44755000
<< note:  procedure showdev was moved unchanged from spool- >> <<04801>>44760000
<< coms to opcommand as part of this enhancement.  its  fix >> <<04801>>44765000
<< number(s) were not changed.                              >> <<04801>>44770000
                                                                        44775000
integer procedure showdev (parmstring, parmnum, console);      <<04801>>44780000
   value parmnum, console;                                     <<04801>>44785000
   logical console;  <<true=> consshowdev, false=> user>>      <<04801>>44790000
   byte array parmstring;                                               44795000
   integer parmnum;                                                     44800000
   option privileged, uncallable;                                       44805000
begin                                                                   44810000
                                                                        44815000
<< declarations >>                                                      44820000
                                                                        44825000
<< parse >>                                                             44830000
   byte pointer      pp;                                                44835000
   integer plen;                                               <<04801>>44840000
                                                                        44845000
<< no parameter (all) scan >>                                           44850000
   integer           maxdev,           <<highest dev num>>              44855000
                     devnum := 1;      <<running dev num>>              44860000
                                                                        44865000
<< class scan >>                                                        44870000
   double            classn0 := "    ",<<class name>>                   44875000
                     classn1 := "    ";                                 44880000
   byte array        classnb (*) = classn0;                             44885000
   integer pointer   dct,              <<running class pointer><<06604>>44890000
                     limitp;           <<dct end>>                      44895000
   double pointer    dctpd   = dct;    <<for name compare>>    <<06604>>44900000
   integer pointer   cldevp,           <<inter-class dev pntr>><<06932>>44905000
                     cllimp;           <<cless entry end>>              44910000
   logical           exch := false;    <<exch(ldt) signal>>             44915000
   integer           err;                                      <<06929>>44920000
                                                                        44925000
<< for processing subroutine >>                                         44930000
   integer           dev,              <<cause of subr parm addressing>>44935000
                     adev,             <<absolute lpdt dev addr>>       44940000
                     savesir;                                           44945000
<< ldt0 thru ldt6 must stay together to form a q array >>      <<06604>>44950000
   double            ldt0,             <<local ldt image>>              44955000
                     ldt2,                                     <<06604>>44960000
                     ldt4;                                     <<06604>>44965000
   integer           ldt6;                                     <<06604>>44970000
   integer array     ldt (*) = ldt0;                                    44975000
   logical array     ldtl (*) = ldt;                                    44980000
                                                               <<06607>>44985000
   << ...................................................... >><<06607>>44990000
   <<        declarations for referencing the jmat           >><<06607>>44995000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>45000000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>45005000
   <<               a specific entry), after an exchange db. >><<06607>>45010000
   <<               or 0 if jmatarr is a local array.        >><<06607>>45015000
   << ...................................................... >><<06607>>45020000
                                                               <<06607>>45025000
   integer       jmatinx;                                      <<06607>>45030000
   integer array     jmatarr(*)=db+0;<< index into jmat >>     <<06607>>45035000
   integer                                                     <<06604>>45040000
      ldt'index := 0,                                          <<07181>>45045000
      dct'offset,                                              <<07181>>45050000
      dct'entry'limit,                                         <<07181>>45055000
      devicecount;      << temp. count >>                      <<07181>>45060000
                                                               <<06604>>45065000
equate dct'header'size = 6;                                    <<06932>>45070000
   logical array dct'head(0:dct'header'size-1);                <<06932>>45075000
   integer array ldevarray(0:9) =q; << for dct ldevs >>        <<06932>>45080000
   logical pcbpt;                                              <<06606>>45085000
   equate            sysprocess  = 1;                                   45090000
   integer           owner := 0;       <<owner jobnum; if user>>        45095000
   integer count,  <<for moving in temp ldev #s from dct>>     <<06932>>45100000
            classldev, <<ldev associated with dev class>>      <<06932>>45105000
           numdevices;  <<temp value for dct'num'devices>>     <<06932>>45110000
integer array                                                  <<04801>>45115000
   ass'entry(0:ass'entrysize); << associate table entry >>     <<06924>>45120000
integer array jitarr(0:jit'entry'size-1);                      <<06924>>45125000
byte array ass'entry'(*)=ass'entry;                            <<06924>>45130000
integer vollen;   <<length of output from pvolid routine>>     <<04801>>45135000
                                                                        45140000
<< print variables >>                                                   45145000
   equate            maxbuf = 37;                              <<06933>>45150000
   array             buf (0:maxbuf);   <<output buffer>>                45155000
   byte array        bufb (*) = buf;                                    45160000
   integer           len;              <<print len (+bytes)>>           45165000
   define            header =                                           45170000
      ("LDEV  AVAIL         OWNERSHIP         VOLID         ", <<06933>>45175000
       "DEN   ASSOCIATION")#;                                  <<04801>>45180000
   equate            headerlen = -69;                          <<06933>>45185000
   logical           headerprinted := false;                            45190000
                                                                        45195000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>45200000
subroutine def'movefromdseg;                                   <<06604>>45205000
                                                                        45210000
subroutine conserr(errnum, errptr, parmmask, parm);            <<04801>>45215000
value errnum, parmmask, parm;                                  <<04801>>45220000
integer errnum, parmmask, parm;                                <<04801>>45225000
byte array errptr;                                             <<04801>>45230000
<<for the moment, this interface is a dummy>>                  <<04801>>45235000
begin                                                          <<04801>>45240000
showdev := errnum;                                             <<04801>>45245000
end;   <<conserr>>                                             <<04801>>45250000
                                                                        45255000
                                                                        45260000
integer subroutine emitfiles (pos);                                     45265000
   value pos;                                                           45270000
   integer pos;                                                         45275000
<< emits:  "<USECOUNT> FILES" >>                                        45280000
begin                                                                   45285000
   move bufb (pos +ascii (ldt'file'use'cnt,10,bufb(pos))):=    <<06604>>45290000
         " FILES";                                                      45295000
   emitfiles := x + 6;                                                  45300000
   end;    <<emitfiles>>                                                45305000
                                                                        45310000
                                                                        45315000
integer subroutine emitdp (pos);                                        45320000
   value pos;                                                           45325000
   integer pos;                                                         45330000
<< emits:  "; DP", if down pending >>                                   45335000
   if logical(ldt'down'pending) then                           <<06604>>45340000
      begin    <<down pending>>                                         45345000
      move bufb (pos) := "; DP";                                        45350000
      emitdp := pos +4;                                                 45355000
      end                                                               45360000
   else                                                                 45365000
      emitdp := pos;                                                    45370000
   <<emitdp>>                                                           45375000
                                                                        45380000
                                                                        45385000
integer subroutine emitspooled (pos);                                   45390000
   value pos;                                                           45395000
   integer pos;                                                         45400000
<< emits:  "SPOOLED" >>                                                 45405000
begin                                                                   45410000
   move bufb (pos) := "SPOOLED";                                        45415000
   emitspooled := pos +7;                                               45420000
   end;    <<emitspooled>>                                              45425000
                                                                        45430000
                                                                        45435000
logical subroutine processrealdev (devparm);                            45440000
   value devparm;                                                       45445000
   integer devparm;                                                     45450000
<< prints status of real device. >>                                     45455000
begin                                                                   45460000
<< db presumed to be at the ldt  >>                            <<06604>>45465000
   lpdt'index:=devparm*integer(lpdt'entry'size);               <<06221>>45470000
   if lpdt'virtual'device <> 1 then                            <<06221>>45475000
      begin  << attempt to process non virtual device >>       <<07181>>45480000
      if lpdt'virtual'device = 0 and                           <<07184>>45485000
              lpdt'dit'ptr <> 0 then                           <<07184>>45490000
      begin    <<a real device: print its status>>                      45495000
      dev := devparm;  <<'cause of subr addressing>>                    45500000
      processrealdev := true;                                           45505000
      savesir := getsir (ldtsir);                                       45510000
<< compute index into ldt (dev * ldtsize). place it >>         <<06604>>45515000
<< on tos , then move in the 5 word/7 word (mpeiv/  >>         <<06604>>45520000
<< mpev) entry to a local copy of the ldt entry.    >>         <<06604>>45525000
<< db is at the ldt, based on db + index            >>         <<06604>>45530000
<< ******  note  ******  this actually moves in 7   >>         <<06604>>45535000
<< words ( 3 doubles and a single).  this is done to>>         <<06604>>45540000
<< prepare for mpev where ldt entries will be 7     >>         <<06604>>45545000
<< words long.  the 6th and 7th word is ignored for >>         <<06604>>45550000
<< mpe iv.                                          >>         <<06604>>45555000
                                                               <<06604>>45560000
      tos := dev *ldtsize;  << ... and ldt >>                           45565000
      ldt0 := dps0;                                                     45570000
      ldt2 := dps0 (1);                                                 45575000
      ldt4 := dps0 (2);                                        <<06604>>45580000
      ldt6 := ps0 (6);                                         <<06604>>45585000
      del;                                                              45590000
      owner := 0;                                                       45595000
      if (not it's'a'disc (ldt'device'type   ) )               <<06604>>45600000
            and ldt'main'pin <> 0 then                         <<06604>>45605000
         begin    <<device has an owner>>                               45610000
         pcbpt := ldt'main'pin*pcbsize;                        <<06606>>45615000
         if procstate.systemprocflag <> sysprocess then        <<06606>>45620000
            begin    <<owned by a user>>                                45625000
            exchangedb (jmatdst);  <<determine job no.>>                45630000
            jmatinx := jmatentryptr; << point to first entry>> <<06607>>45635000
            while (jmatarr = 0)                                <<06607>>45640000
                  or (jmatjobstate = joberr)                   <<06607>>45645000
                  or (jmatmainpin <> ldt'main'pin) do          <<06607>>45650000
               begin                                           <<04801>>45655000
               jmatinx := jmatinx+jmatentrysize;<<next entry>> <<06607>>45660000
               if jmatinx >= jmatcursize & asl(7)  then        <<06607>>45665000
                   go to notowned;                             <<04801>>45670000
                    <<must be starting or terminating>>        <<04801>>45675000
               end;                                            <<04801>>45680000
            owner := jmatarr(jmatinx+jmatjsnooff);             <<06607>>45685000
            end    <<user job no. determination>>                       45690000
         << else owner is 0 >> ;                                        45695000
         end;                                                           45700000
    notowned:                                                  <<04801>>45705000
      relsir (ldtsir, savesir);                                         45710000
      exchangedb (0);                                                   45715000
                                                                        45720000
                                                                        45725000
   << print device info: >>                                             45730000
                                                                        45735000
      buf := "  ";                                             <<04801>>45740000
      move buf(1) := buf,(maxbuf);                             <<04801>>45745000
      if not (headerprinted) then                                       45750000
         begin                                                          45755000
         move bufb := header;                                  <<04801>>45760000
         if requestservice then goto leave;                             45765000
         print (buf, headerlen, %60);                                   45770000
         if <> then goto leave;                                         45775000
         headerprinted := true;                                         45780000
         buf := "  ";                                                   45785000
         move buf (1) := buf, (maxbuf);                                 45790000
         end;                                                           45795000
                                                                        45800000
      buf := "  ";                                                      45805000
      ascii (dev, -10, bufb (2));                                       45810000
      << job-acc, data-acc, both, neither >>                            45815000
   if lpdt'data'accept = 1                                     <<06221>>45820000
       then if lpdt'job'accept = 1 then bufb(4):="A"           <<07183>>45825000
                                   else bufb(4):="D"           <<07183>>45830000
       else if lpdt'job'accept = 1 then bufb(4):="J"           <<07183>>45835000
                                   else bufb(4):=" ";          <<07183>>45840000
      if not (logical(ldt'avail'to'sys)) then                  <<06604>>45845000
         begin    <<down>>                                              45850000
         if logical(ldt'spool'queues) then                     <<06604>>45855000
            emitspooled (6)                                             45860000
         else                                                           45865000
            move buf(3) := "UNAVAIL ";                                  45870000
         move buf (10) := "DOWN";                              <<06933>>45875000
         len := 24;                                            <<06933>>45880000
         if logical(ldt'avail'to'diag) then                    <<06604>>45885000
            begin    <<owned by diag>>                                  45890000
            move buf (12) := ", DIAG";                         <<06933>>45895000
            len := 31;                                         <<06933>>45900000
            end;                                                        45905000
         end                                                            45910000
      else                                                              45915000
         << up >>                                                       45920000
         if it's'a'disc ( ldt'device'type  ) then              <<06604>>45925000
            begin    <<disc>>                                           45930000
            move buf (3) := "DISC    ";                                 45935000
            len := emitdp (emitfiles (20));                    <<06933>>45940000
            end                                                         45945000
         else                                                           45950000
            << ok ... non-sharable device >>                            45955000
            if lpdt'dev'own'state = lpdt'not'owned then        <<06221>>45960000
               << unowned >>                                            45965000
               if logical(ldt'spool'queues) then               <<06604>>45970000
                  len := emitspooled (6)                                45975000
               else                                                     45980000
                  begin    <<available realee>>                         45985000
                  move buf (3) := "AVAIL ";                             45990000
                  len := 11;                                            45995000
                  end                                                   46000000
            else                                                        46005000
               begin    <<unavailable for some reason>>                 46010000
               if  (logical(ldt'spool'queues)) or              <<06604>>46015000
                   (ldt'spool'state = ldt'input'spooled)       <<06604>>46020000
                     then                                               46025000
                  emitspooled (6)                                       46030000
               else                                                     46035000
                  move buf (3) := "UNAVAIL ";                           46040000
               << print owner >>                                        46045000
               if lpdt'dev'own'state <> lpdt'owned             <<06930>>46050000
                  or (owner = 0) then                          <<04801>>46055000
                  << "SYSTEM'S" >>                                      46060000
                  if ldt'spool'state =ldt'not'spooled then     <<06604>>46065000
                     begin                                              46070000
                     move buf (10) := "SYS ";                  <<06933>>46075000
                     len := 23;                                <<06933>>46080000
                     if ldt'main'pin <> 0 then                 <<06604>>46085000
                        begin                                           46090000
                        bufb (24) := "#";                      <<06933>>46095000
                        len := 25                              <<06933>>46100000
                          +ascii(ldt'main'pin,10,bufb(25));    <<06933>>46105000
                        end;                                            46110000
                     end                                                46115000
                  else                                                  46120000
                     begin    <<owned by spooler>>                      46125000
                     move buf (10) := "SPOOLER ";              <<06933>>46130000
                     len := 31;                                <<06933>>46135000
                     if ldt'spool'state =ldt'output'spooled    <<06604>>46140000
                        then                                   <<06604>>46145000
                        move buf (14) := "OUT "                <<06933>>46150000
                     else                                               46155000
                        begin                                           46160000
                        buf (14) := "IN";                      <<06933>>46165000
                        len := len -1;                                  46170000
                        end;                                            46175000
                     end                                                46180000
               else                                                     46185000
                  begin    <<owned by a job>>                           46190000
                  buf(10):=if owner.(0:2)=sessiontype then "#S"<<06933>>46195000
                        else "#J";                                      46200000
                  move bufb(22+ascii(owner.(2:14),10,bufb(22)))<<07183>>46205000
                        := ": ";                                        46210000
                  len := emitfiles (x + 2);                             46215000
                  end;                                                  46220000
               len := emitdp (len);                                     46225000
               end;                                                     46230000
      if (vollen := pvolid(devparm,bufb(38))) <> 0             <<06933>>46235000
         then len := vollen;  << tape - report volid/density >><<04801>>46240000
      savesir := getsir( ass'sir );                            <<04801>>46245000
      tos:=@ass'entry;                                         <<06924>>46250000
      tos := ass'dst;                                          <<04801>>46255000
      tos := dev * ass'entrysize;                              <<04801>>46260000
      tos := ass'entrysize;                                    <<04801>>46265000
      assemble(mfds 4);                                        <<04801>>46270000
      relsir( ass'sir, savesir );                              <<04801>>46275000
      if ass'entry <> 0 then << device is associated >>        <<06924>>46280000
      begin                                                    <<04801>>46285000
         << must obtain the jit dst for this associate entry >><<06924>>46290000
         tos:=@jitarr;                                         <<06924>>46295000
         tos:=ass'entry(ass'jit);                              <<06924>>46300000
         tos:=0;                                               <<06924>>46305000
         tos:=jit'entry'size;                                  <<06924>>46310000
         assemble(mfds 4);                                     <<04801>>46315000
         buf(29):=if jitjstype = 1 then "#S" else "#J";        <<06933>>46320000
         len:=60+ascii(jitjobnumber,10,bufb(60));              <<06933>>46325000
         bufb(len):="-";                                       <<04801>>46330000
         move bufb(len+1):=ass'entry'(b'ass'class),(8);        <<06924>>46335000
         len:=len+9;                                           <<04801>>46340000
      end;                                                     <<04801>>46345000
   if it's'a'disc(ldt'device'type) then                        <<07183>>46350000
   begin         << discrps could be enabled, must check >>             46355000
     err := rps'allow(devparm,2);                                       46360000
     if err = %205                                                      46365000
        then move bufb(12) := "(RPS)";                                  46370000
     end;                                                               46375000
                                                               <<04801>>46380000
      if requestservice then goto leave;                                46385000
      print (buf, -len, 0);                                             46390000
      if <> then goto leave;                                            46395000
      end    << real device, print status >>                   <<07181>>46400000
   else      << not real or virtual, unused device >>          <<07181>>46405000
      begin                                                    <<07181>>46410000
         exchangedb (0);    << from ldt dst >>                 <<07181>>46415000
         processrealdev := false;                              <<07181>>46420000
      end                                                      <<07181>>46425000
   end      << end attempt to process non virtual device>>     <<07181>>46430000
   else     << virtual device. lpdt'virtual'device = 1 >>      <<07181>>46435000
      begin                                                             46440000
      exchangedb (0);                                                   46445000
      processrealdev := false;                                          46450000
      end;                                                              46455000
   end;    <<processrealdev>>                                           46460000
                                                                        46465000
                                                                        46470000
   showdev := 0;                                                        46475000
   scan parmstring while %6440, 1;                                      46480000
   if carry then                                                        46485000
      begin    <<request for all devices>>                              46490000
      del;                                                              46495000
      maxdev:=lpdt'max'entries;                                <<06221>>46500000
      do begin                                                          46505000
         exchangedb (ldtdst);                                           46510000
         processrealdev (devnum);                                       46515000
         end                                                            46520000
      until  ((devnum := devnum +1) > maxdev);                          46525000
      end                                                               46530000
   else                                                                 46535000
      begin    <<parm specified>>                                       46540000
      @pp := s0;                                                        46545000
      move bps0 := bps0 while ans,1;  <<scan token, upshift>>  <<04801>>46550000
      scan bps0 while %6440,1;  <<skip blanks>>                         46555000
      if nocarry <<not carriage return>> then  <<too many parms<<04801>>46560000
         if console then   <<must be handled carefully>>       <<04801>>46565000
            conserr(-showdv2mp, bps0(1), 0, 0)                 <<04801>>46570000
         else   <<regular user, send error message>>           <<04801>>46575000
            cierr(-showdv2mp, bps0(1));  <<warn ignored>>      <<04801>>46580000
      del;  <<pop pointer to extra parm>>                      <<04801>>46585000
      plen := -(tos -tos);                                              46590000
      devnum := binary (pp, plen);                                      46595000
      if = then                                                         46600000
         begin    <<legitimate number>>                                 46605000
         exchangedb (ldtdst);                                           46610000
<< temporarily move the hientry into ldt to compare  >>        <<06604>>46615000
<< against ldt'num'entries.  the second word is not  >>        <<06604>>46620000
<< necessary and when processrealdev is called it    >>        <<06604>>46625000
<< write over these two words in array ldt.          >>        <<06604>>46630000
                                                               <<06604>>46635000
         tos := 0; <<index to beginning of ldt dst >>          <<06932>>46640000
         ldt0 := dps0;  << moves in a double >>                <<06932>>46645000
         del;  << delete index off tos >>                      <<06932>>46650000
         if not (1 <= devnum <= ldt'num'entries) then          <<06604>>46655000
            begin    <<out of bounds>>                                  46660000
            exchangedb (0);                                             46665000
            <<logical device number does not exist>>           <<04801>>46670000
            if console then                                    <<04801>>46675000
               conserr(showdvnosuchldn,pp,%10000,devnum)       <<04801>>46680000
            else                                               <<04801>>46685000
               begin                                           <<04801>>46690000
               cierr(showdev := showdvnosuchldn,pp,%10000,devnum);      46695000
               parmnum := 1;                                   <<04801>>46700000
               end;                                            <<04801>>46705000
            end                                                <<04801>>46710000
         else if not (processrealdev (devnum)) then            <<04801>>46715000
            <<logical device number does not exist>>           <<04801>>46720000
            if console then                                    <<04801>>46725000
               conserr(showdvnosuchldn,pp,%10000,devnum)       <<04801>>46730000
            else                                               <<04801>>46735000
               begin                                           <<04801>>46740000
               cierr(showdev := showdvnosuchldn,pp,%10000,devnum);      46745000
               parmnum := 1;                                   <<04801>>46750000
               end;                                            <<04801>>46755000
         end                                                   <<04801>>46760000
      else if > then   <<too large for binary to handle>>      <<04801>>46765000
         begin                                                 <<04801>>46770000
         tos := pp(plen);                                      <<04801>>46775000
         pp(plen) := 0;  <<stopper for genmsg>>                <<04801>>46780000
         if console then                                       <<04801>>46785000
            conserr(showdvnosuchldn, pp, 0, @pp)               <<04801>>46790000
         else                                                  <<04801>>46795000
            begin                                              <<04801>>46800000
            cierr(showdev := showdvnosuchldn, pp, 0, @pp);     <<04801>>46805000
            parmnum := 1;                                      <<04801>>46810000
            end;                                               <<04801>>46815000
         pp(plen) := tos;                                      <<04801>>46820000
         end                                                   <<04801>>46825000
      else                                                     <<04801>>46830000
         begin    <<not num: try class>>                       <<04801>>46835000
         if plen > 8 then                                      <<04801>>46840000
            begin   <<invalid class name>>                     <<04801>>46845000
            tos := pp(plen);  <<byte past last character>>     <<04801>>46850000
            pp(plen) := 0;  <<insert genmsg stopper>>          <<04801>>46855000
            if console then                                    <<04801>>46860000
               conserr(showdvinvldclas,pp,0,@pp)               <<04801>>46865000
            else                                               <<04801>>46870000
               cierr(showdev := showdvinvldclas, pp, 0, @pp);  <<04801>>46875000
            pp(plen) := tos;  <<restore damaged character>>    <<04801>>46880000
            parmnum := 1;                                      <<04801>>46885000
            return;   <<bail out>>                             <<04801>>46890000
            end;                                               <<04801>>46895000
         move classnb := pp, (plen);                                    46900000
        movefromdseg(@dct'head,dct'dst,0,dct'header'size);     <<06932>>46905000
                                                               <<06604>>46910000
        @dct := dcth'dct'base;                                 <<06932>>46915000
        @limitp := dcth'tdt'base;       <<end of dct>>         <<06932>>46920000
         exchangedb (dct'dst);                                 <<06932>>46925000
         do                                                             46930000
         until  (dctpd = classn0)  and  (dctpd(1) = classn1)   <<06604>>46935000
               or  ((@dct := @dct+dct'next'entry)>=@limitp);   <<06604>>46940000
                                                               <<06604>>46945000
         if @dct >= @limitp then                               <<06604>>46950000
            begin    << didn't find class >>                            46955000
            exchangedb (0);                                             46960000
            tos := pp(plen);  <<byte past last character>>     <<04801>>46965000
            pp(plen) := 0;  <<insert genmsg stopper>>          <<04801>>46970000
            if console then                                    <<04801>>46975000
               conserr(showdvnosuchcls,pp,0,@pp)               <<04801>>46980000
            else                                               <<04801>>46985000
               cierr(showdev := showdvnosuchcls, pp, 0, @pp);  <<04801>>46990000
            pp(plen) := tos;  <<restore damaged character>>    <<04801>>46995000
            parmnum := 1;                                      <<04801>>47000000
            end                                                         47005000
         else                                                           47010000
           <<  now we have found a matching device class we >> <<06932>>47015000
         <<  want to process the ldevs associated with    >>   <<06932>>47020000
         <<  that device class.  in order to do that we   >>   <<06932>>47025000
         <<  must get the device numbers from the dct and >>   <<06932>>47030000
         <<  pass them to processrealdev which expects the>>   <<06932>>47035000
         <<  db to be at the ldt dst.  for this reason we >>   <<06932>>47040000
         <<  batch up the ldevs from the dct 10 at a time >>   <<06932>>47045000
         <<  and put them in an array and then process them>>  <<06932>>47050000
         <<  this keeps us from having to do 2 exchangedb's>>  <<06932>>47055000
         <<  for every for every call to processrealdev.   >>  <<06932>>47060000
         <<================================================>>  <<06932>>47065000
            begin    <<found: scan thru class>>                         47070000
    dct'offset := @dct + dct'first'ldev;                       <<07181>>47075000
    dct'entry'limit := dct'offset + dct'num'devices;           <<07181>>47080000
            numdevices := integer(dct'num'devices);            <<06932>>47085000
            exchangedb(0);  <<from dct dst >>                  <<07181>>47090000
            count := 0;                                        <<06932>>47095000
            while dct'offset <= dct'entry'limit -1             <<07181>>47100000
            do                                                 <<06932>>47105000
            begin                                              <<06932>>47110000
               devicecount := (if numdevices <10               <<07181>>47115000
                   then numdevices  else 10);                  <<07181>>47120000
               if numdevices >=10 then                         <<06932>>47125000
                    numdevices := numdevices - 10;             <<06932>>47130000
               movefromdseg(@ldevarray,dct'dst,dct'offset,     <<07181>>47135000
                  devicecount);                                <<07181>>47140000
               count := 0;                                     <<07181>>47145000
               do begin  << processing ldevs >>                <<06932>>47150000
                  exchangedb (ldt'dst);                        <<07181>>47155000
                  classldev := ldevarray(count); <<ldev #>>    <<06932>>47160000
                  processrealdev(classldev);                   <<06932>>47165000
                  count := count + 1;                          <<06932>>47170000
                  end                                          <<06932>>47175000
               until (((dct'offset := dct'offset+1) >=         <<07181>>47180000
                    dct'entry'limit) lor  (count >= 10));      <<07181>>47185000
               exchangedb (0); << go back for more ldevs >>    <<07181>>47190000
            end;  << while loop >>                             <<06932>>47195000
            end;  << class scan >>                             <<06932>>47200000
         end;    <<class request>>                                      47205000
      end;    <<parm processing>>                                       47210000
                                                                        47215000
leave:                                                                  47220000
   end;    <<showdev>>                                                  47225000
$page "CONSSHOWDEV"                                            <<04801>>47230000
$control segment=oplow                                         <<04801>>47235000
                                                                        47240000
<< note:  procedure consshowdev was  moved  unchanged  from >> <<04801>>47245000
<< spoolcoms to opcommand as part of this enhancement.  its >> <<04801>>47250000
<< fix number(s) were not changed.                          >> <<04801>>47255000
                                                                        47260000
logical procedure consshowdev (parmstring);                             47265000
   byte array parmstring;                                               47270000
   option privileged, uncallable;                                       47275000
begin                                                                   47280000
   integer pn;                                                          47285000
                                                                        47290000
   consshowdev := (showdev (parmstring, pn, true) = 0);                 47295000
   end;    <<consshowdev>>                                              47300000
$page "CXSHOWDEV"                                              <<04801>>47305000
$control segment=ophi                                          <<04801>>47310000
                                                                        47315000
<< note:  procedure  cxshowdev  was  moved  unchanged  from >> <<04801>>47320000
<< spoolcoms to opcommand as part of this enhancement.  its >> <<04801>>47325000
<< fix number(s) were not changed.                          >> <<04801>>47330000
                                                                        47335000
procedure cxshowdev (parmsp, errnum, parmnum);                          47340000
   byte array parmsp;                                                   47345000
   integer errnum, parmnum;                                             47350000
   option privileged, uncallable;                                       47355000
begin                                                                   47360000
   errnum := showdev (parmsp, parmnum, false);                          47365000
   end;    << cxshowdev >>                                              47370000
$page "   ***   =ABORTJOB   ***"                               <<04801>>47375000
$control segment=ophi                                          <<04801>>47380000
                                                                        47385000
<< note:  procedure  deletejob  was  moved  unchanged  from >> <<04801>>47390000
<< spoolcoms to opcommand as part of this enhancement.  its >> <<04801>>47395000
<< fix number(s) were not changed.                          >> <<04801>>47400000
                                                                        47405000
logical procedure deletejob (jmatp);                           <<06607>>47410000
   value jmatp;                                                <<06607>>47415000
   integer pointer jmatp;                                      <<06607>>47420000
   option privileged, uncallable;                                       47425000
begin                                                                   47430000
   comment                                                     <<06607>>47435000
      this procedure deletes a job.  it either aborts the job  <<06607>>47440000
      (if it isn't waiting) or simply removes its jmat entry   <<06607>>47445000
      if it is waiting.                                        <<06607>>47450000
      *********************************************************<<06607>>47455000
                  *********  parameter **************          <<06607>>47460000
      jmatp  --  a pointer to the jmat entry to be deleted.    <<06607>>47465000
      *********************************************************<<06607>>47470000
                                                               <<06607>>47475000
      note:  deletejob expects to be called in split stack     <<06607>>47480000
             mode.  db must point to the jmat dst!!            <<06607>>47485000
                                                               <<06607>>47490000
;                                                              <<06607>>47495000
   integer           state;                                             47500000
   << ...................................................... >><<06607>>47505000
   <<        declarations for referencing the jmat           >><<06607>>47510000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>47515000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>47520000
   <<               a specific entry), after an exchange db. >><<06607>>47525000
   <<               or 0 if jmatarr is a local array.        >><<06607>>47530000
   << ...................................................... >><<06607>>47535000
                                                               <<06607>>47540000
   integer array jmatarr(*)=db+0;                              <<06607>>47545000
   integer       jmatinx := 0;<< index into jmatarr >>         <<06607>>47550000
                                                               <<06607>>47555000
   logical                                                     << 8204>>47560000
      returnval,                                               << 8204>>47565000
      failval := 0;       << flags reason for failing.     >>  << 8204>>47570000
                                                                        47575000
                                                               << 8204>>47580000
<< this fix is for scheduled jobs.  this fix               >>  << 8944>>47585000
<< has modified the return value of these procedures.  the >>  << 8204>>47590000
<< lower eight bits is a logical value that is true if the >>  << 8204>>47595000
<< indicated job is aborted and false if an error was      >>  << 8204>>47600000
<< detected.  the high order eight bits indicate what kind >>  << 8204>>47605000
<< of error was detected if the lower eight bits are       >>  << 8204>>47610000
<< false (the high order eight bits are undefined if the   >>  << 8204>>47615000
<< low order eight bits are true).  the failval have the   >>  << 8204>>47620000
<< following meanings:                                     >>  << 8204>>47625000
<<     0:  the indicated job was in intro state.           >>  << 8204>>47630000
                                                               << 8204>>47635000
   << to reference the jmat via jmatarr (i.e. the include   >> <<06607>>47640000
   << file) it is necessary to have jmatinx as the index    >> <<06607>>47645000
   << into the jmat dst.  therefore, to reference the input >> <<06607>>47650000
   << entry, we must have jmatinx be equivalent to jmatp.   >> <<06607>>47655000
                                                               <<06607>>47660000
   jmatinx := integer(@jmatp);                                 <<06607>>47665000
   state := jmatjobstate;                                      <<06607>>47670000
   if  (jmatp <> 0)  and  (state <> jobintro)  then            <<06607>>47675000
      begin   << wait, init, exec, susp, sched, or term >>     << 8944>>47680000
         if    (  (state=jobciinit)     lor                    << 8204>>47685000
                  (state=jobexec)       lor                    << 8204>>47690000
                  (state=jobsusp)            ) then            << 8204>>47695000
         begin                                                 << 8204>>47700000
         abortjob (jmatmainpin);                               <<06607>>47705000
         if < then suddendeath (371);                                   47710000
         end                                                            47715000
      else                                                              47720000
         if (state = jobwait) then                                      47725000
            begin    <<remove jmat entry & release $stdin file>>        47730000
            << delink'jmat expects an integer index       >>   <<06607>>47735000
            delink'jmat (@jmatp);  << remove the entry from q>><<06607>>47740000
            << push parameter to deletedevfile >>              <<06607>>47745000
            tos := jmatarr(jmatinx+jmatjsnooff);               <<06607>>47750000
            deallocate'jmat (jmatp);                           <<06607>>47755000
            deletedevfile (s0, true);                                   47760000
            del;                                                        47765000
            end                                                         47770000
                                                               << 8204>>47775000
         else if (state = jobsched) then                       << 8204>>47780000
         begin                                                 << 8204>>47785000
                                                               << 8204>>47790000
         << delete the job from the scheduled jobs queue.  >>  << 8204>>47795000
            delinksched( @jmatp );  << expects an index.   >>  << 8204>>47800000
            tos := jmatarr( jmatinx + jmatjsnooff );           << 8204>>47805000
            deallocate'jmat( jmatp );                          << 8204>>47810000
            deletedevfile( s0, true );                         << 8204>>47815000
            del;                                               << 8204>>47820000
                                                               << 8204>>47825000
         end;                                                  << 8204>>47830000
                                                               << 8204>>47835000
         << else done, which is finishing by itself >> ;                47840000
      tos := true;                                                      47845000
      end                                                               47850000
   else                                                                 47855000
      tos := false;                                                     47860000
   returnval := tos;                                           << 8204>>47865000
                                                               << 8204>>47870000
outl:                                                          << 8204>>47875000
   if not returnval                                            << 8204>>47880000
      then returnval.(0:8) := failval;                         << 8204>>47885000
   deletejob := returnval;                                     << 8204>>47890000
   end;    <<deletejob>>                                                47895000
$page "Disc Caching Commands"                                  <<06928>>47900000
procedure cxstartcache executorhead;                           <<06928>>47905000
begin                                                          <<06928>>47910000
                                                               <<06928>>47915000
<<*********************************************************>>  <<06928>>47920000
<<                                                         >>  <<06928>>47925000
<< this is the command executors for the two disc caching  >>  <<06928>>47930000
<< commands, startcache and stopcache.  while most of the  >>  <<06928>>47935000
<< body of these commands' execution is encapsulated in    >>  <<06928>>47940000
<< other procedures, this executor is responsibile for the >>  <<06928>>47945000
<< checking of the command syntax, the checking of the     >>  <<06928>>47950000
<< user's right to execute the command, and the printing   >>  <<06928>>47955000
<< of all associated messages.  the syntax for these       >>  <<06928>>47960000
<< commands are the same--they are of the form:            >>  <<06928>>47965000
<<                                                         >>  <<06928>>47970000
<<      :startcache <ldev>   and   :stopcache <ldev>       >>  <<06928>>47975000
<<                                                         >>  <<06928>>47980000
<<*********************************************************>>  <<06928>>47985000
                                                               <<06928>>47990000
                                                               <<06928>>47995000
entry                                                          <<06928>>48000000
   cxstopcache;      << this executor handles both.        >>  <<06928>>48005000
                                                               <<06928>>48010000
                                                               <<06928>>48015000
<< the following are the possible disc caching status vals.>>  <<06928>>48020000
   equate                                                      <<06928>>48025000
      stat'ok                 = 0,                             <<06928>>48030000
      stat'no'dst             = 1,                             <<06928>>48035000
      stat'int'error          = 2,                             <<06928>>48040000
      stat'ldev'cached        = 3,                             <<06928>>48045000
      stat'cdt'overflow       = 4,                             <<06928>>48050000
      stat'dev'not'cachable   = 5,                             <<06928>>48055000
      stat'sys'not'cachable   = 6,                             <<06928>>48060000
      stat'ldev'not'cached    = 3,                             <<06928>>48065000
      stat'cache'not'enabled  = 1;                             <<06928>>48070000
                                                               <<06928>>48075000
                                                               <<06928>>48080000
                                                               <<06928>>48085000
double                                                         <<06928>>48090000
   dl:=[8/",",8/";",8/cr,8/0]d;  << mycommand delimiters.  >>  <<06928>>48095000
byte array dl'(*) = dl;                                        <<06928>>48100000
                                                               <<06928>>48105000
double array                                                   <<06928>>48110000
   parm(0:1) = q;   << mycommand parameter descriptors.    >>  <<06928>>48115000
byte pointer                                                   <<06928>>48120000
   firstparm = parm,                                           <<06928>>48125000
   sndparm   = parm+2;                                         <<06928>>48130000
                                                               <<06928>>48135000
byte                                                           <<06928>>48140000
   firstlen = parm+1;  << length of the first parameter.   >>  <<06928>>48145000
                                                               <<06928>>48150000
integer                                                        <<06928>>48155000
   stat,               << status of execution try.         >>  <<06928>>48160000
   numparms;                                                   <<06928>>48165000
                                                               <<06928>>48170000
logical                                                        <<06928>>48175000
   ldev,               << <ldev> to be cached.             >>  <<06928>>48180000
   start := true;      << flags whether to start or stop.  >>  <<06928>>48185000
                                                               <<06928>>48190000
                                                               <<06928>>48195000
                                                               <<06928>>48200000
<< start of main code for cxstartcache and cxstopcache.    >>  <<06928>>48205000
                                                               <<06928>>48210000
<< cxstartcache starts here...                             >>  <<06928>>48215000
   go to maincode;                                             <<06928>>48220000
                                                               <<06928>>48225000
<< cxstopcache starts here...                              >>  <<06928>>48230000
cxstopcache:                                                   <<06928>>48235000
   start := false;                                             <<06928>>48240000
                                                               <<06928>>48245000
                                                               <<06928>>48250000
maincode:                                                      <<06928>>48255000
                                                               <<06928>>48260000
<< syntax check--see if only one parm is provided.         >>  <<06928>>48265000
   mycommand(parmsp,dl',2,numparms,parm);                      <<06928>>48270000
   if numparms <> 1 then                                       <<06928>>48275000
   begin                                                       <<06928>>48280000
      tos := errnum := if start                                <<06928>>48285000
                          then startcachereq1p                 <<06928>>48290000
                          else stopcachereq1p;                 <<06928>>48295000
      parmnum := if numparms <1 then 1 else 2;                 <<06928>>48300000
      tos := if parmnum = 1 then @parmsp else @sndparm;        <<06928>>48305000
      cierr(*,*);                                              <<06928>>48310000
   end                                                         <<06928>>48315000
   else                                                        <<06928>>48320000
   begin                                                       <<06928>>48325000
                                                               <<06928>>48330000
   << only one parm provided.  check to see if it is a     >>  <<06928>>48335000
   << real logical device, and make sure that the user has >>  <<06928>>48340000
   << access to this command.                              >>  <<06928>>48345000
      ldev :=                                                  <<06928>>48350000
         verify'rldev(firstparm,firstlen,errnum,parmnum,1);    <<06928>>48355000
      if < then return;       << bad device specification. >>  <<06928>>48360000
$page "CONSABORTJOB"                                           <<04801>>48365000
      << user has access to this command.  perform the     >>  <<06928>>48370000
      << indicated operation.                              >>  <<06928>>48375000
         if start then                                         <<06928>>48380000
         begin                                                 <<06928>>48385000
                                                               <<06928>>48390000
         << this is the startcache operation.              >>  <<06928>>48395000
            cache'ldev( ldev, stat );                          <<06928>>48400000
                                                               <<06928>>48405000
         end                                                   <<06928>>48410000
         else                                                  <<06928>>48415000
         begin                                                 <<06928>>48420000
                                                               <<06928>>48425000
         << this is the stopcache operation.               >>  <<06928>>48430000
            uncache'ldev( ldev, stat );                        <<06928>>48435000
                                                               <<06928>>48440000
         end;                                                  <<06928>>48445000
                                                               <<06928>>48450000
      << report to the user the status of the operation.   >>  <<06928>>48455000
         parmnum := 1;                                         <<06928>>48460000
         if stat = stat'ok then                                <<06928>>48465000
         begin                                                 <<06928>>48470000
            genmsg( cigeneralmsgset,                           <<06928>>48475000
                    ( if start                                 <<06928>>48480000
                         then startcacheok                     <<06928>>48485000
                         else stopcacheok   ), %10000, ldev  );<<06928>>48490000
         end                                                   <<06928>>48495000
         else if stat = stat'no'dst and start                  <<06928>>48500000
              then cierr( errnum := nocachedst )               <<06928>>48505000
         else if stat = stat'int'error                         <<06928>>48510000
              then cierr( errnum := cacheinternalerr )         <<06928>>48515000
         else if stat = stat'ldev'cached and start             <<06928>>48520000
              then cierr( errnum := ldevalreadycached )        <<06928>>48525000
         else if stat = stat'cdt'overflow                      <<06928>>48530000
              then cierr( errnum := toomanydisccachereq )      <<06928>>48535000
         else if stat = stat'dev'not'cachable                  <<06928>>48540000
              then cierr( errnum := devnotcachable )           <<06928>>48545000
         else if stat = stat'sys'not'cachable                  <<06928>>48550000
              then cierr( errnum := sysnotcachable )           <<06928>>48555000
         else if stat = stat'cache'not'enabled                 <<06928>>48560000
              then cierr( errnum := cachenotenabled )          <<06928>>48565000
         else if stat = stat'ldev'not'cached                   <<06928>>48570000
              then cierr( errnum := ldevnotcached );           <<06928>>48575000
                                                               <<06928>>48580000
                                                               <<06928>>48585000
   end;  << syntax checking. >>                                <<06928>>48590000
                                                               <<06928>>48595000
end;  << cxstartcache,  cxstopcache  >>                        <<06928>>48600000
procedure cxshowcache executorhead;                            <<06928>>48605000
option privileged, uncallable;                                 <<06928>>48610000
begin                                                          <<06928>>48615000
                                                               <<06928>>48620000
  <<                                            >>             <<06928>>48625000
  << the syntax for this command is:            >>             <<06928>>48630000
  <<                                            >>             <<06928>>48635000
  << :showcache                                 >>             <<06928>>48640000
  <<                                            >>             <<06928>>48645000
                                                               <<06928>>48650000
  byte pointer addr;                                           <<06928>>48655000
  integer stat;                                                <<06928>>48660000
                                                               <<06928>>48665000
  errnum := 0;                                                 <<06928>>48670000
  scan parmsp while [8/cr,8/" "],1; << check for extra parms >><<06928>>48675000
  if nocarry then                                              <<06928>>48680000
  begin                                                        <<06928>>48685000
    @addr := tos;                                              <<06928>>48690000
    cierr(errnum := -warnxparmsignored,addr);                  <<06928>>48695000
  end                                                          <<06928>>48700000
  else del;                                                    <<06928>>48705000
                                                               <<06928>>48710000
  cdt'display'ldevs(false,stat);                               <<06928>>48715000
  if stat <> 0                                                 <<06928>>48720000
     then cierr(errnum := nocache'onsystem);                   <<06928>>48725000
                                                               <<06928>>48730000
end;  << cxshowcashe >>                                        <<06928>>48735000
$control segment=oplow                                         <<04801>>48740000
                                                                        48745000
<< note:  procedure consabortjob was moved  unchanged  from >> <<04801>>48750000
<< spoolcoms to opcommand as part of this enhancement.  its >> <<04801>>48755000
<< fix number(s) were not changed.                          >> <<04801>>48760000
                                                                        48765000
logical procedure consabortjob (parmstring);                            48770000
   byte array parmstring;                                               48775000
   option privileged, uncallable;                                       48780000
begin                                                                   48785000
   byte pointer      pp;               <<parm>>                         48790000
   integer           plen;                                              48795000
   integer           savesir;                                           48800000
   << ...................................................... >><<06607>>48805000
   <<        declarations for referencing the jmat           >><<06607>>48810000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>48815000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>48820000
   <<               a specific entry), after an exchange db. >><<06607>>48825000
   <<               or 0 if jmatarr is a local array.        >><<06607>>48830000
   << ...................................................... >><<06607>>48835000
                                                               <<06607>>48840000
   integer           jmatinx;          << index into jmat >>   <<06607>>48845000
   integer array     jmatarr(*)=db+0;<< jmat array  >>         <<06607>>48850000
   integer           limit; << end of the jmat >>              <<06607>>48855000
                                                                        48860000
<< >>                                                                   48865000
   consabortjob := false;                                               48870000
   scan parmstring while %6440, 1;                                      48875000
   if  nocarry  and  (bps0 = "#")  then                                 48880000
      begin                                                             48885000
      @pp := s0;                                                        48890000
      scan * until %6440, 1;                                            48895000
      if nocarry then                                                   48900000
         begin                                                          48905000
         scan bps0 while %6440;                                         48910000
         if nocarry then return;                                        48915000
         end;                                                           48920000
      if (plen := tos -@pp) > 2 then                                    48925000
         begin                                                          48930000
         tos := binary (pp(2), plen-2);                                 48935000
         if  =  and  (s0.(0:2) = 0)  then                               48940000
            begin                                                       48945000
            move pp(1) := pp(1) while as;                      <<04801>>48950000
            if pp(1) = "J" then tos.(0:2) := 2                          48955000
            else                                                        48960000
               if pp(1) = "S" then tos.(0:2) := 1                       48965000
               else return;                                             48970000
            exchangedb (jmatdst);                                       48975000
            savesir := getsir (jmatsir);                                48980000
            jmatinx := jmatentryptr; << index to first ent. >> <<06607>>48985000
            limit :=   jmatcursize * tblquantum                <<06607>>48990000
                       - jmatentrysize;                        <<06607>>48995000
            do                                                          49000000
            until (jmatarr(jmatinx) <> 0) and                  <<06607>>49005000
                  (jmatarr(jmatinx+jmatjsnooff) = s0)          <<06607>>49010000
                  or (jmatinx := jmatinx + jmatentrysize)      <<06607>>49015000
                                         > limit;              <<06607>>49020000
            if = then                                                   49025000
               consabortjob := deletejob (jmatinx);            <<06607>>49030000
            relsir (jmatsir, savesir);                                  49035000
            exchangedb (0);                                             49040000
            end;                                                        49045000
         end;                                                           49050000
      end;                                                              49055000
   end;    <<consabortjob>>                                             49060000
$page "   ***   DAYTIME   ***"                                 <<04801>>49065000
$control segment=ophi                                          <<04801>>49070000
                                                                        49075000
<< note:  procedure daytime was moved unchanged from spool- >> <<04801>>49080000
<< coms to opcommand as part of this enhancement.  its  fix >> <<04801>>49085000
<< number(s) were not changed.                              >> <<04801>>49090000
                                                                        49095000
procedure daytime (string, timestamp);                                  49100000
   value timestamp;                                                     49105000
   byte array string;                                                   49110000
   double timestamp;                                                    49115000
   option uncallable;                                                   49120000
<< prints day of week and time.                                         49125000
   format:   "MON 11:53A"   (10 bytes) >>                               49130000
begin                                                                   49135000
   byte array days (*) = pb :=                                          49140000
      "SUNMONTUEWEDTHUFRISAT";                                          49145000
   integer                                                              49150000
      date  = q+1,                                                      49155000
      time  = q+2,                                                      49160000
      year  = q+3,                                                      49165000
      day   = q+4,                                                      49170000
      x     = x;                                                        49175000
   equate                                                               49180000
      noon  = 12 *256;                                                  49185000
                                                                        49190000
subroutine convert (n, pos);                                            49195000
   value n, pos;                                                        49200000
   integer n, pos;                                                      49205000
<< convert n to 2-digit ascii at string (pos) >>                        49210000
begin                                                                   49215000
   x := pos;                                                            49220000
   tos := n;                                                            49225000
   tos := 10;                                                           49230000
   assemble (div, xch);                                                 49235000
   string (x) := tos +"0";                                              49240000
   x := x+1;                                                            49245000
   string (x) := tos +"0";                                              49250000
   end;    <<convert>>                                                  49255000
                                                                        49260000
   tos := timestamp;                                                    49265000
   tos := date.(0:7);                                                   49270000
   tos := date.(7:9);                                                   49275000
   x := ((year-1) &asr(2) +year +day) mod 7 *3;                         49280000
   move string := "      :  A";                                         49285000
   move string := days (x), (3);                                        49290000
   tos := (time.(0:8) +11) mod 12 +1;                                   49295000
   convert (*, 4);                                                      49300000
   if string (4) = "0" then string (4) := " ";                          49305000
   convert (time.(8:8), 7);                                             49310000
   if time >= noon then string (9) := "P";                              49315000
   end;    <<daytime>>                                                  49320000
$page "   ***   SHOWJOB   ***"                                 <<04801>>49325000
$control segment=ophi                                          <<04801>>49330000
                                                                        49335000
<< note:  procedure showjob was moved unchanged from spool- >> <<04801>>49340000
<< coms to opcommand as part of this enhancement.  its  fix >> <<04801>>49345000
<< number(s) were not changed.                              >> <<04801>>49350000
                                                                        49355000
integer procedure showjob (parmsp, parmnum, console);          <<04801>>49360000
   value console;                                              <<04801>>49365000
   logical console;  <<true => called from console>>           <<04801>>49370000
   byte array parmsp;                                                   49375000
   integer parmnum;                                                     49380000
   option privileged, uncallable;                                       49385000
<< procedure which actually performs :(=)showjob.  <parmsp> contains    49390000
   parameter image.  type return is 0 (okay) or ci error number         49395000
   (in which case <parmnum> is erring parm number).  produces           49400000
   showjob listing on $stdlist, using print.  >>                        49405000
begin                                                                   49410000
                                                                        49415000
<< internal representations of job states >>                            49420000
<< these are used for indexes to stcounts; jexec used to     >><<04801>>49425000
<< tally number of jobs in jobexec and jobinit states        >><<04801>>49430000
   equate            nostate  = -1,    <<no specification>>             49435000
                     jintro  = 0,      << introduced >>        <<04801>>49440000
                     jwait   = 1,      << wait       >>        <<04801>>49445000
                     jexec  = 2,       <<includes init.&term.>><<04801>>49450000
                     jterm  = 3, << terminating >>             <<04959>>49455000
                     jsched = 5,  << scheduled. >>             << 8204>>49460000
                     jsusp  = 4;       <<suspended>>                    49465000
                                                                        49470000
<< for parameter parse >>                                               49475000
   equate            maxparms  = 6;                                     49480000
                                                                        49485000
   integer           numparms;                                          49490000
   double array      parms (1:maxparms);                                49495000
   byte pointer      pp;                                                49500000
   byte              plen;                                              49505000
   integer           pdelwd = plen;                                     49510000
   double            parm = pp;                                         49515000
   equate            comma = 0,                                         49520000
                     equal = 1,                                         49525000
                     semi = 2,                                          49530000
                     cr = 3;                                            49535000
   integer           pnum := 0;                                         49540000
   define                                                               49545000
      pspecial          = logical (pdelwd.(10:1))  #,                   49550000
      pdel              = pdelwd.(11:5)  #;                             49555000
                                                                        49560000
   double            x1  := ",=;.";    <<delimiters>>                   49565000
   integer           x2  := %6400;     <<(must follow <x1>.>>           49570000
   byte array        dels (*)  = x1;                                    49575000
   equate            period  = cr,     <<period is add'l delim, ...>>   49580000
                     cr'  = cr +1;     <<... replacing cr>>             49585000
   byte array        keywordsp (*) = pb  :=                             49590000
   << entries contain name, processor index [,and state value] >>       49595000
                        6, 3, "JOB", 1,                                 49600000
                        9, 5, "INTRO", 2, jintro,                       49605000
                        8, 4, "WAIT", 2, jwait,                         49610000
                        8, 4, "EXEC", 2, jexec,                         49615000
                        8, 4, "SUSP", 2, jsusp,                         49620000
                        9, 5, "SCHED", 2, jsched,              <<*8944>>49625000
                        9, 6, "STATUS", 3,                              49630000
                        0;                                              49635000
   equate            keywordslen = (58 + 1)/2;  << in words >> <<*8944>>49640000
   array             keywordspw (*)  = keywordsp,                       49645000
                     keywordsw (0:keywordslen-1) = q;                   49650000
   byte array        keywords (*)  = keywordsw;                         49655000
   byte pointer      keydefn;                                           49660000
                                                                        49665000
<< parameters controlling scan (parse phase "OUTPUT") >>                49670000
   << initialized for null parameter case (all) >>                      49675000
   equate            forjobnum  = 0,   <<command option>>               49680000
                     qualified  = 1,                                    49685000
                     status  = 2;                                       49690000
   integer           optiontype  := qualified,                          49695000
                     jobnum  := 0,     <<specified jobnum, or 0>>       49700000
                     jtype  := 0,      <<"@J", or "@S", or 0>>          49705000
                     state  := nostate;<<specified state>>              49710000
   equate            nodefr  = 2;      <<,n/,d not supplied>>           49715000
   integer           idefr  := nodefr; <<deferredness>>                 49720000
   logical           defr  = idefr;    <<true => deferred>>             49725000
   << names supplied for qualified scan  (nlen <> 0)  >>                49730000
   integer array     inames (0:11) = q;                                 49735000
   byte array        names (*)  = inames,                               49740000
                     jn (*)  = names (16),                              49745000
                     un (*)  = names (0),                               49750000
                     an (*)  = names (8);                               49755000
   integer           nlen  := 0,       <<compare len (bytes)>>          49760000
                     len   := 0,                               << 8204>>49765000
                     nstart  := 0;     <<compare start pos>>   <<04801>>49770000
   logical           sched := false;                           <<*8944>>49775000
                                                                        49780000
<< scan/print phase -- extra data seg variables >>             <<04801>>49785000
   integer           dstnum  := 0,     <<0 => not acquired>>   <<04801>>49790000
                     dstlength,                                <<04801>>49795000
                     errnum := 0;      <<dst err?>>            <<04801>>49800000
                                                               <<04801>>49805000
<< misc variables for scan phase >>                                     49810000
   integer           savesir,          <<getsir result>>                49815000
                     rank  := 0;       <<wait rank accumulator>>        49820000
   integer array     entryp(0:jmatentrysize-1); <<work buf>>   <<04801>>49825000
                                                               <<06607>>49830000
   << ...................................................... >><<06607>>49835000
   <<        declarations for referencing the jmat           >><<06607>>49840000
   <<    jmatarr -- is an array pointing to the jmat entry(s)>><<06607>>49845000
   <<    jmatinx -- is the index into the array (assumedly to>><<06607>>49850000
   <<               a specific entry), after an exchange db. >><<06607>>49855000
   <<               or 0 if jmatarr is a local array.        >><<06607>>49860000
   << ...................................................... >><<06607>>49865000
                                                               <<06607>>49870000
   integer       jmatinx;                                      <<06607>>49875000
   integer array     jmatarr(*);<< used to reference jmat >>   <<06607>>49880000
   define  jobhipri = 15#;<< high priority for a job >>        <<06607>>49885000
   << the following integers are offsets into the jmat dst >>  <<06607>>49890000
   << (showjob's own) pointing to various entries.         >>  <<06607>>49895000
   integer           limit,           << end of jmat  >>       <<06607>>49900000
                     frstentry,     << first jmat entry  >>    <<06607>>49905000
                     schedhead,      << jmat sched. head >>    <<06607>>49910000
                     schedjobshead,   <<index of sched jobs>>  << 8204>>49915000
                     curentry; << current entry  >>            <<06607>>49920000
   equate            maxjsno  =  16383; << biggest j/s number>><<06607>>49925000
   logical           stop := false;    <<stops parsing>>       <<04801>>49930000
   integer           errormax := 5;    <<also stops parsing>>  <<04801>>49935000
   integer errorcount := 0;                                    <<04801>>49940000
   logical jobflag := false;  <<job parm seen>>                <<04801>>49945000
                                                                        49950000
<< misc variables for entry "VISIT"  (temp file write) >>      <<06607>>49955000
   integer           entrystate,       <<current entry's state>>        49960000
                     savestate,        <<save true state value>>        49965000
                     saverank;         <<save overwritten wd>>          49970000
   byte array        jmat'workarea'b (*)  = jmatworkarea;      <<06607>>49975000
                                                                        49980000
<< accumulating summary variables >>                                    49985000
   integer           total  := 0,      <<total visits>>                 49990000
                     sescount  := 0,   <<num exec sessions>>            49995000
                     waitdefcount  := 0; <<num wait deferred>>          50000000
   integer array     stcounts (0:5) = q; <<num per state>>     << 8204>>50005000
   integer           jobfence,                                          50010000
                     jlimit,                                            50015000
                     slimit;                                            50020000
                                                                        50025000
<< variables for print phase >>                                         50030000
   equate            obufmax  = 39;  << obuf length. >>        << 8204>>50035000
   integer array     obuf (0:obufmax); <<output buffer>>                50040000
   byte array        obufb (*)  = obuf;                                 50045000
   integer array     ebuf (0:jmatentrysize-1); <<entry buf>>            50050000
   byte array        ebufb(*) = ebuf;                                   50055000
   logical array     ebufl (*)  = ebuf;                                 50060000
   logical           jlistspooled  := false;  <<jlist spooled?>>        50065000
   define            header =                                           50070000
"JOBNUM  STATE IPRI JIN  JLIST    INTRODUCED  JOB NAME "  #;            50075000
   equate            headerlen  = -53;                                  50080000
   equate            posjnum  = 0,     <<field positions>>              50085000
                     posstate  = posjnum +8,                            50090000
                     posrank  = posstate +4,                            50095000
                     posinpri  = posstate +9,                           50100000
                     posjin  = posinpri +4,                             50105000
                     possr  = posjin +1,                                50110000
                     posjlist  = posjin +3,                             50115000
                     postime  = posjlist +9,                            50120000
                     posjname  = postime +12;                           50125000
                                                               <<*8944>>50130000
<< the following definitions are used for the display of   >>  <<*8944>>50135000
<< scheduled jobs.  unlike the regular header, the header  >>  <<*8944>>50140000
<< for scheduled jobs is read from the catalog.  note that >>  <<*8944>>50145000
<< the sposxxx variables are absolute column positions for >>  <<*8944>>50150000
<< the starts of the associated fields.  those fields that >>  <<*8944>>50155000
<< contain numbers are right justified.                    >>  <<*8944>>50160000
   equate                                                      << 8204>>50165000
      sposjnum     = 0,                                        << 8204>>50170000
      sposstate    = 8,                                        << 8204>>50175000
      sposrank     = 12,                                       <<*8944>>50180000
      sposinpri    = 17,                                       << 8204>>50185000
      sposjin      = 21,                                       << 8204>>50190000
      spossr       = 22,                                       << 8204>>50195000
      sposjlist    = 24,                                       << 8204>>50200000
      spostime     = 33,                                       <<*8944>>50205000
      sposjname    = 52;                                       <<*8944>>50210000
                                                               << 8204>>50215000
   integer array                                               << 8204>>50220000
      temptime(0:2);    << for the scheddaytime call.      >>  << 8204>>50225000
                                                               << 8204>>50230000
   double                                                      << 8204>>50235000
      tempclock;                                               << 8204>>50240000
                                                               << 8204>>50245000
   integer                                                     << 8204>>50250000
      tempclock'0 = tempclock+0,                               << 8204>>50255000
      tempclock'1 = tempclock+1;                               << 8204>>50260000
                                                               << 8204>>50265000
   integer lpdt'index; << indexes lpdt/incllpdt >>             <<06221>>50270000
comment                                                        <<04801>>50275000
   this define is no longer needed.  it was originally         <<04801>>50280000
installed to prevent requestservice from being called when the <<04801>>50285000
showjob command was entered at the console using <control-a>.  <<04801>>50290000
(if showjob is ever put back into the console interface, the   <<04801>>50295000
define can be reactivated by deleting these lines.)            <<04801>>50300000
<< temporary >>                                                <<06607>>50305000
   define            requestservice  = false #;                         50310000
                                                                        50315000
                                                                        50320000
                                                                        50325000
   integer fnum         := 2,                                  <<04801>>50330000
           closeoptions := 0,                                  <<04801>>50335000
           foptions;                                           <<04801>>50340000
   logical listfile := false;                                  <<04801>>50345000
   array datebuf(0:13);                                        <<04801>>50350000
   equate temp     = 2,                                        <<06607>>50355000
          delete   = 4,                                        <<04801>>50360000
          asbefore = 0,                                        <<04801>>50365000
          new      = 0;                                        <<04801>>50370000
   define domain    = (14:2)#,                                 <<04801>>50375000
          not'stdlist = foptions.(10:3) <> 1 #;                <<04801>>50380000
                                                               << 8204>>50385000
intrinsic                                                      << 8204>>50390000
   dateline, clock, calendar;                                  << 8204>>50395000
                                                               << 8204>>50400000
<< subroutines for parameter parsing >>                                 50405000
                                                                        50410000
                                                                        50415000
subroutine error (errn);                                                50420000
   value errn;                                                          50425000
   integer errn;                                                        50430000
begin                                                          <<04801>>50435000
   cierr(errn,pp);                                             <<04801>>50440000
   if errn>0 then   <<serious error>>                          <<04801>>50445000
      begin  <<must keep track of number of serious errors>>   <<04801>>50450000
      showjob := errn;                                         <<04801>>50455000
      parmnum := pnum + parmnum;                               <<04801>>50460000
      errorcount := errorcount+1;                              <<04801>>50465000
      if errorcount > errormax then   <<too many errors,>>     <<04801>>50470000
         begin   <<stop parsing>>                              <<04801>>50475000
         stop := true;                                         <<04801>>50480000
         cierr(-showj2merrors,pp)                              <<04801>>50485000
         end;                                                  <<04801>>50490000
      end;   <<processing of serious errors>>                  <<04801>>50495000
end;  <<subroutine error>>                                     <<04801>>50500000
subroutine fatalerror;                                         <<04801>>50505000
begin                                                          <<04801>>50510000
   cierr(showjob := errnum);                                   <<04801>>50515000
   assemble( exit 3); << fatal error bail out >>               <<04801>>50520000
end;                                                           <<04801>>50525000
                                                               <<04801>>50530000
subroutine getnext;                                            <<04801>>50535000
begin   <<extracts next parameter>>                            <<04801>>50540000
if pnum+1 = maxparms then  <<need a new set of parms>>         <<04801>>50545000
   begin                                                       <<04801>>50550000
   mycommand(pp,dels,maxparms, numparms, parms(1));            <<04801>>50555000
   pnum := 1;                                                  <<04801>>50560000
   parmnum := parmnum+maxparms-1;                              <<04801>>50565000
   end;                                                        <<04801>>50570000
parm := parms(pnum := pnum+1);                                 <<04801>>50575000
end;                                                           <<04801>>50580000
                                                               <<04801>>50585000
subroutine parsestate;                                         <<04801>>50590000
begin                                                          <<04801>>50595000
   << wait (deferred, nondeferred), intro, susp, exec, sched >><<*8944>>50600000
if (state <> nostate) then                                     <<04801>>50605000
   if integer(keydefn(1)) <> state then <<inconsistent specific<<04801>>50610000
      error(-showjredndstate);          <<of states>>          <<*8944>>50615000
state := keydefn(1);                                           <<04801>>50620000
defr := nodefr;                                                <<04801>>50625000
if pdel = comma then   <<subparameter specified>>              <<04801>>50630000
   begin   <<expecting either n (not deffered) or d (deffered) <<04801>>50635000
   getnext;   <<get subparameter>>                             <<04801>>50640000
   if state<>jwait then  <<only valid for wait spool files    <<u.rao>> 50645000
      begin                                                    <<04801>>50650000
      pnum := pnum-1;  <<back up for reparse>>                 <<04801>>50655000
      error(showjndinap)                                       <<04801>>50660000
      end                                                      <<04801>>50665000
   else if plen=1 and pp="N" then                              <<04801>>50670000
      defr := false                                            <<04801>>50675000
   else if plen=1 and pp="D" then                              <<04801>>50680000
      defr := true                                             <<04801>>50685000
   else   <<unknown type, ignore>>                             <<04801>>50690000
      begin                                                    <<04801>>50695000
      pnum := pnum-1;  <<back up for reparse>>                 <<04801>>50700000
      error(showjunkdefr);                                     <<04801>>50705000
      end                                                      <<04801>>50710000
   end;                                                        <<04801>>50715000
optiontype := qualified;                                       <<04801>>50720000
end;   <<subroutine parsestate>>                               <<04801>>50725000
                                                               <<04801>>50730000
subroutine parsejobid;                                         <<04801>>50735000
begin                                                          <<04801>>50740000
<<assumptions:  job name, if any, already parsed.  jn=0=> "@">><<04801>>50745000
<<current parm is pointing to user name>>                      <<04801>>50750000
if plen = 0 then   <<name apparently missing>>                 <<04801>>50755000
   error(usernamemissing)                                      <<04801>>50760000
else if plen > 8 then                                          <<04801>>50765000
   error(usernametoolong)                                      <<04801>>50770000
else if pspecial and not((pp="@") land (plen=1)) then          <<04801>>50775000
   error(showjxpctun)  <<embedded special characters>>         <<04801>>50780000
else   <<valid user name>>                                     <<04801>>50785000
   begin                                                       <<04801>>50790000
   if pp="@" then  <<user name is all>>                        <<04801>>50795000
      begin                                                    <<04801>>50800000
      un := 0;                                                 <<04801>>50805000
      if jn=alpha then   <<jname,@.acct case>>                 <<04801>>50810000
         begin                                                 <<04801>>50815000
         jn := 0;  <<force job name to all>>                   <<04801>>50820000
         error(userexpectnamenotat);  <<warn of problem>>      <<04801>>50825000
         end;                                                  <<04801>>50830000
      end                                                      <<04801>>50835000
   else if pp <> alpha then  <<expected leading alpha>>        <<04801>>50840000
      begin                                                    <<04801>>50845000
      error(userexpectalpha);                                  <<04801>>50850000
      jn := un := 0;  <<force to all users in account>>        <<04801>>50855000
      end                                                      <<04801>>50860000
   else   <<just plain old user name>>                         <<04801>>50865000
      move un := pp, (plen);                                   <<04801>>50870000
   if pdel <> period then   <<missing delimiter>>              <<04801>>50875000
      error(showjxpctperiod)                                   <<04801>>50880000
   else   <<parse account name>>                               <<04801>>50885000
      begin                                                    <<04801>>50890000
      getnext;   <<get account name>>                          <<04801>>50895000
      if plen=0 then                                           <<04801>>50900000
         error(acctnamemissing)                                <<04801>>50905000
      else if plen > 8 then                                    <<04801>>50910000
         error(acctnametoolong)                                <<04801>>50915000
      else if pp="@" then                                      <<04801>>50920000
         error(acctexpectnamenotat)                            <<04801>>50925000
      else if pp <> alpha then                                 <<04801>>50930000
         error(acctexpectalpha)                                <<04801>>50935000
      else if pspecial then                                    <<04801>>50940000
         error(showjxpctan)                                    <<04801>>50945000
      else   <<evidently a valid account name>>                <<04801>>50950000
         move an := pp, (plen);                                <<04801>>50955000
      end                                                      <<04801>>50960000
   end                                                         <<04801>>50965000
end;   <<subroutine parsejobid>>                               <<04801>>50970000
subroutine parsejob;                                           <<04801>>50975000
<<parse the job= parameter.  nothing unusual.>>                <<04801>>50980000
begin                                                          <<04801>>50985000
if jobflag then  <<redundantly specified>>                     <<04801>>50990000
   error (-showjredundjob);                                    <<04801>>50995000
jobflag := true;  <<have seen a job= parameter>>               <<04801>>51000000
jtype := nlen := 0;  <<init	alize to force all jobs/sessions>> <<04801>>51005000
if pdel <> equal then   <<missing "=" of "JOB=">>              <<04801>>51010000
   begin                                                       <<04801>>51015000
   @pp := @pp+integer(plen); <<point past "JOB">>              <<04801>>51020000
   error(showjxpctjobeq);                                      <<04801>>51025000
   end                                                         <<04801>>51030000
else                                                           <<04801>>51035000
   begin  <<at least have equals sign>>                        <<04801>>51040000
   getnext;   <<find first subparameter>>                      <<04801>>51045000
   if plen = 0 then   <<missing subparameter>>                 <<04801>>51050000
      error(showjxpctjob)                                      <<04801>>51055000
   else   <<parameter exist, parse it>>                        <<04801>>51060000
      begin                                                    <<04801>>51065000
      inames := "  ";  <<initialize name buffers>>             <<04801>>51070000
      move inames(1) := inames,(11);                           <<04801>>51075000
      if pp="@" then   <<many possibilities>>                  <<04801>>51080000
         begin                                                 <<04801>>51085000
         if plen > 1 then   <<suspect @j or @s>>               <<04801>>51090000
            begin                                              <<04801>>51095000
            if pp(1) = "S" then  <<sessions>>                  <<04801>>51100000
               begin                                           <<04801>>51105000
               jtype := sessiontype;                           <<04801>>51110000
               if plen > 2 then                                <<04801>>51115000
                  error(showjxpctats);  <<extraneous>>         <<04801>>51120000
               end                                             <<04801>>51125000
            else if pp(1) = "J" then  <<jobs>>                 <<04801>>51130000
               begin                                           <<04801>>51135000
               jtype := batchtype;                             <<04801>>51140000
               if plen > 2 then  <<extraneous data>>           <<04801>>51145000
                  error(showjxpctatj);                         <<04801>>51150000
               end                                             <<04801>>51155000
            else   <<garbage of some sort>>                    <<04801>>51160000
               error(showjunkatx);                             <<*8944>>51165000
            end                                                <<04801>>51170000
         else if pdel = comma then    <<all job names>>        <<04801>>51175000
            begin                                              <<04801>>51180000
            jn := 0;  <<force to all job names>>               <<04801>>51185000
            getnext;  <<get first part of jobid>>              <<04801>>51190000
            parsejobid;  <<parse rest of job id>>              <<04801>>51195000
            end                                                <<04801>>51200000
         else if pdel = period then  <<just jobid, no name>>   <<04801>>51205000
            parsejobid;                                        <<04801>>51210000
         end   <<"@" case>>                                    <<04801>>51215000
      else   <<not an "@" sign>>                               <<04801>>51220000
         begin   <<guess it is [job name,] job id>>            <<04801>>51225000
         if pdel = comma then                                  <<04801>>51230000
            begin   <<job name present>>                       <<04801>>51235000
            if plen <> 0 then                                  <<04801>>51240000
               if plen > 8 then                                <<04801>>51245000
                  error(showjjname2long)                       <<04801>>51250000
               else if pp <> alpha then                        <<04801>>51255000
                  error(showjjnxpctalph)                       <<04801>>51260000
               else if pspecial then   <<embedded specials>>   <<04801>>51265000
                  error(showjxpctjn)                           <<04801>>51270000
               else  <<probably ok>>                           <<04801>>51275000
                  begin                                        <<04801>>51280000
                  move jn := pp,(plen);                        <<04801>>51285000
                  getnext;                                     <<04801>>51290000
                  parsejobid;                                  <<04801>>51295000
                  end                                          <<04801>>51300000
            end                                                <<04801>>51305000
         else   <<must be plain job id>>                       <<04801>>51310000
            parsejobid;                                        <<04801>>51315000
         end;                                                  <<04801>>51320000
      <<now set job identifier length and compare start>>      <<04801>>51325000
      if an=alpha then   <<account name present>>              <<04801>>51330000
         if un=alpha then  <<user name present>>               <<04801>>51335000
            if jn=alpha then   <<job name present>>            <<04801>>51340000
               nlen := 24    <<24 bytes>>                      <<04801>>51345000
            else   <<no job name, just job id>>                <<04801>>51350000
               nlen := 16                                      <<04801>>51355000
         else   <<no user name>>                               <<04801>>51360000
            begin                                              <<04801>>51365000
            nstart := 8;                                       <<04801>>51370000
            nlen := 8;                                         <<04801>>51375000
            end;                                               <<04801>>51380000
      end;  <<parm exists case>>                               <<04801>>51385000
   end   <<equals sign case>>                                  <<04801>>51390000
end;   <<subroutine parsejob>>                                 <<04801>>51395000
                                                               <<04801>>51400000
                                                                        51405000
subroutine incrcounts;                                                  51410000
<< increments summary counts >>                                         51415000
begin                                                                   51420000
   @jmatarr := @entryp; << reference via jmatarr >>            <<06607>>51425000
   jmatinx := 0;<<  jmatarr(0) points to entry  >>             <<06607>>51430000
   total := total +1;                                                   51435000
   stcounts (entrystate) := stcounts (entrystate) +1;                   51440000
   if (entrystate = jwait)                                              51445000
      and (jmatinpri <= jobfence) then                         <<06607>>51450000
      waitdefcount := waitdefcount +1;                                  51455000
   if (entrystate = jexec)                                              51460000
         and (jmatjstype = sessiontype) then                   <<06607>>51465000
      sescount := sescount +1;                                          51470000
   end;    <<incrcounts>>                                               51475000
                                                                        51480000
                                                                        51485000
subroutine def'movefromdseg;                                   <<04801>>51490000
                                                               <<04801>>51495000
subroutine def'movetodseg;                                     <<04801>>51500000
<< subroutine for print phase >>                               <<04801>>51505000
                                                               <<04801>>51510000
                                                               <<04801>>51515000
subroutine write (len, control);                               <<04801>>51520000
   value len, control;                                         <<04801>>51525000
   integer len, control;                                       <<04801>>51530000
begin                                                          <<04801>>51535000
   if requestservice then goto leave;                          <<04801>>51540000
   fwrite(fnum,obuf,len,control);                              <<04801>>51545000
   if <> then                                                  <<04801>>51550000
      begin                                                    <<04801>>51555000
         ferror'(fnum,errnum);                                 <<04801>>51560000
         go to leave;                                          <<04801>>51565000
      end;                                                     <<04801>>51570000
   end;    <<write>>                                           <<04801>>51575000
subroutine printheader;                                        <<04801>>51580000
begin                                                          <<04801>>51585000
   << print header for showjob -- db must be pointing to stk >><<04801>>51590000
   write (0, 0);                                               <<04801>>51595000
   if sched then                                               << 8204>>51600000
   begin                                                       << 8204>>51605000
      obuf := 0;                                               << 8204>>51610000
      move obuf(1) := obuf, (28);                              << 8204>>51615000
      tempclock := clock;                                      << 8204>>51620000
      temptime(0) := calendar;                                 << 8204>>51625000
      temptime(1) := tempclock'0;                              << 8204>>51630000
      temptime(2) := tempclock'1;                              << 8204>>51635000
      scheddaytime( obufb, temptime );                         << 8204>>51640000
      genmsg( sysgenset, showschedcurrtime, 0, @obufb          << 8204>>51645000
              , , , , , -fnum );                               << 8204>>51650000
      write( 0, 0 );                                           << 8204>>51655000
      genmsg( sysgenset, showschedhead, ,,,,,, -fnum );        << 8204>>51660000
      write( 0, 0 );                                           << 8204>>51665000
   end                                                         << 8204>>51670000
   else                                                        << 8204>>51675000
   begin                                                       << 8204>>51680000
      move obuf := header;                                     << 8204>>51685000
      write (headerlen, %60);                                  << 8204>>51690000
   end;                                                        << 8204>>51695000
end;    <<printheader>>                                        <<04801>>51700000
                                                               <<04801>>51705000
                                                               <<04801>>51710000
subroutine printentry;                                         <<04801>>51715000
begin                                                          <<04801>>51720000
   comment:                                                    <<04801>>51725000
      this routine formats and prints the entry.               <<04801>>51730000
      on entry db must be pointing to stack.                   <<04801>>51735000
   ;                                                           <<04801>>51740000
                                                               <<04801>>51745000
   @jmatarr := @entryp; << reference via jmatarr >>            <<*8944>>51750000
   jmatinx := 0;<<  jmatarr(0) points to entry  >>             <<06607>>51755000
   obuf := "  ";                                               <<04801>>51760000
   move obuf(1) := obuf, (obufmax);                            <<04801>>51765000
   jlistspooled := false;                                      <<04801>>51770000
   if jmatjobstate<>jterm then                                 <<06937>>51775000
   begin                                                       <<06937>>51780000
                                                               <<04801>>51785000
   << job number >>                                            <<04801>>51790000
   obufb (if sched then sposjnum else posjnum) := "#";         << 8204>>51795000
   obufb (if sched then sposjnum+1 else posjnum+1) :=          << 8204>>51800000
         if jmatjstype = batchtype then "J" else "S";          <<06607>>51805000
   ascii ( jmatjsno, 10,                                       << 8204>>51810000
          obufb( if sched then sposjnum+2 else sposjnum+2) );  << 8204>>51815000
                                                               <<04801>>51820000
   << spooled ("S") >>                                         <<04801>>51825000
   if jmatsbit = 1                                             << 8204>>51830000
      then obufb( if sched then spossr else possr )            << 8204>>51835000
              := "S";                                          << 8204>>51840000
                                                               <<04801>>51845000
   << state [,rank] [,inpri] [,quiet] [,restart/spooled] >>    <<04801>>51850000
   if jmatjobstate = jobexec or                                <<06607>>51855000
      jmatjobstate = jobciinit or                              <<06607>>51860000
     jmatjobstate = jobsusp then                               <<06607>>51865000
      begin    << executing >>                                 <<04801>>51870000
      if jmatjobstate = jobsusp then                           <<06607>>51875000
         move obufb(posstate) := "SUSP"                        <<04801>>51880000
      else                                                     <<04801>>51885000
        if jmatjobstate = jobciinit then                       <<06607>>51890000
               move obufb(posstate) :="EXEC*"                  <<04801>>51895000
            else                                               <<04801>>51900000
         move obufb (posstate) := "EXEC";                      <<04801>>51905000
   << if quiet bit set and true state of job is not init. >>   <<04801>>51910000
   << (includes exec., susp., and term.), then say so.    >>   <<04801>>51915000
      if (jmatquietmode=1) and                                 <<*8944>>51920000
         (jmatjobstate <> jobciinit) then                      <<*8944>>51925000
         move obufb (posinpri -4) := "QUIET";                  <<04801>>51930000
      if (jmatrestart=1) then obufb (possr) := "R";            <<06607>>51935000
      jmatjindev := jmatorigjin;                               <<06607>>51940000
      lpdt'index := jmatjlistdev * integer(lpdt'entry'size);   <<06607>>51945000
      if lpdt'virtual'device = 1 then  << virtual device >>    <<06221>>51950000
         begin                                                 <<04801>>51955000
         << virt. list: show original destination >>           <<04801>>51960000
         jlistspooled := true;                                 <<04801>>51965000
         jmatjlistdev := jmatorigjlist                         <<06607>>51970000
         end                                                   <<04801>>51975000
      else                                                     <<04801>>51980000
         << real list: show alloc'd device >>                  <<04801>>51985000
         jmatcbit := false;                                    <<06607>>51990000
      end                                                      <<04801>>51995000
   else if jmatjobstate = jobsched then                        << 8204>>52000000
   begin                                                       << 8204>>52005000
      move obufb( sposstate ) := "SCHED";                      << 8204>>52010000
      ascii( jmatinpri, -10, obufb(sposinpri) );               << 8204>>52015000
   end                                                         << 8204>>52020000
   else                                                        << 8204>>52025000
      begin    << intro or waiting >>                          <<04801>>52030000
      << inpri >>                                              <<04801>>52035000
      if jmatinpri = jobhipri then                             <<06607>>52040000
         move obufb (posinpri-1) := "HI"                       <<04801>>52045000
      else                                                     <<04801>>52050000
         ascii (jmatinpri, -10, obufb (posinpri));             <<06607>>52055000
      if jmatinpri <= jobfence then                            <<06607>>52060000
         obufb (posinpri-2) := "D";                            <<04801>>52065000
      if jmatjobstate = jobwait then                           <<06607>>52070000
         begin    << wait: indicate rank >>                    <<04801>>52075000
         move obufb (posstate) := "WAIT";                      <<04801>>52080000
         if jmatschedlink <> 0 then                            <<06607>>52085000
            begin    << ranked >>                              <<04801>>52090000
            obufb (posrank) := ":";                            <<04801>>52095000
            ascii (jmatschedlink, 10, obufb (posrank+1));      <<06607>>52100000
            end;                                               <<04801>>52105000
         end                                                   <<04801>>52110000
      else                                                     <<04801>>52115000
         move obufb (posstate) := "INTRO";                     <<04801>>52120000
      end;                                                     <<04801>>52125000
                                                               <<04801>>52130000
   << jin >>                                                   <<04801>>52135000
   ascii( jmatjindev, -10,                                     << 8204>>52140000
          obufb( if sched then sposjin else posjin ) );        << 8204>>52145000
                                                               <<04801>>52150000
   << jlist >>                                                 <<04801>>52155000
   tos := 0;                                                   <<04801>>52160000
   tos := jmatjlistdev;                                        <<06607>>52165000
   if (jmatcbit=1) then tos := -tos;                           <<06607>>52170000
   tos := devspec (*,                                          << 8204>>52175000
                   obufb(if sched then sposjlist               << 8204>>52180000
                                  else posjlist  ) );          << 8204>>52185000
   if (jmatcbit=0) and jlistspooled then                       <<06607>>52190000
      << tell user that ldev indicated is spooled >>           <<04801>>52195000
      obufb(s0+(if sched then sposjlist else posjlist)) := "S";<< 8204>>52200000
   del;                                                        <<04801>>52205000
                                                               <<04801>>52210000
   << day & time >>                                            <<04801>>52215000
   move temptime := jmatcalendar, (3);                         << 8204>>52220000
   tos := @jmatcalendar;                                       <<06607>>52225000
   if sched                                                    << 8204>>52230000
      then scheddaytime( obufb( spostime ), temptime )         << 8204>>52235000
      else daytime (obufb (postime), dps0);                    << 8204>>52240000
   del;                                                        <<04801>>52245000
                                                               <<04801>>52250000
   << full job name & print it >>                              <<04801>>52255000
   if jmatjobstate <> jterm then                               <<06607>>52260000
    begin                                                      << 8204>>52265000
       len := formname( 2,                                     << 8204>>52270000
                 obufb(if sched then sposjname else posjname), << 8204>>52275000
                 ebufb(jmatjobnameoff*2),                      << 8204>>52280000
                 ebufb(jmatusernameoff*2),                     << 8204>>52285000
                 ebufb(jmatacctnameoff*2),                     << 8204>>52290000
                 ebufb                       );                << 8204>>52295000
       if sched                                                << 8204>>52300000
          then len := -sposjname - len                         <<*8944>>52305000
          else len := -posjname - len;                         <<*8944>>52310000
       write( len, 0 );                                        << 8204>>52315000
    end;                                                       << 8204>>52320000
                                                               <<04801>>52325000
end;                                                           <<06937>>52330000
end;    << printentry >>                                       <<04801>>52335000
                                                               <<04801>>52340000
                                                               <<04801>>52345000
  logical subroutine allocatedst (dstnum,dstsize);             <<04801>>52350000
     integer dstnum, dstsize;                                  <<04801>>52355000
  begin                                                        <<04801>>52360000
     comment:                                                  <<04801>>52365000
        allocatedst= true:  data-seg allocated                 <<04801>>52370000
                     false: could not allocate data-seg,       <<04801>>52375000
                            errnum set to approriate           <<04801>>52380000
                            value.                             <<04801>>52385000
        we use (callable) 'getdseg' here so that data-seg      <<04801>>52390000
        will be released automatically if process terminates   <<04801>>52395000
        abnormally.;                                           <<04801>>52400000
                                                               <<04801>>52405000
     allocatedst := true;                                      <<04801>>52410000
     << we get a negative dstsize here because if the user's>> <<*8062>>52415000
     << configured max xds size is too small getdseg will   >> <<*8062>>52420000
     << see the negative size and get the data segment any- >> <<*8062>>52425000
     << way because we are running privileged.              >> <<*8062>>52430000
     if dstsize > 0 then dstsize := -dstsize;                  <<*8062>>52435000
     getdseg (dstnum,dstsize,0);                               <<*8062>>52440000
     if <> then                                                <<04801>>52445000
        begin                                                  <<04801>>52450000
        errnum := if > or dstnum=%2000 then showsyserr         <<04801>>52455000
                  else if dstnum=%2001 then shownodst          <<04801>>52460000
                  else shownovds;                              <<04801>>52465000
        allocatedst:=dstnum:=0;                                <<04801>>52470000
        end;                                                   <<04801>>52475000
  end;    <<allocatedst>>                                      <<04801>>52480000
subroutine visitentry;                                                  52485000
<< "VISITS" entry, by printing the entry,           >>         <<04801>>52490000
<< after setting state to internal representation   >>         <<04801>>52495000
<< and setting rank (in link wd). calls incrcounts. >>         <<04801>>52500000
begin                                                                   52505000
   @jmatarr := @entryp; << reference via jmatarr >>            <<06607>>52510000
   jmatinx := 0;<<  jmatarr(0) points to entry  >>             <<06607>>52515000
   if jmatjobstate = jobsched then sched := true;              <<*8944>>52520000
   saverank := jmatschedlink;                                  <<06607>>52525000
   if entrystate = jwait then                                           52530000
      jmatschedlink := rank;                                   <<06607>>52535000
   move ebuf := jmatarr, (jmatentrysize);                      <<06607>>52540000
<< print the header if this is the first entry visited >>      <<*8944>>52545000
<< or we are printing the first job in sched state.    >>      <<*8944>>52550000
   if (total = 0) or                                           <<*8944>>52555000
      (sched land (stcounts(jsched) = 0)) then                 <<*8944>>52560000
      printheader;                                             <<*8944>>52565000
   printentry;                                                 <<04801>>52570000
   incrcounts;                                                 <<04801>>52575000
   jmatschedlink := saverank;    <<restore "OFFICIAL" values>> <<06607>>52580000
   sched := false;                                             <<*8944>>52585000
   end;    <<visitentry>>                                               52590000
                                                                        52595000
                                                                        52600000
logical subroutine entryqualifies;                                      52605000
<< determine if <entry> qualifies, in qualified scan.                   52610000
   called only for qualified type scans.                                52615000
   examines:                                                            52620000
      state, deferredness, type and/or names. >>                        52625000
begin                                                          <<06607>>52630000
   @jmatarr := @entryp; << reference via jmatarr >>            <<06607>>52635000
   jmatinx := 0;<<  jmatarr(0) points to entry  >>             <<06607>>52640000
   entryqualifies := false;  <<simply "RETURN" if it doesn't>>          52645000
   if state <> nostate then                                             52650000
      begin    <<state supplied>>                                       52655000
      if entrystate <> state then return;  <<impproper state>>          52660000
      if idefr <> nodefr then                                           52665000
         << "WAIT,N/D" supplied >>                                      52670000
         if (jmatinpri <= jobfence) <> defr then               <<06607>>52675000
            return;  << not correct "DEFERREDNESS" >>                   52680000
      end;                                                              52685000
   if jtype <> 0 then                                                   52690000
      begin    << "@J/S" supplied >>                                    52695000
      if jmatjstype <> jtype then return;                      <<06607>>52700000
      end                                                               52705000
   else                                                                 52710000
      if nlen <> 0 then                                                 52715000
         begin    <<named search requested>>                            52720000
         tos := (@jmatusername &lsl(1)) +nstart;               <<06607>>52725000
         if * <> names (nstart), (nlen) then                   <<04801>>52730000
            return;    <<name(s) don't match>>                          52735000
         end;                                                           52740000
   entryqualifies := true;    << passed all qualifications >>           52745000
   end;    <<entryqualifies>>                                           52750000
                                                                        52755000
                                                                        52760000
subroutine linscan;                                                     52765000
<< performs a linear scan thru the jmat, hitting appropriate entries >> 52770000
begin                                                                   52775000
   @jmatarr := @entryp; << reference via jmatarr >>            <<06607>>52780000
   jmatinx := 0;<<  jmatarr(0) points to entry  >>             <<06607>>52785000
   curentry := frstentry;  << start with first entry >>        <<06607>>52790000
   limit := dstlength-jmatentrysize;  << get end of table >>   <<06607>>52795000
   do begin                                                             52800000
      movefromdseg (@jmatarr, dstnum, curentry,                <<06607>>52805000
                    jmatentrysize);                            <<06607>>52810000
      if jmatarr <> 0                                          <<06607>>52815000
         and (entrystate := jmatjobstate) <> joberr then       <<06607>>52820000
         begin    <<actual, non-error entry>>                           52825000
         << map actual state into internal representation >>            52830000
         if entrystate = jobintro then   tos := jintro                  52835000
         else                                                           52840000
            if entrystate = jobsusp then   tos := jsusp                 52845000
            else                                                        52850000
            if entrystate=jobwait then                         <<04801>>52855000
                 tos := jwait                                  <<04801>>52860000
            else if entrystate = jobsched                      << 8204>>52865000
                    then tos := jsched                         << 8204>>52870000
            else tos := jexec;  << includes init, term >>      << 8204>>52875000
         entrystate := tos;                                             52880000
         case * optiontype of                                           52885000
            begin                                                       52890000
                                                                        52895000
<<jobnum>>  if jmatjsno = jobnum  and  jmatjstype = jtype      <<06607>>52900000
            then                                               <<06607>>52905000
               begin    <<got jobnum>>                                  52910000
               if entrystate = jwait                                    52915000
                     and jmatinpri > jobfence then             <<06607>>52920000
                  begin    <<non-deferred waiting: calc rank>>          52925000
                  exchangedb (dstnum);                         <<04801>>52930000
                  @jmatarr := @arrdb0;<< back at the jmat dst>><<06607>>52935000
                  jmatinx := jmatheadptr;                      <<06607>>52940000
                  while jmatinx <> curentry  do                <<06607>>52945000
                     begin    <<not this 1: advance>>                   52950000
                     rank := rank +1;                                   52955000
                     jmatinx := jmatschedlink;                 <<06607>>52960000
                     end;                                               52965000
                  exchangedb (0);                              <<04801>>52970000
                  rank := rank +1;                                      52975000
                  end                                                   52980000
               << else rank := 0, by initialization >> ;                52985000
               visitentry;                                              52990000
               limit := 0;    <<stop scan>>                    <<06607>>52995000
               end;                                                     53000000
                                                                        53005000
<<qualified>>                                                           53010000
            if entryqualifies then visitentry;                          53015000
                                                                        53020000
<<status>>  incrcounts  <<last case st.>>  <<just accumulate>>          53025000
                                                                        53030000
            end;    <<case>>                                            53035000
         end;    <<entry analysis>>                                     53040000
      end                                                               53045000
   until ((curentry := curentry +jmatentrysize) > limit);      <<06607>>53050000
   end;    <<linscan>>                                                  53055000
                                                               << 8204>>53060000
subroutine scansched;                                          << 8204>>53065000
                                                               << 8204>>53070000
<< scan through the scheduled jobs queue, visiting every   >>  << 8204>>53075000
<< qualifying entry.                                       >>  << 8204>>53080000
                                                               << 8204>>53085000
begin                                                          << 8204>>53090000
   @jmatarr := @entryp;  << reference via jmatarr.         >>  << 8204>>53095000
   jmatinx := 0;                                               << 8204>>53100000
   entrystate := jsched;                                       << 8204>>53105000
   curentry := schedjobshead;                                  << 8204>>53110000
   while <> do                                                 << 8204>>53115000
   begin                                                       << 8204>>53120000
      movefromdseg( @jmatarr, dstnum, curentry,                << 8204>>53125000
                    jmatentrysize );                           << 8204>>53130000
      if entryqualifies then visitentry;                       << 8204>>53135000
      curentry := jmatschedlink;                               << 8204>>53140000
   end;                                                        << 8204>>53145000
end;  << scansched >>                                          << 8204>>53150000
                                                               << 8204>>53155000
                                                                        53160000
subroutine scanwait;                                                    53165000
<< scan thru schedule (waiting) chain, visiting every qualifiying       53170000
   entry.  >>                                                           53175000
begin                                                                   53180000
   @jmatarr := @entryp; << reference via jmatarr >>            <<06607>>53185000
   jmatinx := 0;<<  jmatarr(0) points to entry  >>             <<06607>>53190000
   entrystate := jwait;                                                 53195000
   curentry := schedhead;                                      <<06607>>53200000
   while <> do                                                          53205000
      begin                                                             53210000
      movefromdseg (@jmatarr, dstnum, curentry,                <<06607>>53215000
                    jmatentrysize);                            <<06607>>53220000
      if jmatinpri > jobfence then                             <<06607>>53225000
         << non-deferred, waiting: affects succeeding ranking >>        53230000
         rank := rank +1                                                53235000
      else                                                              53240000
         << deferred => rank = 0 for this & all succeeding >>           53245000
         rank := 0;                                                     53250000
      if entryqualifies then visitentry;                                53255000
      curentry := jmatschedlink;                               <<06607>>53260000
      end;                                                              53265000
   end;    <<scanwait>>                                                 53270000
                                                                        53275000
                                                                        53280000
<< parse phase >>                                                       53285000
comment                                                        <<04801>>53290000
  the following subroutine opens the list file,                <<04801>>53295000
  and if it's new it makes sure that it will be closed as      <<04801>>53300000
  as a temporary file. any errors regarding the list file      <<06607>>53305000
  are considered fatal and will flush futher execution of      <<04801>>53310000
  the command.;                                                <<04801>>53315000
subroutine getlistfile;                                        <<04801>>53320000
begin                                                          <<04801>>53325000
   if pdel <> cr' then                                         <<04801>>53330000
      begin                                                    <<04801>>53335000
         parm := parms(pnum := pnum + 1);                      <<04801>>53340000
         error( errnum := shjbexparmlst );                     <<04801>>53345000
                                                               <<04801>>53350000
         assemble( exit 3 ); <<**** b a i l   o u t ****>>     <<04801>>53355000
                                                               <<04801>>53360000
      end;                                                     <<04801>>53365000
                                                               <<04801>>53370000
   fnum := fopen(pp,%2404,%101);                               <<04801>>53375000
   if <> then                                                  <<04801>>53380000
      begin                                                    <<04801>>53385000
         ferror'(fnum,errnum);                                 <<04801>>53390000
         errnum := showjobopnerr;                              <<04801>>53395000
         fatalerror;                                           <<04801>>53400000
      end                                                      <<04801>>53405000
   else                                                        <<04801>>53410000
      listfile := true;                                        <<04801>>53415000
                                                               <<04801>>53420000
end; << subroutine getlistfile >>                              <<04801>>53425000
<<                                                           >><<04801>>53430000
<<                main body of showjob                       >><<04801>>53435000
<<                                                           >><<04801>>53440000
                                                               << 8204>>53445000
showjob := 0;                                                  <<04801>>53450000
mycommand(parmsp,dels,maxparms,numparms,parms(1));             <<04801>>53455000
if numparms > 0 then  <<some exist>>                           <<04801>>53460000
   begin                                                       <<04801>>53465000
   parm := parms(1);                                           <<04801>>53470000
   if pp="#" or (((pp="J") lor (pp="S")) land (pp(1)=numeric)) then     53475000
      begin   <<specific job number requested>>                <<04801>>53480000
      if pp="#" then   <<delete # sign>>                       <<04801>>53485000
         begin                                                 <<04801>>53490000
         @pp := @pp+1;                                         <<04801>>53495000
         plen := plen-1;                                       <<04801>>53500000
         end;                                                  <<04801>>53505000
      if pp<> "J" and pp<>"S" then  <<unknown request>>        <<04801>>53510000
         error(showjxpctjsnum)                                 <<*8944>>53515000
      else   <<j or s found>>                                  <<04801>>53520000
         begin                                                 <<04801>>53525000
         optiontype := forjobnum;  <<=> explict job number>>   <<04801>>53530000
         if pp="J" then                                        <<04801>>53535000
            jtype  :=  batchtype                               <<06607>>53540000
         else   <<session>>                                    <<04801>>53545000
            jtype  :=  sessiontype;                            <<06607>>53550000
         @pp := @pp+1;  <<move past job type>>                 <<04801>>53555000
         tos := binary(pp, plen:=plen-1);  <<get number>>      <<04801>>53560000
         if <>  or  not(1 <= s0 <= maxjsno)  then              <<06607>>53565000
            begin   <<invalid job number>>                     <<04801>>53570000
            if jtype = sessiontype  then                       <<06607>>53575000
               error(showfxpctsnum)                            <<04801>>53580000
            else                                               <<04801>>53585000
               error(showfxpctjnum);                           <<04801>>53590000
            optiontype := qualified;                           <<04801>>53595000
            end;                                               <<04801>>53600000
         jobnum  :=  tos;  << the job/session number >>        <<06607>>53605000
         end;                                                  <<04801>>53610000
      if numparms > 1 then                                     <<04801>>53615000
            begin                                              <<04801>>53620000
               parm := parms(2);                               <<04801>>53625000
               if pp <> "*" then                               <<04801>>53630000
                  error(showjxtranparms)                       <<04801>>53635000
               else                                            <<04801>>53640000
                  getlistfile;                                 <<04801>>53645000
            end;                                               <<04801>>53650000
      end                                                      <<04801>>53655000
   else   <<at least one keyworded parameter>>                 <<04801>>53660000
      begin                                                    <<04801>>53665000
      move keywordsw := keywordspw, (keywordslen);             <<04801>>53670000
      do begin   <<loop through keywords>>                     <<04801>>53675000
         getnext;                                              <<04801>>53680000
         if plen <> 0 then                                     <<04801>>53685000
            if pp = "*" then                                   <<04801>>53690000
               stop := true                                    <<04801>>53695000
            else                                               <<04801>>53700000
            begin                                              <<04801>>53705000
            if search(pp, plen, keywords, keydefn) = 0 then    <<04801>>53710000
               error(showjunkkey)                              <<*8944>>53715000
            else   <<valid keyword>>                           <<04801>>53720000
               case  *integer(keydefn) of                      <<04801>>53725000
                  begin                                        <<04801>>53730000
                                                               <<04801>>53735000
                  ;   <<can't happen>>                         <<04801>>53740000
                                                               <<04801>>53745000
                  parsejob;   <<job= parameter>>               <<04801>>53750000
                                                               <<04801>>53755000
                  parsestate;  <<susp, intro, exec, wait>>     <<04801>>53760000
                                                               <<04801>>53765000
                  begin                                        <<04801>>53770000
                     if numparms <> 1 then                     <<04801>>53775000
                        begin                                  <<04801>>53780000
                           if pnum > 1 then                    <<04801>>53785000
                              error(showjstatsignrd)           <<04801>>53790000
                           else                                <<04801>>53795000
                              begin                            <<04801>>53800000
                                 parm := parms(pnum + 1);      <<04801>>53805000
                                 if pp <> "*" then             <<04801>>53810000
                                    error(showjstatsignrd)     <<04801>>53815000
                                 else                          <<04801>>53820000
                                    optiontype := status;      <<04801>>53825000
                                 parm := parms(pnum);          <<04801>>53830000
                              end;                             <<04801>>53835000
                        end                                    <<04801>>53840000
                     else                                      <<04801>>53845000
                        optiontype := status;                  <<04801>>53850000
                  end;                                         <<04801>>53855000
                  end;  <<of case statement>>                  <<04801>>53860000
            end  <<of case where keyword exists>>              <<04801>>53865000
         end   <<of keyword loop>>                             <<04801>>53870000
      until  (pdel <> semi) or stop;                           <<04801>>53875000
      if (pdel <> cr') and not stop then   <<unknown junk>>    <<04801>>53880000
         begin                                                 <<04801>>53885000
         parm := parms(pnum := pnum+1);                        <<04801>>53890000
         error(showjxtranparms);                               <<04801>>53895000
         end                                                   <<04801>>53900000
      else                                                     <<04801>>53905000
         if pp = "*" and stop then                             <<04801>>53910000
            getlistfile;                                       <<04801>>53915000
      end;                                                     <<04801>>53920000
   parmnum := pnum := 0;                                       <<04801>>53925000
   stop := false;                                              <<04801>>53930000
   end;   <<of parse>>                                         <<04801>>53935000
                                                               <<04801>>53940000
   << if the command output is not going to $stdlist, then  >> <<04801>>53945000
   << a dateline is printed at the beginning of the file.   >> <<04801>>53950000
                                                               <<04801>>53955000
   fgetinfo( fnum,, foptions );                                <<04801>>53960000
   if foptions.domain = new then                               <<04801>>53965000
      closeoptions := temp;                                    <<06607>>53970000
                                                               <<04801>>53975000
                                                                        53980000
   if (not'stdlist) then                                       <<*8944>>53985000
      begin                                                    <<04801>>53990000
         date'line(datebuf);                                   <<04801>>53995000
         fwrite(fnum,datebuf,-27,%60);                         <<04801>>54000000
      end;                                                     <<04801>>54005000
   stcounts(jintro) := 0;    <<initialize state counts>>                54010000
   stcounts(jwait) := 0;                                                54015000
   stcounts(jexec) := 0;                                                54020000
   stcounts(jsusp) := 0;                                                54025000
   stcounts(jsched) := 0;                                      << 8204>>54030000
   savesir := getsir (jmatsir);                                         54035000
   << get extra data seg & copy jmat >>                        <<04801>>54040000
   movefromdseg(@dstlength,jmatdst,0,1); <<1st word jmat>>     <<04801>>54045000
   dstlength := dstlength.(8:8)*tblquantum; <<cursize of jmat>><<04801>>54050000
   if not allocatedst (dstnum,dstlength) then                  <<04801>>54055000
      begin                                                    <<04801>>54060000
      relsir (jmatsir,savesir);                                <<04801>>54065000
      fatalerror;                                              <<04801>>54070000
      end;                                                     <<04801>>54075000
   exchangedb (dstnum);                                        <<04801>>54080000
   movefromdseg(@arrdb0,jmatdst,0,dstlength);                  <<04801>>54085000
   relsir(jmatsir,savesir);                                    <<04801>>54090000
   @jmatarr := @arrdb0; << prepare to index zeroth entry >>    <<06607>>54095000
   jobfence := jmatjobfence;                                   <<06607>>54100000
   jlimit := jmatjlimit;                                       <<06607>>54105000
   slimit := jmatslimit;                                       <<06607>>54110000
   <<  remember indexes to the first entry in the jmat and  >> <<06607>>54115000
   <<  to the scheduling head entry.                        >> <<06607>>54120000
   frstentry  := jmatentryptr;                                 <<06607>>54125000
   schedhead   := jmatheadptr;                                 <<06607>>54130000
   schedjobshead := jmatschedhead;                             << 8204>>54135000
   exchangedb (0);                                             <<04801>>54140000
   case * optiontype of                                                 54145000
      begin                                                             54150000
                                                                        54155000
<< jobnum search >>                                                     54160000
      linscan;                                                          54165000
                                                                        54170000
<< qualified search >>                                                  54175000
      begin                                                             54180000
         if state = nostate then                                        54185000
            begin    << scan all: exec/wait/intro order >>              54190000
            state := jsusp;                                             54195000
            linscan;                                                    54200000
            state := jexec;                                             54205000
            linscan;                                                    54210000
            state := jwait;                                             54215000
            scanwait;                                                   54220000
            rank := 0;                                                  54225000
            state := jintro;                                            54230000
            linscan;                                                    54235000
            state := nostate;    <<for proper summary>>                 54240000
            end                                                         54245000
         else                                                           54250000
            if state = jwait then                                       54255000
               scanwait                                                 54260000
            else if state = jsched                             << 8204>>54265000
                    then scansched                             << 8204>>54270000
            else                                               << 8204>>54275000
               << <state> appropriately set >>                          54280000
               linscan;                                                 54285000
         end;                                                           54290000
                                                                        54295000
<< status >>                                                            54300000
      linscan                                                  <<*8944>>54305000
                                                                        54310000
      end;                                                              54315000
                                                                        54320000
<< summary >>                                                           54325000
   << print blank line between entries and summary >>          <<04801>>54330000
   if (total > 0) and (optiontype <> status) then write (0,0); <<04801>>54335000
                                                                        54340000
   if (optiontype = status) or (total > 1) then                         54345000
      begin    << print summary info >>                                 54350000
                                                                        54355000
      << tot num jobs >>                                                54360000
      move obufb (ascii (total, 10, obufb)) := " JOBS:", 2;             54365000
      if (optiontype = qualified) and (numparms > 0) then               54370000
         begin    << possible subset listed: tell user >>               54375000
         tos := tos -1;                                                 54380000
         move * := " (DISPLAYED):", 2;                                  54385000
         end;                                                           54390000
      write (-s0 +@obufb, 0);                                           54395000
      del;                                                              54400000
                                                                        54405000
      if state = nostate then                                           54410000
         begin    << all states shown (or status) >>                    54415000
                                                                        54420000
         << intro >>                                                    54425000
         if optiontype <> status then                          <<*8944>>54430000
            begin                                              <<*8944>>54435000
            move obuf := "      INTRO ";                       <<*8944>>54440000
            ascii( stcounts(jintro), -10, obufb(4) );          <<*8944>>54445000
            write (-11, 0);                                    <<*8944>>54450000
            end                                                <<*8944>>54455000
         else                                                  <<*8944>>54460000
            begin                                              <<*8944>>54465000
            move obufb := "      INTRO; ",2;                   <<*8944>>54470000
            ascii( stcounts(jintro), -10, obufb(4) );          <<*8944>>54475000
            tos := tos + ascii(stcounts(jsched),10,obufb(13)); <<*8944>>54480000
            move * := " SCHEDULED",2;                          <<*8944>>54485000
            write(-s0+@obufb, 0);                              <<*8944>>54490000
            end;                                               <<*8944>>54495000
                                                                        54500000
         << wait, incl. deferred >>                                     54505000
         move obufb := "      WAIT; INCL ", 2;                          54510000
         ascii (stcounts (jwait), -10, obufb (4));                      54515000
         tos := tos +ascii (waitdefcount, 10, obufb (17));              54520000
         move * := " DEFERRED", 2;                                      54525000
         write (-s0 +@obufb, 0);                                        54530000
         del;                                                           54535000
                                                                        54540000
         << exec; incl sessions >>                                      54545000
         move obufb := "      EXEC; INCL ", 2;                          54550000
         ascii (stcounts (jexec), -10, obufb (4));                      54555000
         tos := tos +ascii (sescount, 10, obufb (17));                  54560000
         move * := " SESSIONS", 2;                                      54565000
         write (-s0 +@obufb, 0);                                        54570000
         del;                                                           54575000
                                                                        54580000
         << suspended >>                                                54585000
         move obufb := "      SUSP ";                                   54590000
         ascii (stcounts(jsusp),-10,obufb(4));                          54595000
         write (-11,0);                                                 54600000
                                                                        54605000
         end                                                            54610000
      else                                                              54615000
         if state = jwait then                                          54620000
            begin    << just wait: indicate num deferred >>             54625000
            move obuf := "      DEFERRED";                              54630000
            ascii (waitdefcount, -10, obufb (4));                       54635000
            write (-14, 0);                                             54640000
            end                                                         54645000
         else                                                  <<*8944>>54650000
            if state = jexec then                                       54655000
               begin    <<just exec: indicate sessions>>                54660000
               move obuf := "      SESSIONS";                           54665000
               ascii (sescount, -10, obufb (4));                        54670000
               write (-14, 0);                                          54675000
               end;                                                     54680000
      end                                                               54685000
   else                                                                 54690000
      if total = 0 then                                                 54695000
         begin    << indicate none >>                                   54700000
         move obuf := " NO SUCH JOB(S) ";                               54705000
         write (-15, 0);                                                54710000
         end;                                                           54715000
                                                                        54720000
   << fence and limits >>                                               54725000
   move obufb := "JOBFENCE= ", 2;                                       54730000
   tos := tos +ascii (jobfence, 10, obufb (10));                        54735000
   move * := "; JLIMIT= ", 2;                                           54740000
   tos := tos +ascii (jlimit, 10, bps0);                                54745000
   move * := "; SLIMIT= ", 2;                                           54750000
   tos := tos +ascii (slimit, 10, bps0);                                54755000
   write (-s0 +@obufb, %60);                                            54760000
   del;                                                                 54765000
                                                                        54770000
<< if we're doing a qualified showjob, we can have mixed >>    <<*8944>>54775000
<< scheduled and un-scheduled jobs.  in order to impact  >>    <<*8944>>54780000
<< programmatic showjobs the least, we print the sched   >>    <<*8944>>54785000
<< jobs after all other pre-mpemm output is printed.     >>    <<*8944>>54790000
                                                               <<*8944>>54795000
   if optiontype = qualified and state = nostate then          <<*8944>>54800000
      begin                                                    <<*8944>>54805000
      state := jsched;                                         <<*8944>>54810000
      scansched;      << print out any scheduled jobs >>       <<*8944>>54815000
                                                               <<*8944>>54820000
      if stcounts(jsched) > 0 then                             <<*8944>>54825000
         begin        << print summary >>                      <<*8944>>54830000
         write(0,0);                                           <<*8944>>54835000
                                                               <<*8944>>54840000
         move obufb( ascii(stcounts(jsched),10,obufb) ) :=     <<*8944>>54845000
              " SCHEDULED JOB(S)",2;                           <<*8944>>54850000
         write (-s0+@obufb, %60);                              <<*8944>>54855000
         end;                                                  <<*8944>>54860000
      end;                                                     <<*8944>>54865000
                                                               <<*8944>>54870000
leave:                                                                  54875000
   if dstnum <> 0 then freedseg(dstnum,0);                     <<04801>>54880000
   if listfile then                                            <<04801>>54885000
      begin                                                    <<04801>>54890000
         fclose(fnum,closeoptions,0);                          <<04801>>54895000
         if <> then                                            <<04801>>54900000
            begin                                              <<04801>>54905000
               ferror'(fnum,errnum);                           <<04801>>54910000
               error(showjobclserr);                           <<04801>>54915000
            end;                                               <<04801>>54920000
      end;                                                     <<04801>>54925000
                                                               <<04801>>54930000
   end;    << showjob >>                                                54935000
$page "CXSHOWJOB"                                              <<04801>>54940000
$control segment=ophi                                          <<04801>>54945000
                                                                        54950000
<< note:  procedure  cxshowjob  was  moved  unchanged  from >> <<04801>>54955000
<< spoolcoms to opcommand as part of this enhancement.  its >> <<04801>>54960000
<< fix number(s) were not changed.                          >> <<04801>>54965000
                                                                        54970000
procedure cxshowjob (parmsp, errnum, parmnum);                          54975000
   byte array parmsp;                                                   54980000
   integer errnum, parmnum;                                             54985000
   option privileged, uncallable;                                       54990000
begin                                                                   54995000
   errnum := showjob(parmsp, parmnum, false);                  <<04801>>55000000
   end;    << cxshowjob >>                                              55005000
$page "GLOBAL SYMBOL TABLE"                                    <<04801>>55010000
$page                                                          <<04801>>55015000
$control segment = main                                        <<04801>>55020000
end.   << opcommand - module 85 >>                             <<04801>>55025000
