<< 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
