<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$control code,map,uslinit                                               00010000
<<devrec - module 08>>                                                  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
$control privileged,main=devrec                                <<14.eb>>00055000
begin                                                          <<14.eb>>00060000
comment                                                        <<14.eb>>00065000
                                                               <<14.eb>>00070000
devrec (device recognition) program                            <<14.eb>>00075000
                                                               <<14.eb>>00080000
all unexpected interrupts are routed through this program.     <<14.eb>>00085000
certain configurations of devices are handled here.  they are: <<14.eb>>00090000
                                                               <<14.eb>>00095000
   - job or data accepting devices (i.e., terminals, card      <<14.eb>>00100000
     readers and mag tapes)                                    <<14.eb>>00105000
   - non job accepting mag tapes (ordinary tapes) are first    <<14.eb>>00110000
     read to determine if they are labelled tapes.  this is    <<14.eb>>00115000
     automatic volume recognition (avrec).                     <<14.eb>>00120000
                                                               <<14.eb>>00125000
devrec is not core resident, runs pseudo-enabled and is extra- <<14.eb>>00130000
ordinary only in doing no-wait i/o and being the first in      <<14.eb>>00135000
a long chain of code and processes involved in creating a      <<14.eb>>00140000
session (i.e., it calls startdevice).                          <<14.eb>>00145000
                                                               <<14.eb>>00150000
devrec is driven by the service request bits in the lpdt       <<14.eb>>00155000
which is core-resident).  when devrec is awakened it scans     <<14.eb>>00160000
through the lpdt looking at each device which is requesting    <<14.eb>>00165000
service [lpdt(1) <> 0 ].  by looking at bits in the ldt        <<14.eb>>00170000
and lpdt devrec decides if this device is the type of device   <<14.eb>>00175000
it handles.  if it is, the requesting device is placed in an   <<14.eb>>00180000
internal work queue (array task).                              <<14.eb>>00185000
                                                               <<14.eb>>00190000
after scanning the lpdt, devrec then attempts to work off its  <<14.eb>>00195000
work queue by issuing no-wait i/o to the device and then       <<14.eb>>00200000
calling startdevice or avrec when the read completes.          <<14.eb>>00205000
                                                               <<04704>>00210000
current maximum number of devices handled concurrently is 16.  <<04704>>00215000
the maximum number of terminals that devrec may handle         <<04704>>00220000
concurrently is 14.  the theory is if 14 terminals have non-   <<04704>>00225000
timed out logons (and they have pending reads), at least tapes <<04704>>00230000
and pv's can still be used (because of two "non-terminal"      <<04704>>00235000
buffers).                                                      <<04704>>00240000
                                                               <<14.eb>>00245000
devrec continues reading from a job/data accepting device      <<14.eb>>00250000
until startdevice succeeds or and attachio failure occurs,     <<14.eb>>00255000
then stops.                                                    <<14.eb>>00260000
;                                                              <<14.eb>>00265000
                                                               <<14.eb>>00270000
                                                               <<14.eb>>00275000
$include incllpdt                                              <<06223>>00280000
   << supported disc types and subtypes. >>                    <<03517>>00285000
define                                                         <<03517>>00290000
   d7905r     = ( dtype=0 land stype= 4 )#,                    <<03517>>00295000
   d7905f     = ( dtype=0 land stype= 5 )#,                    <<03517>>00300000
   d7920      = ( dtype=0 land stype= 8 )#,                    <<03517>>00305000
   d7925      = ( dtype=0 land stype= 9 )#,                    <<03517>>00310000
   d7906r     = ( dtype=0 land stype=10 )#,                    <<03517>>00315000
   d7906f     = ( dtype=0 land stype=11 )#,                    <<03517>>00320000
   floppy     = ( dtype=2 )#,                                  <<03517>>00325000
   cs80       = ( dtype=3 )#,                                  <<03517>>00330000
   d7935      = ( dtype=3 land stype= 8 )#,                    <<03517>>00335000
   d7911etall     = ( dtype = 3 land stype = 0 )#,             <<06820>>00340000
   buffalo        = ( dtype = 3 land stype = 3 )#,             <<06820>>00345000
   cartridge'tape = ( d7911etall or buffalo )#,                <<06820>>00350000
   remvble    = (d7920 or d7925 or d7905r or d7906r            <<03517>>00355000
                 or floppy or d7935 or d9110a)#,               <<03517>>00360000
   splitdisc  = (d7905f or d7906f)#;                           <<03517>>00365000
                                                               <<03517>>00370000
equate                                                         <<14.eb>>00375000
   magtape      = 24,                                          <<14.eb>>00380000
   terminal     = 16,                                          <<02665>>00385000
                                                               <<14.eb>>00390000
   << important status returns from attachio >>                <<02564>>00395000
   ok'status     =    %1,  << attachio call succeeded >>       <<03517>>00400000
   eof           =    %2,  << end-of-file >>                   <<02721>>00405000
                                                               <<02564>>00410000
   << attachio function types >>                               <<02564>>00415000
   read          =     0,                                      <<02564>>00420000
   write         =     1,                                      <<02564>>00425000
   dclose        =     4,  << device close >>                  <<02564>>00430000
   rewind        =     5,  << rewind for tape-like devices >>  <<02564>>00435000
   status'cs80   =     7,  << status fetch for cs80 discs >>   <<03517>>00440000
   read'status   =    15,  << status fetch for hp7976a >>      <<02564>>00445000
                                                               <<03517>>00450000
   << equates for devrec's status read of cs80 discs >>        <<03517>>00455000
   p1'cs80       =       8,   << p1 & p2 to attachio >>        <<03517>>00460000
   p2'cs80       =       9,                                    <<03517>>00465000
   ignore'rupt   = %101010,   << ignore disc interrupt >>      <<03517>>00470000
                                                               <<14.eb>>00475000
   sysdb        = %1000,                                       <<14.eb>>00480000
   pvprocpinx   = sysdb +%363, << pv recgn. proc       >>      <<14.eb>>00485000
   pvrecg'cnt   = sysdb +%364, << pv recgn. count      >>      <<14.eb>>00490000
                                                               <<14.eb>>00495000
                               << ci errors  >>                <<14.eb>>00500000
                                                               <<14.eb>>00505000
   ciset        = 2,                                           <<14.eb>>00510000
   toolong      = 1401,                                        <<14.eb>>00515000
   invcommand   = 1402,                                        <<14.eb>>00520000
   devcant      = 1403,                                        <<14.eb>>00525000
   maxdevrecerr = 1409,                                        <<14.eb>>00530000
                                                               <<14.eb>>00535000
   charoffset   = 5,  << where chars begin in buffer >>        <<14.eb>>00540000
   maxl = 280, << max. com. length, same as ci read >>         <<*9024>>00545000
   buffmaxfree = 16, << max. number of device buffers >>       <<04704>>00550000
   terminalmaxfree = 14, << max. number of bufs for terms >>   <<04704>>00555000
   buffsize = %250,  << 320 characters (base 10) >>            <<*9024>>00560000
   totalbuffsizem1 = buffmaxfree *buffsize -1,                 <<14.eb>>00565000
   zendofequates1 = 0;                                         <<14.eb>>00570000
                                                               <<14.eb>>00575000
define                                                         <<14.eb>>00580000
                                                               <<02721>>00585000
   gstatus = (13:3)#,   << general part of attachio status >>  <<02721>>00590000
                                                               <<02721>>00595000
   pstop = absolute(%1300).(2:1)#, << process stop flag >>     <<14.eb>>00600000
                                                               <<03517>>00605000
   dit'disc'flag = absolute(lpdt'dit'ptr+sysdb).(0:2)=1#,      <<06223>>00610000
   not'sys'disc = lpdt'non'sys'domain=1#,                      <<06223>>00615000
                                                               <<03517>>00620000
   enable = assemble( sed 1 )#,                                <<14.eb>>00625000
   disable = assemble( sed 0 )#,                               <<14.eb>>00630000
   progen = absolute(%1141)#,                                  <<01549>>00635000
                                                               <<14.eb>>00640000
      << cell & bit definitions in each device buffer >>       <<14.eb>>00645000
                                                               <<14.eb>>00650000
   indev = bufi#,   << input device                >>          <<14.eb>>00655000
   outdev = bufi(1)#, << output device              >>         <<14.eb>>00660000
   nc     = bufi(2)#, <<no. chars (not used by avrec) >>       <<14.eb>>00665000
   ra     = bufi(3)#,<<retn addr.  for i/o completion >>       <<14.eb>>00670000
   flags = buf(4)#,                                            <<14.eb>>00675000
   vavrec = (0:1)#,  << flags word >>                          <<14.eb>>00680000
   ignorerr  =  (1:1)#, << flags word >>                       <<14.eb>>00685000
   special'term = flags.(3:1)#,  << do disconnect processing >><<02857>>00690000
   compend = flags.(10:1) #,                                   <<14.eb>>00695000
   type = flags.(4:6)#,  << device type >>                     <<02665>>00700000
   int = flags#,                                               <<14.eb>>00705000
                                                               <<02564>>00710000
      hp7970  =  0#,           << subtype for hp7970 >>        <<02564>>00715000
      hp7976  =  1#,           << subtype for hp7976 >>        <<02564>>00720000
      hp7978  =  2#,           << buckhorn subtype   >>        <<*7999>>00725000
      hp7974  =  3#,           << antelope subtype   >>        <<*7999>>00730000
                                                               <<02564>>00735000
   variable'density  =    << test for variable density drive >><<02564>>00740000
      ( (avr'stype = hp7976) lor                               <<*7999>>00745000
        (avr'stype = hp7978) lor                               <<*7999>>00750000
        (avr'stype = hp7974)    )#,                            <<*7999>>00755000
                                                               <<02564>>00760000
   zendofdefines1 = 0#;                                        <<14.eb>>00765000
                                                               <<14.eb>>00770000
                                                               <<14.eb>>00775000
integer                                                        <<14.eb>>00780000
   x = x,                                                      <<14.eb>>00785000
   s0 = s -0;                                                  <<14.eb>>00790000
logical                                                        <<01662>>00795000
   s1 = s-1;                                                   <<01662>>00800000
                                                               <<00534>>00805000
integer                                                        <<00534>>00810000
   ldev, << interrupting logical device >>                     <<06820>>00815000
   errnum, << ci error number in parsing logon >>              <<00534>>00820000
   parmnum; << parameter number in which error occurred >>     <<00534>>00825000
                                                               <<14.eb>>00830000
      << buffer control variables >>                           <<14.eb>>00835000
                                                               <<14.eb>>00840000
integer bufffreecount,                                         <<04704>>00845000
        termfreecount;                                         <<04704>>00850000
pointer                                                        <<14.eb>>00855000
   buf,                                                        <<14.eb>>00860000
   buffhead,                                                   <<14.eb>>00865000
   bufftail;                                                   <<14.eb>>00870000
integer pointer task; << will point to array ndev words long >><<14.eb>>00875000
                                                               <<14.eb>>00880000
integer pointer bufi = buf;                                    <<14.eb>>00885000
byte pointer char;  << 5 words into current buffer >>          <<14.eb>>00890000
array buffers(0:totalbuffsizem1);                              <<14.eb>>00895000
                                                               <<14.eb>>00900000
                                                               <<14.eb>>00905000
integer                                                        <<14.eb>>00910000
   lpdt'index,    << index into the lpdt entry    >>           <<06223>>00915000
   ndev,          << # devices in lpdt*2             >>        <<14.eb>>00920000
   ftask;         << index of 1st free task entry    >>        <<14.eb>>00925000
logical                                                        <<14.eb>>00930000
   inoutdevthesame,  <<indicates if ldev or device class>>     <<06551>>00935000
                     <<is true if ldev isn't dev. class >>     <<06551>>00940000
   rf;               << true when all buffers in use    >>     <<06551>>00945000
double                                                         <<14.eb>>00950000
   l;             << iostatus or attachio return     >>        <<03517>>00955000
integer                                                        <<14.eb>>00960000
   dtype,         << device type from ldt(2).        >>        <<03517>>00965000
   stype,         << device subtype from lpdt(1).    >>        <<03517>>00970000
   avr'stype,     << subtype for dotape check. >>              <<*7999>>00975000
   disc'status,   << result of cs80 status fetch.    >>        <<03517>>00980000
   status = l,    << iostatus return word            >>        <<14.eb>>00985000
   tlog = l+1,    << iostatus return word            >>        <<14.eb>>00990000
   i,             << looping index                   >>        <<14.eb>>00995000
   j,             << temporary                       >>        <<14.eb>>01000000
   k,             << j & k must be together          >>        <<14.eb>>01005000
   lparen;        << left paren flag & type          >>        <<14.eb>>01010000
integer prompt := ": ";    << famous mpe colon >>              <<14.eb>>01015000
$include inclldt5                                              <<06551>>01020000
logical array                                                  <<06551>>01025000
   ldt(0:size'of'ldt'entry-1);                                 <<06551>>01030000
integer                                                        <<06551>>01035000
   ldt'index := 0;                                             <<06551>>01040000
                                                               <<14.eb>>01045000
byte array temp(0:3);                                          <<01110>>01050000
                                                               <<01110>>01055000
byte array com(0:47) :=                                        <<14.eb>>01060000
   "JOB"  ,0,0,0,2,%20,                                        <<14.eb>>01065000
   "DATA"   ,0,0,0,%10,                                        <<14.eb>>01070000
   "HELLO"    ,0,1,%21,                                        <<14.eb>>01075000
   "(",0,0,0,0,0,3,%21,   << (cmd) logon  >>                   <<14.eb>>01080000
   %53,0,0,0,0,0,4,%21,   << (apl1) logon >>                   <<14.eb>>01085000
   %72,0,0,0,0,0,5,%21;   << (apl2) logon >>                   <<14.eb>>01090000
array wcom(*) = com;                                           <<14.eb>>01095000
                                                               <<14.eb>>01100000
   << 6-byte command name, startdevice cmd number, lpdt bit >> <<14.eb>>01105000
   << mask for job/data accepting, duplicative & interactive>> <<14.eb>>01110000
   << device configuration characteristics                  >> <<14.eb>>01115000
                                                               <<14.eb>>01120000
                                                               <<14.eb>>01125000
comment                                                        <<14.eb>>01130000
                                                               <<14.eb>>01135000
   a device buffer is allocated to each device being           <<14.eb>>01140000
recognized.  the current buffer is buf which contains 5        <<14.eb>>01145000
words of header and then the ascii info.  the last header      <<14.eb>>01150000
word is flags (see format below).                              <<14.eb>>01155000
                                                               <<14.eb>>01160000
   task contains a two word entry for each lpdt entry.  when   <<14.eb>>01165000
   processing begins for a device, an entry is allocated. the  <<14.eb>>01170000
   next available entry is stored in ftask.  first word is an  <<14.eb>>01175000
   ioq index for the device.  if -1 the task is done.  second  <<14.eb>>01180000
   word is the db relative address of the buffer               <<15.eb>>01185000
   assigned to this device.                                    <<14.eb>>01190000
                                                               <<14.eb>>01195000
                                                               <<14.eb>>01200000
  flags word format:                                           <<14.eb>>01205000
                                                               <<14.eb>>01210000
                       1 1 1 1 1 1   c = command pending       <<14.eb>>01215000
   0|1:2:3|4:5:6|7:8:9|0:1:2|3:4:5   j = job accepting         <<14.eb>>01220000
  |-------------------------------|  a = data accepting        <<14.eb>>01225000
  |v|e: :s|     t     |c:j:a|y:d:i|  y = control y             <<02857>>01230000
  |-------------------------------|  d = duplicitive           <<14.eb>>01235000
                                     i = interactive           <<14.eb>>01240000
                                     v = avrec called          <<14.eb>>01245000
                                     e = ignore io error       <<14.eb>>01250000
                                     t = device type           <<02665>>01255000
                                     s = special terminal for  <<02857>>01260000
                                         disconnect processing <<02857>>01265000
;                                                              <<14.eb>>01270000
$page "EXTERNAL PROCEDURE DECLARATIONS"                        <<02857>>01275000
logical procedure  abortio(i);                                 <<14.eb>>01280000
   value i;                                                    <<14.eb>>01285000
   integer i;                                                  <<14.eb>>01290000
   option external;                                            <<14.eb>>01295000
                                                               <<14.eb>>01300000
double procedure  attachio(l,q,d,a,f,c,p1,p2,fl);              <<14.eb>>01305000
   value l,q,d,a,f,c,p1,p2,fl;                                 <<14.eb>>01310000
   integer l,q,d,a,f,c,p1,p2,fl;                               <<14.eb>>01315000
   option external;                                            <<14.eb>>01320000
                                                               <<14.eb>>01325000
logical procedure avrec(ldev,buff,count,cmd);                  <<14.eb>>01330000
   value ldev,count,cmd;                                       <<14.eb>>01335000
   integer ldev,count,cmd;                                     <<14.eb>>01340000
   array buff;                                                 <<14.eb>>01345000
   option external;                                            <<14.eb>>01350000
comment  - count = positive byte count.                        <<14.eb>>01355000
         - cmd   = 1   1st call from devrec.                   <<14.eb>>01360000
                 = 2   2nd call from devrec.                   <<14.eb>>01365000
         - returns true if finished, false if second call      <<14.eb>>01370000
           is needed.                                          <<14.eb>>01375000
;                                                              <<14.eb>>01380000
                                                               <<02721>>01385000
integer procedure check'avr'status(ldev,iostatus,ignore);      <<02721>>01390000
   value ldev,iostatus,ignore;                                 <<02721>>01395000
   integer ldev,iostatus;                                      <<02721>>01400000
   logical ignore;                                             <<02721>>01405000
   option external;                                            <<02721>>01410000
                                                               <<02721>>01415000
procedure  awake(p,n,w);                                       <<14.eb>>01420000
   value p,n,w;                                                <<14.eb>>01425000
   integer p,n,w;                                              <<14.eb>>01430000
   option external;                                            <<14.eb>>01435000
                                                               <<14.eb>>01440000
procedure  delay(d);                                           <<14.eb>>01445000
   value d;                                                    <<14.eb>>01450000
   double d;                                                   <<14.eb>>01455000
   option external;                                            <<14.eb>>01460000
                                                               <<14.eb>>01465000
integer procedure genmsg(setno,msgno,mask,a,b,c,d,e,           <<14.eb>>01470000
      dest,reply,buff,dst,iotype);                             <<14.eb>>01475000
   value setno,msgno,mask,a,b,c,d,e,dest,reply,buff,           <<14.eb>>01480000
      dst,iotype;                                              <<14.eb>>01485000
   logical setno,msgno,mask,a,b,c,d,e,dest,reply,buff,         <<14.eb>>01490000
      dst,iotype;                                              <<14.eb>>01495000
   option variable,external;                                   <<14.eb>>01500000
                                                               <<14.eb>>01505000
procedure  help;                                               <<14.eb>>01510000
   option external;                                            <<14.eb>>01515000
                                                               <<14.eb>>01520000
double procedure  iostatus(i);                                 <<14.eb>>01525000
   value i;                                                    <<14.eb>>01530000
   integer i;                                                  <<14.eb>>01535000
   option external;                                            <<14.eb>>01540000
                                                               <<14.eb>>01545000
procedure setwake(ioqx);                                       <<01662>>01550000
   value ioqx;                                                 <<01662>>01555000
   integer ioqx;                                               <<01662>>01560000
   option external;                                            <<01662>>01565000
procedure startdevice(com,par,dev,lnum,jmp,iddp,jnum,enum,     <<00534>>01570000
                      pnum);                                   <<00534>>01575000
   value com,par,dev;                                          <<14.eb>>01580000
   integer com,par,dev,jnum,enum,pnum;                         <<00534>>01585000
   logical lnum;                                               <<14.eb>>01590000
   integer pointer jmp,iddp;                                   <<14.eb>>01595000
   option external,variable;                                   <<14.eb>>01600000
                                                               <<14.eb>>01605000
logical procedure special'terminal(ldev);                      <<02857>>01610000
   value ldev; integer ldev;                                   <<02857>>01615000
   option external;                                            <<02857>>01620000
                                                               <<02857>>01625000
procedure  wait(w,s);                                          <<14.eb>>01630000
   value w,s;                                                  <<14.eb>>01635000
   integer w,s;                                                <<14.eb>>01640000
   option external;                                            <<14.eb>>01645000
                                                               <<14.eb>>01650000
procedure cleanldev(ldev);                                     <<02564>>01655000
   value ldev;                                                 <<02574>>01660000
   integer ldev;                                               <<02564>>01665000
   option external;                                            <<02564>>01670000
                                                               <<02564>>01675000
procedure store'density(ldev,buffer,mode);                     <<02564>>01680000
   value ldev,mode;                                            <<02564>>01685000
   integer ldev,mode;                                          <<02564>>01690000
   array buffer;                                               <<02564>>01695000
   option external;                                            <<02564>>01700000
                                                               <<03617>>01705000
procedure labeled'dev'mounted(ldev);                           <<03617>>01710000
  value ldev;                                                  <<03617>>01715000
  integer ldev;                                                <<03617>>01720000
  option external;                                             <<03617>>01725000
                                                               <<02665>>01730000
procedure report'ioerror(ldev,iostatus);                       <<02665>>01735000
   value ldev,iostatus;                                        <<02665>>01740000
   integer ldev,iostatus;                                      <<02665>>01745000
   option external;                                            <<02665>>01750000
$page "SUBROUTINES"                                            <<02857>>01755000
                                                               <<04704>>01760000
logical subroutine checkbuffs;                                 <<04704>>01765000
<< returns true if 1.  dev=not(term) and bufffreecount <> 0 >> <<04704>>01770000
<<                 2.  dev=term and termfreecount <> 0     >>  <<04704>>01775000
<< returns false otherwise                             >>      <<04704>>01780000
<<                                                     >>      <<04704>>01785000
begin                                                          <<04704>>01790000
  if bufffreecount <> 0                                        <<04704>>01795000
     then if dtype = terminal                                  <<04704>>01800000
             then if termfreecount <> 0 << dev is terminal >>  <<04704>>01805000
                     then checkbuffs := true                   <<04704>>01810000
                     else begin                                <<04704>>01815000
                          checkbuffs:=false;                   <<04704>>01820000
                          end                                  <<04704>>01825000
             else checkbuffs := true                           <<04704>>01830000
     else begin                                                <<04704>>01835000
          checkbuffs:=false;                                   <<04704>>01840000
          end;                                                 <<04704>>01845000
end; << checkbuffs >>                                          <<04704>>01850000
                                                               <<04704>>01855000
subroutine getbuff;                                            <<14.eb>>01860000
begin                                                          <<14.eb>>01865000
                                                               <<14.eb>>01870000
   @buf := @buffhead;                                          <<14.eb>>01875000
   @buffhead := buffhead;                                      <<14.eb>>01880000
   bufffreecount := bufffreecount -1;                          <<14.eb>>01885000
if dtype = terminal                                            <<04704>>01890000
   then termfreecount:=termfreecount-1;                        <<04704>>01895000
                                                               <<14.eb>>01900000
end; << subroutine getbuff >>                                  <<14.eb>>01905000
                                                               <<14.eb>>01910000
subroutine initbuffers;                                        <<14.eb>>01915000
begin                                                          <<14.eb>>01920000
                                                               <<14.eb>>01925000
termfreecount:=terminalmaxfree;                                <<04704>>01930000
bufffreecount := buffmaxfree;                                  <<14.eb>>01935000
@bufftail := @buffhead := @buffers;                            <<14.eb>>01940000
for i := 1 until buffmaxfree -1 do                             <<14.eb>>01945000
begin                                                          <<14.eb>>01950000
   bufftail := @bufftail(buffsize);                            <<14.eb>>01955000
   @bufftail := @bufftail(buffsize);                           <<14.eb>>01960000
end;                                                           <<14.eb>>01965000
bufftail := 0;                                                 <<14.eb>>01970000
                                                               <<14.eb>>01975000
end;                                                           <<14.eb>>01980000
                                                               <<14.eb>>01985000
subroutine returnbuff;                                         <<14.eb>>01990000
begin                                                          <<14.eb>>01995000
                                                               <<14.eb>>02000000
if type = terminal then termfreecount:=termfreecount+1;        <<04704>>02005000
buf := 0; << end of free list >>                               <<14.eb>>02010000
if bufffreecount = 0 then                                      <<14.eb>>02015000
   @buffhead := @bufftail := @buf                              <<14.eb>>02020000
else                                                           <<14.eb>>02025000
begin                                                          <<14.eb>>02030000
   bufftail := @buf;                                           <<14.eb>>02035000
   @bufftail := @buf;                                          <<14.eb>>02040000
end;                                                           <<14.eb>>02045000
bufffreecount := bufffreecount +1;                             <<14.eb>>02050000
                                                               <<14.eb>>02055000
end; << subroutine returnbuff >>                               <<14.eb>>02060000
                                                               <<14.eb>>02065000
                                                               <<14.eb>>02070000
subroutine  stop;                                                       02075000
   begin                                                                02080000
<< task is done, release system buffer and task entry >>                02085000
   @buf := task(i +1); returnbuff;                             <<14.eb>>02090000
   ftask := ftask-2;     << compress table >>                           02095000
   task(i) := task(ftask);                                              02100000
   task(i+1) := task(ftask+1);                                          02105000
   i := i-2;                                                            02110000
   end;                                                                 02115000
                                                               <<02857>>02120000
subroutine clear'lpdt;                                         <<02857>>02125000
<< called to set device state to unowned.  for terminals    >> <<02857>>02130000
<< and magtapes, a special communication bit must be reset. >> <<02857>>02135000
begin                                                          <<02857>>02140000
                                                               <<02857>>02145000
lpdt'index:=indev*(integer(lpdt'entry'size));                  <<06223>>02150000
                                                               <<02857>>02155000
if type = magtape then                                         <<02857>>02160000
   begin   << devrec is done with tape drive. >>               <<02857>>02165000
   disable;                                                    <<02857>>02170000
   lpdt'tape'avr:=false;                                       <<06223>>02175000
   enable;                                                     <<02857>>02180000
   end                                                         <<02857>>02185000
else if special'term then                                      <<02857>>02190000
   begin   << terminal logon has been terminated. >>           <<02857>>02195000
   disable;                                                    <<02857>>02200000
   lpdt'logging'on:=false;                                     <<06223>>02205000
   enable;                                                     <<02857>>02210000
   end;                                                        <<02857>>02215000
                                                               <<02857>>02220000
disable;                                                       <<02857>>02225000
   lpdt'dev'own'state:=lpdt'not'owned;                         <<06223>>02230000
enable;                                                        <<02857>>02235000
                                                               <<02857>>02240000
end;   << of clear'lpdt >>                                     <<02857>>02245000
                                                               <<02857>>02250000
subroutine  iofail;                                                     02255000
   begin                                                                02260000
<< called on an i/o failure >>                                          02265000
   << frequently used as normal finish point >>                <<14.eb>>02270000
   attachio( x := indev,0,0,0,4,0,0,0,3);                      <<06820>>02275000
   clear'lpdt;                                                 <<02564>>02280000
                                                               <<02721>>02285000
<< report i/o errors.  tape errors have already been >>        <<02721>>02290000
<< reported.  eof is not an unusual condition, don't >>        <<02721>>02295000
<< report it.  for terminals, since the operator is  >>        <<02721>>02300000
<< not involved in terminal recognition, the message >>        <<02721>>02305000
<< would be confusing. >>                                      <<02721>>02310000
                                                               <<02721>>02315000
   if type <> terminal and type <> magtape and                 <<02721>>02320000
      status.gstatus <> eof  then                              <<02721>>02325000
      report'ioerror(indev,status.(8:8));                      <<02665>>02330000
   stop;                                                                02335000
   end;                                                                 02340000
                                                                        02345000
subroutine  run;                                                        02350000
   begin                                                                02355000
<< this starts the task defined at i >>                                 02360000
   @buf := task(i +1);                                         <<14.eb>>02365000
   @char := @buf(charoffset) & lsl(1);                         <<02564>>02370000
   tos := ra;   << get address to continue at >>                        02375000
   end;   << exit using ra, saving caller on stack >>                   02380000
                                                                        02385000
subroutine  io(p1,p2,p3,p4,p5,p6,p7);                                   02390000
   value p1,p2,p3,p4,p5,p6,p7;                                          02395000
   integer p1,p2,p3,p4,p5,p6,p7;                                        02400000
   begin                                                                02405000
<< starts the i/o, saves the task state, returns to caller of run >>    02410000
   tos := attachio(p1,p2,p3,p4,p5,p6,p7,0 , 2);                         02415000
   del;                                                                 02420000
   task(i) := s0;  << save ioq index >>                                 02425000
   l := iostatus(s0);                                                   02430000
   del;                                                                 02435000
   if  =  then                                                          02440000
     begin  << immediate completion, do not suspend >>                  02445000
      if flags.ignorerr   << avr of tape >>                    <<03517>>02450000
            or                                                 <<03517>>02455000
         status.gstatus = ok'status then return;               <<03517>>02460000
      iofail;                                                           02465000
     end                                                                02470000
   else ra := s0;  << save addr for continuation >>                     02475000
                                                                        02480000
   << return to caller of run >>                                        02485000
   assemble( subs 8 );                                                  02490000
   return 0;                                                            02495000
   end;                                                                 02500000
                                                                        02505000
subroutine  setstate(a);                                                02510000
   value a;                                                             02515000
   integer a;                                                           02520000
   begin                                                                02525000
<< sets the new lpdt state, decrements service count >>                 02530000
   disable;                                                             02535000
   lpdt'dev'own'state := a;                                    <<06223>>02540000
   lpdt'serv'req'count:=lpdt'serv'req'count-1;                 <<06223>>02545000
   enable;                                                              02550000
   end;                                                                 02555000
logical subroutine task'pending;                               <<01662>>02560000
   begin                                                       <<01662>>02565000
<< this routine returns true if there is work for devrec >>    <<01662>>02570000
   task'pending := false;                                      <<01662>>02575000
   if lpdt'serv'req'count <> 0 then task'pending:=true         <<06223>>02580000
   else if pstop then task'pending := true                     <<01662>>02585000
   else                                                        <<01662>>02590000
      begin                                                    <<01662>>02595000
      i := -2;                                                 <<01662>>02600000
      while (i:=i+2) < ftask and not s1 <<task'pending>> do    <<01662>>02605000
         begin                                                 <<01662>>02610000
         if task(i) = -1 then task'pending := true             <<01662>>02615000
         else                                                  <<01662>>02620000
            begin << check for io completion >>                <<01662>>02625000
                  << setwake returns ccl if  >>                <<01662>>02630000
                  << io completed else just  >>                <<01662>>02635000
                  << resets wake flag in ioq >>                <<01662>>02640000
            setwake(task(i));                                  <<01662>>02645000
            if < then task'pending := true;                    <<01662>>02650000
            end;                                               <<01662>>02655000
         end;                                                  <<01662>>02660000
      end;                                                     <<01662>>02665000
   end;                                                        <<01662>>02670000
$page                                                                   02675000
subroutine handle'disc;                                        <<06820>>02680000
begin                                                          <<06820>>02685000
<< devrec generally handles non-system domain disc interrupts ><<06820>>02690000
<< be passing the buck to pvproc.  this is because devrec     ><<06820>>02695000
<< can not know whether the device was owned or unowned       ><<06820>>02700000
<< before its state became "service requested".  pvproc will  ><<06820>>02705000
<< handle all interrupts for this case and will restore the   ><<06820>>02710000
<< device state properly.                                     ><<06820>>02715000
                                                               <<06820>>02720000
setstate(lpdt'service'ok);                                     <<06820>>02725000
disable;                                                       <<06820>>02730000
absolute( pvrecg'cnt ) := absolute( pvrecg'cnt ) + 1;          <<06820>>02735000
enable;                                                        <<06820>>02740000
awake( absolute(pvprocpinx), %20, 0 );                         <<06820>>02745000
                                                               <<06820>>02750000
end;  << subroutine handle'disc >>                             <<06820>>02755000
                                                               <<06820>>02760000
                                                               <<06820>>02765000
logical subroutine legal'disc;                                 <<06820>>02770000
begin                                                          <<06820>>02775000
<< returns true if ldev is a legal non-system domain disc or  ><<06820>>02780000
<< a cartridge tape or what everelse the little disc makers   ><<06820>>02785000
<< come up with                                               ><<06820>>02790000
legal'disc := false;                                           <<06820>>02795000
if dit'disc'flag and not'sys'disc or splitdisc                 <<06820>>02800000
   then legal'disc := true                                     <<06820>>02805000
   else if cartridge'tape                                      <<06820>>02810000
           then legal'disc := true;                            <<06820>>02815000
                                                               <<06820>>02820000
end; << subroutine legal'disc >>                               <<06820>>02825000
                                                               <<06820>>02830000
$page "OUTER BLOCK"                                            <<02857>>02835000
   << set ndev, & allocate array task ndev*2 >>                <<14.eb>>02840000
assemble( zero; lra s-0 );                                     <<14.eb>>02845000
@task := tos;                                                  <<14.eb>>02850000
tos:=ndev:=integer(lpdt'max'entries)*integer(lpdt'entry'size); <<06223>>02855000
assemble( adds 0 );                                                     02860000
ftask := 0;                                                             02865000
initbuffers;                                                   <<14.eb>>02870000
                                                                        02875000
<<                                                                      02880000
   execution loop, check lpdt for requests                              02885000
>>                                                                      02890000
                                                                        02895000
bicycle:                                                                02900000
                                                                        02905000
rf := false;                                                            02910000
lpdt'index:=0;                                                 <<06820>>02915000
while lpdt'serv'req'count <> 0 and  (lpdt'index:=lpdt'index+   <<06820>>02920000
   integer(lpdt'entry'size)) <= ndev do                        <<06820>>02925000
   begin                                                       <<06223>>02930000
   << ldev is  the logical device requesting service >>        <<06820>>02935000
   ldev:=lpdt'index/integer(lpdt'entry'size);                  <<06820>>02940000
   ldt'index:=0;  << base index into ldt array >>              <<06820>>02945000
   if lpdt'dev'own'state = lpdt'service'req then               <<06223>>02950000
      begin  << requesting service >>                                   02955000
      tos := @ldt; << logical array to move to >>              <<06551>>02960000
      tos := ldt'dst;                                          <<06551>>02965000
      tos:=ldev*size'of'ldt'entry;                             <<06820>>02970000
      tos := size'of'ldt'entry;                                <<06551>>02975000
      assemble( mfds 4 );                                               02980000
      dtype := ldt'device'type;                                <<06551>>02985000
      stype:=lpdt'subtype;                                     <<06223>>02990000
      if dtype=magtape or ((lpdt'data'accept lor               <<06223>>02995000
                     lpdt'job'accept) <> 0) then               <<06223>>03000000
      begin   << magtape or job or data accepting >>           <<07.eb>>03005000
         if logical(ldt'avail'to'sys)  then <<available>>      <<06551>>03010000
         begin  << devrec can try to set up device >>                   03015000
         if checkbuffs then                                    <<04704>>03020000
            begin  << system buffer available >>                        03025000
            task(ftask) := -1;                                          03030000
            getbuff; << new buffer pointed to by buf >>        <<14.eb>>03035000
            task(ftask +1) := @buf;                            <<14.eb>>03040000
            nc := 0;                                           <<14.eb>>03045000
            indev:=ldev;                                       <<06820>>03050000
            outdev := ldt'dflt'out'dev;                        <<06551>>03055000
            if (indev=outdev) and ldt'class'index then         <<06551>>03060000
               inoutdevthesame := false                        <<06551>>03065000
            else inoutdevthesame := true;                      <<06551>>03070000
                                                               <<06551>>03075000
            flags := 0; << vavrec,compend =false >>            <<07.eb>>03080000
            flags.(11:1):=lpdt'job'accept;                     <<06820>>03085000
            flags.(12:1):=lpdt'data'accept;                    <<06820>>03090000
            flags.(13:1):=lpdt'control'y;                      <<06820>>03095000
            flags.(14:1):=lpdt'duplicative;                    <<06820>>03100000
            flags.(15:1):=lpdt'interactive;                    <<06820>>03105000
            type := dtype;                                     <<03517>>03110000
            if type = terminal then                            <<02857>>03115000
               special'term := special'terminal(indev);        <<02857>>03120000
            if dtype = magtape  and        << try avr >>       <<03517>>03125000
              not logical (lpdt'tape'avr) then                 <<06223>>03130000
            begin                                              <<14.eb>>03135000
               disable;                                        <<02857>>03140000
               lpdt'tape'avr:=true;                            <<06223>>03145000
               enable;                                         <<02857>>03150000
               flags.ignorerr := true;                         <<14.eb>>03155000
               ra := @dotape  << p address of task for tape >> <<07.eb>>03160000
            end                                                <<14.eb>>03165000
            else                                               <<07.eb>>03170000
            begin << job/hello/data from terminal >>           <<07.eb>>03175000
                                                               <<07.eb>>03180000
            << command pending indication from lpdt eof >>              03185000
             if not(lpdt'eof'type = lpdt'hardware'eof) and     <<06820>>03190000
            lpdt'eof'type <> lpdt'no'eof then                  <<06223>>03195000
               compend := true;                                <<07.eb>>03200000
                                                               <<07.eb>>03205000
            ra := @start;                                               03210000
            if  int  and  inoutdevthesame then                 <<06551>>03215000
               begin  << print lf on outdev >>                          03220000
               tos := attachio(outdev,0,0,0,1,0,0,0,2);                 03225000
               del;                                                     03230000
               task(ftask) := tos;  << save ioq index >>                03235000
               end;                                                     03240000
            end; << job/hello/data from terminal >>            <<07.eb>>03245000
                                                               <<02857>>03250000
            setstate(lpdt'service'ok);                         <<06223>>03255000
                                                               <<02857>>03260000
            if special'term then                               <<02857>>03265000
               begin   << terminal is logging on. >>           <<02857>>03270000
               disable;                                        <<02857>>03275000
               lpdt'logging'on:=true;                          <<06223>>03280000
               enable;                                         <<02857>>03285000
               end;                                            <<02857>>03290000
                                                               <<02857>>03295000
            ftask := ftask+2;                                           03300000
            end                                                         03305000
         else                                                           03310000
            begin  << defer request, no buffer available >>             03315000
            rf := true;                                                 03320000
            end                                                         03325000
         end                                                   <<00431>>03330000
         else   <<device is down>>                             <<00431>>03335000
         begin  <<see if owned by diagnostics>>                <<00431>>03340000
            if ldt'avail'to'diag = 0 then <<owner not diag.>>  <<06551>>03345000
                 begin                                         <<04632>>03350000
                 attachio(ldev,0,0,0,dclose,0,0,0,3);          <<07326>>03355000
                 end;                                          << 9099>>03360000
            setstate (lpdt'not'owned);                         << 9099>>03365000
         end                                                   <<00431>>03370000
      end                                                      <<07.eb>>03375000
      else                                                              03380000
                                                               <<03517>>03385000
      if legal'disc   << ldev legal non-system domain disc?  >><<06820>>03390000
         then handle'disc                                      <<06820>>03395000
         else                                                  <<06820>>03400000
         begin  << clear the request, close device, make avail >>       03405000
         attachio(ldev,0,0,0,4,0,0,0,%3);                      <<06820>>03410000
         setstate(lpdt'not'owned);                             <<06820>>03415000
         end;                                                           03420000
      end;                                                              03425000
   end; << while <> 0 .. and ..<= ndev do begin >>             <<06223>>03430000
                                                                        03435000
<<                                                                      03440000
   task driver, polls for i/o completions, handles errors               03445000
>>                                                                      03450000
                                                                        03455000
i := -2;                                                                03460000
while  (i:=i+2) < ftask  do                                             03465000
   if  task(i) = -1  then  run                                          03470000
   else                                                                 03475000
      begin  << test i/o status before running >>                       03480000
      l := iostatus(task(i));                                           03485000
      if  =  then   << completed >>                                     03490000
      begin                                                    <<14.eb>>03495000
         @buf := task(i +1); << get flags adr. >>              <<14.eb>>03500000
         if flags.ignorerr   << avr of tape >>                 <<03517>>03505000
               or                                              <<03517>>03510000
            status.gstatus = ok'status then run                <<03517>>03515000
         else  iofail;                                                  03520000
      end;                                                     <<07.eb>>03525000
      end;                                                              03530000
                                                                        03535000
<<                                                                      03540000
   all items have been checked, check for process stop                  03545000
>>                                                                      03550000
                                                                        03555000
if  pstop  then                                                         03560000
   begin  << process stop time >>                                       03565000
   while  (i:=0) < ftask  do                                            03570000
      begin                                                             03575000
      if  task(i) <> -1 then                                   <<15.eb>>03580000
         begin  << abort the i/o in progress >>                         03585000
         @buf := task(i +1); << set buffer environment >>      <<15.eb>>03590000
         abortio(indev);                                       <<15.eb>>03595000
         do  iostatus(task)  until  <=;                                 03600000
         end;                                                           03605000
      stop;                                                             03610000
      end;                                                              03615000
   awake(progen,2,0);  << wake up progenitor >>                         03620000
   wait(0,0);                                                           03625000
   end;                                                                 03630000
                                                                        03635000
<<                                                                      03640000
   wait for more to do                                                  03645000
>>                                                                      03650000
                                                                        03655000
comment:                                                       <<01662>>03660000
   before doing a 'wait' check whether all tasks are           <<01662>>03665000
   completed. (the wws for service requested or                <<01662>>03670000
   completion of unblocked io may have been cleared            <<01662>>03675000
   when blocked io was performed -- as is done in              <<01662>>03680000
   startdevice.);                                              <<01662>>03685000
                                                               <<01662>>03690000
if  rf  then  delay(1000d)                                     <<01662>>03695000
else if not task'pending then wait(-%120,0);                   <<01662>>03700000
go bicycle;                                                             03705000
help;                                                                   03710000
$page "MAG TAPE AUTO VOLUME RECOGNITION CODE"                  <<02857>>03715000
dotape:                                                        <<14.eb>>03720000
                                                               <<02564>>03725000
   << make sure that tape is rewound before start. >>          <<02564>>03730000
   io(indev,0,0,0,rewind,0,0);                                 <<02564>>03735000
                                                               <<02564>>03740000
   case check'avr'status(indev,status.(8:8),false) of          <<02721>>03745000
      begin                                                    <<02721>>03750000
                                                               <<02721>>03755000
      ;           << 0 - ok, continue >>                       <<02721>>03760000
                                                               <<02721>>03765000
      go dotape;  << 1 - restart on power problems >>          <<02721>>03770000
                                                               <<02721>>03775000
      begin       << 2 - i/o error.  quit >>                   <<02721>>03780000
      cleanldev(indev);   << zero out tlt entry >>             <<02721>>03785000
      iofail;             << free device and task buffer >>    <<02721>>03790000
      assemble(sxit 0);   << return to task driver >>          <<02721>>03795000
      end;                                                     <<02721>>03800000
                                                               <<02721>>03805000
      ;           << 3 - can't happen, ignore = false >>       <<02721>>03810000
                                                               <<02721>>03815000
      end;   << of case statement >>                           <<02721>>03820000
                                                               <<02721>>03825000
                                                               <<02721>>03830000
   flags.vavrec := false;   << first record on tape >>         <<02721>>03835000
                                                               <<02721>>03840000
more'labels:                                                   <<02721>>03845000
                                                               <<14.eb>>03850000
io(indev,0,0,@buf(charoffset),0,40,0);                         <<14.eb>>03855000
   << read 40 words on indev into buf at charoffset >>         <<14.eb>>03860000
                                                               <<02721>>03865000
case check'avr'status(indev,status.(8:8),true) of              <<02721>>03870000
   begin                                                       <<02721>>03875000
                                                               <<02721>>03880000
   ;           << 0 - ok, continue >>                          <<02721>>03885000
                                                               <<02721>>03890000
   go dotape;  << 1 - restart on power problems >>             <<02721>>03895000
                                                               <<02721>>03900000
   begin       << 2 - i/o error.  quit >>                      <<02721>>03905000
   cleanldev(indev);   << zero out tlt entry >>                <<02721>>03910000
   iofail;             << free device and task buffer >>       <<02721>>03915000
   assemble(sxit 0);   << return to task driver >>             <<02721>>03920000
   end;                                                        <<02721>>03925000
                                                               <<02721>>03930000
   tlog := 0;  << 3 - ignored error >>                         <<02721>>03935000
                                                               <<02721>>03940000
   end;   << of case statement >>                              <<02721>>03945000
                                                               <<02721>>03950000
if not avrec(indev,buf(charoffset),tlog,1 +flags.vavrec) then  <<14.eb>>03955000
   begin  << must read another record >>                       <<02564>>03960000
   flags.vavrec := true;  << signal 2nd or greater to avrec >> <<02564>>03965000
   go more'labels;                                             <<02564>>03970000
   end;                                                        <<02564>>03975000
                                                               <<14.eb>>03980000
<< avrec has taken care of marking the bot bit for all >>      <<02564>>03985000
<< tape drives.  now, if variable density drive, must  >>      <<02564>>03990000
<< determine density of tape on drive.                 >>      <<02564>>03995000
                                                               <<02564>>04000000
lpdt'index := indev * integer(lpdt'entry'size);                <<*7999>>04005000
avr'stype := lpdt'auto'subtype;                                <<*7999>>04010000
if (variable'density) then                                     <<02564>>04015000
   begin                                                       <<02564>>04020000
                                                               <<02564>>04025000
   io(indev,0,0,@buf(charoffset),read'status,-5,0);            <<02564>>04030000
                                                               <<02564>>04035000
   case check'avr'status(indev,status.(8:8),false) of          <<02721>>04040000
      begin                                                    <<02721>>04045000
                                                               <<02721>>04050000
      ;           << 0 - ok, continue >>                       <<02721>>04055000
                                                               <<02721>>04060000
      go dotape;  << 1 - restart on power problems >>          <<02721>>04065000
                                                               <<02721>>04070000
      begin       << 2 - i/o error.  quit >>                   <<02721>>04075000
      cleanldev(indev);   << zero out tlt entry >>             <<02721>>04080000
      iofail;             << free device and task buffer >>    <<02721>>04085000
      assemble(sxit 0);   << return to task driver >>          <<02721>>04090000
      end;                                                     <<02721>>04095000
                                                               <<02721>>04100000
      ;           << 3 - can't happen, ignore = false >>       <<02721>>04105000
                                                               <<02721>>04110000
      end;   << of case statement >>                           <<02721>>04115000
                                                               <<02721>>04120000
   << put density into data structure. >>                      <<02721>>04125000
   store'density(indev,buf(charoffset),1);                     <<02721>>04130000
                                                               <<02721>>04135000
   end;   << of variable density drive. >>                     <<02721>>04140000
                                                               <<02721>>04145000
   << avrec has taken place. tape is as if nothing happened >> <<14.eb>>04150000
   << now try to read job/data accepting tapes              >> <<14.eb>>04155000
lpdt'index:=indev*integer(lpdt'entry'size);                    <<06223>>04160000
if ((lpdt'job'accept=0)land(lpdt'data'accept=0)) then          <<06223>>04165000
begin      << not job/data accepting.  done with tape. >>      <<02721>>04170000
   clear'lpdt;      << set device unowned >>                   <<02564>>04175000
   labeled'dev'mounted(indev);  << tell labseg tape mounted >> <<03617>>04180000
   stop;            << release task buffer >>                  <<02564>>04185000
   assemble( sxit 0); << return control to task driver, >>     <<14.eb>>04190000
                      << who called run subroutine     >>      <<14.eb>>04195000
end;                                                           <<14.eb>>04200000
                                                               <<14.eb>>04205000
   << fall through to try to read :job or :data on tape >>     <<14.eb>>04210000
ra := @start;  << change task code >>                          <<14.eb>>04215000
flags.ignorerr := false; << clear this >>                      <<14.eb>>04220000
                                                               <<14.eb>>04225000
                                                               <<14.eb>>04230000
$page "JOB/HELLO/DATA/(CMD) RECOGNITION CODE"                  <<02857>>04235000
start:                                                                  04240000
                                                                        04245000
errnum := parmnum := 0;                                        <<00723>>04250000
if  int  and  inoutdevthesame   then  << p r o m p t >>        <<06551>>04255000
   io(outdev,0,0,@prompt,25,(integer(compend)-1),%320);                 04260000
compend := false;    <<1st read gets pending command>>                  04265000
                                                                        04270000
read'logon:                                                    <<02564>>04275000
                                                                        04280000
char(nc) := " ";  << blank out first character >>                       04285000
io(indev,0,0,@buf(charoffset +nc&lsr(1)),0,nc -maxl,1);        <<14.eb>>04290000
if  not int  and  char(nc) <> ":"  then                                 04295000
   begin  << flushing >>                                                04300000
   nc := 0;                                                             04305000
   go read'logon;                                              <<02564>>04310000
   end;                                                                 04315000
nc := nc-tlog;                                                          04320000
if char(nc-1) = " " then                                                04325000
   begin  <<strip trailing blanks>>                                     04330000
   if char(nc-2) <> char(nc-1) , (1-nc) , 0                             04335000
         then tos := -tos;                                              04340000
   nc := tos;                                                           04345000
   ddel;                                                                04350000
   end;                                                                 04355000
                                                               <<01110>>04360000
lparen := 0;                                                   <<00.04>>04365000
if int then                                                    <<00.04>>04370000
   begin    <<interactive>>                                    <<00.04>>04375000
   if char = "(" then lparen := 1;  <<normal ascii>>           <<00.04>>04380000
   if char = %53 then lparen := 2;  <<apl bit pair>>           <<00.04>>04385000
   if char = %72 then                                          <<01110>>04390000
     begin                                                     <<01110>>04395000
                                                               <<01110>>04400000
     comment  the  first character could be a %72 if the       <<01110>>04405000
      device is an apl typ pair terminal or a job command was  <<01110>>04410000
      issued from within a job on an interactive device.;      <<01110>>04415000
                                                               <<01110>>04420000
     move temp := char(1),(3);                                 <<01110>>04425000
     temp(3) := 0;                                             <<01110>>04430000
     move temp := temp while as;                               <<01110>>04435000
     if temp = "JOB" then                                      <<01110>>04440000
       flags.(15:1) := 0        << job command. int off >>     <<01110>>04445000
     else                                                      <<01110>>04450000
       lparen := 3              << apl typ pair >>             <<01110>>04455000
     end                                                       <<01110>>04460000
   end;                                                        <<00.04>>04465000
if  nc >= maxl  then                                                    04470000
   begin  << image too long >>                                          04475000
   errnum := toolong;                                          <<00534>>04480000
   go error;                                                            04485000
   end;                                                                 04490000
if lparen <= 1 and char(nc-1) = "&" then                       <<00.04>>04495000
   begin  << continuation expected >>                                   04500000
    if nc = maxl-1 then << too long cause continuation in 279>><<*9024>>04505000
        begin                                                  <<02328>>04510000
        errnum := toolong;                                     <<02328>>04515000
        go error;                                              <<02328>>04520000
        end;                                                   <<02328>>04525000
   if  logical( nc )  then                                              04530000
      begin  << odd read, pad with a blank >>                           04535000
      char(nc) := " ";                                                  04540000
      nc := nc+1;                                                       04545000
      end;                                                              04550000
   go start;                                                            04555000
   end;                                                                 04560000
                                                                        04565000
<< command image in, now process it >>                                  04570000
j := k := 0;                                                            04575000
                                                               <<00.04>>04580000
if lparen > 1 then                                             <<00.04>>04585000
   begin                                                       <<00.04>>04590000
   k :=  nc;                                                   <<00.04>>04595000
   goto lp1;                                                   <<00.04>>04600000
   end;                                                        <<00.04>>04605000
                                                                        04610000
while  j < nc  do                                                       04615000
   begin                                                                04620000
   if  char(j) = "&" then  char(j) := " ";                              04625000
   if  char(j) <> ":"  then                                             04630000
      begin  << move it >>                                              04635000
      char(k) := char(j);                                               04640000
      k := k+1;                                                         04645000
      end;                                                              04650000
   j := j+1;                                                            04655000
   end;                                                                 04660000
                                                                        04665000
lp1:                                                           <<00.04>>04670000
<< image moved, colons and &'s removed, k = #chars >>                   04675000
if  k = 0  then                                                         04680000
   begin  << null image >>                                              04685000
   errnum := 0;                                                <<00534>>04690000
   go error;                                                            04695000
   end;                                                                 04700000
                                                                        04705000
char(k) := %15;   << stopper for startdevice >>                         04710000
if lparen <> 0 then                                            <<00.04>>04715000
   begin                                                       <<00.04>>04720000
   j := @char;                                                 <<00.04>>04725000
   k := lparen+2;                                              <<00.04>>04730000
   goto lp2;                                                   <<00.04>>04735000
   end;                                                        <<00.04>>04740000
                                                               <<00.04>>04745000
move  char := char while as,1;  << upshift the command >>               04750000
j := s0;   << parameter list pointer >>                                 04755000
k := tos-@char-3; << command length-3 >>                                04760000
                                                                        04765000
if  <  or  k > 2  or  char <> com(k*8),(k+3)  then                      04770000
   begin  << illegal command >>                                         04775000
   errnum := invcommand;                                       <<00534>>04780000
   go error;                                                            04785000
   end;                                                                 04790000
lp2:                                                           <<00.04>>04795000
k := k*8 +7; << check if device is configured ok >>            <<14.eb>>04800000
if (logical(com(k)) land flags.(11:5)) <> logical(com(k))      <<14.eb>>04805000
   then <<j & not j, s & not j or not i, d & not a >>          <<07.eb>>04810000
   begin  << device can't do it >>                                      04815000
   errnum := devcant;                                          <<00534>>04820000
   go error;                                                            04825000
   end;                                                                 04830000
startdevice(com(x:=x-1),j,indev,,,,,errnum,parmnum);           <<00534>>04835000
if errnum <= 0 then                                            <<00558>>04840000
   begin  << device recognized, devrec is through >>                    04845000
   stop;                                                                04850000
   assemble( sxit 0 );  << return to caller of run >>                   04855000
   end;                                                                 04860000
                                                                        04865000
error:   << set up and print the error message >>                       04870000
                                                                        04875000
if not inoutdevthesame then outdev := 0; <<  console  >>       <<06551>>04880000
if errnum < 0 then errnum := -errnum;                          <<00534>>04885000
if 1 <= errnum <= maxdevrecerr then                            <<00534>>04890000
   genmsg(ciset,errnum,,,,,,,outdev);                          <<00534>>04895000
nc := 0; << zero character count >>                                     04900000
go start;  << continue reading >>                              <<14.eb>>04905000
end.  << program devrec >>                                     <<02564>>04910000
