$CONTROL USLINIT,MAP,SOURCE,CODE                                        00010000
<< nursery -- module 76 >>                                              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
<<copyright     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1976. ",           >>00055000
<<     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",     >>00060000
<<     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",   >>00065000
<<     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ">>00070000
<<     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ", >>00075000
<<     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.">>00080000
$thirty                                                                 00085000
$control segment=nursery,main=nursery                          <<02.eb>>00090000
<<fri, feb 17, 1978,  8:42 am>>                                         00095000
$control privileged                                                     00100000
begin                                                                   00105000
define                                                                  00110000
           a                 = absolute          #,                     00115000
           enaproc           = assemble(pseb)    #,                     00120000
           disaproc          = assemble(psdb)    #,                     00125000
           disable           = assemble(sed 0)   #,                     00130000
           enable            = assemble(sed 1)   #;                     00135000
integer                                                                 00140000
           db0               = db+0  ,                                  00145000
           db1               = db+1  ,                                  00150000
           db2               = db+2  ,                                  00155000
           db3               = db+3  ,                                  00160000
           db4               = db+4  ,                                  00165000
           db5               = db+5  ,                                  00170000
           db6               = db+6  ,                                  00175000
           db7               = db+7  ,                                  00180000
           db8               = db+8  ,                                  00185000
           db9               = db+9  ,                                  00190000
           db10              = db+10 ,                                  00195000
           db11              = db+11 ,                                  00200000
           s0                = s-0   ,                                  00205000
           s1                = s-1   ,                                  00210000
           s2                = s-2   ,                                  00215000
           s3                = s-3   ,                                  00220000
           s4                = s-4   ,                                  00225000
           s5                = s-5   ,                                  00230000
           x                 = x     ,                                  00235000
           xreg              = x     ;                                  00240000
logical                                                                 00245000
           ldb3              = db+3  ,                                  00250000
           ls0               = s-0   ,                                  00255000
           lxreg             = x     ;                                  00260000
double                                                                  00265000
           ds1               = s-1   ;                                  00270000
integer pointer                                                         00275000
           pdb0              = db+0  ,                                  00280000
           pdb1              = db+1  ,                                  00285000
           pdb2              = db+2  ,                                  00290000
           pdb3              = db+3  ,                                  00295000
           pdb4              = db+4  ,                                  00300000
           ps0               = s-0   ,                                  00305000
           ps2               = s-2   ,                                  00310000
           ps3               = s-3   ;                                  00315000
logical pointer                                                         00320000
           lps0              = s-0   ;                                  00325000
byte pointer                                                            00330000
           bps0              = s-0   ,                         <<05.eb>>00335000
           bps1              = s-1   ;                                  00340000
integer array                                                           00345000
           arrdb(*)          = db+0  ,                                  00350000
           arrdb5(*)         = db+5  ,                                  00355000
           arrdb8(*)         = db+8  ,                                  00360000
           arrdb9(*)         = db+9  ,                                  00365000
           arrdb12(*)        = db+12 ;                                  00370000
equate                                                                  00375000
<< spooling sirs >>                                                     00380000
           iddsir            = 3     ,                                  00385000
           oddsir            = 4     ,                                  00390000
           cilogsir          = 36    ,                         <<00.04>>00395000
<< data segment numbers >>                                              00400000
           idddst            = 45    ,                                  00405000
           odddst            = 46    ,                                  00410000
           cilogdst          = 52    ,                         <<00.04>>00415000
<< table size constants >>                                              00420000
           xddsize           = 30    ,                                  00425000
           iddsize           = xddsize ,                                00430000
           oddsize           = xddsize ,                                00435000
<< low main memory >>                                                   00440000
           cstb              = 0     ,                                  00445000
           xcstb             = 1     ,                                  00450000
           dstb              = 2     ;                         <<06599>>00455000
<< system global table - sysdb >>                                       00460000
equate                                                                  00465000
           jobsync           = %121  ,                                  00470000
           pcbt              = %141  ,                                  00475000
           ucoppcbt          = 2     ,                                  00480000
           cputimelimit      = %1117 ,    <<(sysglob)>>                 00485000
           jobpri            = %334 ,                                   00490000
           jprilim           = %333 ,                                   00495000
           spoollogm         = %167,                           <<05.eb>>00500000
           loginfo           = %1167;                          <<05.eb>>00505000
define                                                                  00510000
           absys             = %1000              #,                    00515000
           absys'jobsync     = a(absys+jobsync)   #,                    00520000
             jobready'f         = 13:1            #,                    00525000
             devfdreed'f        = 14:1            #,                    00530000
             jobwaiting'f       = 15:1            #,                    00535000
           absys'ucoppcbt    = a(absys+pcbt+ucoppcbt)#,                 00540000
           absys'jobpri      = a(absys+jobpri)    #,                    00545000
           absys'jprilim     = a(absys+jprilim)   #,                    00550000
           absys'spoollogm   = a(absys+spoollogm) #,           <<05.eb>>00555000
           loglogon          = a(loginfo).(13:1)#;             <<05.eb>>00560000
                                                               <<02858>>00565000
<< system table (sysglob) pointers >>                          <<02858>>00570000
integer pointer                                                <<02858>>00575000
   sysglob = 0;                                                << 8144>>00580000
                                                               <<02858>>00585000
<< process control block - pcb >>                                       00590000
equate                                                                  00595000
           junkwait          = %20   ;                                  00600000
equate                                                                  00605000
           ucoplpin          = 2     ;                                  00610000
define                                                                  00615000
           pcb'xdst           = 2).(1:10   #;                  <<06600>>00620000
$include incllpdt                                              <<06597>>00625000
<< logical device table - ldt / dct >>                                  00630000
$include inclldt5                                              <<06215>>00635000
define                                                         <<06215>>00640000
              terminal       = 16                #;            <<06215>>00645000
define                                                                  00650000
   << prefix >>                                                         00655000
           tbl'maxsize       = db0.(0:8)         #,                     00660000
           tbl'cursize       = db0.(8:8)         #,                     00665000
              tblquantum     = 128               #,                     00670000
           tbl'entrysize     = db1.(8:8)         #,                     00675000
           tbl'entryareap    = pdb2              #,                     00680000
           << chains defined by "HEAD" pointer,                         00685000
              immediately followed by "TAIL" pointer.                   00690000
              each points to wd 0 of entry.                             00695000
              null chain:  head = 0;  tail = @head.                     00700000
              chain terminated by 0 link.                               00705000
           >>                                                           00710000
           ttchainend        = 0                 #,                     00715000
           tt'inuseword      = 0                 #,                     00720000
              freeentry      = 0                 #,                     00725000
           tt'jtype          = 1).(0:2           #,                     00730000
           tt'jnum           = 1).(2:14          #,                     00735000
           tt'jobnum         = 1                 #,                     00740000
           tt'uname          = 2                 #,                     00745000
           tt'aname          = 6                 #,                     00750000
           tt'jname          = 10                #,                     00755000
           tt'linkp'w        = 25                #,                     00760000
           tt'linkp          = tt'linkp'w        #;                     00765000
<< device directories: general - xdd >>                                 00770000
$include inclxdd5                                              <<06909>>00775000
$set x8=off                                                    <<06600>>00780000
$include incljmat                                              <<06600>>00785000
                                                               <<06600>>00790000
<<  auxiliary jmat declarations  >>                            <<06600>>00795000
                                                               <<06600>>00800000
                                                               <<06600>>00805000
<<  job types, states, etc.  >>                                <<06600>>00810000
equate                                                         <<06600>>00815000
   jobhipri      = 15,  <<  hi priority logon  >>              <<06600>>00820000
   jobchainend   = 0,   <<  the end of ucops's sched. queue. >><<06600>>00825000
                                                               <<06600>>00830000
   jobtype       = 2,   <<  its a job!  >>                     <<06600>>00835000
   sessiontype   = 1,   <<  a session   >>                     <<06600>>00840000
                                                               <<06600>>00845000
   jobintro      = 1,   <<  just introduced  >>                <<06600>>00850000
   jobwait       = %40, <<  waiting  >>                        <<06600>>00855000
   jobinit       = %60, <<  initializing  >>                   <<06600>>00860000
   jobexec       = 2,   <<  executing  >>                      <<06600>>00865000
   jobdone       = 3,   <<  getting ready to say bye  >>       <<06600>>00870000
   jobsusp       = 4,   <<  suspended  >>                      <<06600>>00875000
   joberr        = %50; <<  oops!  >>                          <<06600>>00880000
                                                               <<06600>>00885000
                                                               <<06600>>00890000
integer                                                                 00895000
           stat      = q-1    ;                                         00900000
define                                                                  00905000
           cc        = stat.(6:2)    #,                                 00910000
           cce       = 2             #,                                 00915000
           ccg       = 0             #,                                 00920000
           ccl       = 1             #;                                 00925000
                                                               << 8144>>00930000
  equate                                                       << 8144>>00935000
    ldev'out'of'range            = 7000,                       << 8144>>00940000
    ldev'must'not'be'virtual     = 7001,                       << 8144>>00945000
    ldev'not'a'terminal          = 7002,                       << 8144>>00950000
    ldev'not'free                = 7003,                       << 8144>>00955000
    ldev'not'job'accepting       = 7004,                       << 8144>>00960000
    ldev'avail'to'diag           = 7005,                       << 8144>>00965000
    ldev'not'available           = 7006,                       << 8144>>00970000
    ldev'down'pending            = 7007,                       << 8144>>00975000
    ldev'can'not'be'a'ds'device  = 7008,                       << 8144>>00980000
    user'must'have'ps'capability = 7009,                       << 8144>>00985000
    ldev'wrong'type'or'subtype   = 7036,                       << 8881>>00990000
    stack'space'needed           = 1250,                       << 8144>>00995000
    invalid'end'address          = 7035,                       << 8144>>01000000
                                                               << 8144>>01005000
    free                         = 0;                          << 8144>>01010000
                                                               << 8144>>01015000
define                                                         << 8144>>01020000
   idextract  = (0:2)#,                                        << 8144>>01025000
   numextract = (2:14)#;                                       << 8144>>01030000
                                                               << 8144>>01035000
equate                                                         << 8144>>01040000
  startsess'int'num = 195;                                     << 8144>>01045000
                                                               << 8144>>01050000
                                                               <<05.eb>>01055000
define                                                         <<05.eb>>01060000
   def'movefromdseg   =                                        <<05.eb>>01065000
      movefromdseg(target,dstn,offset,count);                  <<05.eb>>01070000
         value target,dstn,offset,count;                       <<05.eb>>01075000
         logical target,dstn,offset,count;                     <<05.eb>>01080000
      begin                                                    <<05.eb>>01085000
         x :          = tos; << save return address >>         <<05.eb>>01090000
         assemble(mfds 0);                                     <<05.eb>>01095000
         tos :        = x; << restore return address >>        <<05.eb>>01100000
      end #;                                                   <<05.eb>>01105000
                                                               << 8144>>01110000
define                                                         << 8144>>01115000
   def'movetodseg =                                            << 8144>>01120000
       movetodseg(dstn,offset,source,count);                   << 8144>>01125000
       value dstn,offset,source,count;                         << 8144>>01130000
       logical dstn,offset,source,count;                       << 8144>>01135000
       begin                                                   << 8144>>01140000
         x := tos;                                             << 8144>>01145000
         assemble( mtds 0 );                                   << 8144>>01150000
         tos := x;                                             << 8144>>01155000
       end #;                                                  << 8144>>01160000
<< directory >>                                                <<02.eb>>01165000
equate                                                         <<05.eb>>01170000
                                                               <<02.eb>>01175000
   namesize        = 4,                                        <<02.eb>>01180000
                                                               <<02.eb>>01185000
<< account entry >>                                            <<02.eb>>01190000
   aname           = 0,                  <<name>>              <<02.eb>>01195000
   agipntr         = aname+namesize,     <<group index pntr>>  <<02.eb>>01200000
   auipntr         = agipntr+1,          <<user index pntr>>   <<02.eb>>01205000
   acap            = auipntr+1,          <<capability>>        <<02.eb>>01210000
   acapd           = acap/2,                                   <<05.eb>>01215000
   alattr          = acap+2,                                   <<02.eb>>01220000
   apass           = alattr+2,                                 <<02.eb>>01225000
   apassb          = apass*2,                                  <<05.eb>>01230000
   adfscount       = apass+namesize,     <<disc file space>>   <<02.eb>>01235000
   adfscountd      = adfscount /2,                             <<02.eb>>01240000
   adfslimit       = adfscount+2,                              <<02.eb>>01245000
   adfslimitd      = adfslimit /2,                             <<02.eb>>01250000
   acpucount       = adfslimit+2,        <<cpu time>>          <<02.eb>>01255000
   acpucountd      = acpucount /2,                             <<02.eb>>01260000
   acpulimit       = acpucount+2,                              <<02.eb>>01265000
   acpulimitd      = acpulimit /2,                             <<02.eb>>01270000
   acontimecount   = acpulimit+2,        <<connect time>>      <<02.eb>>01275000
   acontimecountd  = acontimecount /2,                         <<02.eb>>01280000
   acontimelimit   = acontimecount+2,                          <<02.eb>>01285000
   acontimelimitd  = acontimelimit /2,                         <<02.eb>>01290000
   asecw           = acontimelimit+2,                          <<02.eb>>01295000
   apurgeflagw     = asecw,                                    <<02.eb>>01300000
   amaxjobw        = asecw+1,            <<max. job priority >><<02.eb>>01305000
   avslipntr       = amaxjobw+1,         <<vs list index>>     <<02.eb>>01310000
   aspare          = avslipntr+1,                              <<02.eb>>01315000
   asize           = aspare +1,                                <<02.eb>>01320000
                                                               <<02.eb>>01325000
<<group entry>>                                                <<02.eb>>01330000
   gname           = 0,                  <<name>>              <<02.eb>>01335000
   gfipntr         = gname+namesize,     <<file index >>       <<02.eb>>01340000
   gpass           = gfipntr+1,          <<password>>          <<02.eb>>01345000
   gpassb          = gpass*2,                                  <<05.eb>>01350000
   gdfscount       = gpass+namesize,     <<disc file space>>   <<02.eb>>01355000
   gdfslimit       = gdfscount+2,                              <<02.eb>>01360000
   gcpucount       = gdfslimit+2,        <<cpu time>>          <<02.eb>>01365000
   gcpucountd      = gcpucount/2,                              <<02.eb>>01370000
   gcpulimit       = gcpucount+2,                              <<02.eb>>01375000
   gcpulimitd      = gcpulimit/2,                              <<02.eb>>01380000
   gcontimecount   = gcpulimit+2,                              <<02.eb>>01385000
   gcontimecountd  = gcontimecount/2,                          <<02.eb>>01390000
   gcontimelimit   = gcontimecount+2,                          <<02.eb>>01395000
   gcontimelimitd  = gcontimelimit/2,                          <<02.eb>>01400000
   gsec            = gcontimelimit+2,                          <<02.eb>>01405000
   gpurgeflagw     = gsec,                                     <<02.eb>>01410000
   gcap            = gsec +2,                                  <<02.eb>>01415000
   glinkage        = gcap+1,                                   <<02.eb>>01420000
   gvsdipntr       = glinkage+1,         <<vs def index pntr>> <<02.eb>>01425000
   ghvsname        = gvsdipntr+1,        <<home vs name>>      <<02.eb>>01430000
   ghvsaname       = ghvsname,           << "   "  acct name>> <<02.eb>>01435000
   ghvsgname       = ghvsaname+namesize, << "   "  grp  name>> <<02.eb>>01440000
   ghvsvsname      = ghvsgname+namesize, << "   "  vs   name>> <<02.eb>>01445000
   gsavefipntr     = ghvsvsname+namesize,<<saves gfipntr>>     <<02.eb>>01450000
   gmountrefcntr   = gsavefipntr+1,      <<mount use counter>> <<02.eb>>01455000
   gspare          = gmountrefcntr+1,                          <<02.eb>>01460000
   gsize           = gspare+1,                                 <<02.eb>>01465000
                                                               <<02.eb>>01470000
<<user entry>>                                                 <<02.eb>>01475000
   uname           = 0,                  <<name>>              <<02.eb>>01480000
   ucap            = uname+namesize,     <<capability>>        <<02.eb>>01485000
   ulattr          = ucap+2,                                   <<02.eb>>01490000
   upass           = ulattr+2,                                 <<02.eb>>01495000
   upassb          = upass*2,                                  <<05.eb>>01500000
   uhgroup         = upass+namesize,     <<home group>>        <<02.eb>>01505000
   uhgroupb        = uhgroup*2,                                <<00802>>01510000
   ulogcount       = uhgroup+namesize,   <<# users logged on>> <<02.eb>>01515000
   umaxjob         = ulogcount+1,                              <<02.eb>>01520000
   upurgeflagw     = umaxjob,                                  <<02.eb>>01525000
   uspare          = umaxjob +1,                               <<02.eb>>01530000
   usize           = uspare +1;                                <<02.eb>>01535000
                                                                        01540000
<< constants for term'type'file and check'filename >>                   01545000
                                                                        01550000
equate                                                                  01555000
   max'namelen   =  8,      << maximun length of names >>               01560000
   file          =  1,      << indicate what the name is >>             01565000
   lockword      =  2,                                                  01570000
   group         =  3,                                                  01575000
   account       =  4,                                                  01580000
   cr            =%15;      << file name terminator >>                  01585000
                                                                        01590000
<< error number for term'type'file and check'filename >>                01595000
                                                                        01600000
equate                                                                  01605000
   valid'name        =   0,                                             01610000
   bad'file'char     = 3170,                                            01615000
   bad'lockwd'char   = 3171,                                            01620000
   bad'group'char    = 3172,                                            01625000
   bad'account'char  = 3173,                                            01630000
   long'file'name    = 3174,                                            01635000
   long'lockwd'name  = 3175,                                            01640000
   long'group'name   = 3176,                                            01645000
   long'account'name = 3177,                                            01650000
   file'non'alpha    = 3178,                                            01655000
   lockwd'non'alpha  = 3179,                                            01660000
   group'non'alpha   = 3180,                                            01665000
   account'non'alpha = 3181,                                            01670000
   too'many'names    = 3182,                                            01675000
   openfail          = 520,                                             01680000
   checkerr          = 522,                                             01685000
   inv'fmt'err       = 521,                                             01690000
   no'sup'err        = 523,                                             01695000
   pverr             = 524;                                             01700000
                                                                        01705000
                                                                        01710000
<< external procedures >>                                               01715000
                                                                        01720000
$page "   Procedure  - TERM'TYPE'FILE"                                  01725000
$include incljcut                                              <<06907>>01730000
$include inclpcb5                                              <<06599>>01735000
logical pointer pcb = syspcbindex;                             <<06599>>01740000
$include incljit                                               <<06906>>01745000
$include inclpxg                                               <<06598>>01750000
$include pcbfincl                                              <<06598>>01755000
integer procedure nextparm(string,ptr,delimptr);               <<05.eb>>01760000
   byte array string;                                          <<05.eb>>01765000
   byte pointer ptr,delimptr;                                  <<05.eb>>01770000
   option variable,external;                                   <<05.eb>>01775000
                                                               <<05.eb>>01780000
integer procedure nextparmd(delims,string,ptr,delimptr);       <<05.eb>>01785000
   byte array delims,string;                                   <<05.eb>>01790000
   byte pointer ptr,delimptr;                                  <<05.eb>>01795000
   option variable,external;                                   <<05.eb>>01800000
                                                               <<05.eb>>01805000
procedure fmtdate(calendar',clock',string);                    <<05.eb>>01810000
   value calendar',clock';                                     <<05.eb>>01815000
   logical calendar';                                          <<05.eb>>01820000
   double clock';                                              <<05.eb>>01825000
   byte array string;                                          <<05.eb>>01830000
   option external;                                            <<05.eb>>01835000
integer procedure get'dcs'failno(from,num);                    << 8144>>01840000
value from, num;                                               << 8144>>01845000
integer from,num;                                              << 8144>>01850000
option forward;                                                << 8144>>01855000
                                                               << 8144>>01860000
procedure errorexit(intexit,err,parm);                         << 8144>>01865000
value intexit,err,parm;                                        << 8144>>01870000
integer intexit,err,parm;                                      << 8144>>01875000
option external;                                               << 8144>>01880000
                                                               << 8144>>01885000
double procedure chek(int,flag,parm,cap,opt);                  << 8144>>01890000
value int,flag,parm,cap,opt;                                   << 8144>>01895000
logical int,flag,opt;                                          << 8144>>01900000
double parm,cap;                                               << 8144>>01905000
option variable,external;                                      << 8144>>01910000
                                                               << 8144>>01915000
                                                               <<05.eb>>01920000
procedure awake(pcbpt,n,waitf);                                         01925000
   value pcbpt,n,waitf;                                                 01930000
   integer pcbpt,n,waitf;                                               01935000
   option external;                                                     01940000
                                                                        01945000
double procedure direcfind (type, linkage'indexp, an,          <<38.pv>>01950000
                            gn, fn, ret);                      <<38.pv>>01955000
   value type, linkage'indexp;                                 <<38.pv>>01960000
   integer type;                                               <<38.pv>>01965000
   double  linkage'indexp;                                     <<38.pv>>01970000
   array an, gn, fn, ret;                                               01975000
   option external;                                                     01980000
                                                                        01985000
logical procedure exchangedb(dstx);                                     01990000
   value dstx;                                                          01995000
   logical dstx;                                                        02000000
   option external;                                                     02005000
                                                                        02010000
integer procedure getdevinfo(device,devinfo);                           02015000
   byte array device;                                                   02020000
   integer array devinfo;                                               02025000
   option external;                                                     02030000
                                                               <<02858>>02035000
integer procedure get'dsdevice(ldev);                          <<02858>>02040000
   value ldev; integer ldev;                                   <<02858>>02045000
   option external;                                            <<02858>>02050000
                                                                        02055000
procedure writedseg(d);                                                 02060000
   value   d;                                                           02065000
   integer d;                                                           02070000
   option external;                                                     02075000
                                                                        02080000
integer procedure altdsegsize (d,s);                           <<00.04>>02085000
   value   d,s;                                                <<00.04>>02090000
   integer d,s;                                                <<00.04>>02095000
   option  external;                                           <<00.04>>02100000
                                                               <<00.04>>02105000
logical procedure getsir(sirnum);                                       02110000
   value sirnum;                                                        02115000
   integer sirnum;                                                      02120000
   option external;                                                     02125000
                                                                        02130000
procedure apltranslatein (m,l,t);                              <<00.04>>02135000
   value   l,t;                                                <<00.04>>02140000
   integer l,t;                                                <<00.04>>02145000
   byte array m;                                               <<00.04>>02150000
   option external;                                            <<00.04>>02155000
                                                               <<00.04>>02160000
integer procedure genmsg(setno,msgno,mask,b,c,d,e,f,           <<0u.eb>>02165000
      dest,reply,buff,dst,iotype);                             <<0u.eb>>02170000
   value setno,msgno,mask,b,c,d,e,f,dest,reply,buff,           <<0u.eb>>02175000
      dst,iotype;                                              <<0u.eb>>02180000
   logical setno,msgno,mask,b,c,d,e,f,dest,reply,buff,         <<0u.eb>>02185000
      dst,iotype;                                              <<0u.eb>>02190000
   option variable,external;                                   <<0u.eb>>02195000
                                                                        02200000
procedure relsir(sirnum,already);                                       02205000
   value sirnum,already;                                                02210000
   integer sirnum;                                                      02215000
   logical already;                                                     02220000
   option external;                                                     02225000
                                                                        02230000
logical procedure sysproc (lpin);                                       02235000
   value   lpin;                                                        02240000
   logical lpin;                                                        02245000
   option external;                                                     02250000
                                                               << 8144>>02255000
logical procedure setcritical;                                 << 8144>>02260000
option external;                                               << 8144>>02265000
                                                                        02270000
double procedure subqueue (t, p);                                       02275000
   value t, p;                                                          02280000
   integer t, p;                                                        02285000
   option external;                                                     02290000
                                                                        02295000
double procedure attachio (p1,p2,p3,p4,p5,p6,p7,p8,p9);                 02300000
   value   p1,p2,p3,p4,p5,p6,p7,p8,p9;                                  02305000
   integer p1,p2,p3,p4,p5,p6,p7,p8,p9;                                  02310000
   option external;                                                     02315000
                                                                        02320000
integer procedure sputxdd (odd, dev, vddentry, xddsubp);                02325000
   value odd, dev;                                                      02330000
   logical odd;                                                         02335000
   integer dev;                                                         02340000
   integer array vddentry;                                              02345000
   integer pointer xddsubp;                                             02350000
   option external;                                                     02355000
                                                                        02360000
logical procedure calendar;                                             02365000
   option external;                                                     02370000
                                                                        02375000
double procedure clock;                                                 02380000
   option external;                                                     02385000
                                                               << 8881>>02390000
procedure sysinterr(err,back);                                 << 8881>>02395000
value err,back;                                                << 8881>>02400000
integer err,back;                                              << 8881>>02405000
option external;                                               << 8881>>02410000
                                                                        02415000
intrinsic dbinary,binary,search,mycommand,terminate,fcontrol,  <<08.eb>>02420000
   clock,calendar,print,read,debug,getpriority;                <<05.eb>>02425000
                                                               <<02.eb>>02430000
intrinsic setjcw,ferrmsg;                                               02435000
intrinsic fclose,fopen,fread,pause,who;                        << 8144>>02440000
                                                               <<00243>>02445000
                                                               <<02.eb>>02450000
procedure date'line(string);                                   <<02.eb>>02455000
   byte array string; option external;                         <<02.eb>>02460000
                                                               <<02.eb>>02465000
integer procedure direclogon(mask,jmat,t1,t2,aentry,uentry,    <<02.eb>>02470000
      gentry);                                                 <<02.eb>>02475000
   value mask,t1,t2; integer mask; double t1,t2;               <<02.eb>>02480000
   array jmat,aentry,uentry,gentry;                            <<02.eb>>02485000
   option external;                                            <<02.eb>>02490000
                                                               <<02.eb>>02495000
procedure erroron; option external;                            <<02.eb>>02500000
                                                               <<02.eb>>02505000
procedure help;  option external;                              <<01130>>02510000
                                                               <<01130>>02515000
integer procedure fjopen(filedesignator,foptions,aoptions,     <<02.eb>>02520000
      recsize,device, formmsg, recmode, blockfactor,           <<02.eb>>02525000
      numbuffers,filesize,numextents, initalloc, filecode);    <<02.eb>>02530000
   value foptions, aoptions, recsize, recmode, blockfactor,    <<02.eb>>02535000
      numbuffers,filesize, numextents, initalloc, filecode;    <<02.eb>>02540000
   byte array filedesignator,  device, formmsg;                <<02.eb>>02545000
   logical foptions, aoptions;                                 <<02.eb>>02550000
   integer recsize, recmode, blockfactor, numbuffers,          <<02.eb>>02555000
      numextents,initalloc, filecode;                          <<02.eb>>02560000
   double filesize;                                            <<02.eb>>02565000
   option variable, external;                                  <<02.eb>>02570000
                                                               <<02.eb>>02575000
integer procedure formname(type,target,ba1,ba2,ba3,ba4);       <<02.eb>>02580000
   value type; integer type;                                   <<02.eb>>02585000
   byte array target,ba1,ba2,ba3,ba4;                          <<02.eb>>02590000
   option external;                                            <<02.eb>>02595000
                                                               <<02.eb>>02600000
procedure log2;  option external;                              <<06600>>02605000
                                                               <<02.eb>>02610000
                                                               <<04555>>02615000
procedure resetcritical(parm);                                 <<02.eb>>02620000
   value parm; logical parm;                                   <<02.eb>>02625000
   option external;                                            <<02.eb>>02630000
                                                               <<02.eb>>02635000
procedure suddendeath(errornumber);                            <<02.eb>>02640000
   value errornumber;                                          <<02.eb>>02645000
   integer errornumber;                                        <<02.eb>>02650000
   option external;                                            <<02.eb>>02655000
                                                               <<02.eb>>02660000
                                                                        02665000
logical procedure validspoolee(devtype,out);                   <<sp1sz>>02670000
   value devtype,out;                                          <<sp1sz>>02675000
   integer devtype;                                            <<sp1sz>>02680000
   logical out;                                                <<sp1sz>>02685000
   option external;                                            <<sp1sz>>02690000
                                                               <<sp1sz>>02695000
procedure cierr(errnum,erradr,parmask,parm);                   <<00534>>02700000
   value errnum,parmask,parm;                                  <<00534>>02705000
   integer errnum,parmask,parm;                                <<00534>>02710000
   byte array erradr;                                          <<00534>>02715000
   option privileged,uncallable,variable,external;             <<00534>>02720000
                                                               << 8144>>02725000
double procedure findprocessport(pin);                         << 8144>>02730000
value pin;                                                     << 8144>>02735000
logical pin;                                                   << 8144>>02740000
option external;                                               << 8144>>02745000
                                                               << 8144>>02750000
procedure receivewait'db(port'id,message,enable'mask);         << 8144>>02755000
value port'id,message,enable'mask;                             << 8144>>02760000
integer pointer message;                                       << 8144>>02765000
double port'id;                                                << 8144>>02770000
logical enable'mask;                                           << 8144>>02775000
option external;                                               << 8144>>02780000
                                                               << 8144>>02785000
procedure send'db(portid,subqueue,message);                    << 8144>>02790000
value portid,subqueue,message;                                 << 8144>>02795000
integer subqueue;                                              << 8144>>02800000
integer pointer message;                                       << 8144>>02805000
double portid;                                                 << 8144>>02810000
option external;                                               << 8144>>02815000
                                                               << 8144>>02820000
                                                               <<00534>>02825000
procedure upshift(string); byte array string;                  <<09.eb>>02830000
   option forward;                                             <<09.eb>>02835000
                                                               << 8881>>02840000
integer procedure ldevtotype(ldev);                            << 8881>>02845000
value ldev;                                                    << 8881>>02850000
logical ldev;                                                  << 8881>>02855000
option external;                                               << 8881>>02860000
                                                               << 8881>>02865000
integer procedure ldevtosubtype(ldev);                         << 8881>>02870000
value ldev;                                                    << 8881>>02875000
logical ldev;                                                  << 8881>>02880000
option external;                                               << 8881>>02885000
                                                               <<09.eb>>02890000
$page                                                          <<06600>>02895000
                                                               <<06600>>02900000
<< ........................................................ >> <<06600>>02905000
<<    the following three routines:                         >> <<06600>>02910000
<<       allocate'jmat, deallocate'jmat, delink'jmat        >> <<06600>>02915000
<<    are part of the mpe-v changes for the jmat.  the      >> <<06600>>02920000
<<    routines, or their equivalents, used to live in       >> <<06600>>02925000
<<    allocate, as common routines for the jmat and the xdd.>> <<06600>>02930000
<<    this had to change for the mpe-v tables expansion.    >> <<06600>>02935000
<<                                                          >> <<06600>>02940000
<<    **** the fix numbers for the procedures below ****    >> <<06600>>02945000
<<    **** are the same as on this comment.         ****    >> <<06600>>02950000
<<                                                          >> <<06600>>02955000
                                                               <<06600>>02960000
<< ......................................................... >>         02965000
<<                  procedure allocate'jmat                  >>         02970000
<<                                                           >>         02975000
<<  this procedure allocates a jmat entry and returns a      >>         02980000
<<  jmat dst db relative index to that entry.                >>         02985000
<<      an allocatable entry is one with a zero header.  the >>         02990000
<<  first such entry is returned; if none are found the jmat >>         02995000
<<  is expanded (if possible).                               >>         03000000
<<                                                           >>         03005000
<<     input:   exchange db to jmat                          >>         03010000
<<    output:   cce:  no error                               >>         03015000
<<              ccl:  out of room                            >>         03020000
<<                                                           >>         03025000
<<   returned:  integer index to the allocated jmat entry    >>         03030000
<< ......................................................... >>         03035000
                                                                        03040000
integer procedure allocate'jmat;                                        03045000
   option privileged, uncallable;                                       03050000
                                                                        03055000
begin                                                                   03060000
   integer           maxp;             <<index of last possible entry>> 03065000
   integer pointer   extensionp;       <<pointer to 1st word of ext >>  03070000
   integer           testp  = allocate'jmat;<<  entry being tested >>   03075000
   integer           << current seg size (wds) = extension pntr >>      03080000
                     curwsize  = extensionp,                            03085000
                     numquan;          <<num of quan to extend>>        03090000
                                                                        03095000
   integer array     jmatarr(*) = db+0;                                 03100000
                                                                        03105000
   integer stat = q-1;  << pcall status in marker >>                    03110000
   integer pcbpt;       << pointer to the pcb >>                        03115000
                                                                        03120000
                                                                        03125000
                                                                        03130000
   testp := 0;  << start at beginning of jmat >>                        03135000
   maxp := (curwsize := jmatcursize *  tblquantum) - jmatentrysize;     03140000
   do begin    <<loop until an available entry found: word(0)=0 >>      03145000
      if (testp := testp + jmatentrysize) > maxp then                   03150000
         begin    << no room for entry in table: expand >>              03155000
         << numquan := ceil ((add'l-room-needed)/tblquantum) >>         03160000
         numquan := ((testp +jmatentrysize -curwsize) +(tblquantum-1))  03165000
                    /tblquantum;                                        03170000
         if (tos := jmatcursize +numquan) > (jmatmaxsize-1) then        03175000
            begin    <<no room for expansion>>                          03180000
            testp := 0;                                                 03185000
            cc := ccl;                                                  03190000
            return;                                                     03195000
            end;                                                        03200000
                                                                        03205000
         << change the segment size (new size is also on tos) >>        03210000
         pcbpt := curprc;  << we are the current process >>             03215000
         altdsegsize (spcbxdsdst, +(numquan                             03220000
                  *tblquantum));                                        03225000
         if <> then suddendeath (350);                                  03230000
         << ................................................... >>      03235000
         <<   extensionp points to the newly allocated entry    >>      03240000
         <<   by virtue of its equivalence to curwsize.  the new>>      03245000
         <<   entry is now zeroed out.                          >>      03250000
         << ................................................... >>      03255000
                                                                        03260000
         extensionp := 0;                                               03265000
         move extensionp(1) := extensionp, ((numquan *tblquantum) -1);  03270000
         jmatcursize := tos;                                            03275000
         end;                                                           03280000
      end                                                               03285000
   until jmatarr(testp) = 0;                                            03290000
   << got one >>                                                        03295000
   << allocate'jmat := testp;  by equivalence >>                        03300000
   cc := cce; << successful return >>                                   03305000
   end;   <<  allocate'jmat  >>                                         03310000
$page                                                                   03315000
                                                                        03320000
                                                                        03325000
<< .......................................................... >>        03330000
<<                   procedure  deallocate'jmat               >>        03335000
<<                                                            >>        03340000
<<    deallocates the input jmat entry.  this means simply    >>        03345000
<<    zeroing the first word of the entry and if neccessary   >>        03350000
<<    shrinking the jmat data segment.                        >>        03355000
<<                                                            >>        03360000
<<     input:  entryp -- pointer to entry to be deallocated   >>        03365000
<<             exchange db to the jmat dst                    >>        03370000
<<    output:  none                                           >>        03375000
<< .......................................................... >>        03380000
                                                                        03385000
procedure deallocate'jmat (entryp);                                     03390000
   value entryp;                                                        03395000
   integer pointer entryp;   <<pointer to entry to be deallocated >>    03400000
   option privileged, uncallable;                                       03405000
                                                                        03410000
begin                                                                   03415000
   integer pointer   maxp,      << pointer to last possible entry >>    03420000
                     nextp;     << pointer scanning through jmat  >>    03425000
   integer           pcbpt;     << pointer to the pcb >>                03430000
   integer           deltaquan;        <<amount of trailing free>>      03435000
                                                                        03440000
                                                                        03445000
   integer array jmatarr(*) =db+0; << used to access the jmat >>        03450000
<< >>                                                                   03455000
   pcbpt := curprc;  << point to the current process >>                 03460000
                                                                        03465000
   entryp := 0;  << this entry is now free >>                           03470000
   @maxp := (jmatcursize *tblquantum) -jmatentrysize;                   03475000
   << check if entryp is last alloc'd entry >>                          03480000
   @nextp := @entryp;                                                   03485000
   while (@nextp := @nextp +jmatentrysize) <= @maxp do                  03490000
      if nextp <> 0 then go to write'segment;                           03495000
   << entryp is last; find preceding used one >>                        03500000
   do @entryp := @entryp -jmatentrysize                                 03505000
   until (@entryp < @jmatentryptr)  or  (entryp <> 0);                  03510000
   @entryp := @entryp +jmatentrysize;                                   03515000
   << entryp is now last alloc'd >>                                     03520000
   if (deltaquan := ((jmatcursize *tblquantum) -@entryp) /tblquantum)   03525000
      > 0 then                                                          03530000
      begin   <<at least 1 quantum slack; contract >>                   03535000
      jmatcursize := jmatcursize -deltaquan;                            03540000
      altdsegsize (spcbxdsdst, -(deltaquan                              03545000
            *tblquantum));                                              03550000
      if <> then suddendeath (351);                                     03555000
      end;                                                              03560000
                                                                        03565000
write'segment:                                                          03570000
                                                                        03575000
   writedseg(spcbxdsdst);                                               03580000
   end;   << deallocate'jmat >>                                         03585000
                                                                        03590000
$page                                                                   03595000
                                                                        03600000
<< .............................................................. >>    03605000
<<                 procedure  delink'jmat                         >>    03610000
<<                                                                >>    03615000
<<   delinks the jmat entry from ucop's scheduling queue.         >>    03620000
<<   the head and tail of the queue, kept in the jmat zeroth      >>    03625000
<<   entry are updated.                                           >>    03630000
<<                                                                >>    03635000
<<     input:  jmatind -- a db index to the jmat entry to be      >>    03640000
<<                        delinked.                               >>    03645000
<<             exchange db to the jmat dst                        >>    03650000
<<    output:  none                                               >>    03655000
<< .............................................................. >>    03660000
                                                                        03665000
                                                                        03670000
procedure delink'jmat (jmatind);                                        03675000
   value jmatind;                                                       03680000
   integer jmatind;                                                     03685000
   option  uncallable;                                                  03690000
                                                                        03695000
begin                                                                   03700000
                                                                        03705000
integer       previnx;  << index to previous jmat entry in queue >>     03710000
integer array jmatarr(*) = db+0; << the jmat >>                         03715000
                                                                        03720000
                                                                        03725000
previnx := 0;  << this is in case we are the head and the tail >>       03730000
if jmatind = jmatheadptr  << are we delinking the head? >>              03735000
then jmatheadptr := jmatarr(jmatind+jmatschedlinkoff)                   03740000
else begin                       << find the previous jmat >>           03745000
  previnx := jmatheadptr;        << start at the top >>                 03750000
  while jmatarr(previnx+jmatschedlinkoff) <> jmatind do                 03755000
    previnx := jmatarr(previnx+jmatschedlinkoff);                       03760000
                                                                        03765000
  << previnx now points to the preceding jmat in the queue >>           03770000
  << link around jmatind.                                  >>           03775000
                                                                        03780000
  jmatarr(previnx+jmatschedlinkoff) :=                                  03785000
                 jmatarr(jmatind+jmatschedlinkoff);                     03790000
end;                                                                    03795000
                                                                        03800000
if jmatind = jmattailptr             << a new tail? >>                  03805000
then jmattailptr := previnx;                                            03810000
                                                                        03815000
                                                                        03820000
end;  << delink'jmat >>                                                 03825000
                                                                        03830000
                                                                        03835000
                                                               <<06600>>03840000
<<  ****  the above procedures have the same fix number **** >><<06600>>03845000
<<  ****  as this comment.                              **** >><<06600>>03850000
$page                                                                   03855000
                                                                        03860000
procedure schedulejob (jmatp);                                          03865000
   value jmatp;                                                         03870000
   integer pointer jmatp;                                               03875000
   option uncallable, privileged;                                       03880000
<< links intro <jmatp> into scheduling queue;                           03885000
   changes intro state to waiting; and awakes ucop.  >>                 03890000
begin                                                                   03895000
   entry schedulejob';                                                  03900000
                                                                        03905000
   integer           incomingdst,                                       03910000
                     savesir;                                           03915000
   integer           targetvalue;      <<sched. value of <jmatp>.>>     03920000
   logical           flag   := false;  <<true => main entry>>           03925000
                                                               <<06600>>03930000
<< ......................................................... >><<06600>>03935000
<<       declarations for referencing the jmat               >><<06600>>03940000
<<   jmatarr -- a db+0 array used after an exchange db       >><<06600>>03945000
<<   jmatinx -- used to index into jmatarr in the include    >><<06600>>03950000
<<              file definitions.                            >><<06600>>03955000
<< ......................................................... >><<06600>>03960000
   integer array     jmatarr(*) = db + 0;<< jmat array >>      <<06600>>03965000
   integer           jmatinx; << index into the jmatarr >>     <<06600>>03970000
   integer           lastinx; << index for loop through jmat >><<06600>>03975000
   integer           jvalue; << word used to build jobvalue >> <<06600>>03980000
<< >>                                                                   03985000
                                                                        03990000
                                                                        03995000
integer subroutine jobvalue (jmatinx);                         <<06600>>04000000
   value jmatinx;                                              <<06600>>04005000
   integer jmatinx;                                            <<06600>>04010000
                                                               <<06600>>04015000
<<  jobvalue is called in split stack mode with db = jmatdst>> <<06600>>04020000
<<       parameter:                                         >> <<06600>>04025000
<<             jmatinx  -- input -- index to jmat entry     >> <<06600>>04030000
<<  calculates and returns the "scheduling value" for the >>   <<06600>>04035000
<<  job whose jmat is pointed at by the input index jmatinx>>  <<06600>>04040000
<<  the scheduling value is:                              >>   <<06600>>04045000
<<           sv.(10:2) := entrytype (0=job -- 2=session)  >>   <<06600>>04050000
<<           sv.(12:4) := inpri                           >>   <<06600>>04055000
<<                                                        >>   <<06600>>04060000
<<  note:  the parameter to this routine must be named    >>   <<06600>>04065000
<<         jmatinx, in order for the define, jmatjstype   >>   <<06600>>04070000
<<         to have meaning.  it references the jmat entry >>   <<06600>>04075000
<<         utilizing jmatinx.                             >>   <<06600>>04080000
<<                                                        >>   <<06600>>04085000
                                                               <<06600>>04090000
                                                               <<06600>>04095000
begin                                                                   04100000
   jvalue := 0; << we will be building the value here>>        <<06600>>04105000
   if jmatjstype = sessiontype                                 <<06600>>04110000
   then  jvalue := jvalue + 2;                                 <<06600>>04115000
   jvalue := jvalue &lsl(4);                                   <<06600>>04120000
   jvalue := integer(logical(jvalue) lor  logical(jmatinpri)); <<06600>>04125000
   jobvalue := jvalue;                                         <<06600>>04130000
   end;    <<jobvalue>>                                                 04135000
                                                                        04140000
                                                                        04145000
<< ........................................................ >> <<06600>>04150000
<<   ***** main program for procedure schedulejob *****     >> <<06600>>04155000
<< ........................................................ >> <<06600>>04160000
                                                               <<06600>>04165000
   incomingdst := exchangedb (jmatdst);                                 04170000
   savesir := getsir (jmatsir);                                         04175000
   flag := true;                                                        04180000
                                                                        04185000
schedulejob':                                                           04190000
   targetvalue := jobvalue (@jmatp);                           <<06600>>04195000
<<  link through the scheduling queue until a job of lower  >> <<06600>>04200000
<<  scheduling value if found.  insert the new jmat there.  >> <<06600>>04205000
<<    jmatinx is the index to the jmat whose value we check >> <<06600>>04210000
<<    lastinx is the index to the previous jmat in the queue>> <<06600>>04215000
<<            after jmatinx                                 >> <<06600>>04220000
<<    jmatp   is a pointer to the jmat we are inserting     >> <<06600>>04225000
                                                               <<06600>>04230000
   jmatinx := jmatheadptr; << start at list head >>            <<06600>>04235000
   lastinx := jmatinx; << me too! >>                           <<06600>>04240000
                                                               <<06600>>04245000
   while (jmatinx <> jobchainend)   and                        <<06600>>04250000
         (jobvalue(jmatinx) >= targetvalue) do                 <<06600>>04255000
         begin                                                          04260000
          lastinx := jmatinx; << remember where we were >>     <<06600>>04265000
          jmatinx := jmatschedlink;                            <<06600>>04270000
         end;                                                           04275000
   << jmatinx is now pointing at the jmat which belongs  >>    <<06600>>04280000
   << after jmatp, and lastinx pointing at the preceder  >>    <<06600>>04285000
                                                               <<06600>>04290000
   if jmatinx = jmatheadptr  << we have a new list head >>     <<06600>>04295000
   then jmatheadptr := @jmatp                                  <<06600>>04300000
   else jmatarr(lastinx + jmatschedlinkoff) := @jmatp;         <<06600>>04305000
                                                               <<06600>>04310000
   jmatarr(@jmatp + jmatschedlinkoff) := jmatinx;              <<06600>>04315000
                                                               <<06600>>04320000
   if jmatinx = jobchainend     << are we at the end? >>       <<06600>>04325000
   then jmattailptr := @jmatp;                                 <<06600>>04330000
                                                                        04335000
   << change intro state to wait >>                                     04340000
   jmatinx := @jmatp; << we reference new jmat in defines now>><<06600>>04345000
   jmatjobstate := jobwait;                                    <<06600>>04350000
   if jmatinpri <= jmatjobfence                                <<06600>>04355000
         and jmatjstype = jobtype then                         <<06600>>04360000
      <<tell op that deferred job just inroduced >>                     04365000
      begin                                                             04370000
      tos := jmatjindev;                                       <<06600>>04375000
      exchangedb (0);                                                   04380000
      genmsg(1,242,%10000,s0,,,,,0);                           <<0u.eb>>04385000
      exchangedb (jmatdst);                                             04390000
      del;                                                              04395000
      end;                                                              04400000
   if jmatjstype = jobtype then << if job, write out >>        <<06600>>04405000
      writedseg(jmatdst);      << jmat              >>         <<05.eb>>04410000
   << synch and awake ucop >>                                           04415000
   disable;                                                             04420000
   absys'jobsync.(jobready'f) := true;                                  04425000
   enable;                                                              04430000
   awake (sysproc(ucoplpin),junkwait,0);                                04435000
                                                                        04440000
   if flag then                                                         04445000
      begin                                                             04450000
      relsir (jmatsir, savesir);                                        04455000
      exchangedb (incomingdst);                                         04460000
      end;                                                              04465000
                                                                        04470000
   end;    <<schedulejob>>                                              04475000
                                                                        04480000
                                                               <<00.04>>04485000
                                                               <<00.04>>04490000
logical procedure cilogtable(code,jmatx,cntword,command);      <<00.04>>04495000
   value   code,jmatx;                                         <<00.04>>04500000
   integer code,jmatx,cntword;                                 <<00.04>>04505000
   integer array command;                                      <<00.04>>04510000
    option  privileged,uncallable;                             <<00.04>>04515000
   <<  access the cilog data segment with action           >>  <<00.04>>04520000
   <<    code = 0 get entry and put                        >>  <<00.04>>04525000
   <<         = 1 get entry data                           >>  <<00.04>>04530000
   <<         = 2 delete entry                             >>  <<00.04>>04535000
   <<  returns                                             >>  <<00.04>>04540000
   <<    true if ok                                        >>  <<00.04>>04545000
   <<    false if error                                    >>  <<00.04>>04550000
   <<  note : db must be at stack - no bounds checks -     >>  <<00.04>>04555000
   <<         - entry size musty be 128 by initial.        >>  <<00.04>>04560000
   begin                                                       <<00.04>>04565000
   logical ok :=  false;                                       <<00.04>>04570000
   integer cntwrd,                                             <<00.04>>04575000
           oldsir,                                             <<00.04>>04580000
           olddst,                                             <<00.04>>04585000
           key,                                                <<00.04>>04590000
           index,                                              <<00.04>>04595000
           size;                                               <<00.04>>04600000
   integer pointer dlcom,                                      <<00.04>>04605000
                   p;                                          <<00.04>>04610000
   define max   = db0.(0:8)#,                                  <<00.04>>04615000
          cur   = db0.(8:8)#,                                  <<00.04>>04620000
          esize = db1      #; <<=128>>                         <<00.04>>04625000
   << >>                                                       <<00.04>>04630000
   push(dl);                                                   <<00.04>>04635000
   @dlcom := -tos+@command;                                    <<00.04>>04640000
   if code = 0 then cntwrd := cntword;                         <<00.04>>04645000
   if (olddst := exchangedb(cilogdst)) <> 0 then goto err;     <<00.04>>04650000
   oldsir := getsir(cilogsir);                                 <<00.04>>04655000
   index := 1;                                                 <<00.04>>04660000
   @p := esize;                                                <<00.04>>04665000
   key :=  if code=0 then 0 else jmatx;                        <<00.04>>04670000
   while p <> key do                                           <<00.04>>04675000
      begin                                                    <<00.04>>04680000
      index := index+1;                                        <<00.04>>04685000
      @p := @p+esize;                                          <<00.04>>04690000
      if index >= cur then                                     <<00.04>>04695000
         if code <> 0 then goto error                          <<00.04>>04700000
         else                                                  <<00.04>>04705000
            if index >= max then goto error                    <<00.04>>04710000
            else                                               <<00.04>>04715000
               begin                                           <<00.04>>04720000
               if (size:=max-cur) > 4 then size := 4;          <<00.04>>04725000
               cur := cur+size;                                <<00.04>>04730000
               size := size*esize;                             <<00.04>>04735000
               altdsegsize(cilogdst,size);                     <<00.04>>04740000
               if <> then goto error;                          <<00.04>>04745000
               p := 0;                                         <<00.04>>04750000
               move p(1) := p(0),(size);                       <<00.04>>04755000
               end;                                            <<00.04>>04760000
      end;                                                     <<00.04>>04765000
   case code of                                                <<00.04>>04770000
      begin                                                    <<00.04>>04775000
      begin                                                    <<00.04>>04780000
         p := jmatx;                                           <<00.04>>04785000
         p(1) := cntwrd;                                       <<00.04>>04790000
         tos := @p(2);                                         <<00.04>>04795000
         tos :=  @dlcom;                                       <<00.04>>04800000
         tos := (cntwrd+1)&lsl(2)&lsr(3);                      <<00.04>>04805000
         assemble(mvlb);                                       <<00.04>>04810000
      end;                                                     <<00.04>>04815000
      begin                                                    <<00.04>>04820000
         cntwrd := p(1);                                       <<00.04>>04825000
         tos := @dlcom;                                        <<00.04>>04830000
         tos := @p(2);                                         <<00.04>>04835000
         tos := (cntwrd+1)&lsl(2)&lsr(3);                      <<00.04>>04840000
         assemble(mvbl);                                       <<00.04>>04845000
      end;                                                     <<00.04>>04850000
      p := 0;                                                  <<00.04>>04855000
      end;                                                     <<00.04>>04860000
   ok := true;                                                 <<00.04>>04865000
error:                                                         <<00.04>>04870000
    relsir(cilogsir,oldsir);                                   <<00.04>>04875000
err:                                                           <<00.04>>04880000
   exchangedb(olddst);                                         <<00.04>>04885000
   if ok and code=1 then cntword := cntwrd;                    <<00.04>>04890000
   cilogtable := ok;                                           <<00.04>>04895000
   end;                                                        <<00.04>>04900000
                                                               <<00.04>>04905000
logical procedure special'terminal(ldev);                      <<02858>>04910000
   value ldev;  integer ldev;                                  <<02858>>04915000
option privileged, uncallable;                                 <<04555>>04920000
                                                               <<02858>>04925000
comment                                                        <<02858>>04930000
   in order to detect a terminal disconnect during the logon   <<02858>>04935000
sequence, the logon bit was defined in the lpdt.  devrec/progen<<02858>>04940000
set this bit when the logon sequence starts.  if the bit is off<<02858>>04945000
when initjsmp polls it, the terminal has disconnected.         <<02858>>04950000
   this procedure determines whether a terminal (device type   <<02858>>04955000
16) supports the use of this bit.  for now, ioterm0/hioterm0   <<02858>>04960000
do.  multipoint and ds pseudo-terminals do not.                <<02858>>04965000
                                                               <<02858>>04970000
input:                                                         <<02858>>04975000
   ldev - the device in question.  the caller should already   <<02858>>04980000
          have determined that it is a terminal (type 16).     <<02858>>04985000
output:                                                        <<02858>>04990000
   procedure return - true, if this device supports the use of <<02858>>04995000
                      the logon bit.                           <<02858>>05000000
                                                               <<02858>>05005000
;   << end of comment >>                                       <<02858>>05010000
                                                               <<02858>>05015000
begin                                                          <<02858>>05020000
integer lpdt'index;                                            <<06597>>05025000
integer                                                        <<06597>>05030000
   ds'result;              << return from get'dsdevice >>      <<02858>>05035000
logical                                                        <<02858>>05040000
   result = special'terminal;   << procedure return >>         <<02858>>05045000
                                                               <<02858>>05050000
                                                               <<02858>>05055000
result := false;           << initialize return >>             <<02858>>05060000
                                                               <<02858>>05065000
ds'result := get'dsdevice(ldev);                               <<02858>>05070000
                                                               <<02858>>05075000
<< get'dsdevice returns -2 if there are no ds devices >>       <<02858>>05080000
<< configured.  it returns 0 if the specified device  >>       <<02858>>05085000
<< is not a ds-related device. >>                              <<02858>>05090000
                                                               <<02858>>05095000
if (ds'result = -2) or (ds'result = 0) then                    <<02858>>05100000
   begin                                                       <<02858>>05105000
                                                               <<02858>>05110000
<< at this point, device is either a multipoint terminal    >> <<02858>>05115000
<< or an ioterm0-type terminal.  the two types of terminals >> <<02858>>05120000
<< can be distinguished by examining the terminal bit in    >> <<02858>>05125000
<< dit.  if it's on, the device is an ioterm0-type device.  >> <<02858>>05130000
                                                               <<02858>>05135000
   lpdt'index:=ldev*integer(lpdt'entry'size);                  <<06597>>05140000
   if lpdt'virtual'device = 1 then return; << virt. device >>  <<06597>>05145000
                                                               <<02858>>05150000
   result:=sysglob(lpdt'dit'ptr) < 0;                          <<06597>>05155000
   end;                                                        <<02858>>05160000
end;      << of special'terminal >>                            <<02858>>05165000
                                                               <<02858>>05170000
                                                                        05175000
                                                                        05180000
logical procedure putjmat (entryp, jmatp);                              05185000
   array entryp;                                                        05190000
   integer pointer jmatp;                                               05195000
   option privileged, uncallable;                                       05200000
                                                               <<06600>>05205000
<< this routine places the fully formatted, input jmat      >> <<06600>>05210000
<< entry into the jmat with a call to allocentry and a      >> <<06600>>05215000
<< move.  the job/session counters in the jmat are updated  >> <<06600>>05220000
<< and the new job/session is given a job/session number.   >> <<06600>>05225000
<<   parameters:                                            >> <<06600>>05230000
<<        entryp -- input -- pointer to jmat entry to be    >> <<06600>>05235000
<<                  inserted.                               >> <<06600>>05240000
<<        jmatp  -- output -- pointer to new jmat entry.    >> <<06600>>05245000
<<                                                          >> <<06600>>05250000
<<  returned value -- true if everything works              >> <<06600>>05255000
<<                    false otherwise                       >> <<06600>>05260000
                                                               <<06600>>05265000
begin                                                                   05270000
   integer pointer   entrypdl;         <<dl-rel addr of entryp><<06600>>05275000
   integer           jp;   << allocated entry index >>         <<06600>>05280000
   integer           savejsno'type; << saved job # and type >> <<06600>>05285000
   integer           savesir;                                           05290000
<< ......................................................... >><<06600>>05295000
<<       declarations for referencing the jmat               >><<06600>>05300000
<<   jmatarr -- a db+0 array used after an exchange db       >><<06600>>05305000
<<   jmatinx -- used to index into jmatarr in the include    >><<06600>>05310000
<<              file definitions.                            >><<06600>>05315000
<< ......................................................... >><<06600>>05320000
   integer array jmatarr(*) = db + 0;                          <<06600>>05325000
   integer       jmatinx;                                      <<06600>>05330000
   define maxcount = %037777#; << maximum job/session count >> <<06600>>05335000
                                                               <<06600>>05340000
<< >>                                                                   05345000
   push (dl);                                                           05350000
   @entrypdl := -tos +@entryp;                                          05355000
   exchangedb (jmatdst);                                                05360000
   savesir := getsir (jmatsir);                                         05365000
   jp := allocate'jmat;    <<get space>>                       <<06600>>05370000
   if = then                                                   <<06600>>05375000
      begin    <<got space>>                                            05380000
      tos := jp;    <<move entry into jmat>>                   <<06600>>05385000
      tos := @entrypdl;                                                 05390000
      tos := jmatentrysize;                                    <<06600>>05395000
      assemble (mvlb);                                                  05400000
          << get job/session number and update in jmat >>      <<06600>>05405000
                                                               <<06600>>05410000
      jmatinx := jp;  << point to new entry >>                 <<06600>>05415000
                                                               <<06600>>05420000
      if logical(jmatinteractive) then   << a session? >>      <<06600>>05425000
      begin                                                    <<06600>>05430000
         jmatjstype  :=  sessiontype;  << set job type field>> <<06600>>05435000
         if jmatscounter > maxcount  << no more numbers >>     <<06600>>05440000
         then  <<  wrap around and start counting again  >>    <<06600>>05445000
         begin                                                 <<06600>>05450000
            jmatscounter := 1;                                 <<06600>>05455000
            jmatjsno     := 1;                                 <<06600>>05460000
         end                                                   <<06600>>05465000
         else                                                  <<06600>>05470000
         begin                                                 <<06600>>05475000
            jmatjsno      := jmatscounter;                     <<06600>>05480000
            jmatscounter  := jmatscounter + 1;                 <<06600>>05485000
         end;                                                  <<06600>>05490000
      end                                                      <<06600>>05495000
      else             <<  its a job  >>                       <<06600>>05500000
      begin                                                    <<06600>>05505000
         jmatjstype  :=  jobtype;  << job type field >>        <<06600>>05510000
         if jmatjcounter > maxcount                            <<06600>>05515000
         then                                                  <<06600>>05520000
         begin                                                 <<06600>>05525000
            jmatjcounter := 1;                                 <<06600>>05530000
            jmatjsno     := 1;                                 <<06600>>05535000
         end                                                   <<06600>>05540000
         else                                                  <<06600>>05545000
         begin                                                 <<06600>>05550000
            jmatjsno      := jmatjcounter;                     <<06600>>05555000
            jmatjcounter  := jmatjcounter + 1;                 <<06600>>05560000
         end;                                                  <<06600>>05565000
      end;                                                     <<06600>>05570000
      tos := true;    <<signal ok>>                                     05575000
      end                                                               05580000
   else                                                                 05585000
      tos := false;                                                     05590000
   putjmat := tos;                                                      05595000
   <<  save the j/s number and type for local jmat >>          <<06600>>05600000
   savejsno'type :=  jmatarr(jmatinx+jmatjsnooff);             <<06600>>05605000
   relsir (jmatsir, savesir);                                           05610000
   exchangedb (0);                                                      05615000
   <<  put the j/s number and type in our local jmat >>        <<06600>>05620000
   entryp(jmatjsnooff) := savejsno'type;                       <<06600>>05625000
   @jmatp := jp;                                               <<06600>>05630000
   end;    <<putjmat>>                                                  05635000
                                                               << 8881>>05640000
procedure speedsense;                                          << 8881>>05645000
option internal,privileged,uncallable;                         << 8881>>05650000
begin                                                          << 8881>>05655000
  logical array buffer(0:1);                                   << 8881>>05660000
  logical done;                                                << 8881>>05665000
  integer lgth;                                                << 8881>>05670000
  integer temp;                                                << 8881>>05675000
  intrinsic fsetmode,readx;                                    << 8881>>05680000
  << we do not speed sense now, maybe in the future.  we will>><< 8881>>05685000
  << just wait for a cr.                                     >><< 8881>>05690000
  fsetmode(1,4);  << no cr/lf on read >>                       << 8881>>05695000
  fcontrol(1,14,temp);  << disable break >>                    << 8881>>05700000
  done := false;                                               << 8881>>05705000
  while not done do                                            << 8881>>05710000
  begin                                                        << 8881>>05715000
    lgth := readx(buffer,-1);                                  << 8881>>05720000
    if = and (lgth = 0)                                        << 8881>>05725000
       then done := true;                                      << 8881>>05730000
  end;                                                         << 8881>>05735000
  fsetmode(1,0);                                               << 8881>>05740000
  fcontrol(1,15,temp);                                         << 8881>>05745000
end;  << speedsense >>                                         << 8881>>05750000
$title " INITJSMP  - JOB INITIATION "                          <<05.eb>>05755000
procedure initjsmp(expcode);                                   <<02.eb>>05760000
   integer expcode;                                            <<11.eb>>05765000
   option uncallable;                                          <<11.eb>>05770000
comment                                                        <<02.eb>>05775000
sets up everything after for job/session main process after    <<02.eb>>05780000
ucop finishes.                                                 <<02.eb>>05785000
on entry:                                                      <<02.eb>>05790000
   - jmat entry is set up.                                     <<02.eb>>05795000
   - jit is unitialized, but contains communication info.      <<02.eb>>05800000
   - jdt is unitialized.                                       <<02.eb>>05805000
then:                                                          <<02.eb>>05810000
   - jmat entry set to running.                                <<02.eb>>05815000
   - job type & job number placed in pcbx.                     <<02.eb>>05820000
   - job cutoff table set, index placed in pcbx.               <<02.eb>>05825000
   - direclogon called to update use count & get entries.      <<02.eb>>05830000
   - capabilities placed in pcbx.                              <<02.eb>>05835000
   - jit initialized.                                          <<02.eb>>05840000
   - jdt initialized.                                          <<02.eb>>05845000
   - session timeout turned off.                               <<02.eb>>05850000
   - open $stdin & $stdlist.                                   <<02.eb>>05855000
   - passwords checked.                                        <<02.eb>>05860000
   - account & grup time limits checked.                       <<02.eb>>05865000
   - logon msg sent to console.                                <<02.eb>>05870000
   - standand forms are requested if needed.                   <<02.eb>>05875000
   - log called.                                               <<02.eb>>05880000
   - logon msg printed for user.                               <<02.eb>>05885000
;                                                              <<02.eb>>05890000
begin                                                          <<02.eb>>05895000
                                                               <<02.eb>>05900000
equate                                                         <<02.eb>>05905000
                                                               <<02.eb>>05910000
<< table info >>                                               <<02.eb>>05915000
                                                               <<02.eb>>05920000
   jdtsize    = 50*128-4,  << 50 sectors less links >>         <<06910>>05925000
   << 50 is an arbitrary amount used to get to about 6k >>     <<06910>>05930000
   << words in the jdt.                                 >>     <<06910>>05935000
                                                               <<06910>>05940000
   numjdtptrs = 6,                                             <<u.rao>>05945000
   jdtptr     = numjdtptrs+18,                                 <<u.rao>>05950000
                                                               <<02.eb>>05955000
                                                               <<02.eb>>05960000
                                                               <<02.eb>>05965000
<< genmsg messages >>                                          <<02.eb>>05970000
                                                               <<02.eb>>05975000
   syset          = 1,                                         <<02.eb>>05980000
   ciset          = 2,                                         <<05.eb>>05985000
   cpassfail      = 5,                                         <<05.eb>>05990000
   cacpufail      = 6,                                         <<01112>>05995000
   caconnfail     = 7,                                         <<01112>>06000000
   cbafail        = 9,                                         <<00603>>06005000
   ciafail        = 10,                                        <<00603>>06010000
   cgcpufail      = 11,                                        <<01112>>06015000
   cgconnfail     = 12,                                        <<01112>>06020000
   cstdinfail      = 40,                                       <<03785>>06025000
   cstdlistfail    = 41,                                       <<03785>>06030000
   formreqd       = 243,                                       <<02.eb>>06035000
   logonheadj     = 42,                                        <<05.eb>>06040000
   logonsno       = 34,                                        <<05.eb>>06045000
   logonjno       = 43,                                        <<05.eb>>06050000
   logontpri      = 50,                                        <<05.eb>>06055000
   logonthipri    = 51,                                        <<05.eb>>06060000
   logonpri       = 44,                                        <<05.eb>>06065000
   logonhipri     = 52,                                        <<05.eb>>06070000
   logondatelevel = 35,                                        <<05.eb>>06075000
   passmsg        = 52, << 53=group,54=acct,55=user>>          <<05.eb>>06080000
   passwdfail     = 1441,                                      <<05.eb>>06085000
   accoutcpu      = 1442,                                      <<01112>>06090000
   w'accoutcpu    = 1443,                                      <<01112>>06095000
   grpoutcpu      = 1445,                                      <<01112>>06100000
   w'grpoutcpu    = 1446,                                      <<01112>>06105000
   accoutconn     = 1491,                                      <<01112>>06110000
   w'accoutconn   = 1492,                                      <<01112>>06115000
   grpoutconn     = 1493,                                      <<01112>>06120000
   w'grpoutconn   = 1494,                                      <<01112>>06125000
   clogonmsg      = 33,                                        <<05.eb>>06130000
   proglogon      = 39,                                        << 8144>>06135000
   noia           = 1431,                                      <<05.eb>>06140000
   noba           = 1432,                                      <<05.eb>>06145000
   noia'acct      = 1447,                                      <<01053>>06150000
   noba'acct      = 1448,                                      <<01053>>06155000
   noacct         = 1435, << 1436 - 1439 >>                    <<05.eb>>06160000
   <<nogroup      = 1436, >>                                   <<05.eb>>06165000
   <<noacct'      = 1437, >>                                   <<05.eb>>06170000
   <<nouser       = 1438, >>                                   <<05.eb>>06175000
   <<nohomeg      = 1439, >>                                   <<05.eb>>06180000
   conslogonfail  = 60,   << 61 - 72 >>                        <<01112>>06185000
   <<cpassfail    = 65,   >>                                   <<05.eb>>06190000
   <<cacpufail    = 66,   >>                                   <<01112>>06195000
   <<caconnfail   = 67,   >>                                   <<01112>>06200000
   <<cbafail      = 69,   >>                                   <<01053>>06205000
   <<ciafail      = 70,   >>                                   <<01053>>06210000
   <<cgcpufail    = 71,   >>                                   <<01112>>06215000
   <<cgconnfail   = 72,   >>                                   <<01112>>06220000
                                                               <<02.eb>>06225000
<< misc >>                                                     <<02.eb>>06230000
                                                               <<02.eb>>06235000
   logonfail = 7,                                              <<02.eb>>06240000
   timedout  = 12,                                             <<01130>>06245000
   echoon    = 8,                                              <<01130>>06250000
   echooff   = 9,                                              <<01130>>06255000
   ucopcommsize = 5,                                           <<02.eb>>06260000
   version      = %1116,                                       <<02.eb>>06265000
   updatelevel  = %1114,                                       <<02.eb>>06270000
   fixlevel     = %1115;                                       <<02.eb>>06275000
                                                               <<06018>>06280000
define                                                         <<06018>>06285000
   sysglobext        = absolute( %1377 ) #,                    <<06018>>06290000
   base'ver          = sysglobext + %1074 #,                   <<06018>>06295000
   base'upd          = sysglobext + %1075 #,                   <<06018>>06300000
   base'fix          = sysglobext + %1076 #;                   <<06018>>06305000
                                                               <<02.eb>>06310000
define                                                         <<02.eb>>06315000
   outpribits = 5:4#,                                          <<02332>>06320000
   jpri         = 12:4 #,                                      <<02.eb>>06325000
   duplicitive  =  6:1 #,                                      <<02.eb>>06330000
   udcexist       = (1:1) #; <<in dir. uentry>>                <<04.eb>>06335000
double                                                         << 8144>>06340000
   port'id;                                                    << 8144>>06345000
                                                               << 8144>>06350000
logical                                                        << 8144>>06355000
   sub'queue;                                                  << 8144>>06360000
                                                               << 8144>>06365000
integer array                                                  << 8144>>06370000
   msgarr(0:2);                                                << 8144>>06375000
                                                               << 8144>>06380000
                                                               << 8144>>06385000
integer                                                        << 8144>>06390000
   ldev;                                                       << 8144>>06395000
                                                               <<02.eb>>06400000
integer pointer ps0 = s-0;                                     <<06907>>06405000
  logical array buffer(0:5);                                   << 8144>>06410000
  byte array bufferb(*) = buffer;                              << 8144>>06415000
  integer lgth;                                                << 8144>>06420000
  logical infile,outfile;                                      << 8144>>06425000
  integer timer := 1;                                          << 8144>>06430000
  logical done,progcreation;                                   << 8144>>06435000
                                                               << 8144>>06440000
  define                                                       << 8144>>06445000
    primary'stat       = (%33,"^")#,                           << 8144>>06450000
    primary'stat'len   = -2#;                                  << 8144>>06455000
                                                               << 8144>>06460000
  intrinsic debug,fcheck,fclose,fcontrol,ferrmsg,fopen,fread,  << 8144>>06465000
            fsetmode,fwrite,pause,print,readx,quit,terminate;  << 8144>>06470000
                                                               << 8144>>06475000
                                                               <<02.eb>>06480000
integer                                                        <<02.eb>>06485000
   jcutindex, << index into the jcut >>                        <<06907>>06490000
   temp,                                                       <<02.eb>>06495000
   temp1,                                                      <<00220>>06500000
   echostate = temp1,                                          <<00220>>06505000
   time = temp,                                                <<02.eb>>06510000
   sirflag,                                                    <<02.eb>>06515000
   dummy = temp,                                               <<02.eb>>06520000
   dirfail,                                                    <<05.eb>>06525000
   indev,   << input device from jmat entry >>                 <<02858>>06530000
   passfailcnt,                                                <<04213>>06535000
   jobnum,                                                     <<02.eb>>06540000
   s0 = s-0,                                                   <<02.eb>>06545000
   s1 = s-1,                                                   <<02.eb>>06550000
   s2 = s-2,                                                   <<02.eb>>06555000
   x = x;                                                      <<02.eb>>06560000
                                                               <<02.eb>>06565000
define                                                         <<38.pv>>06570000
    pvf = 0:1  #,                                              <<38.pv>>06575000
    mvtabxf = 8:8 #,                                           <<38.pv>>06580000
    pv'and'mounted = gentry (glinkage).(pvf) = 1 and           <<38.pv>>06585000
                     gentry (x).(mvtabxf) <> 0 #;              <<38.pv>>06590000
                                                               <<38.pv>>06595000
define                                                         <<0313>> 06600000
   sysmgr  = uentry(ucap).(0:1) #,                             <<0313>> 06605000
   acctmgr = uentry(ucap).(1:1) #;                             <<0313>> 06610000
logical                                                        <<02.eb>>06615000
   lost'terminal,  << for special disconnect processing. >>    <<02858>>06620000
   passfail,                                                   <<01130>>06625000
   passwordok,                                                 <<04213>>06630000
   job;                                                        <<02.eb>>06635000
integer lpdt'index; << used to index into lpdt/incllpdt >>     <<06597>>06640000
<< global allow mask stuff >>                                  <<06908>>06645000
logical pointer sysglobextion  = %377;                         <<06908>>06650000
equate gamask =%103;<< start global allow mask in sysglobext >><<06908>>06655000
integer i;                                                     <<06908>>06660000
                                                               <<02.eb>>06665000
<< ......................................................... >><<06600>>06670000
<<       declarations for referencing the jmat               >><<06600>>06675000
<<   jmatarr -- a local array which holds an entry.          >><<06600>>06680000
<<   jmatarrb, jmatarrd -- byte and double of jmatarr        >><<06600>>06685000
<<   jmatinx -- used to index into jmatarr in the include    >><<06600>>06690000
<<              file definitions.  note that since jmatarr is>><<06600>>06695000
<<              the entry, this will be 0.                   >><<06600>>06700000
<< ......................................................... >><<06600>>06705000
array jmatarr(0:jmatentrysize-1);                              <<06600>>06710000
byte array jmatarrb(*) = jmatarr;                              <<06600>>06715000
double array jmatarrd(*) = jmatarr;                            <<06600>>06720000
integer      jmatinx;                                          <<06600>>06725000
                                                               <<02.eb>>06730000
array aentry(0:asize-1); double array aentryd(*) = aentry;     <<02.eb>>06735000
array uentry(0:usize-1); double array uentryd(*) = uentry;     <<02.eb>>06740000
array gentry(0:gsize-1); double array gentryd(*) = gentry(1);  <<02.eb>>06745000
                                                               <<02.eb>>06750000
   << ucop communication area - initially in jit >>            <<02.eb>>06755000
array ucopcomm(0:ucopcommsize-1) = q;                          <<02.eb>>06760000
integer pointer jinxddep   = ucopcomm;                         <<02.eb>>06765000
integer         jindevtype = ucopcomm +1;                      <<02.eb>>06770000
integer pointer jlistxddep = ucopcomm +2;                      <<02.eb>>06775000
logical         stdforms   = ucopcomm +3;                      <<02.eb>>06780000
                                                               <<02.eb>>06785000
integer array jitarr(0:jit'entry'size-1);                      <<06906>>06790000
array jdt(0:jdtptr+7);                                         <<05.ro>>06795000
integer array allowmask(0:jit'allow'mask'length-1);            <<06906>>06800000
                                                               <<u.rao>>06805000
byte array logonq(0:1);                                        <<02.eb>>06810000
byte array jobid(0:35);                                        <<02.eb>>06815000
byte array datebuf(0:27);                                      <<02.eb>>06820000
                                                               <<12.km>>06825000
array partno(0:4);                                             <<06018>>06830000
byte array bpartno(*) = partno;                                <<06018>>06835000
define                                                         <<06018>>06840000
   verpart = bpartno    #,                                     <<06018>>06845000
   updpart = bpartno(3) #,                                     <<06018>>06850000
   fixpart = bpartno(6) #;                                     <<06018>>06855000
                                                               <<06018>>06860000
array basepartno(0:4);                                         <<06018>>06865000
byte array bbasepartno(*) = basepartno;                        <<06018>>06870000
define                                                         <<06018>>06875000
   basever = bbasepartno    #,                                 <<06018>>06880000
   baseupd = bbasepartno(3) #,                                 <<06018>>06885000
   basefix = bbasepartno(6) #;                                 <<06018>>06890000
logical parthold;                                              <<06018>>06895000
integer type;                                                  << 8881>>06900000
byte array bparthold(*) = parthold;                            <<06018>>06905000
                                                               <<12.km>>06910000
array buff'(0:8); byte array buff(*) = buff';                  <<02.eb>>06915000
array qarray(*) = q + 0;                                       <<06598>>06920000
integer pcbglobloc;                                            <<06598>>06925000
logical pxfixedloc;                                            <<06598>>06930000
logical pcbpt;                                                 <<06599>>06935000
                                                               <<02.eb>>06940000
subroutine movefromdseg(target,dstn,offset,count);             <<02.eb>>06945000
   value target,dstn,offset,count;                             <<02.eb>>06950000
   logical target,dstn,offset,count;                           <<02.eb>>06955000
begin                                                          <<02.eb>>06960000
   x := tos; << save return address >>                         <<02.eb>>06965000
   assemble(mfds 0);                                           <<02.eb>>06970000
   tos := x; << restore return address >>                      <<02.eb>>06975000
end;                                                           <<02.eb>>06980000
                                                               <<02.eb>>06985000
subroutine movetodseg(dstn,offset,source,count);               <<02.eb>>06990000
   value dstn,offset,source,count;                             <<02.eb>>06995000
   logical dstn,offset,source,count;                           <<02.eb>>07000000
begin                                                          <<02.eb>>07005000
   x := tos;                                                   <<02.eb>>07010000
   assemble(mtds 0);                                           <<02.eb>>07015000
   tos := x;                                                   <<02.eb>>07020000
end;                                                           <<02.eb>>07025000
                                                               <<06906>>07030000
                                                               <<06906>>07035000
subroutine get'sys'allow'mask;                                 <<06906>>07040000
<< gets the global allow mask from the sysglob extension     >><<06908>>07045000
<< area.  the pointer to this area is kept in the sysglob    >><<06908>>07050000
<< cell %377.  the offset for the start of the global allow  >><<06908>>07055000
<< mask is %103 (gamask) into the sysglob extension area.    >><<06908>>07060000
<< the global allow mask is placed in the array allowmask.   >><<06908>>07065000
begin                                                          <<06908>>07070000
i:=-1;                                                         <<06908>>07075000
while (i:=i+1) < jit'allow'mask'length                         <<06908>>07080000
      do allowmask(i):=sysglobextion(gamask+i);                <<06908>>07085000
end; << subroutine get'sys'allow'mask >>                       <<06906>>07090000
                                                               <<06906>>07095000
                                                               <<02.eb>>07100000
                                                               <<02.eb>>07105000
subroutine setjcut;                                            <<02.eb>>07110000
begin                                                          <<02.eb>>07115000
                                                               <<02.eb>>07120000
<< this subroutine allocates an entry in the job cut off    >> <<06907>>07125000
<< table.  the next free entry is in word 0 of the header   >> <<06907>>07130000
<< the next free entry after that, is in the first word of  >> <<06907>>07135000
<< entry that just got allocated, thus the first word of the>> <<06907>>07140000
<< header must be updated as such.                          >> <<06907>>07145000
tos:=jmatcpulim;                                               <<06907>>07150000
if > then begin                                                <<06907>>07155000
          jcutindex:=jcutfreehead; << get free entry >>        <<06907>>07160000
          jcutfreehead:=jcutcpul; << save ptr to next entry >> <<06907>>07165000
          jcutcpul:=tos; << set the limit for user >>          <<06907>>07170000
          jcutcpuc1:=0;  << zero out >>                        <<06907>>07175000
          jcutcpuc2:=0;  << and again >>                       <<06907>>07180000
          tos:=((jcutindex-jcutheadsize)/jcutentsize)+1;       <<06907>>07185000
          pxglobal;                                            <<06907>>07190000
          pxg'jcutinx:=tos;              << to pxglobal area >><<06907>>07195000
          end                                                  <<06907>>07200000
     else begin << no entry needed, unlimited cpu granted  >>  <<06907>>07205000
          del; << delete the cpu time from tos >>              <<06907>>07210000
          pxglobal;                                            <<06907>>07215000
          pxg'jcutinx:=0;   << jcut index in pxglobal is 0 >>  <<06907>>07220000
          end;                                                 <<06907>>07225000
                                                               <<02.eb>>07230000
end; << setjcut >>                                             <<02.eb>>07235000
                                                               <<05.eb>>07240000
                                                               <<05.eb>>07245000
                   << ******************** >>                  <<05.eb>>07250000
                   << *  tellop          * >>                  <<05.eb>>07255000
                   << ******************** >>                  <<05.eb>>07260000
                                                               <<05.eb>>07265000
                                                               <<05.eb>>07270000
subroutine tellop(msgno);                                      <<02.eb>>07275000
   value msgno; integer msgno;                                 <<02.eb>>07280000
begin                                                          <<02.eb>>07285000
   formname(3, jobid, jmatarrb(jmatjobnameoff*2),              <<06600>>07290000
                      jmatarrb(jmatusernameoff*2),             <<06600>>07295000
                      jmatarrb(jmatacctnameoff*2),             <<06600>>07300000
                      jmatarrb(jmatgrplogonoff*2));            <<06600>>07305000
                                                               <<06600>>07310000
   <<  tell operator about the logon  >>                       <<06600>>07315000
   genmsg(syset, msgno, %01000, @jobid, jmatorigjin,,,,0);     <<06600>>07320000
end; << tellop >>                                              <<02.eb>>07325000
                                                               <<05.eb>>07330000
                                                               <<05.eb>>07335000
                   << ******************** >>                  <<05.eb>>07340000
                   << *    timinate      * >>                  <<05.eb>>07345000
                   << ******************** >>                  <<05.eb>>07350000
                                                               <<05.eb>>07355000
                                                               <<05.eb>>07360000
subroutine timinate(messno,failno);                            <<05.eb>>07365000
   value messno,failno; integer messno,failno;                 <<05.eb>>07370000
comment - called to prevent logon msg on $stdlist              <<05.eb>>07375000
          & also prints reason at console. calls:              <<05.eb>>07380000
   1 - 4  directory fails,                                     <<01112>>07385000
       5  password fail,                                       <<05.eb>>07390000
       6  account out of cpu time,                             <<01112>>07395000
       7  account out of connect time,                         <<01112>>07400000
       9  no ba,                                               <<00603>>07405000
       10 no ia.                                               <<00603>>07410000
       11 group out of cpu time,                               <<01112>>07415000
       12 group out of connect time.                           <<01112>>07420000
                                                               <<01130>>07425000
   if the logon timeout expires, expcode is set to             <<01130>>07430000
   12 + dirfail by the main body of initjsmp.                  <<01130>>07435000
;                                                              <<05.eb>>07440000
begin                                                          <<05.eb>>07445000
   if (failno < cstdinfail) and ( not progcreation )           << 8144>>07450000
      then genmsg(ciset,messno);                               << 8144>>07455000
   if jmatwaittillon = 1 then                                  << 8144>>07460000
   begin                                                       << 8144>>07465000
   << creator is waiting to hear from us. >>                   << 8144>>07470000
   msgarr(1) := 3;  << message length >>                       << 8144>>07475000
   msgarr(2) := get'dcs'failno(3,failno);  << translate error>><< 8144>>07480000
   send'db(port'id,sub'queue,msgarr);                          << 8144>>07485000
   pxglobal;                                                   << 8144>>07490000
   jmatwaittillon := 0;                                        << 8144>>07495000
   movetodseg(jmatdst,pxg'jmatinx*jmatentrysize,@jmatarr,      << 8144>>07500000
              jmatentrysize);                                  << 8144>>07505000
   end;                                                        << 8144>>07510000
   tellop(conslogonfail +failno);                              <<05.eb>>07515000
   if failno > 4 then   << tell expire reason >>               <<03785>>07520000
   begin                <<    for logoff.     >>               <<03785>>07525000
      if failno >= cstdinfail                                  <<03785>>07530000
         then expcode := failno                                <<03785>>07535000
         else expcode := logonfail;                            <<03785>>07540000
   end                                                         <<03785>>07545000
   else       expcode := logonfail + failno;                   <<03785>>07550000
   setjcw(logical(expcode) lor %100000); <<abort bit>>         <<00243>>07555000
   expcode.(0:8) := dirfail;  << for job clean up. >>          <<04200>>07560000
   terminate; << shall never return >>                         <<05.eb>>07565000
   help       << for linking purposes >>                       <<01130>>07570000
end; << timinate >>                                            <<05.eb>>07575000
                                                               <<02.eb>>07580000
                                                               <<05.eb>>07585000
                                                               <<05.eb>>07590000
                   << ******************** >>                  <<05.eb>>07595000
                   << *  getcheckdir     * >>                  <<05.eb>>07600000
                   << ******************** >>                  <<05.eb>>07605000
                                                               <<05.eb>>07610000
                                                               <<05.eb>>07615000
subroutine getcheckdir;                                        <<02.eb>>07620000
begin <<get a,u,g dir. entries, check cap & maxpri, set pcbx >><<02.eb>>07625000
                                                               <<02.eb>>07630000
uentry(umaxjob) := 0; << if direclogon fails, then        >>   <<06.eb>>07635000
                      << getpriority won't be called      >>   <<06.eb>>07640000
dirfail := direclogon(0,jmatarr,0d,0d,aentry,uentry,gentry);   <<06600>>07645000
if dirfail <> 0 then return;                                   <<05.eb>>07650000
                                                               <<05.eb>>07655000
   << found acct, user, group directory entryies>>             <<02.eb>>07660000
                                                               <<05.eb>>07665000
if jmatgrplogon = "  " then                                    <<06600>>07670000
begin << get home group >>                                     <<05.eb>>07675000
   move jmatgrplogon := uentry(uhgroup),(4);                   <<06600>>07680000
end;                                                           <<05.eb>>07685000
if uentry(ucap) lor aentry(acap) <> aentry(acap) or            <<02.eb>>07690000
   uentry(ucap +1) lor aentry(acap +1) <> aentry(acap +1) then <<02.eb>>07695000
begin << ucap is less than acap >>                             <<02.eb>>07700000
   uentry(ucap) := uentry(ucap) land aentry(acap);             <<02.eb>>07705000
   uentry(ucap +1) := uentry(ucap +1) land aentry(acap +1);    <<02.eb>>07710000
end;                                                           <<02.eb>>07715000
pxglobal;                                                      <<06598>>07720000
pxfixed;                                                       <<06598>>07725000
pxg'userattributes := uentry(ucap);                            <<06598>>07730000
pxfxcap := uentry(ucap+1);                                     <<06598>>07735000
pxfxuserudc := uentry(umaxjob).udcexist;                       <<06598>>07740000
pxfxacctudc := aentry(amaxjobw).udcexist;                      <<06598>>07745000
if integer(uentry(umaxjob).(8:8)) < integer(aentry             <<05.eb>>07750000
   (amaxjobw).(8:8)) then << user maxjobpri > acct >>          <<02.eb>>07755000
   uentry(umaxjob).(8:8) := aentry(amaxjobw).(8:8);            <<02.eb>>07760000
                                                               <<02.eb>>07765000
end; << getcheckdir >>                                         <<02.eb>>07770000
comment     - jmatentry(0)                                     <<02.eb>>07775000
    0          5  6  7  8  9 10 11 12      15                  <<02.eb>>07780000
   *******************************************                 <<02.eb>>07785000
   !  job state ! d! i! g! a! u! c!  inpri   !                 <<02.eb>>07790000
   *******************************************                 <<02.eb>>07795000
                                                               <<02.eb>>07800000
   d - duplicative                                             <<02.eb>>07805000
   i - interactive                                             <<02.eb>>07810000
   g - = 1 group pass not checked                              <<02.eb>>07815000
   a - = 1 acct  pass not checked                              <<02.eb>>07820000
   u - = 1 user  pass not checked                              <<02.eb>>07825000
   c - device class specified                                  <<02.eb>>07830000
;                                                              <<02.eb>>07835000
                                                               <<02.eb>>07840000
logical subroutine checkpass(passwd,level);                    <<02.eb>>07845000
   value level; integer level;                                 <<02.eb>>07850000
   array passwd;                                               <<02.eb>>07855000
begin <<1=g,2=a,3=u >>                                         <<02.eb>>07860000
                                                               <<02.eb>>07865000
passfailcnt := 0;                                              <<04213>>07870000
passwordok := true;                                            <<04213>>07875000
x := level;                                                    <<02.eb>>07880000
tos := jmatarr;                                                <<06600>>07885000
assemble(tbc 7,x; del); << check if omitted on :hello >>       <<02.eb>>07890000
if <> and passwd <> "  " then                                  <<02.eb>>07895000
begin << password omitted but required >>                      <<02.eb>>07900000
             <<************************************************<<04213>>07905000
passprompt:  << if bad password then prompt maximum three times<<04213>>07910000
             <<************************************************<<04213>>07915000
   if job then passwordok := false                             <<04213>>07920000
   else                                                        <<08.eb>>07925000
   begin                                                       <<08.eb>>07930000
      << turn off echo and save old state >>                   <<01130>>07935000
      pxglobal;                                                <<06598>>07940000
      tos := attachio(pxg'outputldev,0,0,0,echooff,            <<06598>>07945000
                      0,0,0,1);                                <<01130>>07950000
      echostate := tos;                                        <<01130>>07955000
      del;                                                     <<01130>>07960000
      << prompt for appropriate password >>                    <<01130>>07965000
      pxglobal;                                                <<06598>>07970000
      genmsg(syset,passmsg+level,,,,,,,pxg'outputldev,,,,      <<06598>>07975000
             %100000);                                         <<01130>>07980000
      buff' := "  ";                                           <<08.eb>>07985000
      move buff'(1) := buff',(7);                              <<08.eb>>07990000
      buff(16) := 0;                                           <<08.eb>>07995000
      << read password from terminal >>                        <<01130>>08000000
      pxglobal;                                                <<06598>>08005000
      tos := attachio(pxg'inputldev,0,0,@buff',                <<06598>>08010000
                      0,-16,0,0,1);                            <<02858>>08015000
      del;                                                     <<01130>>08020000
      << check for successful completion >>                    <<01130>>08025000
      if tos.(13:3) <> 1 then                                  <<01130>>08030000
        passwordok := false                                    <<04213>>08035000
      else                                                     <<04213>>08040000
      begin                    << read successful >>           <<01130>>08045000
      pxglobal;                                                <<06598>>08050000
      attachio(pxg'outputldev,0,0,0,1,                         <<06598>>08055000
               0,0,0,1);       << give cr/lf >>                <<02858>>08060000
      scan buff while " ",1;                                   <<08.eb>>08065000
      assemble(dup,dup);                                       <<08.eb>>08070000
      move * := * while ans; << upshift >>                     <<08.eb>>08075000
      temp := tos; << clean stack so parm ref. works>>         <<08.eb>>08080000
      tos := @passwd &lsl(1);                                  <<08.eb>>08085000
      tos := temp;                                             <<08.eb>>08090000
      if * <> *,(8) then                                       <<04213>>08095000
         begin                                                 <<04213>>08100000
         passwordok := false;                                  <<04213>>08105000
         passfailcnt := passfailcnt + 1;                       <<04213>>08110000
         end                                                   <<04213>>08115000
      else                                                     <<04213>>08120000
         passwordok := true;                                   <<04213>>08125000
<< check to see if there is a need to loop back to >>          <<04213>>08130000
<< prompt for  the password again.                 >>          <<04213>>08135000
                                                               <<04213>>08140000
      if  (passfailcnt >0) and (passfailcnt < 3) and           <<04213>>08145000
         (not passwordok) then                                 <<04213>>08150000
         begin                                                 <<04213>>08155000
         tellop(conslogonfail + cpassfail);                    <<04213>>08160000
         if echostate = 0 then                                 <<04213>>08165000
            begin                                              <<06598>>08170000
            pxglobal;                                          <<06598>>08175000
            attachio(pxg'outputldev,0,0,0,echoon,0,0,0,1);     <<06598>>08180000
            end;                                               <<06598>>08185000
         goto passprompt;                                      <<04213>>08190000
         end                                                   <<04213>>08195000
      else                                                     <<04213>>08200000
         if echostate = 0 then                                 <<04213>>08205000
          begin                                                <<06598>>08210000
          pxglobal;                                            <<06598>>08215000
          attachio(pxg'outputldev,0,0,0,echoon,0,0,0,1);       <<06598>>08220000
          end;                                                 <<06598>>08225000
      if echostate = 0 then                                    <<01130>>08230000
         begin                                                 <<06598>>08235000
           pxglobal;                                           <<06598>>08240000
           attachio(pxg'outputldev,0,0,0,echoon,0,0,0,1);      <<06598>>08245000
           end;                                                <<06598>>08250000
      end                                                      <<01130>>08255000
   end;                                                        <<08.eb>>08260000
end;                                                           <<02.eb>>08265000
                                                               <<02.eb>>08270000
checkpass := passwordok; << set return value to true or false ><<04213>>08275000
end; << checkpass >>                                           <<02.eb>>08280000
                                                               <<02.eb>>08285000
subroutine initjit;                                            <<02.eb>>08290000
comment                                                        <<02.eb>>08295000
   uses local copy of jmat. also uses direclogon arrays        <<02.eb>>08300000
   uentry, aentry & gentry.                                    <<02.eb>>08305000
;                                                              <<02.eb>>08310000
begin                                                          <<02.eb>>08315000
                                                               <<02.eb>>08320000
jitarr:=0;                      << set up to zero out >>       <<06906>>08325000
move jitarr(1):=jitarr,(jit'entry'size-1); << zero array >>    <<06906>>08330000
jitvalue6:=6;                                                  <<06906>>08335000
pxglobal;  << set up for getting jit data segment number >>    <<06906>>08340000
jitdst:=pxg'jitdst;                                << dstn >>  <<06906>>08345000
jitjobinfoptr:=jit'job'info'ptr; << job info ptr.  why???  don'<<06906>>08350000
jitacctinfoptr:=jit'acct'info'ptr;                             <<06906>>08355000
jitreserveptr:=jit'resrv'area'ptr;                             <<06906>>08360000
jitvalue7:=7;                                                  <<06906>>08365000
jitjobnumber:=jmatjsno;                                        <<06906>>08370000
jitjstype:=jmatjstype;                                         <<06906>>08375000
jitmaxpri:=uentry(umaxjob);                                    <<06906>>08380000
jitmainpin:=jmatmainpin;                                       <<06906>>08385000
jitacctsec:=aentry(asecw);                                     <<06906>>08390000
move jitgroupsec:=gentry(gsec),(2);                            <<06906>>08395000
move jithacctname:=jmatacctname,(4);                           <<06906>>08400000
move jithomegroup:=uentry(uhgroup),(4);                        <<06906>>08405000
move jitlogongroup:=jmatgrplogon,(4);                          <<06906>>08410000
move jitusername:=jmatusername,(4);                            <<06906>>08415000
jitaipptr:=jit'jitaip'ptr;                                     <<06906>>08420000
jitgipptr:=jit'jitgip'ptr;                                     <<06906>>08425000
jitgipvf:=gentry(glinkage).(pvf);                              <<06906>>08430000
jitaip2:=aentry(agipntr);                                      <<06906>>08435000
jitgip2:= if pv'and'mounted then gentry(gsavefipntr)           <<06906>>08440000
                        else gentry(gfipntr);                  <<06906>>08445000
move jitlocalattr:=uentry(ulattr),(2);                         <<06906>>08450000
move jitusercaps:=uentry(ucap),(2);                            <<06906>>08455000
move jitjobname:=jmatjobname,(4);                              <<06906>>08460000
jitacctinfo:=3;                                                <<06906>>08465000
pcbpt := curprc;                                               <<06906>>08470000
jithipri:=spcbppri;                                            <<06906>>08475000
jitvalue1:=1;                                                  <<06906>>08480000
move jitallowmask:=allowmask,(jit'allow'mask'length);          <<06906>>08485000
movetodseg(pxg'jitdst,0,@jitarr,jit'entry'size);               <<06906>>08490000
end;                                 << initjit >>             <<02.eb>>08495000
                                                               <<02.eb>>08500000
subroutine initjdt; << uses jmat >>                            <<02.eb>>08505000
begin                                                          <<02.eb>>08510000
                                                               <<02.eb>>08515000
jdt := jdtsize;                                                <<02.eb>>08520000
jdt(1) := jdtptr;<<initial pointer to tables>>                 <<02.eb>>08525000
move jdt(2) := jdt(1),(numjdtptrs-1);                          <<u.rao>>08530000
jdt(numjdtptrs) := jdt(numjdtptrs)+8;  <<for "JCW">>           <<05.ro>>08535000
jdt(jdtptr-2) := jmatarr(jmatjsnooff);                         <<06600>>08540000
jdt(jdtptr-1) := jmatmainpin;                                  <<06600>>08545000
move jdt(jdtptr) := ([8/3,8/"J"],"CW",0,                       <<05.ro>>08550000
                     [8/7,8/"C"],"IE","RR","OR",0);            <<05.ro>>08555000
pxglobal;                                                      <<06598>>08560000
movetodseg(pxg'jdtdst,0,@jdt,jdtptr+8);                        <<06598>>08565000
                                                               <<02.eb>>08570000
end; << initjdt >>                                             <<02.eb>>08575000
                                                               <<05.eb>>08580000
                                                               <<05.eb>>08585000
                   << ******************** >>                  <<05.eb>>08590000
                   << *  printlogon      * >>                  <<05.eb>>08595000
                   << ******************** >>                  <<05.eb>>08600000
                                                               <<05.eb>>08605000
                                                               <<05.eb>>08610000
                                                               <<02.eb>>08615000
subroutine printlogon;                                         <<05.eb>>08620000
begin                                                          <<05.eb>>08625000
                                                               <<05.eb>>08630000
time := if jmatcpulim <= 0 then 0 else jmatcpulim;             <<06600>>08635000
fmtdate(jmatcalendar, jmatarrd(jmattimeoff/2), datebuf);       <<06600>>08640000
datebuf(27):=0;                                                <<02337>>08645000
move partno := "..........";                                   <<06018>>08650000
partno(4) := 0;    << genmsg delimiter >>                      <<06018>>08655000
move basepartno := "..........";                               <<06018>>08660000
basepartno(4) := 0;                                            <<06018>>08665000
parthold := absolute( base'ver );                              <<06018>>08670000
move basever := bparthold,(2);                                 <<06018>>08675000
parthold := absolute( base'upd );                              <<06018>>08680000
move baseupd := bparthold,(2);                                 <<06018>>08685000
parthold := absolute( base'fix );                              <<06018>>08690000
move basefix := bparthold,(2);                                 <<06018>>08695000
                                                               <<06018>>08700000
parthold := absolute( version );                               <<06018>>08705000
move verpart := bparthold,(2);                                 <<06018>>08710000
parthold := absolute( updatelevel );                           <<06018>>08715000
move updpart := bparthold,(2);                                 <<06018>>08720000
parthold := absolute( fixlevel );                              <<06018>>08725000
move fixpart := bparthold,(2);                                 <<06018>>08730000
                                                               <<06018>>08735000
if job then                                                    <<05.eb>>08740000
begin                                                          <<05.eb>>08745000
      << print job name if not duplicitave >>                  <<05.eb>>08750000
      << :job/hello jname,uname.aname.gname >>                 <<05.eb>>08755000
      << priority = cs/ds; inpri = n/hipri; (time = t) >>      <<05.eb>>08760000
   if not jmatduplicative then                                 <<06600>>08765000
   begin                                                       <<05.eb>>08770000
      print(dummy,0,%61); << page eject >>                     <<05.eb>>08775000
      genmsg(syset,logonheadj,%0,@jobid);                      <<05.eb>>08780000
      if time > 0 then                                         <<05.eb>>08785000
         if jmatinpri = jobhipri then                          <<06600>>08790000
            genmsg(syset, logonthipri ,%01000, @logonq, time)  <<06600>>08795000
         else genmsg(syset, logontpri, %01100, @logonq,        <<06600>>08800000
                     jmatinpri, time)                          <<06600>>08805000
      else                                                     <<05.eb>>08810000
         begin                                                 <<0314>> 08815000
         move buff:=("UNLIMITED",0);                           <<0314>> 08820000
         if jmatinpri = jobhipri then                          <<06600>>08825000
            genmsg(syset, logonthipri, %0, @logonq, @buff)     <<06600>>08830000
         else genmsg(syset, logontpri, %01000, @logonq,        <<06600>>08835000
                     jmatinpri, @buff);                        <<06600>>08840000
         end;                                                  <<0314>> 08845000
   end;                                                        <<05.eb>>08850000
      << session/job number = #s/j num >>                      <<05.eb>>08855000
   genmsg(syset,logonjno,%10000,jobnum);                       <<05.eb>>08860000
      <<sun, may 29, 1977,  6:13 pm>>                          <<05.eb>>08865000
      <<hp32002u.vv.ff>>                                       <<12.km>>08870000
   genmsg(syset,logondatelevel,%0,@datebuf,                    <<06018>>08875000
          @bpartno, @bbasepartno );                            <<06018>>08880000
end                                                            <<05.eb>>08885000
else << session >>                                             <<05.eb>>08890000
   genmsg(syset,logonsno,%0,@bpartno,@bbasepartno,             <<06018>>08895000
          @datebuf);                                           <<06018>>08900000
                                                               <<05.eb>>08905000
end; << printlogon >>                                          <<05.eb>>08910000
                                                               <<02.eb>>08915000
subroutine setlogonq;                                          <<05.eb>>08920000
begin                                                          <<05.eb>>08925000
                                                               <<05.eb>>08930000
x := jmatxpri;                                                 <<06600>>08935000
if x = 100 then logonq := "B" else                             <<05.eb>>08940000
if x = 150 then logonq := "C" else                             <<05.eb>>08945000
if x = 200 then logonq := "D" else                             <<05.eb>>08950000
   logonq := "E";                                              <<05.eb>>08955000
                                                               <<05.eb>>08960000
end; << setlogonq >>                                           <<05.eb>>08965000
                                                               <<02.eb>>08970000
                                                               <<02.eb>>08975000
subroutine logit;                                              <<05.eb>>08980000
begin                                                          <<02.eb>>08985000
                                                               <<02.eb>>08990000
tos := @jmatusername;                                          <<06600>>08995000
tos := @jmatacctname;                                          <<06600>>09000000
tos := @jmatjobname;                                           <<06600>>09005000
tos := @jmatgrplogon;                                          <<06600>>09010000
tos := jmatorigjin;                                            <<06600>>09015000
tos := jmatorigjlist;                                          <<06600>>09020000
tos := 0;                                                      <<02.eb>>09025000
tos := logonq;                                                 <<02.eb>>09030000
tos := double(integer(jmatcpulim));                            <<06600>>09035000
tos := logical(jmatinpri &lsl(8))<< input priority  >>         <<06600>>09040000
   lor logical(jmatoutpri); <<outpri>>                         <<06600>>09045000
tos := 0; << reserved >>                                       <<00861>>09050000
tos := 2; << log type >>                                       <<02.eb>>09055000
log2;                                                          <<06600>>09060000
                                                               <<02.eb>>09065000
end; << subroutine logit >>                                    <<05.eb>>09070000
                                                               <<02.eb>>09075000
                                                               <<02.eb>>09080000
                   << ********************** >>                <<05.eb>>09085000
                   << * initjsmp main body * >>                <<05.eb>>09090000
                   << ********************** >>                <<05.eb>>09095000
                                                               <<05.eb>>09100000
                                                               <<02.eb>>09105000
                                                               <<06.eb>>09110000
<< set locals >>                                               <<02.eb>>09115000
                                                               <<02.eb>>09120000
pxfixed;                                                       <<06598>>09125000
pxglobal;                                                      <<06598>>09130000
jmatinx := pxg'jmatinx;                                        <<06600>>09135000
                                                               <<02.eb>>09140000
   << get ucop communication stuff >>                          <<02.eb>>09145000
movefromdseg(@ucopcomm,pxg'jitdst,0,ucopcommsize);             <<06598>>09150000
                                                               <<02.eb>>09155000
   << get local jmat copy >>                                   <<02.eb>>09160000
movefromdseg(@jmatarr, jmatdst, jmatinx * jmatentrysize,       <<06600>>09165000
             jmatentrysize);                                   <<06600>>09170000
   << get local copy of ldtx and set up pcs stuff >>           << 8144>>09175000
sub'queue := 3;                                                << 8144>>09180000
jmatinx := 0;                                                  << 8144>>09185000
port'id := findprocessport(jmatcreator);                       << 8144>>09190000
                                                               <<02.eb>>09195000
if jmatproglogon = 1                                           << 8144>>09200000
   then progcreation := true                                   << 8144>>09205000
   else progcreation := false;                                 << 8144>>09210000
jmatinx := 0; << we will reference jmatarr locally >>          <<06600>>09215000
pxfxjobnum   := jmatjsno;                                      <<06600>>09220000
pxfxjobtype  := jmatjstype;                                    <<06600>>09225000
job := if jmatjstype = jobtype  then true else false;          <<06600>>09230000
jobnum := jmatjsno;                                            <<06600>>09235000
                                                               <<02.eb>>09240000
setjcut; << set job cut-off for cpu limited jobs,set in pcb>>  <<02.eb>>09245000
                                                               <<02.eb>>09250000
getcheckdir; <<get dir entries, check & set cap>>              <<02.eb>>09255000
                                                               <<02.eb>>09260000
get'sys'allow'mask; << to abtain the system allow mask >>      <<06906>>09265000
initjit;                                                       <<00125>>09270000
   << reschedule if default queue higher than cap. >>          <<05.eb>>09275000
if uentry(umaxjob).(8:8) > jmatxpri then                       <<06600>>09280000
begin                                                          <<05.eb>>09285000
   jmatxpri := uentry(umaxjob).(8:8);                <<05.eb>> <<06600>>09290000
   setlogonq; << logonq := "B/C/D/E"  >>                       <<05.eb>>09295000
   getpriority(0,logical(logonq&lsl(8)) lor "S");              <<05.eb>>09300000
end;                                                           <<05.eb>>09305000
                                                               <<05.eb>>09310000
   << set jmat stat to running, turn off passwd flags, move >> <<05.eb>>09315000
                                                               <<05.eb>>09320000
   << copy of jmat, may have added group name               >> <<05.eb>>09325000
   << re-time stamp jmat if job.                            >> <<05.eb>>09330000
   << xpri will be lowered (bigger numbers) if default      >> <<05.eb>>09335000
   << if higher than accts.                                 >> <<05.eb>>09340000
if job then                                                    <<05.eb>>09345000
begin                                                          <<05.eb>>09350000
   jmatcalendar              :=  calendar;                     <<06600>>09355000
   jmatarrd(jmattimeoff/2)    :=  clock;                       <<06600>>09360000
end;                                                           <<05.eb>>09365000
                                                               <<04636>>09370000
                                                               <<04636>>09375000
                                                               <<04636>>09380000
                                                               <<05.eb>>09385000
initjdt;                                                       <<02.eb>>09390000
                                                               <<02.eb>>09395000
passfail := false;                                             <<01130>>09400000
                                                               <<01130>>09405000
<< don't check for passwords if direclogon failed. >>          <<01130>>09410000
if dirfail = 0 then                                            <<01130>>09415000
  if not checkpass(aentry(apass),2) or                         <<01130>>09420000
     not checkpass(uentry(upass),3) or                         <<01130>>09425000
     not checkpass(gentry(gpass),1) then                       <<01130>>09430000
     passfail := true;                                         <<01130>>09435000
                                                               <<01130>>09440000
   << turn off timeouts on sessions >>                         <<02.eb>>09445000
                                                               <<02858>>09450000
if not progcreation then                                       << 8144>>09455000
begin                                                          << 8144>>09460000
  << set state to exec >>                                      << 8144>>09465000
  jmatarr := jmatarr land %1437 lor %4000;                     << 8144>>09470000
  jmatinx := pxg'jmatinx;                                      << 8144>>09475000
jmatinx := pxg'jmatinx;           <<  need to move it back  >> <<06600>>09480000
movetodseg(jmatdst, jmatinx*jmatentrysize, @jmatarr,           <<06600>>09485000
          jmatentrysize);                                      << 8144>>09490000
end;                                                           << 8144>>09495000
jmatinx := 0;  << we reference jmatarr locally some more >>    <<06600>>09500000
indev := jmatjindev;                                           <<06600>>09505000
lost'terminal := false;   << initialize >>                     <<02858>>09510000
lpdt'index:=indev*integer(lpdt'entry'size);                    <<06597>>09515000
if jindevtype=terminal then                                    <<02858>>09520000
   begin                                                       <<02858>>09525000
   if not job then                                             <<02858>>09530000
      attachio(indev,0,0,0,21,0,1,0,1); << block for timing. >><<02858>>09535000
                                                               <<02858>>09540000
   if special'terminal(indev) then                             <<02858>>09545000
      begin                                                    <<02858>>09550000
                                                               <<02858>>09555000
      << if the logon bit is no longer on, then the >>         <<02858>>09560000
      << terminal disconnected for some reason. >>             <<02858>>09565000
                                                               <<02858>>09570000
         if lpdt'logging'on = 0 then                           <<06597>>09575000
         begin                                                 <<02858>>09580000
         lost'terminal := true;                                <<02858>>09585000
      << set flags correctly for cleanupjob >>                 <<02858>>09590000
         expcode := dirfail + logonfail;                       <<02858>>09595000
         setjcw( logical(expcode) lor %100000 );  << abort >>  <<02858>>09600000
         end                                                   <<02858>>09605000
      else                                                     <<02858>>09610000
         begin   << no problems.  reset logon bit. >>          <<02858>>09615000
         disable;                                              <<02858>>09620000
         lpdt'logging'on:=false;                               <<06597>>09625000
         enable;                                               <<02858>>09630000
         end;                                                  <<02858>>09635000
      end;   << of disconnect check. >>                        <<02858>>09640000
   end;   << of terminal >>                                    <<02858>>09645000
                                                               <<02858>>09650000
<< even if a prior error has occurred, we attempt to do the >> <<04200>>09655000
<< job's fjopens on the $stdfiles.  if these opens succeed, >> <<04200>>09660000
<< we can safely tell the job why it fails, and cleanup of  >> <<04200>>09665000
<< the job in morgue is easier.                             >> <<04200>>09670000
<< note, however, that these fjopens may fail, it which     >> <<04200>>09675000
<< case, morgue cleans up as best it can, but the user will >> <<04200>>09680000
<< not be informed of the reason his job fails.  jobs will  >> <<04200>>09685000
<< flush from the system and sessions will appear to ignore >> <<04200>>09690000
<< the logon attempt (but the terminal won't hang).  in all >> <<04200>>09695000
<< cases a message will be printed to the console, however. >> <<04200>>09700000
<< future development may investigate using attachios to    >> <<04200>>09705000
<< the session $stdlist device, since ucop has allocated    >> <<04200>>09710000
<< the device before the ci is awoken (and this procedure   >> <<04200>>09715000
<< is called.                                               >> <<04200>>09720000
fjopen(,%2044,%1300,@jinxddep);                                <<01130>>09725000
if <> then                                                     <<03785>>09730000
begin                                                          <<03785>>09735000
   resetcritical(0);  << ucop creates cis critical. >>         <<03785>>09740000
   timinate( 0, cstdinfail );                                  <<03785>>09745000
end;                                                           <<03785>>09750000
fjopen(,%2414,%1301,@jlistxddep);                              <<01130>>09755000
if <> then                                                     <<03785>>09760000
begin                                                          <<03785>>09765000
   resetcritical(0);  << ucop creates cis critical. >>         <<03785>>09770000
   timinate( 0, cstdlistfail );                                <<03785>>09775000
end;                                                           <<03785>>09780000
                                                               <<01130>>09785000
resetcritical(0);  << jsmp can now die.  >>                    <<01130>>09790000
erroron;           << enable error mechanism >>                <<01130>>09795000
                                                               <<02858>>09800000
if lost'terminal then terminate;   << bye-bye >>               <<02858>>09805000
                                                               <<02.eb>>09810000
   << if getcheckdir failed then bail out >>                   <<05.eb>>09815000
if dirfail <> 0 then timinate(noacct +dirfail,dirfail);        <<05.eb>>09820000
                                                               <<01130>>09825000
<< if checkpass failed, tell user & console and terminate >>   <<01130>>09830000
if passfail then timinate(passwdfail,cpassfail);               <<01130>>09835000
                                                               <<05.eb>>09840000
   << out of time ? -- allow sys mgr. to log on any time, >>   <<0313>> 09845000
   << allow act mgr to log on if acct has time left.      >>   <<0313>> 09850000
if aentryd(acpucountd) >= aentryd(acpulimitd) then             <<01112>>09855000
  if sysmgr then                                               <<01112>>09860000
    genmsg(ciset,w'accoutcpu)                                  <<01112>>09865000
  else                                                         <<01112>>09870000
    timinate(accoutcpu,cacpufail);                             <<01112>>09875000
if aentryd(acontimecountd) >= aentryd(acontimelimitd) then     <<01112>>09880000
  if sysmgr then                                               <<01112>>09885000
    genmsg(ciset,w'accoutconn)                                 <<01112>>09890000
  else                                                         <<01112>>09895000
    timinate(accoutconn,caconnfail);                           <<01112>>09900000
                                                               <<05.eb>>09905000
   << ia/ba check >>                                           <<05.eb>>09910000
if job then                                                    <<05.eb>>09915000
begin << batch access ? >>                                     <<05.eb>>09920000
   if not aentry(acap +1).(7:1) then timinate(noba'acct,       <<01053>>09925000
      cbafail);                                                <<01053>>09930000
   if not uentry(ucap +1).(7:1) then timinate(noba,            <<00248>>09935000
      cbafail);                                                <<00603>>09940000
end                                                            <<05.eb>>09945000
else                                                           <<05.eb>>09950000
begin                                                          <<05.eb>>09955000
   if not aentry(acap +1).(8:1) then timinate(noia'acct,       <<01053>>09960000
      ciafail);                                                <<01053>>09965000
   if not uentry(ucap +1).(8:1) then timinate(noia,            <<00248>>09970000
      ciafail);                                                <<00603>>09975000
end;                                                           <<05.eb>>09980000
                                                               <<02.eb>>09985000
if gentryd(gcpucountd) >= gentryd(gcpulimitd) then             <<01112>>09990000
  if sysmgr or acctmgr then                                    <<01112>>09995000
    genmsg(ciset,w'grpoutcpu)                                  <<01112>>10000000
  else                                                         <<01112>>10005000
    timinate(grpoutcpu,cgcpufail);                             <<01112>>10010000
if gentryd(gcontimecountd) >= gentryd(gcontimelimitd) then     <<01112>>10015000
  if sysmgr or acctmgr then                                    <<01112>>10020000
    genmsg(ciset,w'grpoutconn)                                 <<01112>>10025000
  else                                                         <<01112>>10030000
    timinate(grpoutconn,cgconnfail);                           <<01112>>10035000
                                                               <<05.eb>>10040000
   << set logonq & stopper for logon jobs >>                   <<05.eb>>10045000
logonq(1) := 0; << stopper >>                                  <<00283>>10050000
setlogonq;                                                     <<00283>>10055000
<< this next set of code will handle the case of a session  >>          10060000
<< that is being programmatically created.  if waittillon is>>          10065000
<< set, then we must send a message to the creator that we  >>          10070000
<< made it.  for looks, we will turn off echo and set the   >>          10075000
<< terminal to do one character reads without a  cr/lf while>>          10080000
<< we are looking for a carriage return from the user.  we  >>          10085000
<< do not check condition codes, because if it fails we will>>          10090000
<< still continue because its not a good enough reason to   >>          10095000
<< cause the logon to fail.  note: it should never fail     >>          10100000
<< anyway.                                                  >>          10105000
<< note: ds devices do not have to respond with a cr.       >>          10110000
                                                               <<05.eb>>10115000
if progcreation then                                           << 8144>>10120000
begin                                                          << 8144>>10125000
  if jmatwaittillon = 1 then                                   << 8144>>10130000
  begin                                                        << 8144>>10135000
    << creator is waiting to hear from us >>                   << 8144>>10140000
    msgarr(1) := 3;  << message length >>                      << 8144>>10145000
    msgarr(2) := 0;  << no errors! >>                          << 8144>>10150000
    send'db(port'id,sub'queue,msgarr);                         << 8144>>10155000
    pxglobal;                                                  << 8144>>10160000
    jmatwaittillon := false;                                   << 8144>>10165000
    movetodseg(jmatdst,pxg'jmatinx*jmatentrysize,@jmatarr,     << 8144>>10170000
               jmatentrysize);                                          10175000
  end;                                                         << 8144>>10180000
  done := false;  << assume it will not work >>                << 8144>>10185000
  << turn off echo >>                                          << 8144>>10190000
  pxglobal;                                                    << 8144>>10195000
  tos := attachio(pxg'outputldev,0,0,0,echooff,0,0,0,1);       << 8144>>10200000
  echostate := tos;                                            << 8144>>10205000
  del;                                                         << 8144>>10210000
  type := get'dsdevice(indev);                                 << 8881>>10215000
  if (type <> 3) and (type <> 5)  << ds terminal >>  and       << 9041>>10220000
     jmatlogonnow=0  << nowait option not specified >>         << 9041>>10225000
     then speedsense;                                          << 8881>>10230000
  << change state to exec >>                                   << 8144>>10235000
    jmatarr := jmatarr land %1437 lor %4000;                   << 8144>>10240000
    jmatproglogon := 0;                                                 10245000
    movetodseg(jmatdst,pxg'jmatinx*jmatentrysize,@jmatarr ,    << 8144>>10250000
               jmatentrysize);                                 << 8144>>10255000
  if echostate = 0 then                                        << 8144>>10260000
  begin                                                        << 8144>>10265000
    attachio(pxg'outputldev,0,0,0,echoon,0,0,0,1);             << 8144>>10270000
  end;                                                         << 8144>>10275000
end;                                                           << 8144>>10280000
                                                               <<02.eb>>10285000
jmatinx := 0;                                                           10290000
if not progcreation                                            << 8144>>10295000
   then tellop(clogonmsg)                                      << 8144>>10300000
   else tellop(proglogon);                                     << 8144>>10305000
                                                               <<02.eb>>10310000
   << ask op for std forms, go on regardless >>                <<02.eb>>10315000
if stdforms  then                                              <<06600>>10320000
genmsg(syset, formreqd, %10000, jmatjlistdev                   <<06600>>10325000
       ,,,,, 0, 1, @stdforms);                                 <<06600>>10330000
                                                               <<04555>>10335000
<< congratulations!  having made it this far, you are >>       <<04555>>10340000
<< now a full-fledged job/session main process.  set  >>       <<04555>>10345000
<< the expcode to 4 (normal log on) so when your job  >>       <<04555>>10350000
<< terminates, you will be logged appropriately.      >>       <<04555>>10355000
   setcritical;                                                <<04555>>10360000
   expcode := 4;                                               <<04555>>10365000
if loglogon then logit; << call log >>                         <<05.eb>>10370000
   resetcritical(0);                                           <<04555>>10375000
                                                               <<02.eb>>10380000
printlogon; << send out logon head >>                          <<02.eb>>10385000
                                                               <<02.eb>>10390000
end; << initjsmp >>                                            <<02.eb>>10395000
$title "PRINTCARET"                                            <<05.eb>>10400000
procedure printcaret(glistdev,command,offset);                 <<05.eb>>10405000
   value glistdev,command,offset;                              <<05.eb>>10410000
   integer glistdev,command,offset;                            <<05.eb>>10415000
   option internal;                                            <<05.eb>>10420000
begin                                                          <<05.eb>>10425000
                                                               <<05.eb>>10430000
equate                                                         <<05.eb>>10435000
   cdata = 0,                                                  <<05.eb>>10440000
   chello= 1,                                                  <<05.eb>>10445000
   cjob  = 2;                                                  <<05.eb>>10450000
                                                               <<05.eb>>10455000
integer len;                                                   <<05.eb>>10460000
                                                               <<05.eb>>10465000
byte array buff(0:255);                                        <<05.eb>>10470000
                                                               <<05.eb>>10475000
buff := " ";                                                   <<05.eb>>10480000
move buff(1) := buff,(255);                                    <<05.eb>>10485000
case command of                                                <<06.eb>>10490000
begin                                                          <<06.eb>>10495000
   len := 5; << data >>                                        <<06.eb>>10500000
   len := 6; << hello >>                                       <<06.eb>>10505000
   len := 4; << job >>                                         <<06.eb>>10510000
   len := 0; << special logon >>                               <<06.eb>>10515000
   len := 0; << special logon, apl1 >>                         <<06.eb>>10520000
   len := 0; << special logon, apl2 >>                         <<06.eb>>10525000
end;                                                           <<06.eb>>10530000
move buff(len +offset) := ("^",0);                             <<05.eb>>10535000
genmsg(-1,@buff,,,,,,,glistdev);                               <<05.eb>>10540000
                                                               <<05.eb>>10545000
end; << procedure printcaret >>                                <<05.eb>>10550000
$title "JOBKEYS"                                               <<05.eb>>10555000
integer procedure jobkeys(parm,plen);                          <<05.eb>>10560000
   value plen;                                                 <<05.eb>>10565000
   byte pointer parm;                                          <<05.eb>>10570000
   integer plen;                                               <<05.eb>>10575000
   option internal;                                            <<11.eb>>10580000
comment returns index into job key array. calls search.        <<05.eb>>10585000
;                                                              <<05.eb>>10590000
begin                                                          <<05.eb>>10595000
                                                               <<05.eb>>10600000
byte array keys(0:58);                                         << 9041>>10605000
                                                               <<05.eb>>10610000
move keys := (6,4,"TERM",                                      <<05.eb>>10615000
              5,3,"PRI",                                       <<05.eb>>10620000
              6,4,"TIME",                                      <<05.eb>>10625000
              7,5,"INPRI",                                     <<05.eb>>10630000
              7,5,"HIPRI",                                     <<05.eb>>10635000
             10,8,"OUTCLASS",                                  <<05.eb>>10640000
              9,7,"RESTART",                                   <<05.eb>>10645000
              8,6,"NOWAIT",                                    << 9041>>10650000
              0);                                              <<05.eb>>10655000
                                                               <<05.eb>>10660000
jobkeys := search(parm,plen,keys);                             <<05.eb>>10665000
                                                               <<05.eb>>10670000
end; << procedure jobkeys >>                                   <<05.eb>>10675000
procedure term'type'file(ldev,filename,len,gname,aname                  10680000
                        ,names,error,fserr);                            10685000
   value ldev,len,names;                                                10690000
   byte array filename,gname,aname;                                     10695000
   integer ldev,len,names,error,fserr;                                  10700000
   option privileged,uncallable;                                        10705000
                                                                        10710000
comment                                                                 10715000
   access terminal type file and set terminal type etc..                10720000
   the fully qualified file name terminated by cr will                  10725000
   be passed to attachio.                                               10730000
                                                                        10735000
input parameters :                                                      10740000
   ldev       -   logical device number for logon terminal.             10745000
   filename   -   file name of terminal type file.                      10750000
   len        -   byte length of filename.                              10755000
   names      -   indicate whether group or/and                         10760000
                  account name specified.                               10765000
                    1  =   file only                                    10770000
                    3  =   file and group name                          10775000
                    4  =   file, group and account name                 10780000
                                                                        10785000
output parameters :                                                     10790000
   error      -    error number.  '0' for no error.                     10795000
   fserr      -    fopen error number.                                  10800000
                                                                        10805000
procedure called (external) :                                           10810000
   attachio                                                             10815000
   direcfind                                                            10820000
;                                                                       10825000
                                                                        10830000
begin                                                                   10835000
                                                                        10840000
double dstatus;                    << status returned by >>             10845000
integer status = dstatus,          << attachio.          >>             10850000
        xlog   = dstatus + 1;      << transmission log >>               10855000
define errnum = status.(8:8)#;     << error status bits  >>             10860000
                                                                        10865000
integer                                                                 10870000
   gname'len,                      << group name length >>              10875000
   aname'len,                      << account name length >>            10880000
   i,                              << iteration counter >>              10885000
   gstart,                         << group starting pt. >>             10890000
   glen,                           << group name length >>              10895000
   cnt;                            << data transfer count >>            10900000
double link'index:=0d;                                                  10905000
integer type := %10;                                                    10910000
                                   << negative means bytes>>            10915000
logical array                                                           10920000
   fullname(0:18);                 << fully qualified    >>             10925000
byte array                         << file name.         >>             10930000
   fullbname(*) = fullname;                                             10935000
logical array                                                           10940000
   acctl(0:4);                                                          10945000
byte array                                                              10950000
   acct'(*)=acctl;                                                      10955000
logical array                                                           10960000
   groupl(0:4);                                                         10965000
byte array                                                              10970000
   group'(*)=groupl;                                                    10975000
logical array                                                           10980000
   dummy(0:3);                                                          10985000
logical array                                                           10990000
   workarea(0:40);                                                      10995000
                                                                        11000000
equate                                                                  11005000
   delim'len    = 3,               << two dots and cr >>                11010000
   impede       = 0,               << caller will be impeded >>         11015000
   func         = 192,                                                  11020000
   flag         = 1,               << flag for attachio >>              11025000
   file'error   = %25,             << failure in fopen/fread >>         11030000
   checksum'err = %55,             << file checksum error >>            11035000
   inv'fmt      = %45,             << file is not ttype file >>         11040000
   no'support   = %04;             << unsupported on port >>            11045000
subroutine check'for'error;                                             11050000
<< this subroutine will check for errors after each attachio >>         11055000
<< call and return the appropriate message to the user       >>         11060000
begin                                                                   11065000
  if errnum = file'error then                                           11070000
     begin                                                              11075000
       fserr := xlog;                                                   11080000
       error := openfail;                                               11085000
       end                                                              11090000
  else if errnum = checksum'err                                         11095000
          then error := checkerr                                        11100000
  else if errnum = inv'fmt                                              11105000
          then error := inv'fmt'err                                     11110000
  else if errnum = no'support                                           11115000
          then error := no'sup'err;                                     11120000
end;  << check'for'error >>                                             11125000
                                                                        11130000
logical subroutine file'on'private'volume;                              11135000
<< this subroutine checks to see if the terminal type file >>           11140000
<< resides on a private volume.  the check is made because >>           11145000
<< devrec is waiting and if we try to fopen (in attachio)  >>           11150000
<< a file on a pv, devrec will not be able to handle the   >>           11155000
<< interuppt until attachio returns and attachio will not  >>           11160000
<< return until devrec handles the interrupt.  the call to >>           11165000
<< direcfind checks to see if the group is on a pv, because>>           11170000
<< if it is then any file from that group is also.         >>           11175000
begin                                                                   11180000
  file'on'private'volume:= false; << assume it isn't on pv >>           11185000
  move acct':="          ";                                             11190000
  move group':="          ";                                            11195000
  i := 0;                                                               11200000
  while fullbname(i) <> "."                                             11205000
    do i := i + 1;  << skip past file name, not needed >>               11210000
  i := i+1;  << move past period, now pointing at group name >>         11215000
  gstart := i;                                                          11220000
  while fullbname(i) <> "."                                             11225000
    do i := i + 1;  << find group name length >>                        11230000
  glen := i - gstart;                                                   11235000
  i := i + 1;  << move past period, now pointing at acct name >>        11240000
  move group' := fullbname(gstart),(glen);                              11245000
  move acct' := fullbname(i),(len-i);                                   11250000
  move group':=group' while ans;                                        11255000
  move acct':=acct' while ans;                                          11260000
  direcfind(type,link'index,acctl,groupl,dummy,workarea);               11265000
  if =                                                                  11270000
     then if workarea(24).(0:1)=1 << group on pv >>                     11275000
          then file'on'private'volume := true;                          11280000
end; << file'on'private'volume >>                                       11285000
<< entry point >>                                                       11290000
                                                                        11295000
move dummy :="DUMMY ";                                                  11300000
fserr := 0;                                                             11305000
error := 0;                                                             11310000
i := 0;                            << get group name length >>          11315000
while gname(i) <> " " and i < max'namelen                               11320000
   do i := i + 1;                                                       11325000
gname'len := i;                                                         11330000
                                                                        11335000
i := 0;                            <<get account name length>>          11340000
while aname(i) <> " " and i < max'namelen                               11345000
   do i := i + 1;                                                       11350000
aname'len := i;                                                         11355000
                                                                        11360000
if names = file then               << only file name   >>               11365000
   begin                           << was specified.   >>               11370000
   move fullbname := filename,(len),2; << add logon group  >>           11375000
   move * := ".",2;                   << and account names>>            11380000
   move * := gname,(gname'len),2;                                       11385000
   move * := ".",2;                                                     11390000
   move * := aname,(aname'len),2;                                       11395000
   move * := cr;                                                        11400000
   cnt := len + gname'len + aname'len + delim'len;                      11405000
   if file'on'private'volume                                            11410000
      then error := pverr                                               11415000
      else begin                                                        11420000
      dstatus:=attachio(ldev,0,0,@fullname,func,-cnt,1,2,flag);         11425000
      check'for'error;                                                  11430000
      end;                                                              11435000
   end                                                                  11440000
else if names = group then                                              11445000
   begin                                  << group name was >>          11450000
   move fullbname := filename,(len),2;    << specified.     >>          11455000
   move * := ".",2;                                                     11460000
   move * := aname,(aname'len),2;                                       11465000
   move * := cr;                                                        11470000
   cnt := len + aname'len + delim'len;                                  11475000
   if file'on'private'volume                                            11480000
      then error := pverr                                               11485000
      else begin                                                        11490000
      dstatus:=attachio(ldev,0,0,@fullname,func,-cnt,1,2,flag);         11495000
      check'for'error;                                                  11500000
      end;                                                              11505000
   end                                                                  11510000
else if names = account then       << fully qualified name >>           11515000
   begin                           << specified.           >>           11520000
   move fullbname := filename,(len),2;                                  11525000
   move * := cr;                                                        11530000
   cnt := len + 1;                                                      11535000
   if file'on'private'volume                                            11540000
      then error := pverr                                               11545000
      else begin                                                        11550000
      dstatus:=attachio(ldev,0,0,@fullname,func,-cnt,1,2,flag);         11555000
      check'for'error;                                                  11560000
      end;                                                              11565000
   end;                                                                 11570000
end;  << term'type'file >>                                              11575000
$page "   Procedure  -  CHECK'FILENAME"                                 11580000
procedure check'filename(filename,length,iname,error);                  11585000
   value filename,length;                                               11590000
   byte pointer filename;                                               11595000
   integer length,iname,error;                                          11600000
   option privileged,uncallable;                                        11605000
                                                                        11610000
comment                                                                 11615000
   check the validity of file name.                                     11620000
   if error is found, the error number is returned to error.            11625000
                                                                        11630000
file name syntax :                                                      11635000
------------------                                                      11640000
     filename = name[/name][.name][.name]                               11645000
                                                                        11650000
                where name is alphanumeric (alpha first)                11655000
                and length of name <= 8.                                11660000
                                                                        11665000
input parameters:                                                       11670000
      filename  -  the file name should be checked.                     11675000
      length    -  length of the file name.                             11680000
                                                                        11685000
output parameter:                                                       11690000
      error     -  error number.  '0' for no error.                     11695000
                                                                        11700000
input/output parameter:                                                 11705000
      iname     -  indicate what names specified.                       11710000
                   1 - file name                                        11715000
                   2 - file name and lockword                           11720000
                   3 - file/lockword and group                          11725000
                   4 - file/lockword, group and account                 11730000
;                                                                       11735000
                                                                        11740000
begin                                                                   11745000
byte array fnamebuff(0:35); << local buffer for file name >>            11750000
byte array namebuff(0:35);  << temporary buffer       >>                11755000
byte pointer head,          << start address of name  >>                11760000
             taile;         << end address of name    >>                11765000
integer bytecount;          << length of name         >>                11770000
                                                                        11775000
                                                                        11780000
<< entry point >>                                                       11785000
                                                                        11790000
error := 0;                                                             11795000
if iname = file then                                                    11800000
   begin                                                                11805000
   move fnamebuff := filename,(length);<< save file name >>             11810000
   move fnamebuff(length) := cr;       << put terminator  >>            11815000
   @filename := @fnamebuff;            << set pointer >>                11820000
   end;                                                                 11825000
if filename = alpha then               << first byte must be >>         11830000
   begin                               << alpha.             >>         11835000
   @head := @filename;                   << calculate the    >>         11840000
   move namebuff := filename while an, 0;<< length of names. >>         11845000
   @taile := tos;                                                       11850000
   bytecount := @taile - @head;                                         11855000
   if bytecount <= max'namelen then    << is length ok ?   >>           11860000
      if taile = "." then              << check delimiter  >>           11865000
         begin                         << it's a good name >>           11870000
         if iname = file then                                           11875000
            iname := group             << lockword omitted >>           11880000
         else if iname = account then                                   11885000
                 begin                   << dot after account>>         11890000
                 error := too'many'names;<< name.            >>         11895000
                 return;                                                11900000
                 end                                                    11905000
              else                                                      11910000
                 iname := iname + 1;   << ok so far.>>                  11915000
         @filename := @taile + 1;      << do next.  >>                  11920000
         check'filename(filename,length,iname,error);                   11925000
         end                                                            11930000
      else if iname = file and taile = "/" then                         11935000
         begin                         << expect lockword >>            11940000
         @filename := @taile + 1;                                       11945000
         iname := lockword;                                             11950000
         check'filename(filename,length,iname,error);                   11955000
         end                                                            11960000
      else if taile = cr then          << end of names      >>          11965000
         if iname <= account then                                       11970000
            error := valid'name        << valid name        >>          11975000
         else                                                           11980000
            error := too'many'names    << more than account >>          11985000
      else                                                              11990000
         case iname of                                                  11995000
            begin                      << taile <> { . / cr }>>         12000000
            ;                                                           12005000
            error := bad'file'char;    << found unexpected   >>         12010000
            error := bad'lockwd'char;  << characters in name.>>         12015000
            error := bad'group'char;                                    12020000
            error := bad'account'char;                                  12025000
            end                                                         12030000
   else                                << bytecount > 8      >>         12035000
      case iname of                                                     12040000
         begin                                                          12045000
            ;                                                           12050000
         error := long'file'name;      << name > 8 characters>>         12055000
         error := long'lockwd'name;                                     12060000
         error := long'group'name;                                      12065000
         error := long'account'name;                                    12070000
         end;                                                           12075000
   end                                                                  12080000
else                                   << filename <> alpha >>          12085000
   case iname of                                                        12090000
      begin                            << the name does not >>          12095000
            ;                                                           12100000
      error := file'non'alpha;         << start with alpha. >>          12105000
      error := lockwd'non'alpha;                                        12110000
      error := group'non'alpha;                                         12115000
      error := account'non'alpha;                                       12120000
      end;                                                              12125000
end;  << check'filename >>                                              12130000
$title "STARTDEVICE - JOB INITIATION"                                   12135000
$title "STARTDEVICE - JOB INITIATION"                          <<05.eb>>12140000
procedure startdevice(command,parmarr,device,sequenced,jmatp,  <<00534>>12145000
                      iddsubp,jobnum,errnum,parmnum);          <<00534>>12150000
   value command,device,sequenced;                             <<1.rao>>12155000
   integer device,command,jobnum,errnum,parmnum;               <<00534>>12160000
   logical sequenced;                                          <<1.rao>>12165000
   byte array parmarr;                                         <<05.eb>>12170000
   integer pointer jmatp,iddsubp;                              <<05.eb>>12175000
   option variable,privileged,uncallable;                      <<05.eb>>12180000
comment                                                        <<05.eb>>12185000
   command executor for :job, :hello, :data, :( )              <<05.eb>>12190000
   operates in three environments. may be called from devrec   <<06.eb>>12195000
   (terminal or card reader), stream command from session/job, <<06.eb>>12200000
   or from the input spooler.                                  <<06.eb>>12205000
                                                               <<05.eb>>12210000
   handles all errors & prints them on $stdlist, unless its a  <<05.eb>>12215000
   spooler call, which prints on the console.                  <<05.eb>>12220000
   if called from stream then cierr handles errors.            <<00569>>12225000
   successful execution is indicated by errnum = 0.            <<00569>>12230000
                                                               <<05.eb>>12235000
   work startdevice performs:                                  <<05.eb>>12240000
   - solve funny terminal problem.                             <<05.eb>>12245000
   - parse logon id.                                           <<05.eb>>12250000
   - check logon id for validity, get directory entries.       <<05.eb>>12255000
   - check validity of keywords.                               <<05.eb>>12260000
   - set up jmat entry.                                        <<05.eb>>12265000
   - set up idd for :data                                      <<05.eb>>12270000
   - turn off time-out for :stream from terminal.              <<05.eb>>12275000
                                                               <<05.eb>>12280000
   parameters:                                                 <<06.eb>>12285000
      command = 0  - :data                                     <<06.eb>>12290000
                1  - :hello                                    <<06.eb>>12295000
                2  - :job                                      <<06.eb>>12300000
                3  - (cmd) logon                               <<06.eb>>12305000
                4  - (apl1) logon                              <<06.eb>>12310000
                5  - (apl2) logon                              <<06.eb>>12315000
   << the next value for command (6) is sort of a kludge to >> << 8144>>12320000
   << support programmatic creation of sessions.  since the >> << 8144>>12325000
   << externals of startdevice could not be changed, and    >> << 8144>>12330000
   << we must know whether the session is being started with>> << 8144>>12335000
   << the new pcs feature, then a value of 6 will cause the >> << 8144>>12340000
   << variable progcreation to be set to true, and command' >> << 8144>>12345000
   << will be changed to a 1 to signify that it is a session>> << 8144>>12350000
   << that is being created.                                >> << 8144>>12355000
                6 - programmatic session                       << 8144>>12360000
                                                               << 8144>>12365000
      parmarr - 1st byte past :job/data/hello (except for      <<06.eb>>12370000
                '(cmd)' which is 1st byte. this must be on     <<06.eb>>12375000
                word boundary.).                               <<06.eb>>12380000
      sequenced -  value true if job card is believed numbered.<<1.rao>>12385000
         jmatseqbit set with this value.                       <<06600>>12390000
      device  - input device ldev.  this is phoney for stream. <<06.eb>>12395000
      jmatp   - returned pointer to jmat entry                 <<06600>>12400000
      iddsubp - idd subentry pointer is returned.              <<06.eb>>12405000
      jobnum  - job number is returned.                        <<06.eb>>12410000
      errnum - ci error number if error occurred.              <<00569>>12415000
               negative for ci warnings.                       <<00569>>12420000
      parmnum - parameter in which error occurred.             <<00569>>12425000
;                                                              <<06.eb>>12430000
begin                                                          <<05.eb>>12435000
                                                               <<05.eb>>12440000
<< install defines & equates here >>                           <<05.eb>>12445000
                                                               <<05.eb>>12450000
equate                                                         <<05.eb>>12455000
   cdata                = 0,                                   <<05.eb>>12460000
   chello               = 1,                                   <<05.eb>>12465000
   cjob                 = 2,                                   <<05.eb>>12470000
   definpri             = 8,                                   <<05.eb>>12475000
   defxpri              = 150, << cs queue >>                  <<05.eb>>12480000
   direntrysize         = 41,                                  <<05.eb>>12485000
   glevel               = 1,                                   <<05.eb>>12490000
   alevel               = 2,                                   <<05.eb>>12495000
   ulevel               = 3,                                   <<05.eb>>12500000
   kterm                = 1,                                   <<05.eb>>12505000
   kpri                 = 2,                                   <<05.eb>>12510000
   ktime                = 3,                                   <<05.eb>>12515000
   kinpri               = 4,                                   <<05.eb>>12520000
   khipri               = 5,                                   <<05.eb>>12525000
   koutclass            = 6,                                   <<05.eb>>12530000
   krestart             = 7,                                   <<05.eb>>12535000
   knowait              = 8,                                   << 9041>>12540000
   cilogputentry        = 0,                                   <<05.eb>>12545000
   cilogrementry        = 2,                                   <<05.eb>>12550000
   maxinpri             = 13,                                  <<00569>>12555000
   ciset                = 2,                                   <<05.eb>>12560000
   syset                = 1, << system message set >>          <<12.eb>>12565000
                                                               <<05.eb>>12570000
   << warnings >>                                              <<05.eb>>12575000
                                                               <<05.eb>>12580000
   ignoreddelim         = 1451,                                <<05.eb>>12585000
   unknownparm          = 1452,                                <<05.eb>>12590000
   noequalkey           = 1453,                                <<05.eb>>12595000
   expkeyvalue          = 1454,                                <<05.eb>>12600000
   dupkey               = 1455,                                <<05.eb>>12605000
   notnumeric           = 1456,                                <<05.eb>>12610000
   jobterminal          = 1457,                                <<05.eb>>12615000
   badtermtype          = 1458,                                <<05.eb>>12620000
   invpri               = 1459,                                <<05.eb>>12625000
   nohipricap           = 1460,                                <<05.eb>>12630000
   inprihipri           = 1461,                                <<05.eb>>12635000
   toolowinpri          = 1462,                                <<05.eb>>12640000
   toohiinpri           = 1463,                                <<05.eb>>12645000
   hipriinpri           = 1464,                                <<05.eb>>12650000
   sessionoutclass      = 1465,                                <<05.eb>>12655000
   invoutclass          = 1466,                                <<05.eb>>12660000
   nond                 = 1467,                                <<05.eb>>12665000
   toolowoutpri         = 1468,                                <<05.eb>>12670000
   toohioutpri          = 1469,                                <<05.eb>>12675000
   expnumcopies         = 1470,                                <<05.eb>>12680000
   maxcopies127         = 1471,                                <<05.eb>>12685000
   extraoutclassparm    = 1472,                                <<05.eb>>12690000
   sessionrestart       = 1473,                                <<05.eb>>12695000
   nonprognowait        = 1498,                                << 9041>>12700000
   exceedxpri           = 1474,                                <<05.eb>>12705000
   nopassreqd           = 1474,                                <<08.eb>>12710000
   << group pass not reqd=1475 >>                                       12715000
   << accnt pass not reqd=1476 >>                                       12720000
   << user  pass not reqd=1477 >>                                       12725000
   invouttype           = 1478,                                <<sp1sz>>12730000
   invalidtime          = 1479,                                <<0314>> 12735000
   mincopies1           = 1480,                                <<04817>>12740000
   notnuminoutpri       = 1481,                                         12745000
   notnumcopies         = 1482,                                         12750000
   notnumterm           = 1483,                                         12755000
                                                               <<05.eb>>12760000
   << errors >>                                                <<05.eb>>12765000
                                                               <<05.eb>>12770000
   << internal errors >>                                       <<05.eb>>12775000
                                                               <<05.eb>>12780000
   iddfull              = 1411,                                <<05.eb>>12785000
   jmatfull             = 1412,                                <<05.eb>>12790000
   cilogfull            = 1413,                                <<05.eb>>12795000
                                                               <<05.eb>>12800000
   << syntax or semantic errors >>                             <<05.eb>>12805000
                                                               <<05.eb>>12810000
   missingrightparen    = 1421,                                <<05.eb>>12815000
   missingleftparen     = 1422,                                <<05.eb>>12820000
   expjname             = 1423,                                <<05.eb>>12825000
   expuname             = 1424,                                <<05.eb>>12830000
   expupass             = 1425,                                <<05.eb>>12835000
   expaname             = 1426,                                <<05.eb>>12840000
   expapass             = 1427,                                <<05.eb>>12845000
   expfname             = 1428,                                <<05.eb>>12850000
   expgname             = 1429,                                <<05.eb>>12855000
   expgpass             = 1430,                                <<05.eb>>12860000
   noia                 = 1431,                                <<05.eb>>12865000
   noba                 = 1432,                                <<05.eb>>12870000
   extraparms           = 1433,                                <<05.eb>>12875000
   namenotalpha         = 1434,                                <<05.eb>>12880000
   nametoolong          = 1435,                                <<05.eb>>12885000
   noacct               = 1435, << actually 1436 >>            <<05.eb>>12890000
   nogroup              = 1436,                                <<05.eb>>12895000
   noacct'              = 1437,                                <<05.eb>>12900000
   nouser               = 1438,                                <<05.eb>>12905000
   nohomeg              = 1439,                                <<05.eb>>12910000
   invpass              = 1441,                                <<05.eb>>12915000
   mispass              = 1444,                                <<0312>> 12920000
                                                               <<12.eb>>12925000
      << console messages for illegitimate access >>           <<12.eb>>12930000
                                                               <<12.eb>>12935000
   conslogonfail        = 60, << 61 - 67 >>                    <<12.eb>>12940000
   <<cnogroup           = 61, >>                               <<12.eb>>12945000
   <<cnoacct            = 62, >>                               <<12.eb>>12950000
   <<cnouser            = 63, >>                               <<12.eb>>12955000
   cnohomeg             = 64,                                  <<12.eb>>12960000
   cinvpass             = 65,                                  <<02320>>12965000
   cmispass             = 68,                                  <<0312>> 12970000
                                                               <<05.eb>>12975000
   zendofequates        = 0;                                   <<05.eb>>12980000
                                                               <<05.eb>>12985000
integer                                                        <<05.eb>>12990000
   plen,                                                       <<05.eb>>12995000
   byte'indx,                                                  <<00068>>13000000
    temp'byte'indx,                                            <<02322>>13005000
    len'string'left,                                           <<02322>>13010000
    temp'byte'cnt,                                             <<02322>>13015000
   byte'cnt,                                                   <<00068>>13020000
   dummy,                                                      <<05.eb>>13025000
   cmdlen    = dummy,                                          <<05.eb>>13030000
   savesir   = dummy,                                          <<05.eb>>13035000
   termtype  = dummy,                                          <<05.eb>>13040000
   queue     = dummy,                                          <<05.eb>>13045000
   pri       = dummy,                                          <<05.eb>>13050000
   inpri     = dummy,                                          <<05.eb>>13055000
   outpri    = dummy,                                          <<05.eb>>13060000
   numcopies = dummy,                                          <<05.eb>>13065000
   dirindex  = dummy,                                          <<05.eb>>13070000
   outdev    = dummy,                                          <<05.eb>>13075000
   outdevtype= dummy,                                          <<05.eb>>13080000
   command',                                                   <<06.eb>>13085000
   glistdev,                                                   <<05.eb>>13090000
   funnyterm,                                                  <<05.eb>>13095000
   cicomlen,                                                   <<05.eb>>13100000
   amaxpri,                                                    <<05.eb>>13105000
   umaxpri,                                                    <<05.eb>>13110000
   indevtype,                                                  <<05.eb>>13115000
   keyno,                                                      <<05.eb>>13120000
   splen,                                                               13125000
   iname;                                                               13130000
                                                               << 8144>>13135000
logical                                                        << 8144>>13140000
   waittillon,                                                 << 8144>>13145000
   progcreation;<< true if session is being programmatically>> << 8144>>13150000
                 << created, false otherwise.               >> << 8144>>13155000
                                                               <<05.eb>>13160000
double capd;                                                   <<05.eb>>13165000
logical cap0 = capd, cap1 = capd +1;                           <<05.eb>>13170000
                                                               <<05.eb>>13175000
logical                                                        <<05.eb>>13180000
   z'slash:=%000057,                                           <<00068>>13185000
   z'ro:=%0,                                                   <<00068>>13190000
   fterm,                                                      <<05.eb>>13195000
   fpri,                                                       <<05.eb>>13200000
   ftime,                                                      <<05.eb>>13205000
   finpri,                                                     <<05.eb>>13210000
   fhipri,                                                     <<05.eb>>13215000
   foutclass,                                                  <<05.eb>>13220000
   frestart,                                                   <<05.eb>>13225000
   groupspec,                                                  <<05.eb>>13230000
   homegroup,                                                  <<00802>>13235000
   parmask = q-4;                                              <<05.eb>>13240000
integer lpdt'index; << index into lpdt/incllpdt >>             <<06597>>13245000
                                                               <<05.eb>>13250000
define                                                         <<05.eb>>13255000
   seqnumpassed = parmask.(10:1) #,                            <<00534>>13260000
   spoolercall = parmask.(12:1) #;                             <<00534>>13265000
                                                               <<05.eb>>13270000
byte pointer                                                   <<05.eb>>13275000
   b'pointer,                                                  <<00068>>13280000
   b'char:=@parmarr,                                           <<00068>>13285000
   parm,                                                       <<05.eb>>13290000
   ptr,                                                        <<05.eb>>13295000
   sparm,                                                      <<05.eb>>13300000
   saveptr,                                                    <<05.eb>>13305000
   oldparmptr,                                                 <<05.eb>>13310000
   iddsp = oldparmptr;                                         <<05.eb>>13315000
                                                               <<05.eb>>13320000
pointer                                                        <<05.eb>>13325000
   jmatxptr,                                                   <<05.eb>>13330000
   cicomptrw;                                                  <<05.eb>>13335000
array                                                          <<06215>>13340000
   ldt(0:size'of'ldt'entry-1);                                 <<06215>>13345000
integer                                                        <<06215>>13350000
   ldt'index := 0;                                             <<06215>>13355000
                                                               <<06215>>13360000
                                                               <<05.eb>>13365000
<< ......................................................... >><<06600>>13370000
<<       declarations for referencing the jmat               >><<06600>>13375000
<<   jmatarr -- a local array which holds an entry.          >><<06600>>13380000
<<   jmatarrb, jmatarrd -- byte and double of jmatarr        >><<06600>>13385000
<<   jmatinx -- used to index into jmatarr in the include    >><<06600>>13390000
<<              file definitions.  note that since jmatarr is>><<06600>>13395000
<<              the entry, this will be 0.                   >><<06600>>13400000
<< ......................................................... >><<06600>>13405000
array jmatarr(0:jmatentrysize-1);                              <<06600>>13410000
double array jmatarrd(*) = jmatarr;                            <<06600>>13415000
byte array jmatarrb(*) = jmatarr;                              <<06600>>13420000
integer    jmatinx;                                            <<06600>>13425000
                                                               <<06600>>13430000
integer    temptime;  << holds converted time from binary >>   <<06600>>13435000
                                                                        13440000
array direntry(0:direntrysize);                                <<05.eb>>13445000
byte array direntryb(*) = direntry;                            <<05.eb>>13450000
double array direntryd(*) = direntry;                          <<05.eb>>13455000
                                                               <<05.eb>>13460000
logical array xdd'subentry(0:size'of'xdd'subentry);            <<06909>>13465000
byte array xdd'bsubentry(*) = xdd'subentry;                    <<06909>>13470000
array devinfo(0:8);                                            <<05.eb>>13475000
                                                               <<05.eb>>13480000
byte array                                                     <<05.eb>>13485000
   tparm'arr(0:257),                                           <<04637>>13490000
   delims(0:4),                                                <<05.eb>>13495000
   upasswb(0:31);                                              <<05.eb>>13500000
                                                               <<05.eb>>13505000
define                                                         <<05.eb>>13510000
   apasswb  = upasswb(8) #,                                    <<05.eb>>13515000
   gpasswb  = upasswb(16) #,                                   <<05.eb>>13520000
   fnamewb  = upasswb(24) #;                                   <<05.eb>>13525000
logical array                                                           13530000
   errmsgbuff(0:35);               << print out file error >>           13535000
byte array                                                              13540000
   errmsgbuff'b(*)=errmsgbuff;     << byte array file error >>          13545000
integer errbufflgth;               << error msg. length >>              13550000
integer fserr;                                                          13555000
                                                                        13560000
                                                               <<05.eb>>13565000
byte array buff(*) = direntry;                                 <<05.eb>>13570000
                                                               <<08.eb>>13575000
byte nocaret := 0; << don't try to print caret >>              <<08.eb>>13580000
logical pcbpt;                                                 <<06599>>13585000
                                                               <<05.eb>>13590000
                                                               <<05.eb>>13595000
subroutine def'movefromdseg;                                   <<05.eb>>13600000
                                                               <<12.eb>>13605000
                                                               <<12.eb>>13610000
                   << ******************** >>                  <<12.eb>>13615000
                   << *  tellop          * >>                  <<12.eb>>13620000
                   << ******************** >>                  <<12.eb>>13625000
                                                               <<12.eb>>13630000
                                                               <<12.eb>>13635000
subroutine tellop(msgno);                                      <<12.eb>>13640000
   value msgno; integer msgno;                                 <<12.eb>>13645000
begin                                                          <<12.eb>>13650000
   formname(3, buff, jmatarrb(jmatjobnameoff*2),               <<06600>>13655000
                     jmatarrb(jmatusernameoff*2),              <<06600>>13660000
                     jmatarrb(jmatacctnameoff*2),              <<06600>>13665000
                     jmatarrb(jmatgrplogonoff*2));             <<06600>>13670000
                                                               <<06600>>13675000
   genmsg(syset,msgno,%01000,@buff,device,,,,0);               <<12.eb>>13680000
      << tell operator illeg. access >>                        <<12.eb>>13685000
end; << tellop >>                                              <<12.eb>>13690000
                                                               <<12.eb>>13695000
                                                               <<12.eb>>13700000
                   << ******************** >>                  <<12.eb>>13705000
                   << *  error routines  * >>                  <<12.eb>>13710000
                   << ******************** >>                  <<12.eb>>13715000
                                                               <<12.eb>>13720000
                                                               <<05.eb>>13725000
subroutine errprint(errn,pntr);                                <<05.eb>>13730000
   value errn,pntr;                                            <<05.eb>>13735000
   integer errn;                                               <<05.eb>>13740000
   byte pointer pntr;                                          <<05.eb>>13745000
begin                                                          <<05.eb>>13750000
   << if the job/session is being created through a        >>  << 8144>>13755000
   << programmatic :stream or with the new programmatic    >>  << 8144>>13760000
   << creation of sessions feature, then we don't want to  >>  << 8144>>13765000
   << print to the target ldev if there is an error.       >>  << 8144>>13770000
   << in the case of pcs, we don't guarantee that the      >>  << 8144>>13775000
   << physical device is ready to accept i/o at this point >>  << 8144>>13780000
   << (e.g. terminal is not turned on).                    >>  << 8144>>13785000
                                                               << 8144>>13790000
   pcbpt := curprc;                                            << 8144>>13795000
  if spcbptype < 2 or progcreation = true then return;         << 8144>>13800000
   case command of                                             <<05.eb>>13805000
   begin                                                       <<05.eb>>13810000
      move buff := (" DATA",0);                                <<05.eb>>13815000
      move buff := (" HELLO",0);                               <<05.eb>>13820000
      move buff := (" JOB",0);                                 <<05.eb>>13825000
      go errleftparen; << special logon >>                     <<06.eb>>13830000
      go errleftparen; << special logon apl1 >>                <<06.eb>>13835000
      begin << special logon apl2 >>                           <<06.eb>>13840000
                                                               <<06.eb>>13845000
errleftparen:                                                  <<06.eb>>13850000
         buff := 0;                                            <<06.eb>>13855000
         parmarr := "(";                                       <<06.eb>>13860000
      end;                                                     <<06.eb>>13865000
   end;                                                        <<05.eb>>13870000
       tos:=@parmarr;                                          <<00068>>13875000
s'can:                                                         <<00068>>13880000
       scan * until z'ro,1;                                    <<00068>>13885000
       if carry then                                           <<00068>>13890000
        begin                                                  <<00068>>13895000
         byte'cnt:=byte'indx:=tos - @parmarr + 1;              <<00068>>13900000
       temp'byte'cnt:= byte'cnt;                               <<02322>>13905000
         move tparm'arr:=" ";                                  <<00068>>13910000
         move tparm'arr(1):=tparm'arr,(byte'indx+1);           <<00068>>13915000
         move tparm'arr:=parmarr,(byte'indx);                  <<00068>>13920000
        end                                                    <<00068>>13925000
         else go s'can;                                        <<00068>>13930000
     tos:=@parmarr;                                            <<00068>>13935000
repeat'scan:                                                   <<00068>>13940000
     scan * until z'slash,1;                                   <<00068>>13945000
     if carry then                                             <<00068>>13950000
      begin                                                    <<00068>>13955000
       del;                                                    <<00068>>13960000
       go exit;                                                <<00068>>13965000
      end else                                                 <<00068>>13970000
          begin                                                <<02322>>13975000
              @b'pointer := tos;                               <<02322>>13980000
              byte'indx := @b'pointer - @parmarr +1;           <<02322>>13985000
              temp'byte'indx := byte'indx; <<save byte index>> <<02322>>13990000
              while b'char(byte'indx) <> special               <<02322>>13995000
              do begin                                         <<02322>>14000000
                 move b'char(byte'indx) := " "; << blank pass>><<02322>>14005000
                 byte'indx := byte'indx + 1;                   <<02322>>14010000
                 end;                                          <<02322>>14015000
              if b'char(byte'indx) = 0 then go exit else       <<02322>>14020000
                 begin                                         <<02322>>14025000
                 len'string'left := temp'byte'cnt-byte'indx;   <<02322>>14030000
                 move b'char(temp'byte'indx) :=                <<02322>>14035000
                       b'char(byte'indx),(len'string'left);    <<02322>>14040000
                 temp'byte'cnt := temp'byte'cnt -              <<02322>>14045000
                       (byte'indx - temp'byte'indx);           <<02322>>14050000
                 << new string length computed >>              <<02322>>14055000
          tos:=@b'pointer + 1;                                 <<00068>>14060000
          go repeat'scan;                                      <<00068>>14065000
         end;                                                  <<00068>>14070000
       end;                                                    <<00068>>14075000
exit:                                                          <<00068>>14080000
   genmsg(-1,@buff,,,,,,,glistdev,,,,%100000);                 <<05.eb>>14085000
   genmsg(-1,@parmarr,,,,,,,glistdev);                         <<05.eb>>14090000
  << move the original content of the array back >>            << 9000>>14095000
    move parmarr:=tparm'arr,(byte'cnt);                        <<00068>>14100000
   if pntr <> 0 then printcaret(glistdev,command,@pntr         <<08.eb>>14105000
      -@parmarr);                                              <<05.eb>>14110000
   if spcbptype = 2 then << ci process >>                      <<06599>>14115000
      << cierr prints msg and sets jcw 'cierror' >>            <<00534>>14120000
      cierr (errnum := -errn) <<negative so job not killed>>   <<04754>>14125000
   else                                                        <<00534>>14130000
      genmsg(ciset,errn,,,,,,,glistdev);                       <<00534>>14135000
   if command > 2 then parmarr := " ";                         <<04638>>14140000
end; << subroutine errprint >>                                 <<05.eb>>14145000
                                                               <<05.eb>>14150000
subroutine warn(errn,pntr);                                    <<05.eb>>14155000
   value errn,pntr;                                            <<05.eb>>14160000
   integer errn;                                               <<05.eb>>14165000
   byte pointer pntr;                                          <<05.eb>>14170000
begin                                                          <<05.eb>>14175000
   errprint(errn,pntr);                                        <<05.eb>>14180000
   if parmask.(14:1) then errnum := -errn;                     <<00534>>14185000
end; << subroutine warn >>                                     <<05.eb>>14190000
                                                               <<05.eb>>14195000
subroutine err(errn,pntr);                                     <<05.eb>>14200000
   value errn,pntr;                                            <<05.eb>>14205000
   integer errn;                                               <<05.eb>>14210000
   byte pointer pntr;                                          <<05.eb>>14215000
begin                                                          <<05.eb>>14220000
   errprint(errn,pntr);                                        <<05.eb>>14225000
   if parmask.(14:1) then errnum := errn;                      <<00534>>14230000
   go outl;                                                    <<05.eb>>14235000
end; << subroutine err >>                                      <<05.eb>>14240000
                                                               <<05.eb>>14245000
subroutine erri(errn);                                         <<05.eb>>14250000
   value errn; integer errn;                                   <<05.eb>>14255000
begin                                                          <<05.eb>>14260000
   errprint(errn,nocaret);                                              14265000
   if parmask.(14:1) then errnum := errn;                      <<00534>>14270000
   go outl;                                                    <<05.eb>>14275000
end; << subroutine erri >>                                     <<05.eb>>14280000
                                                               <<06600>>14285000
   <<  remove jmat is called when logon fails.  it      >>     <<06600>>14290000
   <<  deallocates the jmat entry.                      >>     <<07279>>14295000
   <<    jmatxptr is the pointer to the entry we kill   >>     <<06600>>14300000
                                                               <<06600>>14305000
                                                               <<06600>>14310000
subroutine removejmat;                                         <<05.eb>>14315000
begin                                                          <<05.eb>>14320000
                                                               <<05.eb>>14325000
exchangedb(jmatdst);                                           <<05.eb>>14330000
savesir := getsir(jmatsir);                                    <<05.eb>>14335000
deallocate'jmat(jmatxptr);                                     <<06600>>14340000
relsir(jmatsir,savesir);                                       <<05.eb>>14345000
exchangedb(0);                                                 <<05.eb>>14350000
                                                               <<05.eb>>14355000
end; << subroutine removejmat >>                               <<05.eb>>14360000
                                                               <<05.eb>>14365000
                                                               <<05.eb>>14370000
                   << ******************** >>                  <<05.eb>>14375000
                   << * getcheckname     * >>                  <<05.eb>>14380000
                   << ******************** >>                  <<05.eb>>14385000
                                                               <<05.eb>>14390000
                                                               <<05.eb>>14395000
   << used to parse logonid >>                                 <<05.eb>>14400000
logical subroutine getcheckname(name,required,prechar,         <<05.eb>>14405000
      postchar,errno);                                         <<05.eb>>14410000
   value required,prechar,postchar,errno;                      <<05.eb>>14415000
   byte array name;                                            <<05.eb>>14420000
   logical required;                                           <<05.eb>>14425000
   byte prechar,postchar;                                      <<05.eb>>14430000
   integer errno;                                              <<05.eb>>14435000
comment  - note, does not blank out 8-byte name array.         <<05.eb>>14440000
   uses externals:                                             <<05.eb>>14445000
    - plen                                                     <<05.eb>>14450000
    - ptr                                                      <<05.eb>>14455000
    - parm                                                     <<05.eb>>14460000
   returns true if optional parm is found.                     <<05.eb>>14465000
;                                                              <<05.eb>>14470000
begin                                                          <<05.eb>>14475000
                                                               <<05.eb>>14480000
if required then                                               <<05.eb>>14485000
begin                                                          <<05.eb>>14490000
   if prechar <> 0 and prechar <> ptr then err(errno,ptr);     <<05.eb>>14495000
   plen := nextparmd(delims,ptr,parm,ptr); << fetch parm >>    <<05.eb>>14500000
   if = then err(errno,parm);                                  <<05.eb>>14505000
   if postchar <> 0 and postchar <> ptr then err(errno,parm);  <<05.eb>>14510000
   if parm <> alpha then err(namenotalpha,parm);               <<05.eb>>14515000
   if plen > 8 then err(nametoolong,parm);                     <<05.eb>>14520000
   move name := parm,(plen);                                   <<05.eb>>14525000
end                                                            <<05.eb>>14530000
else                                                           <<05.eb>>14535000
begin << not required, don't fetch parm if missing >>          <<05.eb>>14540000
   if prechar = 0 or prechar = ptr then                        <<05.eb>>14545000
   begin << may have it >>                                     <<05.eb>>14550000
      splen := plen;                                           <<05.eb>>14555000
      @saveptr := @ptr;                                        <<05.eb>>14560000
      @sparm := @parm;                                         <<05.eb>>14565000
         << save old state >>                                  <<05.eb>>14570000
      plen := nextparmd(delims,ptr,parm,ptr);                  <<05.eb>>14575000
      if > then                                                <<05.eb>>14580000
      begin                                                    <<05.eb>>14585000
         if postchar = 0 or postchar = ptr then                <<05.eb>>14590000
         begin << do indeed have it >>                         <<05.eb>>14595000
            getcheckname := true;                              <<05.eb>>14600000
            if parm <> alpha then err(namenotalpha,parm);      <<05.eb>>14605000
            if plen > 8 then err(nametoolong,parm);            <<05.eb>>14610000
            move name := parm,(plen);                          <<05.eb>>14615000
         end                                                   <<05.eb>>14620000
         else                                                  <<05.eb>>14625000
         begin << don't have it, back up >>                    <<05.eb>>14630000
            plen := splen;                                     <<05.eb>>14635000
            @ptr := @saveptr;                                  <<05.eb>>14640000
            @parm := @sparm;                                   <<05.eb>>14645000
         end;                                                  <<05.eb>>14650000
      end                                                      <<05.eb>>14655000
      else                                                     <<05.eb>>14660000
      begin << don't have it, back up >>                       <<05.eb>>14665000
         plen := splen;                                        <<05.eb>>14670000
         @ptr := @saveptr;                                     <<05.eb>>14675000
         @parm := @sparm;                                      <<05.eb>>14680000
      end;                                                     <<05.eb>>14685000
   end;                                                        <<05.eb>>14690000
end;                                                           <<05.eb>>14695000
                                                               <<05.eb>>14700000
end; << getcheckname >>                                        <<05.eb>>14705000
                                                               <<05.eb>>14710000
                                                               <<05.eb>>14715000
   << used to parse keys >>                                    <<05.eb>>14720000
subroutine checkdupkey(keyname);                               <<05.eb>>14725000
   logical keyname;                                            <<05.eb>>14730000
begin                                                          <<05.eb>>14735000
   if keyname then warn(dupkey,parm);                          <<05.eb>>14740000
   keyname := true;                                            <<05.eb>>14745000
end; << subroutine checkdupkey >>                              <<05.eb>>14750000
                                                               <<05.eb>>14755000
subroutine getnextparm;                                        <<05.eb>>14760000
begin                                                          <<05.eb>>14765000
   plen := nextparm(ptr,parm,ptr);                             <<05.eb>>14770000
end; << subroutine getnextparm >>                              <<05.eb>>14775000
                                                               <<05.eb>>14780000
logical subroutine convertnum(errnum);                                  14785000
value errnum; integer errnum;                                           14790000
begin                                                          <<05.eb>>14795000
   convertnum := binary(parm,plen);                            <<05.eb>>14800000
   if <> then warn(errnum,parm);                               <<04963>>14805000
end; << subroutine convertnum >>                               <<05.eb>>14810000
                                                               <<05.eb>>14815000
                                                               <<05.eb>>14820000
<< ***************************** >>                            <<05.eb>>14825000
<<                               >>                            <<05.eb>>14830000
<< keyword parsers & executors   >>                            <<05.eb>>14835000
<<                               >>                            <<05.eb>>14840000
<< ***************************** >>                            <<05.eb>>14845000
                                                               <<05.eb>>14850000
                                                               <<05.eb>>14855000
                   << ******************** >>                  <<05.eb>>14860000
                   << *     term         * >>                  <<05.eb>>14865000
                   << ******************** >>                  <<05.eb>>14870000
                                                               <<05.eb>>14875000
subroutine doterm;                                             <<05.eb>>14880000
begin                                                          <<05.eb>>14885000
                                                               <<05.eb>>14890000
if indevtype <> terminal or spoolercall                                 14895000
   then warn(jobterminal,parm)                                          14900000
else begin                                                              14905000
checkdupkey(fterm);                                            <<05.eb>>14910000
       << is terminal type file or number specified ? >>                14915000
       if parm = alpha then                                             14920000
          begin              << term type file specified >>             14925000
          iname := file;     << check file name first    >>             14930000
          check'filename(parm,plen,iname,errnum);                       14935000
          if errnum <> 0                                                14940000
             then warn(errnum,parm)                            <<06911>>14945000
          else begin                                                    14950000
              term'type'file(device, parm, plen,               <<06911>>14955000
                             jmatarrb(jmatgrplogonoff*2),      <<06911>>14960000
                             jmatarrb(jmatacctnameoff*2),      <<06911>>14965000
                             iname, errnum, fserr);            <<06911>>14970000
               if errnum <> 0                                  <<06911>>14975000
                  then warn(errnum,parm);                               14980000
               if fserr <> 0 then                                       14985000
                  begin                                                 14990000
                    ferrmsg(fserr,errmsgbuff,errbufflgth);              14995000
                    errmsgbuff'b(errbufflgth) := 0;                     15000000
                    genmsg(-1,@errmsgbuff'b,,,,,,,glistdev);            15005000
                    end;                                                15010000
               end;                                                     15015000
          end << parm = alpha >>                                        15020000
      else                                                              15025000
         begin        << term type number specified >>                  15030000
         termtype := binary(parm,plen);                                 15035000
         if <> then warn(badtermtype,parm)                              15040000
         else begin                                                     15045000
            << finished parsing, now execute >>                         15050000
            tos := attachio(device,0,0,0,23,0,termtype,0,1);            15055000
            del;                                                        15060000
            if tos.(13:3) <> 1 then warn(badtermtype,parm);             15065000
            end;                                                        15070000
 end;                                                                   15075000
                                                                        15080000
                                                               <<05.eb>>15085000
end;                                                           <<04963>>15090000
end; << subroutine doterm >>                                   <<05.eb>>15095000
                                                               <<05.eb>>15100000
                                                               <<05.eb>>15105000
                   << ******************** >>                  <<05.eb>>15110000
                   << *    pri           * >>                  <<05.eb>>15115000
                   << ******************** >>                  <<05.eb>>15120000
                                                               <<05.eb>>15125000
                                                               <<05.eb>>15130000
subroutine dopri;                                              <<05.eb>>15135000
begin                                                          <<05.eb>>15140000
                                                               <<05.eb>>15145000
checkdupkey(fpri);                                             <<05.eb>>15150000
if plen <> 2 then warn(invpri,parm)                            <<04963>>15155000
else                                                           <<05.eb>>15160000
begin                                                          <<05.eb>>15165000
   if parm <> "BS" and                                         <<05.eb>>15170000
      parm <> "CS" and                                         <<05.eb>>15175000
      parm <> "DS" and                                         <<05.eb>>15180000
      parm <> "ES" then warn(invpri,parm)                      <<04963>>15185000
   else                                                        <<05.eb>>15190000
   begin                                                       <<05.eb>>15195000
      queue := parm;                                           <<05.eb>>15200000
      tos := subqueue(4,queue);                                <<05.eb>>15205000
      if < then                                                <<05.eb>>15210000
      begin                                                    <<05.eb>>15215000
         ddel;                                                 <<05.eb>>15220000
         warn(invpri,parm);                                    <<04963>>15225000
      end                                                      <<05.eb>>15230000
      else                                                     <<05.eb>>15235000
      begin                                                    <<05.eb>>15240000
         pri := tos.(8:8);                                     <<12.eb>>15245000
         del;                                                  <<05.eb>>15250000
                                                               <<05.eb>>15255000
            << finished parse, now execute >>                  <<05.eb>>15260000
            << user higher cap. than acct? >>                  <<05.eb>>15265000
         if umaxpri < amaxpri then umaxpri := amaxpri;         <<05.eb>>15270000
         if pri < umaxpri then                                 <<05.eb>>15275000
         begin                                                 <<05.eb>>15280000
            pri := umaxpri;                                    <<05.eb>>15285000
         end;                                                  <<05.eb>>15290000
         if command' = cjob and pri < absys'jprilim then       <<12.eb>>15295000
            jmatxpri := absys'jprilim                          <<06600>>15300000
         else jmatxpri := pri;                                 <<06600>>15305000
            << don't override jobpri on jobs >>                <<12.eb>>15310000
      end;                                                     <<05.eb>>15315000
   end;                                                        <<05.eb>>15320000
end;                                                           <<05.eb>>15325000
                                                               <<05.eb>>15330000
end; << subroutine dopri >>                                    <<05.eb>>15335000
                                                               <<05.eb>>15340000
                                                               <<05.eb>>15345000
                   << ******************** >>                  <<05.eb>>15350000
                   << *    time          * >>                  <<05.eb>>15355000
                   << ******************** >>                  <<05.eb>>15360000
                                                               <<05.eb>>15365000
                                                               <<05.eb>>15370000
subroutine dotime;                                             <<05.eb>>15375000
begin                                                          <<05.eb>>15380000
                                                               <<05.eb>>15385000
checkdupkey(ftime);                                            <<05.eb>>15390000
if plen=1 and parm="?" or plen=5 and parm="UNLIM"              <<0314>> 15395000
   then jmatcpulim := -1                                       <<06600>>15400000
else                                                           <<0314>> 15405000
   begin                                                       <<0314>> 15410000
   << .................................................. >>    <<06600>>15415000
   <<  convert user input time and save in a temporary   >>    <<06600>>15420000
   <<  rather than jmatcpulim in order to preserve cc    >>    <<06600>>15425000
   <<  return from binary (the indexing kills it if we   >>    <<06600>>15430000
   <<  assign directly to jmatcpulim).                   >>    <<06600>>15435000
   << .................................................. >>    <<06600>>15440000
   temptime := binary(parm,plen);                              <<06600>>15445000
   if <>  or  temptime <= 0                                    <<06600>>15450000
      then begin                                               <<04963>>15455000
             warn(invalidtime,parm);                           <<04963>>15460000
             jmatcpulim := -1;                                 <<06600>>15465000
             end                                               <<06600>>15470000
   else  jmatcpulim := temptime;                               <<06600>>15475000
   end;                                                        <<0314>> 15480000
                                                               <<05.eb>>15485000
                                                               <<0314>> 15490000
end; << subroutine dotime >>                                   <<05.eb>>15495000
                                                               <<05.eb>>15500000
                                                               <<05.eb>>15505000
subroutine checksetinpri;                                      <<05.eb>>15510000
begin                                                          <<05.eb>>15515000
      << must have sm or op cap. for hipri >>                  <<05.eb>>15520000
   if inpri = jobhipri then                                    <<06600>>15525000
      if (cap0 land %102000) = 0 then                          <<05.eb>>15530000
      begin                                                    <<05.eb>>15535000
         inpri := maxinpri;                                    <<00569>>15540000
         warn(nohipricap,parm);                                <<04943>>15545000
      end;                                                     <<05.eb>>15550000
   jmatinpri := inpri;                                         <<06600>>15555000
end; << subroutine checkinpri >>                               <<05.eb>>15560000
                                                               <<05.eb>>15565000
                                                               <<05.eb>>15570000
                   << ******************** >>                  <<05.eb>>15575000
                   << *    inpri         * >>                  <<05.eb>>15580000
                   << ******************** >>                  <<05.eb>>15585000
                                                               <<05.eb>>15590000
                                                               <<05.eb>>15595000
subroutine doinpri;                                            <<05.eb>>15600000
begin                                                          <<05.eb>>15605000
                                                               <<05.eb>>15610000
checkdupkey(finpri);                                           <<05.eb>>15615000
if fhipri then warn(inprihipri,parm);                          <<01305>>15620000
   inpri := convertnum(notnuminoutpri);                                 15625000
if <> then inpri := 8;                                         <<04963>>15630000
      << finished parse, now execute >>                        <<05.eb>>15635000
   if inpri < 1 then                                           <<05.eb>>15640000
      begin                                                    <<04963>>15645000
        warn(toolowinpri,parm);                                <<04963>>15650000
        inpri := 1;                                            <<04963>>15655000
        end;                                                   <<04963>>15660000
   if inpri > maxinpri   then                                  <<00569>>15665000
      begin                                                    <<04963>>15670000
        warn(toohiinpri,parm);                                 <<04963>>15675000
        inpri := maxinpri;                                     <<04963>>15680000
        end;                                                   <<04963>>15685000
   checksetinpri;                                              <<05.eb>>15690000
                                                               <<05.eb>>15695000
end; << subroutine doinpri >>                                  <<05.eb>>15700000
                                                               <<05.eb>>15705000
                                                               <<05.eb>>15710000
                   << ******************** >>                  <<05.eb>>15715000
                   << *     hipri        * >>                  <<05.eb>>15720000
                   << ******************** >>                  <<05.eb>>15725000
                                                               <<05.eb>>15730000
                                                               <<05.eb>>15735000
subroutine dohipri;                                            <<05.eb>>15740000
begin                                                          <<05.eb>>15745000
                                                               <<05.eb>>15750000
checkdupkey(fhipri);                                           <<05.eb>>15755000
if finpri then warn(hipriinpri,parm);                          <<05.eb>>15760000
                                                               <<05.eb>>15765000
   << finished parse, now execute >>                           <<05.eb>>15770000
inpri := jobhipri;                                             <<06600>>15775000
checksetinpri;                                                 <<05.eb>>15780000
                                                               <<05.eb>>15785000
end; << subroutine hipri >>                                    <<05.eb>>15790000
                                                               <<05.eb>>15795000
                                                               <<05.eb>>15800000
                   << ******************** >>                  <<05.eb>>15805000
                   << *    outclass      * >>                  <<05.eb>>15810000
                   << ******************** >>                  <<05.eb>>15815000
                                                               <<05.eb>>15820000
                                                               <<05.eb>>15825000
subroutine dooutclass;                                         <<05.eb>>15830000
begin                                                          <<05.eb>>15835000
                                                               <<05.eb>>15840000
if command' = chello then warn(sessionoutclass,parm)           <<06.eb>>15845000
else                                                           <<05.eb>>15850000
begin                                                          <<05.eb>>15855000
   checkdupkey(foutclass);                                     <<05.eb>>15860000
   if plen > 0 then                                            <<05.eb>>15865000
   begin << check & execute outclass device >>                 <<05.eb>>15870000
      if getdevinfo(parm,devinfo) <> 0 then warn(invoutclass,  <<04963>>15875000
         parm)                                                 <<05.eb>>15880000
      else                                                     <<05.eb>>15885000
         if not validspoolee(devinfo(1),true) then warn(       <<04963>>15890000
            invouttype,parm)                                   <<sp1sz>>15895000
         else                                                  <<sp1sz>>15900000
      begin                                                    <<05.eb>>15905000
         if not cap0.(14:1) then warn(nond,parm)               <<04963>>15910000
            << can't specify outclass device without >>        <<05.eb>>15915000
            << non-sharable device capability        >>        <<05.eb>>15920000
         else                                                  <<05.eb>>15925000
         begin                                                 <<05.eb>>15930000
               << solve class vs. ldev problem >>              <<05.eb>>15935000
            tos := devinfo;                                    <<05.eb>>15940000
            if < then                                          <<05.eb>>15945000
            begin << dev class >>                              <<05.eb>>15950000
               tos := -tos;                                    <<05.eb>>15955000
               tos := true;                                    <<05.eb>>15960000
            end                                                <<05.eb>>15965000
            else tos := false; << ldev >>                      <<05.eb>>15970000
            jmatcbit := tos; << set class >>                   <<06600>>15975000
            jmatjlistdev := tos;                               <<06600>>15980000
         end;                                                  <<05.eb>>15985000
      end;                                                     <<05.eb>>15990000
   end;                                                        <<05.eb>>15995000
      << finished executing outclass >>                        <<05.eb>>16000000
   if ptr = "," then                                           <<05.eb>>16005000
   begin << may have outpri,numcopies >>                       <<05.eb>>16010000
      getnextparm;                                             <<05.eb>>16015000
      if > then                                                <<05.eb>>16020000
      begin                                                    <<05.eb>>16025000
         outpri := convertnum(notnuminoutpri);                          16030000
         if <> then outpri := 8;                               <<04963>>16035000
            << finished parsing, now execut outpri >>          <<05.eb>>16040000
         if outpri < 1 then                                    <<05.eb>>16045000
             begin                                             <<04963>>16050000
               warn(toolowoutpri,parm);                        <<04963>>16055000
               outpri := 1;                                    <<04963>>16060000
               end;                                            <<04963>>16065000
         if outpri > 13 then                                   <<05.eb>>16070000
             begin                                             <<04963>>16075000
               warn(toohioutpri,parm);                         <<04963>>16080000
               outpri := 13;                                   <<04963>>16085000
               end;                                            <<04963>>16090000
         jmatoutpri := outpri;                                 <<06600>>16095000
            << finished executing outpri >>                    <<05.eb>>16100000
      end;                                                     <<05.eb>>16105000
         << now look for numcopies >>                          <<05.eb>>16110000
      if ptr = "," then                                        <<05.eb>>16115000
      begin                                                    <<05.eb>>16120000
         getnextparm;                                          <<05.eb>>16125000
          if = then warn(expnumcopies,parm)                    <<04963>>16130000
         else                                                  <<05.eb>>16135000
         begin                                                 <<05.eb>>16140000
           numcopies := convertnum(notnumcopies);                       16145000
               << finished numcopies parse, now execute >>     <<05.eb>>16150000
            if numcopies > 127 then                            <<05.eb>>16155000
               begin                                           <<04963>>16160000
                 warn(maxcopies127,parm);                      <<04963>>16165000
                 numcopies := 127;                             <<04963>>16170000
                 end;                                          <<04963>>16175000
            if numcopies < 1 then                              <<04817>>16180000
               begin                                           <<04817>>16185000
                 warn(mincopies1,parm);                        <<04817>>16190000
                 numcopies := 1;                               <<04817>>16195000
               end;                                            <<04817>>16200000
            jmatnumcopies := numcopies;                        <<06600>>16205000
               << now parse for next parameter >>              <<05.eb>>16210000
            if ptr = "," then                                  <<05.eb>>16215000
            begin << extra parameter here >>                   <<05.eb>>16220000
               warn(extraoutclassparm,ptr);                    <<05.eb>>16225000
               getnextparm;                                    <<05.eb>>16230000
            end;                                               <<05.eb>>16235000
         end;                                                  <<05.eb>>16240000
      end;                                                     <<05.eb>>16245000
   end;                                                        <<05.eb>>16250000
end;                                                           <<05.eb>>16255000
                                                               <<05.eb>>16260000
end; << subroutine outclass >>                                 <<05.eb>>16265000
                                                               <<05.eb>>16270000
                                                               <<05.eb>>16275000
                   << ******************** >>                  <<05.eb>>16280000
                   << *      restart     * >>                  <<05.eb>>16285000
                   << ******************** >>                  <<05.eb>>16290000
                                                               <<05.eb>>16295000
                                                               <<05.eb>>16300000
subroutine dorestart;                                          <<05.eb>>16305000
begin                                                          <<05.eb>>16310000
                                                               <<05.eb>>16315000
checkdupkey(frestart);                                         <<05.eb>>16320000
                                                               <<05.eb>>16325000
   << finsihed parsing, now execute >>                         <<05.eb>>16330000
if command' = cjob then jmatrestart := true                    <<06600>>16335000
else warn(sessionrestart,parm);                                <<05.eb>>16340000
                                                               <<05.eb>>16345000
end; << subroutine dorestart >>                                <<05.eb>>16350000
                                                               <<05.eb>>16355000
                                                               <<05.eb>>16360000
                   << ******************** >>                  <<05.eb>>16365000
                   << *    checkpass     * >>                  <<05.eb>>16370000
                   << ******************** >>                  <<05.eb>>16375000
                                                               <<05.eb>>16380000
   << used to verify logon >>                                  <<05.eb>>16385000
   << g/a/u = 1/2/3        >>                                  <<05.eb>>16390000
                                                               <<05.eb>>16395000
logical subroutine checkpass(level,usern,pass);                <<05.eb>>16400000
   value level;                                                <<05.eb>>16405000
   integer level;                                              <<05.eb>>16410000
   array usern;                                                <<05.eb>>16415000
   byte array pass;                                            <<05.eb>>16420000
comment - fetches each directory entry & checks password.      <<05.eb>>16425000
   returns true if password must be checked by ci. error       <<05.eb>>16430000
   calls err & never returns                                   <<05.eb>>16435000
;                                                              <<05.eb>>16440000
begin                                                          <<05.eb>>16445000
                                                               <<05.eb>>16450000
   direcfind(level&lsl(3), 0d, jmatacctname,                   <<06600>>16455000
             usern, dummy, direntry);                          <<06600>>16460000
   if <> then                                                  <<12.eb>>16465000
   begin                                                       <<12.eb>>16470000
      tellop(conslogonfail +level);                            <<12.eb>>16475000
      erri(noacct +level); << will never return >>             <<12.eb>>16480000
   end;                                                        <<12.eb>>16485000
   if level = ulevel and not groupspec then                    <<05.eb>>16490000
   begin                                                       <<05.eb>>16495000
         << group required for job/session.  use home group>>  <<10.eb>>16500000
         << from user entry if none specified.             >>  <<10.eb>>16505000
      if direntry(uhgroup) = "  " and command' <> cdata        <<10.eb>>16510000
         then                                                  <<12.eb>>16515000
      begin                                                    <<12.eb>>16520000
         tellop(cnohomeg);                                     <<12.eb>>16525000
         erri(nohomeg); << will never return >>                <<12.eb>>16530000
      end;                                                     <<12.eb>>16535000
      move jmatgrplogon := direntry(uhgroup),(4);              <<06600>>16540000
   end;                                                        <<05.eb>>16545000
   << check to see if password is needed.  if it    >>         <<00802>>16550000
   << is needed & it is supplied check its validity >>         <<00802>>16555000
   if level = glevel and homegroup then                        <<00802>>16560000
   begin                                                       <<00802>>16565000
      << password not required for home group >>               <<00802>>16570000
      checkpass := false;                                      <<00802>>16575000
      if pass <> " " then warn(nopassreqd+level,nocaret);      <<00802>>16580000
   end                                                         <<00802>>16585000
   else                                                        <<00802>>16590000
   begin                                                       <<00802>>16595000
      dirindex := if level = alevel then apassb else           <<00802>>16600000
         if level = ulevel then upassb else gpassb;            <<00802>>16605000
      if direntryb(dirindex) <> " " then                       <<00802>>16610000
      begin << password in directory >>                        <<00802>>16615000
         if pass = " " then checkpass := true                  <<00802>>16620000
         else                                                  <<00802>>16625000
            if direntryb(dirindex) <> pass,(8) then            <<02320>>16630000
            begin                                              <<02320>>16635000
               tellop(cinvpass);                               <<02320>>16640000
               erri(invpass);                                  <<02320>>16645000
            end;                                               <<02320>>16650000
      end                                                      <<00802>>16655000
      else if pass <> " " then warn(nopassreqd+level,nocaret); <<00802>>16660000
         << pass word provided but not needed >>               <<00802>>16665000
   end;                                                        <<00802>>16670000
                                                               <<05.eb>>16675000
end; << subroutine checkpass >>                                <<05.eb>>16680000
                                                               << 9041>>16685000
subroutine donowait;                                           << 9041>>16690000
begin                                                          << 9041>>16695000
  if not progcreation                                          << 9041>>16700000
     then warn(nonprognowait,parm)                             << 9041>>16705000
     else jmatlogonnow := 1;                                   << 9041>>16710000
end;  << donowait >>                                           << 9041>>16715000
                                                               << 9041>>16720000
                                                               <<05.eb>>16725000
                                                               <<05.eb>>16730000
<< ***************************** >>                            <<05.eb>>16735000
<<                               >>                            <<05.eb>>16740000
<<  main proc. body              >>                            <<05.eb>>16745000
<<                               >>                            <<05.eb>>16750000
<< ***************************** >>                            <<05.eb>>16755000
                                                               <<05.eb>>16760000
<< intiialize error return parameters >>                       <<00723>>16765000
if parmask.(14:1) then errnum := 0;                            <<00723>>16770000
if parmask.(15:1) then parmnum := 0;                           <<00723>>16775000
                                                               <<05.eb>>16780000
<< set up locals >>                                            <<05.eb>>16785000
upasswb := " ";                                                <<05.eb>>16790000
move upasswb(1) := upasswb,(31);                               <<05.eb>>16795000
fterm := fpri := ftime := finpri :=                            <<1.rao>>16800000
fhipri := foutclass := frestart := false;                      <<05.eb>>16805000
command' := command;                                           <<06.eb>>16810000
waittillon := false;                                           << 8144>>16815000
if command = 6 then                                            << 8144>>16820000
begin                                                          << 8144>>16825000
   command' := 1;                                              << 8144>>16830000
   progcreation := true;                                       << 8144>>16835000
   waittillon := false;                                        << 8144>>16840000
end                                                            << 8144>>16845000
else if command = 7 then                                       << 8144>>16850000
begin                                                          << 8144>>16855000
  command' := 1;                                               << 8144>>16860000
  progcreation := true;                                        << 8144>>16865000
  waittillon := true;                                          << 8144>>16870000
end                                                            << 8144>>16875000
else progcreation := false;                                    << 8144>>16880000
                                                               <<05.eb>>16885000
                                                               <<05.eb>>16890000
scan parmarr until %15,1;                                      <<05.eb>>16895000
bps0 := 0; del;  << change cr to 0 >>                          <<05.eb>>16900000
groupspec := false; << no group specified in logon >>          <<10.eb>>16905000
                                                               <<05.eb>>16910000
                                                               <<05.eb>>16915000
<< ***************************** >>                            <<05.eb>>16920000
<<                               >>                            <<05.eb>>16925000
<< initialize jmat entry         >>                            <<05.eb>>16930000
<<                               >>                            <<05.eb>>16935000
<< ***************************** >>                            <<05.eb>>16940000
                                                               <<06600>>16945000
jmatinx := 0; << we reference jmatarr locally >>               <<06600>>16950000
                                                               <<06600>>16955000
jmatarr := 0;                                                  <<06600>>16960000
<< zero out the jmat array so that there are no >>             <<*8061>>16965000
<< uninitialized variables in the jmat entry    >>             <<*8061>>16970000
move jmatarr(1) := jmatarr(0),(jmatentrysize-1);               <<*8061>>16975000
                                                               <<*8061>>16980000
jmatjobstate := jobintro;                                      <<06600>>16985000
jmatinpri := definpri;                                         <<06600>>16990000
   << the job type and the job number are set by putjmat >>    <<06600>>16995000
                                                               <<06600>>17000000
   << blank out the user, acct., job and group logon names >>  <<06600>>17005000
jmatusername := "  ";                                          <<06600>>17010000
move jmatarr(jmatusernameoff + 1) :=                           <<06600>>17015000
             jmatarr(jmatusernameoff), (jmatnamelen*4 - 1);    <<06600>>17020000
jmatjindev := device;                                          <<06600>>17025000
jmatcalendar := calendar;                                      <<06600>>17030000
jmatarrd(jmattimeoff/2) := clock;                              <<06600>>17035000
   << initjsmp sets the main pin field >>                      <<06600>>17040000
jmatxpri := if command' = cjob then absys'jobpri               <<06600>>17045000
   else defxpri;                                               <<06600>>17050000
jmatcpulim := if command' = cjob then                          <<06600>>17055000
   absolute(cputimelimit)                                      <<06600>>17060000
   else  -1;                                                   <<06600>>17065000
jmatnumcopies := 0;                                            <<06600>>17070000
 if progcreation                                               << 8144>>17075000
    then jmatproglogon := 1                                    << 8144>>17080000
    else jmatproglogon := 0;                                   << 8144>>17085000
if waittillon                                                  << 8144>>17090000
    then jmatwaittillon := 1                                   << 8144>>17095000
    else jmatwaittillon := 0;                                  << 8144>>17100000
jmatcreator := curprc/pcbsize;                                 << 8144>>17105000
jmatftbits := 0;                                               <<06600>>17110000
jmatrestart := 0;                                              <<06600>>17115000
if seqnumpassed then   <<use spooler provided value>>          <<06600>>17120000
   jmatseqbit := sequenced                                     <<06600>>17125000
else   <<use devrec provided value>>                           <<06600>>17130000
   jmatseqbit := false;  <<default, no check right now>        <<06600>>17135000
if spoolercall then jmatsbit := true;                          <<06600>>17140000
   <<schedule link/origjin-origjlist set by putjmat, >>        <<05.eb>>17145000
   << then by initjsmp                               >>        <<05.eb>>17150000
                                                               <<05.eb>>17155000
                                                               <<05.eb>>17160000
<< ***************************** >>                            <<05.eb>>17165000
<<                               >>                            <<05.eb>>17170000
<<  fetch device info            >>                            <<05.eb>>17175000
<<                               >>                            <<05.eb>>17180000
<< ***************************** >>                            <<05.eb>>17185000
                                                               <<05.eb>>17190000
movefromdseg(@ldt,ldt'dst,                                     <<06215>>17195000
  device*size'of'ldt'entry, size'of'ldt'entry);                <<06215>>17200000
indevtype := ldt'device'type;                                  <<06215>>17205000
jmatcbit := ldt'class'index;                                   <<06600>>17210000
outdev := ldt'dflt'out'dev;                                    <<06215>>17215000
jmatjlistdev := outdev;                                        <<06600>>17220000
                                                               <<05.eb>>17225000
   << set genmsg list device. $stdlist = -2                    <<05.eb>>17230000
   << $stdlist is ldev if caller is devrec or                  <<05.eb>>17235000
   << spooling running on jsmp                                 <<05.eb>>17240000
   <<>>                                                        <<05.eb>>17245000
glistdev := -2; << $stdlist >>                                 <<05.eb>>17250000
if not spoolercall and not jmatcbit then                       <<06600>>17255000
begin                                                          <<05.eb>>17260000
   movefromdseg(@ldt, ldt'dst, jmatjlistdev*                   <<06600>>17265000
      size'of'ldt'entry, size'of'ldt'entry);                   <<06215>>17270000
   outdevtype := ldt'device'type;                              <<06215>>17275000
   if outdevtype = terminal then                               <<06600>>17280000
   glistdev := jmatjlistdev;                                   <<06600>>17285000
end;                                                           <<05.eb>>17290000
                                                               <<05.eb>>17295000
                                                               <<05.eb>>17300000
<< ***************************** >>                            <<05.eb>>17305000
<<                               >>                            <<05.eb>>17310000
<<  list dev set up, can now     >>                            <<05.eb>>17315000
<< have errors & report them.    >>                            <<05.eb>>17320000
<< ***************************** >>                            <<05.eb>>17325000
                                                               <<05.eb>>17330000
                                                               <<05.eb>>17335000
<< ***************************** >>                            <<05.eb>>17340000
<<                               >>                            <<05.eb>>17345000
<<  solve funnyterm problem      >>                            <<05.eb>>17350000
<<                               >>                            <<05.eb>>17355000
<< ***************************** >>                            <<05.eb>>17360000
                                                               <<05.eb>>17365000
if command' > cjob then                                        <<06.eb>>17370000
begin << special logon,                             >>         <<05.eb>>17375000
      << translate from apl, find right end of cmd, >>         <<05.eb>>17380000
      << set funnyterm, find logon id               >>         <<05.eb>>17385000
   @cicomptrw := @parmarr&lsr(1);                              <<06.eb>>17390000
      << assumes '(' in 1st byte, on word boundary >>          <<06.eb>>17395000
   funnyterm := command -cjob;                                 <<05.eb>>17400000
   command' := chello; << change cmd back to hello >>          <<06.eb>>17405000
   scan parmarr until 0,1;                                     <<05.eb>>17410000
   cmdlen := tos -@parmarr;                                    <<05.eb>>17415000
   apltranslatein(parmarr,cmdlen,funnyterm);                   <<05.eb>>17420000
   move delims := ("()",0);                                    <<05.eb>>17425000
   @parm := @parmarr;                                          <<05.eb>>17430000
   x := 1;                                                     <<05.eb>>17435000
                                                               <<05.eb>>17440000
      << find last ")" & check for matching left & right>>     <<05.eb>>17445000
   do begin                                                    <<05.eb>>17450000
      << only update saveptr if terminating delim is ")" >>    <<02320>>17455000
      if parm = ")" then @saveptr := @parm;                    <<02320>>17460000
                                                               <<02320>>17465000
      x := x + (if parm = "(" then 1 else                      <<05.eb>>17470000
         if parm = ")" then -1 else 0);                        <<05.eb>>17475000
      nextparmd(delims,parm,ptr,parm);                         <<05.eb>>17480000
   end until carry; << hit end of string >>                    <<05.eb>>17485000
                                                               <<05.eb>>17490000
   x := x-1;                                                   <<05.eb>>17495000
   if > then err(missingrightparen,ptr);                       <<05.eb>>17500000
   if < then err(missingleftparen,ptr);                        <<05.eb>>17505000
   @ptr := @saveptr(1);  << set ptr for remainder of parsing >><<02320>>17510000
   cicomlen := @saveptr -@parmarr;                             <<05.eb>>17515000
   parmarr := " "; <<ci needs image on word boundary >>        <<06.eb>>17520000
                   << blank out '('                  >>        <<06.eb>>17525000
                   << cicomlen is 1 greater than length>>      <<06.eb>>17530000
                                                               <<05.eb>>17535000
      << (cmd)  mike.mpem;...                        >>        <<02320>>17540000
      <<  \  \ \              \--parm                >>        <<02320>>17545000
      <<   \  \ \----------------ptr                 >>        <<02320>>17550000
      <<    \  \                                     >>        <<02320>>17555000
      <<     \  \----------------saveptr }           >>        <<02320>>17560000
      <<      \------------------cicomptr} cicomlen  >>        <<02320>>17565000
                                                               <<05.eb>>17570000
   jmatftbits := funnyterm;                                    <<06600>>17575000
end                                                            <<05.eb>>17580000
else                                                           <<05.eb>>17585000
begin << normal logon >>                                       <<05.eb>>17590000
   @ptr := @parmarr; << setup for getcheckname >>              <<05.eb>>17595000
   funnyterm := 0;                                             <<05.eb>>17600000
end;                                                           <<05.eb>>17605000
                                                               <<11.eb>>17610000
                                                               <<11.eb>>17615000
<< ***************************** >>                            <<11.eb>>17620000
<<                               >>                            <<11.eb>>17625000
<<  upshift to end of string     >>                            <<11.eb>>17630000
<<                               >>                            <<11.eb>>17635000
<< ***************************** >>                            <<11.eb>>17640000
                                                               <<11.eb>>17645000
upshift(parmarr);                                              <<11.eb>>17650000
                                                               <<05.eb>>17655000
                                                               <<05.eb>>17660000
<< ***************************** >>                            <<05.eb>>17665000
<<                               >>                            <<05.eb>>17670000
<<  parse logon id               >>                            <<05.eb>>17675000
<<                               >>                            <<05.eb>>17680000
<< ***************************** >>                            <<05.eb>>17685000
                                                               <<05.eb>>17690000
comment                                                        <<05.eb>>17695000
   syntax for parms in :hello/job/data/()                      <<05.eb>>17700000
                                                               <<05.eb>>17705000
   used                                                        <<05.eb>>17710000
   s|j|d|                                                      <<05.eb>>17715000
   x x x  [jname,] uname [/upass] .acct [/apass]               <<05.eb>>17720000
   x x    [,group] [/gpass]                                    <<05.eb>>17725000
       x  [<semi-colon> filename]                              <<05.eb>>17730000
1  x x    term=<termtype>                                      <<05.eb>>17735000
2  x x    pri= {bs}                                            <<05.eb>>17740000
               {cs}                                            <<05.eb>>17745000
               {ds}                                            <<05.eb>>17750000
               {es}                                            <<05.eb>>17755000
3  x x    time=<cpusecs>                                       <<05.eb>>17760000
4  x x    inpri=<inpriority>                                   <<05.eb>>17765000
5  x x    hipri                                                <<05.eb>>17770000
6    x    outclass=[dev] [,[outpri] [,numcopies]               <<05.eb>>17775000
7    x    restart                                              <<05.eb>>17780000
   ;                                                           <<05.eb>>17785000
                                                               <<05.eb>>17790000
<< parms are parsed 1 at a time from left to right. ptr        <<05.eb>>17795000
<< at start points to delim in front of parm. after call       <<05.eb>>17800000
<< to get getcheckname (or anything that calls nextparm)       <<05.eb>>17805000
<< parm points to parm & ptr points to trailing delim.         <<05.eb>>17810000
<<>>                                                           <<05.eb>>17815000
                                                               <<05.eb>>17820000
move delims := (",/.;",0); << special ones for logon >>        <<05.eb>>17825000
   getcheckname(jmatarrb(jmatjobnameoff*2) , false,  0,        <<06600>>17830000
                ",", expjname);                                <<06600>>17835000
   getcheckname(jmatarrb(jmatusernameoff*2)  ,true,  0,        <<06600>>17840000
                0, expuname);                                  <<06600>>17845000
   getcheckname(upasswb          ,false,"/",  0,expupass);     <<10.eb>>17850000
   getcheckname(jmatarrb(jmatacctnameoff*2)  ,true,".",        <<06600>>17855000
                0, expaname);                                  <<06600>>17860000
   getcheckname(apasswb          ,false,"/",  0,expapass);     <<10.eb>>17865000
if command' = cdata then     << :data >>                       <<10.eb>>17870000
   getcheckname(fnamewb          ,false,";",  0,expfname)      <<10.eb>>17875000
else                                                           <<10.eb>>17880000
begin                                                          <<10.eb>>17885000
   groupspec := << set if group name found >>                  <<10.eb>>17890000
   getcheckname(jmatarrb(jmatgrplogonoff*2),false,",",         <<06600>>17895000
                0, expgname);                                  <<06600>>17900000
   getcheckname(gpasswb         , false,"/",  0,expgpass);     <<10.eb>>17905000
end;                                                           <<10.eb>>17910000
                                                               <<05.eb>>17915000
                                                               <<05.eb>>17920000
<< ***************************** >>                            <<05.eb>>17925000
<<                               >>                            <<05.eb>>17930000
<<     verify logon id, ia/ba    >>                            <<05.eb>>17935000
<<                               >>                            <<05.eb>>17940000
<< ***************************** >>                            <<05.eb>>17945000
                                                               <<05.eb>>17950000
                                                               <<05.eb>>17955000
                                                               <<05.eb>>17960000
                                                               <<05.eb>>17965000
jmatacctpass := checkpass(alevel,dummy,apasswb);               <<06600>>17970000
capd := direntryd(acapd);                                      <<05.eb>>17975000
amaxpri := direntry(amaxjobw).(8:8);                           <<05.eb>>17980000
jmatuserpass := checkpass(ulevel, jmatusername, upasswb);      <<06600>>17985000
cap0 := cap0 land direntry(ucap);                              <<05.eb>>17990000
cap1 := cap1 land direntry(ucap +1);                           <<05.eb>>17995000
umaxpri := direntry(umaxjob).(8:8);                            <<05.eb>>18000000
homegroup := if jmatarrb(jmatgrplogonoff*2) =                  <<06600>>18005000
                         direntryb(uhgroupb), (jmatnamelen*2)  <<06600>>18010000
             then true else false;                             <<00802>>18015000
   << ci will check passwords for session     >>               <<0312>> 18020000
   << don't check group pass for :data        >>                        18025000
if command' = cdata then                                                18030000
   if  (logical(jmatuserpass)    lor                           <<06600>>18035000
        logical(jmatacctpass)    lor                           <<06600>>18040000
        logical(jmatgrouppass))        <>  0                   <<06600>>18045000
      then begin                                               <<06600>>18050000
      tellop(cmispass);                                        <<04207>>18055000
      erri(mispass);                                           <<04207>>18060000
      end                                                      <<04207>>18065000
   else                                                        <<04207>>18070000
else                                                           <<14.eb>>18075000
begin                                                          <<14.eb>>18080000
   jmatgrouppass := checkpass(glevel, jmatgrplogon, gpasswb);  <<06600>>18085000
   if ((command'=cjob) or (progcreation = true)) and           << 8144>>18090000
       (logical(jmatuserpass)    lor                           <<06600>>18095000
        logical(jmatacctpass)    lor                           <<06600>>18100000
        logical(jmatgrouppass))        <>  0                   <<06600>>18105000
      then begin                                               <<06600>>18110000
        << no prompting for passwords if job or programmatic>> << 8144>>18115000
        << session is logging on.  either they are there or >> << 8144>>18120000
        << attempt fails.                                   >> << 8144>>18125000
      tellop(cmispass);                                        <<0312>> 18130000
      erri(mispass);                                           <<0312>> 18135000
      end;                                                     <<0312>> 18140000
end;                                                           <<14.eb>>18145000
                                                               <<05.eb>>18150000
                                                               <<05.eb>>18155000
                                                               <<05.eb>>18160000
<< ***************************** >>                            <<05.eb>>18165000
<<                               >>                            <<05.eb>>18170000
<<   parse & verify key words    >>                            <<05.eb>>18175000
<<                               >>                            <<05.eb>>18180000
<< ***************************** >>                            <<05.eb>>18185000
                                                               <<05.eb>>18190000
                                                               <<05.eb>>18195000
                                                               <<05.eb>>18200000
if command' = cdata and ptr <> 0 then err(extraparms,ptr);     <<06.eb>>18205000
   << no keywords for :data  >>                                <<05.eb>>18210000
                                                               <<05.eb>>18215000
   << big loop for key words >>                                <<05.eb>>18220000
while ptr <> 0 do                                              <<05.eb>>18225000
begin                                                          <<05.eb>>18230000
   @oldparmptr := @ptr;                                        <<05.eb>>18235000
   getnextparm;                                                <<05.eb>>18240000
   if = then                                                   <<05.eb>>18245000
   begin << hit delim >>                                       <<05.eb>>18250000
      warn(ignoreddelim,oldparmptr);                           <<05.eb>>18255000
   end                                                         <<05.eb>>18260000
   else                                                        <<05.eb>>18265000
   begin << some chars in parm >>                              <<05.eb>>18270000
      keyno := jobkeys(parm,plen);                             <<05.eb>>18275000
      if keyno = 0 then                                        <<05.eb>>18280000
      begin                                                    <<05.eb>>18285000
         if ptr = 0 and plen = 8 and not seqnumpassed then     <<1.rao>>18290000
         begin << check for line numbers >>                    <<08.eb>>18295000
            dbinary(parm,8);                                   <<08.eb>>18300000
            if = then jmatseqbit := true                       <<06600>>18305000
      else warn(unknownparm,parm);                             <<04963>>18310000
         end                                                   <<08.eb>>18315000
         else                                                  <<08.eb>>18320000
         begin                                                 <<08.eb>>18325000
      warn(unknownparm,parm);                                  <<04963>>18330000
            if ptr = "=" then nextparm(ptr,parm,ptr);          <<08.eb>>18335000
            << skip over 2nd half >>                           <<05.eb>>18340000
         end;                                                  <<08.eb>>18345000
      end                                                      <<05.eb>>18350000
      else                                                     <<05.eb>>18355000
      begin  << now get key value. key=value >>                <<05.eb>>18360000
             << 1st look for keys that don't have value >>     <<05.eb>>18365000
         if keyno = khipri or keyno = krestart or              << 9041>>18370000
            keyno = knowait then                               << 9041>>18375000
         begin                                                 <<05.eb>>18380000
      if ptr ="=" then warn(noequalkey,ptr);                   <<04963>>18385000
            if keyno = khipri then dohipri                     <<05.eb>>18390000
            else if keyno = krestart then dorestart            << 9041>>18395000
            else donowait;                                     << 9041>>18400000
         end                                                   <<05.eb>>18405000
         else                                                  <<05.eb>>18410000
         begin << work on other keys >>                        <<05.eb>>18415000
      if ptr <> "=" then warn(expkeyvalue,ptr)                 <<04963>>18420000
            else                                               <<05.eb>>18425000
            begin << there is "=" >>                           <<05.eb>>18430000
               getnextparm;                                    <<05.eb>>18435000
               if = and keyno <> koutclass then                <<05.eb>>18440000
            warn(expkeyvalue,ptr)                              <<04963>>18445000
               else                                            <<05.eb>>18450000
               begin << finally have key value >>              <<05.eb>>18455000
                  case keyno of                                <<05.eb>>18460000
                  begin                                        <<05.eb>>18465000
                                                               <<05.eb>>18470000
<< **************************************************** >>     <<05.eb>>18475000
<<                                                      >>     <<05.eb>>18480000
<<            parse keyword values                      >>     <<05.eb>>18485000
<<                                                      >>     <<05.eb>>18490000
<< **************************************************** >>     <<05.eb>>18495000
                                                               <<05.eb>>18500000
                     ; << 0 not used >>                        <<05.eb>>18505000
                     doterm;                                   <<05.eb>>18510000
                     dopri;                                    <<05.eb>>18515000
                     dotime;                                   <<05.eb>>18520000
                     doinpri;                                  <<05.eb>>18525000
                     ; << hipri already done >>                <<05.eb>>18530000
                     dooutclass;                               <<05.eb>>18535000
                     ; << restart already done >>              <<05.eb>>18540000
                                                               <<05.eb>>18545000
                  end; << case on keyno >>                     <<05.eb>>18550000
                                                               <<05.eb>>18555000
               end; << of key value >>                         <<05.eb>>18560000
            end; << of =            >>                         <<05.eb>>18565000
         end; << of other types of keys >>                     <<05.eb>>18570000
      end; << of everything to do with keys >>                 <<05.eb>>18575000
   end; << end of parm pair                 >>                 <<05.eb>>18580000
end; << of big key parm loop                   >>              <<05.eb>>18585000
                                                               <<05.eb>>18590000
                                                               <<05.eb>>18595000
<< ***************************** >>                            <<05.eb>>18600000
<<                               >>                            <<05.eb>>18605000
<< finish jmat entry             >>                            <<05.eb>>18610000
<<                               >>                            <<05.eb>>18615000
<< ***************************** >>                            <<05.eb>>18620000
                                                               <<05.eb>>18625000
if not foutclass then                                          <<05.eb>>18630000
begin                                                          <<05.eb>>18635000
   lpdt'index:=device*integer(lpdt'entry'size);                <<06597>>18640000
   jmatduplicative := lpdt'duplicative;                        <<06600>>18645000
   jmatinteractive := lpdt'interactive;                        <<06600>>18650000
   if command' <> chello then jmatinteractive := false;        <<06600>>18655000
end;                                                           <<05.eb>>18660000
                                                               <<05.eb>>18665000
                                                               <<05.eb>>18670000
                                                               <<05.eb>>18675000
<< ***************************** >>                            <<05.eb>>18680000
<<                               >>                            <<05.eb>>18685000
<< set up idd, putjmat, schedule >>                            <<05.eb>>18690000
<<                               >>                            <<05.eb>>18695000
<< ***************************** >>                            <<05.eb>>18700000
                                                               <<05.eb>>18705000
xdd'subentry := 0;                                             <<06909>>18710000
move xdd'subentry(1) := xdd'subentry,(size'of'xdd'subentry-1); <<06909>>18715000
                                                               <<06600>>18720000
<<  move the user, acct., and job names into the idd  >>       <<06600>>18725000
move xdds'user'name := jmatusername,(jmatnamelen*3);           <<06909>>18730000
xdds'spool'state := if spoolercall then xdds'active            <<06909>>18735000
                    else xdds'ready;                           <<06909>>18740000
idds'restart := jmatrestart;                                   <<06909>>18745000
if command' = cdata then                                       <<06.eb>>18750000
begin << finish everything up for :data >>                     <<05.eb>>18755000
   idds'data := true;                                          <<06909>>18760000
   move xddsb'file'name := fnamewb,(8);                        <<06909>>18765000
   if sputxdd(false,device,xdd'subentry,iddsp) <> 0 then       <<06909>>18770000
      erri(iddfull)                                            <<06909>>18775000
   else                                                        <<05.eb>>18780000
   begin                                                       <<05.eb>>18785000
      if spoolercall then @iddsubp := @iddsp                   <<05.eb>>18790000
      else                                                     <<05.eb>>18795000
      begin                                                    <<05.eb>>18800000
         if indevtype = terminal then                          <<05.eb>>18805000
         begin << disable break & turn off timeout >>          <<05.eb>>18810000
            attachio(device,0,0,0,21,0,0,0,%13);               <<05.eb>>18815000
                                                               <<02858>>18820000
            << if the lpdt logging on bit is used with this >> <<02858>>18825000
            << terminal, turn it off since logon sequence   >> <<02858>>18830000
            << for data commands is done.  for now, ignore  >> <<02858>>18835000
            << disconnect of terminal. >>                      <<02858>>18840000
                                                               <<02858>>18845000
            if special'terminal(device) then                   <<02858>>18850000
               begin                                           <<02858>>18855000
               disable;                                        <<02858>>18860000
               lpdt'index:=device*integer(lpdt'entry'size);    <<06597>>18865000
               lpdt'logging'on:=false;                         <<06597>>18870000
               enable;                                         <<02858>>18875000
               end;                                            <<02858>>18880000
         end;                                                  <<05.eb>>18885000
      end;                                                     <<05.eb>>18890000
      if parmask.(11:1) then @jmatp := 0;                      <<00534>>18895000
   end;                                                        <<05.eb>>18900000
   return;                                                     <<05.eb>>18905000
                                                               <<05.eb>>18910000
      << exit point for :data >>                               <<05.eb>>18915000
                                                               <<05.eb>>18920000
end;                                                           <<05.eb>>18925000
                                                               <<05.eb>>18930000
   << schedule job >>                                          <<05.eb>>18935000
if not putjmat(jmatarr, jmatxptr) then erri(jmatfull);         <<06600>>18940000
                                                               <<05.eb>>18945000
   << put cicomimage into table >>                             <<05.eb>>18950000
if funnyterm <> 0 and not cilogtable(cilogputentry,@jmatxptr,  <<05.eb>>18955000
   cicomlen,cicomptrw) then                                    <<05.eb>>18960000
begin                                                          <<05.eb>>18965000
   removejmat;                                                 <<05.eb>>18970000
   erri(cilogfull);                                            <<05.eb>>18975000
end;                                                           <<05.eb>>18980000
                                                               <<05.eb>>18985000
   << finish idd for job/session >>                            <<05.eb>>18990000
move xdds'file'name := "$STDIN  ";                             <<06909>>18995000
xdds'job'number := jmatjsno;                                   <<06909>>19000000
xdds'job'type := jmatjstype;                                   <<06909>>19005000
if sputxdd(false,device,xdd'subentry,iddsp) <> 0 then          <<06909>>19010000
begin                                                          <<05.eb>>19015000
   if funnyterm <> 0 then cilogtable(cilogrementry,@jmatxptr,  <<05.eb>>19020000
      cicomlen,cicomptrw);                                     <<05.eb>>19025000
   removejmat;                                                 <<05.eb>>19030000
   erri(iddfull);                                              <<05.eb>>19035000
end;                                                           <<05.eb>>19040000
if not spoolercall then                                        <<05.eb>>19045000
begin                                                          <<05.eb>>19050000
   if command' = cjob and indevtype = terminal then            <<06.eb>>19055000
         << turn off timeout >>                                <<05.eb>>19060000
      attachio(device,0,0,0,21,0,2,0,%13);                     <<05.eb>>19065000
   schedulejob(jmatxptr);<< wake ucop - req. queue not used>>  <<05.eb>>19070000
end                                                            <<05.eb>>19075000
else @iddsubp := @iddsp;                                       <<05.eb>>19080000
if parmask.(11:1) then @jmatp := @jmatxptr;                    <<00534>>19085000
if parmask.(13:1) then jobnum := jmatarr(jmatjsnooff);         <<06600>>19090000
                                                               <<05.eb>>19095000
outl:                                                          <<05.eb>>19100000
end; << procedure startdevice >>                               <<05.eb>>19105000
$title "UPSHIFT"                                               <<09.eb>>19110000
procedure upshift(string);                                     <<09.eb>>19115000
   byte array string;                                          <<09.eb>>19120000
   option internal;                                            <<09.eb>>19125000
begin                                                          <<09.eb>>19130000
                                                               <<09.eb>>19135000
tos := @string;                                                <<09.eb>>19140000
do begin                                                       <<09.eb>>19145000
   assemble(dup);                                              <<09.eb>>19150000
   move * := * while ans,1;                                    <<09.eb>>19155000
   tos := tos +1;                                              <<09.eb>>19160000
end until bps0(-1) = 0;                                        <<09.eb>>19165000
                                                               <<09.eb>>19170000
end; << procedure upshift >>                                   <<09.eb>>19175000
$page"             Procedure CHECK'TERM'ATTRIBUTES - PCS"      << 8144>>19180000
procedure check'term'attributes(ldev,err);                     << 8144>>19185000
value ldev;                                                    << 8144>>19190000
integer err;                                                   << 8144>>19195000
logical ldev;                                                  << 8144>>19200000
option privileged,uncallable;                                  << 8144>>19205000
begin                                                          << 8144>>19210000
<<**********************************************************>> << 8144>>19215000
<<                                                          >> << 8144>>19220000
<< this procedure is called by devlogon to determine if the >> << 8144>>19225000
<< ldev parameter is valid and available for programmatic   >> << 8144>>19230000
<< creation of sessions.  if the device meets all of the    >> << 8144>>19235000
<< requirements then the logging on bit in the lpdt will be >> << 8144>>19240000
<< set to true (1) and the err parameter will be returned   >> << 8144>>19245000
<< with a value of zero (0).  otherwise, this procedure will>> << 8144>>19250000
<< not make any modifications of any of the system tables   >> << 8144>>19255000
<< and will return the appropriate error number in err.     >> << 8144>>19260000
<<                                                          >> << 8144>>19265000
<< note:  some of the interrupt handlers can run while the  >> << 8144>>19270000
<< system is pdisabled and modify the lpdt.  therefore this >> << 8144>>19275000
<< procedure will check the information that will not be    >> << 8144>>19280000
<< modified while the system is running and then disable all>> << 8144>>19285000
<< interrupts before checking the information that can be   >> << 8144>>19290000
<< changed when the system is running.                      >> << 8144>>19295000
<<                                                          >> << 8144>>19300000
<< warning:  the order that these checks are made is        >> << 8144>>19305000
<< significant.  this order cannot be changed at all without>> << 8144>>19310000
<< introducing the possibility of loss of integrity.  each  >> << 8144>>19315000
<< check relies on the previous check: ex. if the device is >> << 8144>>19320000
<< virtual, then the dit pointer will be zero (0).          >> << 8144>>19325000
<< therefore the check to see if its a terminal by looking  >> << 8144>>19330000
<< at the dit will be invalid if the device is a virtual    >> << 8144>>19335000
<< device and thats why the check is made to see if the     >> << 8144>>19340000
<< device is virtual before attempting to look at the dit.  >> << 8144>>19345000
<<                                                          >> << 8144>>19350000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>19355000
<<                                                          >> << 8144>>19360000
<<  written by:                  ken jordan                 >> << 8144>>19365000
<<  written on:                  10/14/83                   >> << 8144>>19370000
<<  last modification:           11/02/83                   >> << 8144>>19375000
<<  target segment:              nursery - module 76        >> << 8144>>19380000
<<                                                          >> << 8144>>19385000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>19390000
<<**********************************************************>> << 8144>>19395000
                                                               << 8144>>19400000
equate                                                         << 8144>>19405000
   service'granted = 3;                                        << 8144>>19410000
                                                               << 8144>>19415000
logical                                                        << 8144>>19420000
    anet'term,                                                 << 8881>>19425000
    ldt'index,                                                 << 8144>>19430000
    lpdt'index;                                                << 8144>>19435000
                                                               << 8144>>19440000
integer                                                        << 8144>>19445000
    critinfo,    << holds value returned from setcritical. >>  << 8144>>19450000
    lpdtinfo,    << holds value returned from getsir. >>       << 8144>>19455000
    ldtinfo;     << holds value returned from getsir. >>       << 8144>>19460000
                                                               << 8144>>19465000
logical array ldt(0:size'of'ldt'entry-1);                      << 8144>>19470000
                                                               << 8144>>19475000
subroutine def'movefromdseg;                                   << 8144>>19480000
                                                               << 8144>>19485000
err := 0; << initialize >>                                     << 8144>>19490000
lpdt'index := ldev * size'of'lpdt'entry;                       << 8144>>19495000
ldt'index := ldev * size'of'ldt'entry;                         << 8144>>19500000
if get'dsdevice(ldev)=5                                        << 8881>>19505000
   then anet'term := true                                      << 8881>>19510000
   else anet'term := false;                                    << 8881>>19515000
                                                               << 8144>>19520000
<< 1.  check to see if ldev is within range >>                 << 8144>>19525000
if ldev > lpdt'max'entries or ldev = 0                         << 8144>>19530000
   then err := ldev'out'of'range                               << 8144>>19535000
                                                               << 8144>>19540000
<< 2.  make sure ldev is not a virtual device >>               << 8144>>19545000
else if lpdt'dit'ptr=0                                         << 8881>>19550000
   then err := ldev'must'not'be'virtual                        << 8144>>19555000
                                                               << 8144>>19560000
<< 3.  check dit to verify that ldev is a terminal >>          << 8144>>19565000
else if absolute(lpdt'dit'ptr + %1000).(0:1) <> 1              << 8144>>19570000
   then err := ldev'not'a'terminal                             << 8144>>19575000
                                                               << 8881>>19580000
<< 4.  make sure the type and subtype are correct           >> << 8881>>19585000
else if (ldevtotype(ldev) <> 16) or                            << 8881>>19590000
        ((ldevtosubtype(ldev) <> 0) land                       << 8881>>19595000
         (ldevtosubtype(ldev) <> 4))                           << 8881>>19600000
   then err := ldev'wrong'type'or'subtype                      << 8881>>19605000
                                                               << 8144>>19610000
<< 5.  now we must check conditions that can change.        >> << 8881>>19615000
<< we will disable to have exclusive access to the          >> << 8144>>19620000
<< lpdt.  if all the checks pass, then the logging on bit   >> << 8144>>19625000
<< will be set to one (1) and the device will be ours       >> << 8144>>19630000
<< exclusively.                                             >> << 8144>>19635000
else begin   << so far, so good. >>                            << 8144>>19640000
                                                               << 8144>>19645000
       << a.  obtain exclusive access of ldt and lpdt. >>      << 8144>>19650000
       critinfo := setcritical;                                << 8144>>19655000
       ldtinfo := getsir(ldt'sir);                             << 8904>>19660000
       lpdtinfo := getsir(lpdt'sir);                           << 8904>>19665000
       movefromdseg(@ldt,ldt'dst,ldt'index,size'of'ldt'entry); << 8144>>19670000
       ldt'index := 0;                                         << 8144>>19675000
       disable;                                                << 8144>>19680000
                                                               << 8144>>19685000
       << b.  the device must be free. >>                      << 8144>>19690000
       if lpdt'dev'own'state <> free and not anet'term then    << 8881>>19695000
       begin                                                   << 8881>>19700000
            enable;                                            << 8881>>19705000
            relsir(lpdt'sir,lpdtinfo);                         << 8881>>19710000
            relsir(ldt'sir,ldtinfo);                           << 8881>>19715000
            resetcritical(critinfo);                           << 8881>>19720000
            err := ldev'not'free                               << 8881>>19725000
       end                                                     << 8881>>19730000
                                                               << 8144>>19735000
       << c.  the device must be job accepting. >>             << 8144>>19740000
       else if not lpdt'job'accept then                        << 8144>>19745000
       begin                                                   << 8144>>19750000
         enable;                                               << 8144>>19755000
         relsir(lpdt'sir,lpdtinfo);                            << 8144>>19760000
         relsir(ldt'sir,ldtinfo);                              << 8144>>19765000
         resetcritical(critinfo);                              << 8144>>19770000
         err := ldev'not'job'accepting;                        << 8144>>19775000
       end                                                     << 8144>>19780000
                                                               << 8144>>19785000
       << d.  the device must be available to system. >>       << 8144>>19790000
       else if not ldt'avail'to'sys then                       << 8144>>19795000
       begin                                                   << 8144>>19800000
         enable;                                               << 8144>>19805000
         relsir(lpdt'sir,lpdtinfo);                            << 8144>>19810000
         relsir(ldt'sir,ldtinfo);                              << 8144>>19815000
         resetcritical(critinfo);                              << 8144>>19820000
         err := ldev'not'available;                            << 8144>>19825000
       end                                                     << 8144>>19830000
                                                               << 8144>>19835000
       << e.  go for it. >>                                    << 8144>>19840000
       else                                                    << 8144>>19845000
       begin                                                   << 8144>>19850000
                                                               << 8144>>19855000
         <<  must set logging on bit. >>                       << 8144>>19860000
         lpdt'logging'on := 1;                                 << 8144>>19865000
         lpdt'dev'own'state := service'granted;                << 8144>>19870000
         enable;                                               << 8144>>19875000
         relsir(lpdt'sir,lpdtinfo);                            << 8144>>19880000
         << put pin in ldt or ldtx >>                          << 8144>>19885000
         relsir(ldt'sir,ldtinfo);                              << 8144>>19890000
         resetcritical(critinfo);                              << 8144>>19895000
         if not anet'term and get'dsdevice(ldev) <> 3          << 8881>>19900000
            then attachio(ldev,0,0,0,2,0,0,0,1);               << 8881>>19905000
         err := 0;  << no errors. >>                           << 8144>>19910000
       end;                                                    << 8144>>19915000
                                                               << 8144>>19920000
     end;                                                      << 8144>>19925000
                                                               << 8144>>19930000
end;  << procedure check'term'attributes >>                    << 8144>>19935000
$page"             Procedure DO'START - PCS"                   << 8144>>19940000
procedure do'start(ldev,logonstr,jsid,jsnum,err,waittillon);   << 8144>>19945000
                                                               << 8144>>19950000
value ldev,waittillon;                                         << 8144>>19955000
                                                               << 8144>>19960000
logical ldev,waittillon;                                       << 8144>>19965000
byte array logonstr;                                           << 8144>>19970000
integer jsid;                                                  << 8144>>19975000
double jsnum;                                                  << 8144>>19980000
integer array err;                                             << 8144>>19985000
option privileged,uncallable;                                  << 8144>>19990000
                                                               << 8144>>19995000
begin                                                          << 8144>>20000000
<<**********************************************************>> << 8144>>20005000
<<                                                          >> << 8144>>20010000
<< intrinsic do'start will start a session on <ldev> using  >> << 8144>>20015000
<< <logonstr> as the command string specifying the user and >> << 8144>>20020000
<< all of the attributes in the same format as the :hello   >> << 8144>>20025000
<< command.  we do not parse <logonstr> here, that is left  >> << 8144>>20030000
<< to procedure startdevice.                                >> << 8144>>20035000
<<                                                          >> << 8144>>20040000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>20045000
<<                                                          >> << 8144>>20050000
<<  written by:                ken jordan                   >> << 8144>>20055000
<<  written on:                11/03/83                     >> << 8144>>20060000
<<  last modification:         11/03/83                     >> << 8144>>20065000
<<  target segment:            nursery - module 76          >> << 8144>>20070000
<<                                                          >> << 8144>>20075000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>20080000
<<**********************************************************>> << 8144>>20085000
                                                               << 8144>>20090000
integer                                                        << 8144>>20095000
   jobnum,   << will be split into number and type.     >>     << 8144>>20100000
   parmnum,  << parameter that was in error, if any.    >>     << 8144>>20105000
   lpdtinfo, << to be passed to relsir.                 >>     << 8144>>20110000
   critinfo; << to be passed to resetcritical.          >>     << 8144>>20115000
                                                               << 8144>>20120000
integer                                                        << 8144>>20125000
   logontype := 6;  << programmatic logon.              >>     << 8144>>20130000
                                                               << 8144>>20135000
integer                                                        << 8144>>20140000
   my'pin;  << used to find my port'id.                 >>     << 8144>>20145000
                                                               << 8144>>20150000
integer array                                                  << 8144>>20155000
   msgarr(0:2);  << area for message return.            >>     << 8144>>20160000
                                                               << 8144>>20165000
double                                                         << 8144>>20170000
   port'id;  << my port id number.                      >>     << 8144>>20175000
                                                               << 8144>>20180000
logical                                                        << 8144>>20185000
   enable'mask;  << subqueue we expect to receive from. >>     << 8144>>20190000
                                                               << 8144>>20195000
logical                                                        << 8144>>20200000
   lpdt'index;                                                 << 8144>>20205000
                                                               << 8144>>20210000
logical array                                                  << 8144>>20215000
   ldtx(0:size'of'ldtx'entry-1),                               << 8144>>20220000
   ldt(0:size'of'ldt'entry-1);                                 << 8144>>20225000
                                                               << 8144>>20230000
logical                                                        << 8144>>20235000
   ldtx'index;                                                 << 8144>>20240000
                                                               << 8144>>20245000
subroutine def'movefromdseg;                                   << 8144>>20250000
subroutine def'movetodseg;                                     << 8144>>20255000
  critinfo := setcritical; << can't be aborted, too messy >>   << 8144>>20260000
                                                               << 8144>>20265000
if waittillon                                                  << 8144>>20270000
   then logontype := 7;                                        << 8144>>20275000
  startdevice(logontype,logonstr,ldev,,,,jobnum,err);          << 8144>>20280000
                                                               << 8144>>20285000
  if err > 0 then                                              << 8144>>20290000
  begin                                                        << 8144>>20295000
                                                               << 8144>>20300000
    << must dclose terminal to free device. >>                 << 8144>>20305000
    attachio(ldev,0,0,0,4,0,0,0,1);                            << 8144>>20310000
                                                               << 8144>>20315000
    << must undo everything thats been done to this point. >>  << 8144>>20320000
    lpdt'index := ldev * size'of'lpdt'entry;                   << 8144>>20325000
    lpdtinfo := getsir(lpdt'sir);                              << 8144>>20330000
    disable;                                                   << 8144>>20335000
    lpdt'logging'on := 0;                                      << 8144>>20340000
    lpdt'dev'own'state := 0;                                   << 8144>>20345000
    enable;                                                    << 8144>>20350000
    relsir(lpdt'sir,lpdtinfo);                                 << 8144>>20355000
    resetcritical(critinfo);                                   << 8144>>20360000
    return;                                                    << 8144>>20365000
                                                               << 8144>>20370000
  end;                                                         << 8144>>20375000
                                                               << 8144>>20380000
  if waittillon then                                           << 8144>>20385000
  begin                                                        << 8144>>20390000
    << use the port procedures to receive info. >>             << 8144>>20395000
    my'pin := 0;  << denotes this processes pin. >>            << 8144>>20400000
    enable'mask := %010000;  << reserved for waited io. >>     << 8144>>20405000
    port'id := findprocessport(my'pin);                        << 8144>>20410000
    msgarr(1) := 3;  << message length. >>                     << 8144>>20415000
    msgarr(2) := 0;  << initialize return value. >>            << 8144>>20420000
    receivewait'db(port'id,msgarr,enable'mask);                << 8144>>20425000
    err := msgarr(2);  << return value. >>                     << 8144>>20430000
  end;                                                         << 8144>>20435000
                                                               << 8144>>20440000
  resetcritical(critinfo); << session doesn't need us now. >>  << 8144>>20445000
                                                               << 8144>>20450000
  if err <= 0 then                                             << 8144>>20455000
  begin                                                        << 8144>>20460000
    << set up jsid and jsnum. >>                               << 8144>>20465000
    jsid := jobnum.idextract;                                  << 8144>>20470000
    tos := 0;                                                  << 8144>>20475000
    tos := jobnum.numextract;                                  << 8144>>20480000
    jsnum := tos;                                              << 8144>>20485000
  end;                                                         << 8144>>20490000
                                                               << 8144>>20495000
end;  << do'start >>                                           << 8144>>20500000
$page"             Procedure STARTSESS - PCS"                  << 8144>>20505000
procedure startsess(ldev,logonstr,jsid,jsnum,err);             << 8144>>20510000
                                                               << 8144>>20515000
value ldev;                                                    << 8144>>20520000
                                                               << 8144>>20525000
logical ldev;                                                  << 8144>>20530000
byte array logonstr;                                           << 8144>>20535000
integer jsid;                                                  << 8144>>20540000
double jsnum;                                                  << 8144>>20545000
integer array err;                                             << 8144>>20550000
option privileged;                                             << 8144>>20555000
                                                               << 8144>>20560000
begin                                                          << 8144>>20565000
<<**********************************************************>> << 8144>>20570000
<<                                                          >> << 8144>>20575000
<< intrinsic startsess will start a session on <ldev> using >> << 8144>>20580000
<< <logonstr> as the command string specifying the user and >> << 8144>>20585000
<< all of the attributes in the same format as the :hello   >> << 8144>>20590000
<< command.  we do not parse <logonstr> here, that is left  >> << 8144>>20595000
<< to procedure startdevice.  check'term'attributes will do >> << 8144>>20600000
<< all of the necessary checks for the terminal.            >> << 8144>>20605000
<<                                                          >> << 8144>>20610000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>20615000
<<                                                          >> << 8144>>20620000
<<  written by:                ken jordan                   >> << 8144>>20625000
<<  written on:                10/14/83                     >> << 8144>>20630000
<<  last modification:         11/02/83                     >> << 8144>>20635000
<<  target segment:            nursery - module 76          >> << 8144>>20640000
<<                                                          >> << 8144>>20645000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>20650000
<<**********************************************************>> << 8144>>20655000
                                                               << 8144>>20660000
logical                                                        << 8144>>20665000
  end'addr'stopper := %6415;  << cr cr >>                      << 8144>>20670000
                                                               << 8144>>20675000
integer                                                        << 8144>>20680000
  qm4 = q - 4;  << for end address check. >>                   << 8144>>20685000
                                                               << 8144>>20690000
equate                                                         << 8144>>20695000
  maxlen = 270;                                                << 8144>>20700000
                                                               << 8144>>20705000
integer                                                        << 8144>>20710000
  s0 = s - 0;                                                  << 8144>>20715000
                                                               << 8144>>20720000
integer                                                        << 8144>>20725000
   ds'result;<< return from get'dsdevice.               >>     << 8144>>20730000
                                                               << 8144>>20735000
double                                                         << 8144>>20740000
  capability;  << for who intrinsic. >>                        << 8144>>20745000
                                                               << 8144>>20750000
integer jsnumparm = q - 5;                                     << 8144>>20755000
                                                               << 8144>>20760000
integer                                                        << 8144>>20765000
  word1 = capability;                                          << 8144>>20770000
                                                               << 8144>>20775000
logical                                                        << 8144>>20780000
  startsess'hang := [10/startsess'int'num,6/5];                << 8144>>20785000
                                                               << 8144>>20790000
erroron;                                                       << 8144>>20795000
err := 0;                                                      << 8933>>20800000
<< must do parameter bounds check here. >>                     << 8144>>20805000
chek(startsess'hang,5,%1254d);                                 << 8144>>20810000
jsnumparm := jsnumparm + 1;                                    << 8144>>20815000
chek(startsess'hang,5,%200d);                                  << 8144>>20820000
jsnumparm := jsnumparm - 1;                                    << 8144>>20825000
<< also end address for logonstr >>                            << 8144>>20830000
scan logonstr until %6415,1; << save end address >>            << 8144>>20835000
if (s0 - @logonstr > maxlen) or (s0 > @qm4) then               << 8144>>20840000
begin                                                          << 8144>>20845000
  err := invalid'end'address;                                  << 8144>>20850000
  assemble(del);                                               << 8144>>20855000
  errorexit(startsess'hang,0,0); <<?>>                         << 8144>>20860000
end;                                                           << 8144>>20865000
                                                               << 8144>>20870000
assemble(del);                                                 << 8144>>20875000
<< user must have ps capability. >>                            << 8144>>20880000
who(,capability);                                              << 8144>>20885000
if word1.(10:1) <> 1                                           << 8144>>20890000
   then err := user'must'have'ps'capability                    << 8144>>20895000
else                                                           << 8144>>20900000
begin                                                          << 8144>>20905000
                                                               << 8144>>20910000
                                                               << 8144>>20915000
<< since we don't want to abort while critical(sf 311), we  >> << 8144>>20920000
<< must attempt to expand the stack at least as big as we   >> << 8144>>20925000
<< need to see if we have the space.  if we don't have the  >> << 8144>>20930000
<< space, then the process will abort now; averting the     >> << 8144>>20935000
<< system failure.                                          >> << 8144>>20940000
<< remember, we must be in an abortable state now (i.e. not >> << 8144>>20945000
<< holding any sirs) for this test to work correctly.       >> << 8144>>20950000
                                                               << 8144>>20955000
  tos := stack'space'needed;                                   << 8144>>20960000
  assemble(adds 0);                                            << 8144>>20965000
<< if we didn't abort on that instruction with a stack over->> << 8144>>20970000
<< flow, then we will have enough room on the stack to      >> << 8144>>20975000
<< finish.  now we will delete the space we just added.     >> << 8144>>20980000
  tos := stack'space'needed;                                   << 8144>>20985000
  assemble(subs 0);                                            << 8144>>20990000
                                                               << 8144>>20995000
<< the logging on bit in the lpdt must be true(1) when the  >> << 8144>>21000000
<< call to startdevice is made.  to ensure that this bit is >> << 8144>>21005000
<< set correctly, a call is made to check'term'attributes   >> << 8144>>21010000
<< which will set the bit to true(1) when successfully      >> << 8144>>21015000
<< executed.  if successfully executed, the error parameter >> << 8144>>21020000
<< will be returned with a zero, signifying no error.  if   >> << 8144>>21025000
<< any of the conditions are not met (ex. dev is down or    >> << 8144>>21030000
<< is not free) then the error parameter will return a      >> << 8144>>21035000
<< number which corresponds to an error message in set 2 of >> << 8144>>21040000
<< the system message catalog.                              >> << 8144>>21045000
                                                               << 8144>>21050000
                                                               << 8144>>21055000
<< make sure <ldev> is not a ds device. >>                     << 8144>>21060000
    ds'result := get'dsdevice(ldev);                           << 8144>>21065000
<< this procedure retrieves entries from the dsdevice table >> << 8144>>21070000
<< (in the ds global dataseg.)                              >> << 8144>>21075000
<< the functional returns are:                              >> << 8144>>21080000
<<                         -2 - no dslines are configured.  >> << 8144>>21085000
<<                         -1 - illegal ldev passed.        >> << 8144>>21090000
<<                          0 - non ds related device.      >> << 8144>>21095000
<<                          1 - ds related cs device.       >> << 8144>>21100000
<<                          2 - ds device.                  >> << 8144>>21105000
<<                          3 - ds psuedo terminal.         >> << 8144>>21110000
<<                          4 - ???                         >> << 8144>>21115000
<<                                                          >> << 8144>>21120000
    if (ds'result > 0)                                         << 9036>>21125000
       then err := ldev'can'not'be'ds'device;                  << 8144>>21130000
                                                               << 8144>>21135000
  if err = 0 then check'term'attributes(ldev,err);             << 8881>>21140000
                                                               << 8144>>21145000
end;  << user has ps capability. >>                            << 8144>>21150000
                                                               << 8144>>21155000
if err = 0                                                     << 8144>>21160000
   then do'start(ldev,logonstr,jsid,jsnum,err,true);           << 8144>>21165000
                                                               << 8144>>21170000
errorexit(startsess'hang,0,0);                                 << 8144>>21175000
                                                               << 8144>>21180000
end;  << startsess >>                                          << 8144>>21185000
$page"             Procedure DEVLOGON - PCS"                   << 8144>>21190000
procedure devlogon(ldev,logonstr,jsid,jsnum,err,waittillon);   << 8144>>21195000
                                                               << 8144>>21200000
value ldev,waittillon;                                         << 8144>>21205000
                                                               << 8144>>21210000
logical ldev,waittillon;                                       << 8144>>21215000
byte array logonstr;                                           << 8144>>21220000
integer jsid;                                                  << 8144>>21225000
double jsnum;                                                  << 8144>>21230000
integer array err;                                             << 8144>>21235000
option privileged,uncallable;                                  << 8144>>21240000
                                                               << 8144>>21245000
begin                                                          << 8144>>21250000
<<**********************************************************>> << 8144>>21255000
<<                                                          >> << 8144>>21260000
<< intrinsic devlogon will start a session on <ldev> using  >> << 8144>>21265000
<< <logonstr> as the command string specifying the user and >> << 8144>>21270000
<< all of the attributes in the same format as the :hello   >> << 8144>>21275000
<< command.  we do not parse <logonstr> here, that is left  >> << 8144>>21280000
<< to procedure startdevice.  check'term'attributes will do >> << 8144>>21285000
<< all of the necessary checks for the terminal.            >> << 8144>>21290000
<<                                                          >> << 8144>>21295000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>21300000
<<                                                          >> << 8144>>21305000
<<  written by:                ken jordan                   >> << 8144>>21310000
<<  written on:                10/14/83                     >> << 8144>>21315000
<<  last modification:         11/02/83                     >> << 8144>>21320000
<<  target segment:            nursery - module 76          >> << 8144>>21325000
<<                                                          >> << 8144>>21330000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>21335000
<<**********************************************************>> << 8144>>21340000
                                                               << 8144>>21345000
<< the logging on bit in the lpdt must be true(1) when the  >> << 8144>>21350000
<< call to startdevice is made.  to ensure that this bit is >> << 8144>>21355000
<< set correctly, a call is made to check'term'attributes   >> << 8144>>21360000
<< which will set the bit to true(1) when successfully      >> << 8144>>21365000
<< executed.  if successfully executed, the error parameter >> << 8144>>21370000
<< will be returned with a zero, signifying no error.  if   >> << 8144>>21375000
<< any of the conditions are not met (ex. dev is down or    >> << 8144>>21380000
<< is not free) then the error parameter will return a      >> << 8144>>21385000
<< number which corresponds to an error message in set 2 of >> << 8144>>21390000
<< the system message catalog.                              >> << 8144>>21395000
                                                               << 8144>>21400000
check'term'attributes(ldev,err);                               << 8144>>21405000
                                                               << 8144>>21410000
if err = 0                                                     << 8144>>21415000
   then do'start(ldev,logonstr,jsid,jsnum,err,waittillon);     << 8144>>21420000
                                                               << 8144>>21425000
end;  << devlogon >>                                           << 8144>>21430000
$page"                 Procedure GET'DCS'FAILNO - PCS"         << 8144>>21435000
integer procedure get'dcs'failno(from,num);                    << 8144>>21440000
value from,num;                                                << 8144>>21445000
integer from,num;                                              << 8144>>21450000
begin                                                          << 8144>>21455000
<<**********************************************************>> << 8144>>21460000
<<                                                          >> << 8144>>21465000
<< procedure get'dcs'failno is called when a session that   >> << 8144>>21470000
<< is being programmatically created encounters an error.   >> << 8144>>21475000
<< this procedure will convert the error number of the      >> << 8144>>21480000
<< caller to an error number in set 2 (cierr msgs) of the   >> << 8144>>21485000
<< system catalog.  since the numbers are diverse, we will  >> << 8144>>21490000
<< not use the case statement.                              >> << 8144>>21495000
<<                                                          >> << 8144>>21500000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>21505000
<<                                                          >> << 8144>>21510000
<<  written by:                ken jordan                   >> << 8144>>21515000
<<  written on:                10/14/83                     >> << 8144>>21520000
<<  last modification:         02/01/83                     >> << 8144>>21525000
<<  target segment:            nursery - module 76          >> << 8144>>21530000
<<                                                          >> << 8144>>21535000
<<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++>> << 8144>>21540000
<<**********************************************************>> << 8144>>21545000
integer failno = q - 6;                                        << 8881>>21550000
  if from = 4 << morgue >> then                                << 8144>>21555000
  begin                                                        << 8144>>21560000
    if num = 7258 << random number denoting abort >>           << 8144>>21565000
       then get'dcs'failno := 7014                             << 8144>>21570000
       else get'dcs'failno := 7025;  << unexpected >>          << 8144>>21575000
  end                                                          << 8144>>21580000
  else if from = 2 then   << ucop >>                           << 8144>>21585000
  begin                                                        << 8144>>21590000
    if num = 8              << deferred fail          >>       << 8144>>21595000
       then get'dcs'failno := 7016                             << 8144>>21600000
    else if num = 9         << jlist fail             >>       << 8144>>21605000
       then get'dcs'failno := 7023                             << 8144>>21610000
    else if num = 10        << jin fail               >>       << 8144>>21615000
       then get'dcs'failno := 7024                             << 8144>>21620000
    else if num = 16        << limit fail             >>       << 8144>>21625000
       then get'dcs'failno := 7015                             << 8144>>21630000
    else if num = 24        << stack fail             >>       << 8144>>21635000
       then get'dcs'failno := 7018                             << 8144>>21640000
    else if num = 25        << jit fail               >>       << 8144>>21645000
       then get'dcs'failno := 7019                             << 8144>>21650000
    else if num = 26        << jdt fail               >>       << 8144>>21655000
       then get'dcs'failno := 7020                             << 8144>>21660000
    else if num = 27        << pcb fail               >>       << 8144>>21665000
       then get'dcs'failno := 7017                             << 8144>>21670000
    else if num = 28        << jpcnt fail             >>       << 8144>>21675000
       then get'dcs'failno := 7022                             << 8144>>21680000
    else if num = 29        << file fail              >>       << 8144>>21685000
       then get'dcs'failno := 7021                             << 8144>>21690000
    else get'dcs'failno := 7025;     << unknown  fail >>       << 8144>>21695000
  end                                                          << 8144>>21700000
  else if from = 1 then   << startdevice >>                    << 8144>>21705000
  begin                                                        << 8144>>21710000
    get'dcs'failno := 7025;  << shouldn't be any >>            << 8144>>21715000
  end                                                          << 8144>>21720000
  else if from = 3 then << initjsmp >>                         << 8144>>21725000
  begin                                                        << 8144>>21730000
    if num = %50            << stdin fail             >>       << 8144>>21735000
       then get'dcs'failno := 7026                             << 8144>>21740000
    else if num = %51       << stdlist fail           >>       << 8144>>21745000
       then get'dcs'failno := 7027                             << 8144>>21750000
    else if num = 5         << password fail          >>       << 8144>>21755000
       then get'dcs'failno := 7028                             << 8144>>21760000
    else if num = 6         << acct cpu fail          >>       << 8144>>21765000
       then get'dcs'failno := 7029                             << 8144>>21770000
    else if num = 7         << acct connect time fail >>       << 8144>>21775000
       then get'dcs'failno := 7030                             << 8144>>21780000
    else if num = %11       << no ba capability       >>       << 8144>>21785000
       then get'dcs'failno := 7031                             << 8144>>21790000
    else if num = %12       << no ia capability       >>       << 8144>>21795000
       then get'dcs'failno := 7032                             << 8144>>21800000
    else if num = %13       << group cpu fail         >>       << 8144>>21805000
       then get'dcs'failno := 7033                             << 8144>>21810000
    else if num = %14       << group connect time fail>>       << 8144>>21815000
       then get'dcs'failno := 7034                             << 8144>>21820000
    else get'dcs'failno := 7025;  << unknown >>                << 8144>>21825000
  end                                                          << 8144>>21830000
  else get'dcs'failno := 7025;                                 << 8144>>21835000
  if failno = 7025 then                                        << 8881>>21840000
  begin                                                        << 8881>>21845000
    << generate the info needed to find the illegal call >>    << 8881>>21850000
    << then call the system internal error procedure.    >>    << 8881>>21855000
    genmsg(1,151,%11000,from,num);                             << 8881>>21860000
    sysinterr(103,1);                                          << 8881>>21865000
  end;                                                         << 8881>>21870000
end;  << get'dcs'failno >>                                     << 8144>>21875000
$control segment=main                                          << 8144>>21880000
end.  << of nursery -- module 76 >>                            << 8144>>21885000
