$CONTROL CODE,MAP,USLINIT                                               00010000
<<DEVREC - MODULE 08>>                                                  00012000
<<HP32002C MPE SOURCE C.00.00>>                                         00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL PRIVILEGED,MAIN=DEVREC                                <<14.EB>>00028000
BEGIN                                                          <<14.EB>>00030000
COMMENT                                                        <<14.EB>>00032000
                                                               <<14.EB>>00034000
DEVREC (Device Recognition) Program                            <<14.EB>>00036000
                                                               <<14.EB>>00038000
All unexpected interrupts are routed through this program.     <<14.EB>>00040000
Certain configurations of devices are handled here.  They are: <<14.EB>>00042000
                                                               <<14.EB>>00044000
   - Job or data accepting devices (i.e., terminals, card      <<14.EB>>00046000
     readers and mag tapes)                                    <<14.EB>>00048000
   - Non job accepting mag tapes (ordinary tapes) are first    <<14.EB>>00050000
     read to determine if they are labelled tapes.  This is    <<14.EB>>00052000
     automatic volume recognition (AVREC).                     <<14.EB>>00054000
                                                               <<14.EB>>00056000
Devrec is not core resident, runs pseudo-enabled and is extra- <<14.EB>>00058000
ordinary only in doing no-wait I/O and being the first in      <<14.EB>>00060000
a long chain of code and processes involved in creating a      <<14.EB>>00062000
session (i.e., it calls STARTDEVICE).                          <<14.EB>>00064000
                                                               <<14.EB>>00066000
Devrec is driven by the service request bits in the LPDT       <<14.EB>>00068000
which is core-resident).  When Devrec is awakened it scans     <<14.EB>>00070000
through the LPDT looking at each device which is requesting    <<14.EB>>00072000
service [LPDT(1) <> 0 ].  By looking at bits in the LDT        <<14.EB>>00074000
and LPDT Devrec decides if this device is the type of device   <<14.EB>>00076000
it handles.  If it is, the requesting device is placed in an   <<14.EB>>00078000
internal work queue (array TASK).                              <<14.EB>>00080000
                                                               <<14.EB>>00082000
After scanning the LPDT, Devrec then attempts to work off its  <<14.EB>>00084000
work queue by issuing no-wait I/O to the device and then       <<14.EB>>00086000
calling STARTDEVICE or AVREC when the read completes.          <<14.EB>>00088000
                                                               <<04704>>00090000
Current maximum number of devices handled concurrently is 16.  <<04704>>00092000
The maximum number of terminals that DEVREC may handle         <<04704>>00094000
concurrently is 14.  The theory is if 14 terminals have non-   <<04704>>00096000
timed out logons (and they have pending reads), at least tapes <<04704>>00098000
and PV's can still be used (because of two "non-terminal"      <<04704>>00100000
buffers).                                                      <<04704>>00102000
                                                               <<14.EB>>00104000
Devrec continues reading from a Job/Data accepting device      <<14.EB>>00106000
until STARTDEVICE succeeds or and ATTACHIO failure occurs,     <<14.EB>>00108000
then stops.                                                    <<14.EB>>00110000
;                                                              <<14.EB>>00112000
                                                               <<14.EB>>00114000
                                                               <<14.EB>>00116000
   << Supported Disc types and subtypes. >>                    <<03517>>00120000
DEFINE                                                         <<03517>>00122000
   D7905R     = ( DTYPE=0 LAND STYPE= 4 )#,                    <<03517>>00124000
   D7905F     = ( DTYPE=0 LAND STYPE= 5 )#,                    <<03517>>00126000
   D7920      = ( DTYPE=0 LAND STYPE= 8 )#,                    <<03517>>00128000
   D7925      = ( DTYPE=0 LAND STYPE= 9 )#,                    <<03517>>00130000
   D7906R     = ( DTYPE=0 LAND STYPE=10 )#,                    <<03517>>00132000
   D7906F     = ( DTYPE=0 LAND STYPE=11 )#,                    <<03517>>00134000
   FLOPPY     = ( DTYPE=2 )#,                                  <<03517>>00136000
   CS80       = ( DTYPE=3 )#,                                  <<03517>>00138000
   D7935      = ( DTYPE=3 LAND STYPE= 8 )#,                    <<03517>>00140000
   D9110A     = ( DTYPE=3 LAND STYPE= 0 )#,                    <<03517>>00142000
   REMVBLE    = (D7920 OR D7925 OR D7905R OR D7906R            <<03517>>00144000
                 OR FLOPPY OR D7935 OR D9110A)#,               <<03517>>00146000
   SPLITDISC  = (D7905F OR D7906F)#;                           <<03517>>00148000
                                                               <<03517>>00150000
EQUATE                                                         <<14.EB>>00152000
   LDT          = 14,                                          <<14.EB>>00154000
   LDTENT       = 5,           << LDT ENTRY SIZE         >>    <<14.EB>>00156000
   LPDTENT      = 2,    << LPDT entry size >>                  <<02564>>00158000
   MAGTAPE      = 24,                                          <<14.EB>>00160000
   TERMINAL     = 16,                                          <<02665>>00162000
   UNOWNED      = 0,    << Unowned state for LPDT. >>          <<02857>>00164000
   SERV'GRANTED = 3,    << Service granted state for LPDT. >>  <<02857>>00166000
                                                               <<14.EB>>00170000
   << Important status returns from ATTACHIO >>                <<02564>>00172000
   OK'STATUS     =    %1,  << ATTACHIO call succeeded >>       <<03517>>00174000
   EOF           =    %2,  << End-of-file >>                   <<02721>>00176000
                                                               <<02564>>00180000
   << ATTACHIO function types >>                               <<02564>>00182000
   READ          =     0,                                      <<02564>>00184000
   WRITE         =     1,                                      <<02564>>00186000
   DCLOSE        =     4,  << Device close >>                  <<02564>>00188000
   REWIND        =     5,  << Rewind for tape-like devices >>  <<02564>>00190000
   STATUS'CS80   =     7,  << Status fetch for CS80 discs >>   <<03517>>00192000
   READ'STATUS   =    15,  << Status fetch for HP7976A >>      <<02564>>00194000
                                                               <<03517>>00196000
   << Equates for DEVREC's status read of CS80 discs >>        <<03517>>00198000
   P1'CS80       =       8,   << P1 & P2 to ATTACHIO >>        <<03517>>00200000
   P2'CS80       =       9,                                    <<03517>>00202000
   IGNORE'RUPT   = %101010,   << Ignore disc interrupt >>      <<03517>>00204000
                                                               <<14.EB>>00206000
   SYSDB        = %1000,                                       <<14.EB>>00208000
   PVPROCPINX   = SYSDB +%363, << PV RECGN. PROC       >>      <<14.EB>>00210000
   PVRECG'CNT   = SYSDB +%364, << PV RECGN. COUNT      >>      <<14.EB>>00212000
                                                               <<14.EB>>00214000
                               << CI ERRORS  >>                <<14.EB>>00216000
                                                               <<14.EB>>00218000
   CISET        = 2,                                           <<14.EB>>00220000
   TOOLONG      = 1401,                                        <<14.EB>>00222000
   INVCOMMAND   = 1402,                                        <<14.EB>>00224000
   DEVCANT      = 1403,                                        <<14.EB>>00226000
   MAXDEVRECERR = 1409,                                        <<14.EB>>00228000
                                                               <<14.EB>>00230000
   CHAROFFSET   = 5,  << WHERE CHARS BEGIN IN BUFFER >>        <<14.EB>>00232000
   MAXL = 244, << MAXIMUM COMMAND LENGTH >>                    <<14.EB>>00234000
   BUFFMAXFREE = 16, << Max. number of device buffers >>       <<04704>>00236000
   TERMINALMAXFREE = 14, << Max. number of bufs for terms >>   <<04704>>00238000
   BUFFSIZE = 128,                                             <<14.EB>>00240000
   TOTALBUFFSIZEM1 = BUFFMAXFREE *BUFFSIZE -1,                 <<14.EB>>00242000
   ZENDOFEQUATES1 = 0;                                         <<14.EB>>00244000
                                                               <<14.EB>>00246000
DEFINE                                                         <<14.EB>>00248000
                                                               <<02721>>00250000
   GSTATUS = (13:3)#,   << General part of ATTACHIO status >>  <<02721>>00252000
                                                               <<02721>>00254000
   PSTOP = ABSOLUTE(%1300).(2:1)#, << PROCESS STOP FLAG >>     <<14.EB>>00256000
   SS = (0:2)#, << SS FIELD IN LPDT >>                         <<14.EB>>00258000
                                                               <<03517>>00260000
   DEVTYPE       = (10:6)#,    << LDT(2) device type field >>  <<03517>>00262000
   SUBTYPE       = (12:4)#,    << LPDT(1) subtype field    >>  <<03517>>00264000
   DIT'DISC'FLAG = ABSOLUTE(LPDT(I).(1:15)+SYSDB).(0:2)=1#,    <<03517>>00266000
   NOT'SYS'DISC  = LPDT(I+1).(4:1)=1#,                         <<03517>>00268000
                                                               <<03517>>00270000
   SERVICECNT = LPDT(1)#,                                      <<14.EB>>00272000
   ENABLE = ASSEMBLE( SED 1 )#,                                <<14.EB>>00274000
   DISABLE = ASSEMBLE( SED 0 )#,                               <<14.EB>>00276000
   PROGEN = ABSOLUTE(%1141)#,                                  <<01549>>00278000
                                                               <<14.EB>>00280000
      << CELL & BIT DEFINITIONS IN EACH DEVICE BUFFER >>       <<14.EB>>00282000
                                                               <<14.EB>>00284000
   INDEV = BUFI#,   << INPUT DEVICE                >>          <<14.EB>>00286000
   OUTDEV = BUFI(1)#, << OUTPUT DEVICE              >>         <<14.EB>>00288000
   NC     = BUFI(2)#, <<NO. CHARS (NOT USED BY AVREC) >>       <<14.EB>>00290000
   RA     = BUFI(3)#,<<RETN ADDR.  FOR I/O COMPLETION >>       <<14.EB>>00292000
   FLAGS = BUF(4)#,                                            <<14.EB>>00294000
   VAVREC = (0:1)#,  << FLAGS WORD >>                          <<14.EB>>00296000
   IGNORERR  =  (1:1)#, << FLAGS WORD >>                       <<14.EB>>00298000
   SPECIAL'TERM = FLAGS.(3:1)#,  << Do disconnect processing >><<02857>>00300000
   COMPEND = FLAGS.(10:1) #,                                   <<14.EB>>00302000
   TYPE = FLAGS.(4:6)#,  << Device type >>                     <<02665>>00304000
   INT = FLAGS#,                                               <<14.EB>>00306000
                                                               <<02564>>00308000
   << Field definitions for 2nd word of LPDT entry. >>         <<02564>>00310000
                                                               <<02564>>00312000
   LOGON    =  (11:1)#,   << For terminals, used to detect >>  <<02857>>00314000
              << if the device has disconnected during the >>  <<02857>>00316000
              << logon sequence. >>                            <<02857>>00318000
   TAPEREC  =  (11:1)#,   << For job/data accepting tapes, >>  <<02564>>00320000
              << indicates that AVREC has already occured  >>  <<02857>>00322000
              << and DEVREC should process next job on tape. >><<02564>>00324000
   T'SUBTYPE  =  (13:3)#,  << Subtype field for tapes >>       <<02564>>00326000
      HP7970  =  0#,           << Subtype for HP7970 >>        <<02564>>00328000
      HP7976  =  1#,           << Subtype for HP7976 >>        <<02564>>00330000
                                                               <<02564>>00332000
   VARIABLE'DENSITY  =    << Test for variable density drive >><<02564>>00334000
      LPDT(INDEV*LPDTENT + 1).T'SUBTYPE = HP7976#,             <<02564>>00336000
                                                               <<02564>>00338000
   ZENDOFDEFINES1 = 0#;                                        <<14.EB>>00340000
                                                               <<14.EB>>00342000
INTEGER POINTER    << SYSTEM TABLES >>                         <<02857>>00344000
   LPDT = 8;                                                   <<02857>>00346000
                                                               <<14.EB>>00348000
INTEGER                                                        <<14.EB>>00350000
   X = X,                                                      <<14.EB>>00352000
   S0 = S -0;                                                  <<14.EB>>00354000
LOGICAL                                                        <<01662>>00356000
   S1 = S-1;                                                   <<01662>>00358000
                                                               <<00534>>00360000
INTEGER                                                        <<00534>>00362000
   ERRNUM, << CI ERROR NUMBER IN PARSING LOGON >>              <<00534>>00364000
   PARMNUM; << PARAMETER NUMBER IN WHICH ERROR OCCURRED >>     <<00534>>00366000
                                                               <<14.EB>>00368000
      << BUFFER CONTROL VARIABLES >>                           <<14.EB>>00370000
                                                               <<14.EB>>00372000
INTEGER BUFFFREECOUNT,                                         <<04704>>00374000
        TERMFREECOUNT;                                         <<04704>>00376000
POINTER                                                        <<14.EB>>00378000
   BUF,                                                        <<14.EB>>00380000
   BUFFHEAD,                                                   <<14.EB>>00382000
   BUFFTAIL;                                                   <<14.EB>>00384000
INTEGER POINTER TASK; << WILL POINT TO ARRAY NDEV WORDS LONG >><<14.EB>>00386000
                                                               <<14.EB>>00388000
INTEGER POINTER BUFI = BUF;                                    <<14.EB>>00390000
BYTE POINTER CHAR;  << 5 WORDS INTO CURRENT BUFFER >>          <<14.EB>>00392000
ARRAY BUFFERS(0:TOTALBUFFSIZEM1);                              <<14.EB>>00394000
                                                               <<14.EB>>00396000
                                                               <<14.EB>>00398000
INTEGER                                                        <<14.EB>>00400000
   LPDT'INDEX,    << Index into word 1 of LPDT entry >>        <<02857>>00402000
   NDEV,          << # DEVICES IN LPDT*2             >>        <<14.EB>>00404000
   FTASK;         << INDEX OF 1ST FREE TASK ENTRY    >>        <<14.EB>>00406000
LOGICAL                                                        <<14.EB>>00408000
   RF;            << TRUE WHEN ALL BUFFERS IN USE    >>        <<14.EB>>00410000
DOUBLE                                                         <<14.EB>>00412000
   L;             << IOSTATUS or ATTACHIO return     >>        <<03517>>00414000
INTEGER                                                        <<14.EB>>00416000
   DTYPE,         << Device type from LDT(2).        >>        <<03517>>00418000
   STYPE,         << Device subtype from LPDT(1).    >>        <<03517>>00420000
   DISC'STATUS,   << Result of CS80 status fetch.    >>        <<03517>>00422000
   STATUS = L,    << IOSTATUS RETURN WORD            >>        <<14.EB>>00424000
   TLOG = L+1,    << IOSTATUS RETURN WORD            >>        <<14.EB>>00426000
   I,             << LOOPING INDEX                   >>        <<14.EB>>00428000
   J,             << TEMPORARY                       >>        <<14.EB>>00430000
   K,             << J & K MUST BE TOGETHER          >>        <<14.EB>>00432000
   LPAREN;        << LEFT PAREN FLAG & TYPE          >>        <<14.EB>>00434000
INTEGER PROMPT := ": ";    << FAMOUS MPE COLON >>              <<14.EB>>00436000
                                                               <<14.EB>>00438000
BYTE ARRAY TEMP(0:3);                                          <<01110>>00440000
                                                               <<01110>>00442000
BYTE ARRAY COM(0:47) :=                                        <<14.EB>>00444000
   "JOB"  ,0,0,0,2,%20,                                        <<14.EB>>00446000
   "DATA"   ,0,0,0,%10,                                        <<14.EB>>00448000
   "HELLO"    ,0,1,%21,                                        <<14.EB>>00450000
   "(",0,0,0,0,0,3,%21,   << (CMD) LOGON  >>                   <<14.EB>>00452000
   %53,0,0,0,0,0,4,%21,   << (APL1) LOGON >>                   <<14.EB>>00454000
   %72,0,0,0,0,0,5,%21;   << (APL2) LOGON >>                   <<14.EB>>00456000
ARRAY WCOM(*) = COM;                                           <<14.EB>>00458000
                                                               <<14.EB>>00460000
   << 6-BYTE COMMAND NAME, STARTDEVICE CMD NUMBER, LPDT BIT >> <<14.EB>>00462000
   << MASK FOR JOB/DATA ACCEPTING, DUPLICATIVE & INTERACTIVE>> <<14.EB>>00464000
   << DEVICE CONFIGURATION CHARACTERISTICS                  >> <<14.EB>>00466000
                                                               <<14.EB>>00468000
                                                               <<14.EB>>00470000
COMMENT                                                        <<14.EB>>00472000
                                                               <<14.EB>>00474000
   A device buffer is allocated to each device being           <<14.EB>>00476000
recognized.  The current buffer is BUF which contains 5        <<14.EB>>00478000
words of header and then the ASCII info.  The last header      <<14.EB>>00480000
word is FLAGS (see format below).                              <<14.EB>>00482000
                                                               <<14.EB>>00484000
   TASK CONTAINS A TWO WORD ENTRY FOR EACH LPDT ENTRY.  WHEN   <<14.EB>>00486000
   PROCESSING BEGINS FOR A DEVICE, AN ENTRY IS ALLOCATED. THE  <<14.EB>>00488000
   NEXT AVAILABLE ENTRY IS STORED IN FTASK.  FIRST WORD IS AN  <<14.EB>>00490000
   IOQ INDEX FOR THE DEVICE.  IF -1 THE TASK IS DONE.  SECOND  <<14.EB>>00492000
   WORD IS THE DB RELATIVE ADDRESS OF THE BUFFER               <<15.EB>>00494000
   ASSIGNED TO THIS DEVICE.                                    <<14.EB>>00496000
                                                               <<14.EB>>00498000
                                                               <<14.EB>>00500000
  FLAGS WORD FORMAT:                                           <<14.EB>>00502000
                                                               <<14.EB>>00504000
                       1 1 1 1 1 1   C = COMMAND PENDING       <<14.EB>>00506000
   0|1:2:3|4:5:6|7:8:9|0:1:2|3:4:5   J = JOB ACCEPTING         <<14.EB>>00508000
  |-------------------------------|  A = DATA ACCEPTING        <<14.EB>>00510000
  |V|E: :S|     T     |C:J:A|Y:D:I|  Y = CONTROL Y             <<02857>>00512000
  |-------------------------------|  D = DUPLICITIVE           <<14.EB>>00514000
                                     I = INTERACTIVE           <<14.EB>>00516000
                                     V = AVREC CALLED          <<14.EB>>00518000
                                     E = IGNORE IO ERROR       <<14.EB>>00520000
                                     T = DEVICE TYPE           <<02665>>00522000
                                     S = SPECIAL TERMINAL FOR  <<02857>>00524000
                                         DISCONNECT PROCESSING <<02857>>00526000
;                                                              <<14.EB>>00528000
$PAGE "EXTERNAL PROCEDURE DECLARATIONS"                        <<02857>>00532000
LOGICAL PROCEDURE  ABORTIO(I);                                 <<14.EB>>00534000
   VALUE I;                                                    <<14.EB>>00536000
   INTEGER I;                                                  <<14.EB>>00538000
   OPTION EXTERNAL;                                            <<14.EB>>00540000
                                                               <<14.EB>>00542000
DOUBLE PROCEDURE  ATTACHIO(L,Q,D,A,F,C,P1,P2,FL);              <<14.EB>>00544000
   VALUE L,Q,D,A,F,C,P1,P2,FL;                                 <<14.EB>>00546000
   INTEGER L,Q,D,A,F,C,P1,P2,FL;                               <<14.EB>>00548000
   OPTION EXTERNAL;                                            <<14.EB>>00550000
                                                               <<14.EB>>00552000
LOGICAL PROCEDURE AVREC(LDEV,BUFF,COUNT,CMD);                  <<14.EB>>00554000
   VALUE LDEV,COUNT,CMD;                                       <<14.EB>>00556000
   INTEGER LDEV,COUNT,CMD;                                     <<14.EB>>00558000
   ARRAY BUFF;                                                 <<14.EB>>00560000
   OPTION EXTERNAL;                                            <<14.EB>>00562000
COMMENT  - COUNT = POSITIVE BYTE COUNT.                        <<14.EB>>00564000
         - CMD   = 1   1ST CALL FROM DEVREC.                   <<14.EB>>00566000
                 = 2   2ND CALL FROM DEVREC.                   <<14.EB>>00568000
         - RETURNS TRUE IF FINISHED, FALSE IF SECOND CALL      <<14.EB>>00570000
           IS NEEDED.                                          <<14.EB>>00572000
;                                                              <<14.EB>>00574000
                                                               <<02721>>00576000
INTEGER PROCEDURE CHECK'AVR'STATUS(LDEV,IOSTATUS,IGNORE);      <<02721>>00578000
   VALUE LDEV,IOSTATUS,IGNORE;                                 <<02721>>00580000
   INTEGER LDEV,IOSTATUS;                                      <<02721>>00582000
   LOGICAL IGNORE;                                             <<02721>>00584000
   OPTION EXTERNAL;                                            <<02721>>00586000
                                                               <<02721>>00588000
PROCEDURE  AWAKE(P,N,W);                                       <<14.EB>>00590000
   VALUE P,N,W;                                                <<14.EB>>00592000
   INTEGER P,N,W;                                              <<14.EB>>00594000
   OPTION EXTERNAL;                                            <<14.EB>>00596000
                                                               <<14.EB>>00598000
PROCEDURE  DELAY(D);                                           <<14.EB>>00600000
   VALUE D;                                                    <<14.EB>>00602000
   DOUBLE D;                                                   <<14.EB>>00604000
   OPTION EXTERNAL;                                            <<14.EB>>00606000
                                                               <<14.EB>>00608000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<14.EB>>00610000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<14.EB>>00612000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<14.EB>>00614000
      DST,IOTYPE;                                              <<14.EB>>00616000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<14.EB>>00618000
      DST,IOTYPE;                                              <<14.EB>>00620000
   OPTION VARIABLE,EXTERNAL;                                   <<14.EB>>00622000
                                                               <<14.EB>>00624000
PROCEDURE  HELP;                                               <<14.EB>>00626000
   OPTION EXTERNAL;                                            <<14.EB>>00628000
                                                               <<14.EB>>00630000
DOUBLE PROCEDURE  IOSTATUS(I);                                 <<14.EB>>00632000
   VALUE I;                                                    <<14.EB>>00634000
   INTEGER I;                                                  <<14.EB>>00636000
   OPTION EXTERNAL;                                            <<14.EB>>00638000
                                                               <<14.EB>>00640000
PROCEDURE SETWAKE(IOQX);                                       <<01662>>00642000
   VALUE IOQX;                                                 <<01662>>00644000
   INTEGER IOQX;                                               <<01662>>00646000
   OPTION EXTERNAL;                                            <<01662>>00648000
PROCEDURE STARTDEVICE(COM,PAR,DEV,LNUM,JMP,IDDP,JNUM,ENUM,     <<00534>>00650000
                      PNUM);                                   <<00534>>00652000
   VALUE COM,PAR,DEV;                                          <<14.EB>>00654000
   INTEGER COM,PAR,DEV,JNUM,ENUM,PNUM;                         <<00534>>00656000
   LOGICAL LNUM;                                               <<14.EB>>00658000
   INTEGER POINTER JMP,IDDP;                                   <<14.EB>>00660000
   OPTION EXTERNAL,VARIABLE;                                   <<14.EB>>00662000
                                                               <<14.EB>>00664000
LOGICAL PROCEDURE SPECIAL'TERMINAL(LDEV);                      <<02857>>00666000
   VALUE LDEV; INTEGER LDEV;                                   <<02857>>00668000
   OPTION EXTERNAL;                                            <<02857>>00670000
                                                               <<02857>>00672000
PROCEDURE  WAIT(W,S);                                          <<14.EB>>00674000
   VALUE W,S;                                                  <<14.EB>>00676000
   INTEGER W,S;                                                <<14.EB>>00678000
   OPTION EXTERNAL;                                            <<14.EB>>00680000
                                                               <<14.EB>>00682000
PROCEDURE CLEANLDEV(LDEV);                                     <<02564>>00684000
   VALUE LDEV;                                                 <<02574>>00686000
   INTEGER LDEV;                                               <<02564>>00688000
   OPTION EXTERNAL;                                            <<02564>>00690000
                                                               <<02564>>00692000
PROCEDURE STORE'DENSITY(LDEV,BUFFER,MODE);                     <<02564>>00694000
   VALUE LDEV,MODE;                                            <<02564>>00696000
   INTEGER LDEV,MODE;                                          <<02564>>00698000
   ARRAY BUFFER;                                               <<02564>>00700000
   OPTION EXTERNAL;                                            <<02564>>00702000
                                                               <<03617>>00704000
PROCEDURE LABELED'DEV'MOUNTED(LDEV);                           <<03617>>00706000
  VALUE LDEV;                                                  <<03617>>00708000
  INTEGER LDEV;                                                <<03617>>00710000
  OPTION EXTERNAL;                                             <<03617>>00712000
                                                               <<02665>>00714000
PROCEDURE REPORT'IOERROR(LDEV,IOSTATUS);                       <<02665>>00716000
   VALUE LDEV,IOSTATUS;                                        <<02665>>00718000
   INTEGER LDEV,IOSTATUS;                                      <<02665>>00720000
   OPTION EXTERNAL;                                            <<02665>>00722000
$PAGE "SUBROUTINES"                                            <<02857>>00726000
                                                               <<04704>>00728000
LOGICAL SUBROUTINE CHECKBUFFS;                                 <<04704>>00730000
<< RETURNS TRUE IF 1.  DEV=NOT(TERM) AND BUFFFREECOUNT <> 0 >> <<04704>>00732000
<<                 2.  DEV=TERM AND TERMFREECOUNT <> 0     >>  <<04704>>00734000
<< RETURNS FALSE OTHERWISE                             >>      <<04704>>00736000
<<                                                     >>      <<04704>>00738000
BEGIN                                                          <<04704>>00740000
  IF BUFFFREECOUNT <> 0                                        <<04704>>00742000
     THEN IF DTYPE = TERMINAL                                  <<04704>>00744000
             THEN IF TERMFREECOUNT <> 0 << Dev is terminal >>  <<04704>>00746000
                     THEN CHECKBUFFS := TRUE                   <<04704>>00748000
                     ELSE BEGIN                                <<04704>>00750000
                          CHECKBUFFS:=FALSE;                   <<04704>>00752000
                          END                                  <<04704>>00754000
             ELSE CHECKBUFFS := TRUE                           <<04704>>00756000
     ELSE BEGIN                                                <<04704>>00758000
          CHECKBUFFS:=FALSE;                                   <<04704>>00760000
          END;                                                 <<04704>>00762000
END; << CHECKBUFFS >>                                          <<04704>>00764000
                                                               <<04704>>00766000
SUBROUTINE GETBUFF;                                            <<14.EB>>00768000
BEGIN                                                          <<14.EB>>00770000
                                                               <<14.EB>>00772000
   @BUF := @BUFFHEAD;                                          <<14.EB>>00774000
   @BUFFHEAD := BUFFHEAD;                                      <<14.EB>>00776000
   BUFFFREECOUNT := BUFFFREECOUNT -1;                          <<14.EB>>00778000
IF DTYPE = TERMINAL                                            <<04704>>00780000
   THEN TERMFREECOUNT:=TERMFREECOUNT-1;                        <<04704>>00782000
                                                               <<14.EB>>00784000
END; << SUBROUTINE GETBUFF >>                                  <<14.EB>>00786000
                                                               <<14.EB>>00788000
SUBROUTINE INITBUFFERS;                                        <<14.EB>>00790000
BEGIN                                                          <<14.EB>>00792000
                                                               <<14.EB>>00794000
TERMFREECOUNT:=TERMINALMAXFREE;                                <<04704>>00796000
BUFFFREECOUNT := BUFFMAXFREE;                                  <<14.EB>>00798000
@BUFFTAIL := @BUFFHEAD := @BUFFERS;                            <<14.EB>>00800000
FOR I := 1 UNTIL BUFFMAXFREE -1 DO                             <<14.EB>>00802000
BEGIN                                                          <<14.EB>>00804000
   BUFFTAIL := @BUFFTAIL(BUFFSIZE);                            <<14.EB>>00806000
   @BUFFTAIL := @BUFFTAIL(BUFFSIZE);                           <<14.EB>>00808000
END;                                                           <<14.EB>>00810000
BUFFTAIL := 0;                                                 <<14.EB>>00812000
                                                               <<14.EB>>00814000
END;                                                           <<14.EB>>00816000
                                                               <<14.EB>>00818000
SUBROUTINE RETURNBUFF;                                         <<14.EB>>00820000
BEGIN                                                          <<14.EB>>00822000
                                                               <<14.EB>>00824000
IF TYPE = TERMINAL THEN TERMFREECOUNT:=TERMFREECOUNT+1;        <<04704>>00826000
BUF := 0; << END OF FREE LIST >>                               <<14.EB>>00828000
IF BUFFFREECOUNT = 0 THEN                                      <<14.EB>>00830000
   @BUFFHEAD := @BUFFTAIL := @BUF                              <<14.EB>>00832000
ELSE                                                           <<14.EB>>00834000
BEGIN                                                          <<14.EB>>00836000
   BUFFTAIL := @BUF;                                           <<14.EB>>00838000
   @BUFFTAIL := @BUF;                                          <<14.EB>>00840000
END;                                                           <<14.EB>>00842000
BUFFFREECOUNT := BUFFFREECOUNT +1;                             <<14.EB>>00844000
                                                               <<14.EB>>00846000
END; << SUBROUTINE RETURNBUFF >>                               <<14.EB>>00848000
                                                               <<14.EB>>00850000
                                                               <<14.EB>>00852000
SUBROUTINE  STOP;                                                       00854000
   BEGIN                                                                00856000
<< TASK IS DONE, RELEASE SYSTEM BUFFER AND TASK ENTRY >>                00858000
   @BUF := TASK(I +1); RETURNBUFF;                             <<14.EB>>00860000
   FTASK := FTASK-2;     << COMPRESS TABLE >>                           00862000
   TASK(I) := TASK(FTASK);                                              00864000
   TASK(I+1) := TASK(FTASK+1);                                          00866000
   I := I-2;                                                            00868000
   END;                                                                 00870000
                                                               <<02857>>00874000
SUBROUTINE CLEAR'LPDT;                                         <<02857>>00876000
<< Called to set device state to unowned.  For terminals    >> <<02857>>00878000
<< and magtapes, a special communication bit must be reset. >> <<02857>>00880000
BEGIN                                                          <<02857>>00882000
                                                               <<02857>>00884000
LPDT'INDEX := INDEV*LPDTENT + 1;                               <<02857>>00886000
                                                               <<02857>>00888000
IF TYPE = MAGTAPE THEN                                         <<02857>>00890000
   BEGIN   << DEVREC is done with tape drive. >>               <<02857>>00892000
   DISABLE;                                                    <<02857>>00894000
   LPDT(LPDT'INDEX).TAPEREC := FALSE;                          <<02857>>00896000
   ENABLE;                                                     <<02857>>00898000
   END                                                         <<02857>>00900000
ELSE IF SPECIAL'TERM THEN                                      <<02857>>00902000
   BEGIN   << Terminal logon has been terminated. >>           <<02857>>00904000
   DISABLE;                                                    <<02857>>00906000
   LPDT(LPDT'INDEX).LOGON := FALSE;                            <<02857>>00908000
   ENABLE;                                                     <<02857>>00910000
   END;                                                        <<02857>>00912000
                                                               <<02857>>00914000
DISABLE;                                                       <<02857>>00916000
LPDT(LPDT'INDEX).SS := UNOWNED;                                <<02857>>00918000
ENABLE;                                                        <<02857>>00920000
                                                               <<02857>>00922000
END;   << of CLEAR'LPDT >>                                     <<02857>>00924000
                                                               <<02857>>00926000
SUBROUTINE  IOFAIL;                                                     00928000
   BEGIN                                                                00930000
<< CALLED ON AN I/O FAILURE >>                                          00932000
   << FREQUENTLY USED AS NORMAL FINISH POINT >>                <<14.EB>>00934000
   ATTACHIO( X := INDEV,0,0,0,4,0,0,0,%13);                    <<14.EB>>00936000
   CLEAR'LPDT;                                                 <<02564>>00938000
                                                               <<02721>>00942000
<< Report I/O errors.  Tape errors have already been >>        <<02721>>00944000
<< reported.  EOF is not an unusual condition, don't >>        <<02721>>00946000
<< report it.  For terminals, since the operator is  >>        <<02721>>00948000
<< not involved in terminal recognition, the message >>        <<02721>>00950000
<< would be confusing. >>                                      <<02721>>00952000
                                                               <<02721>>00954000
   IF TYPE <> TERMINAL AND TYPE <> MAGTAPE AND                 <<02721>>00956000
      STATUS.GSTATUS <> EOF  THEN                              <<02721>>00958000
      REPORT'IOERROR(INDEV,STATUS.(8:8));                      <<02665>>00960000
   STOP;                                                                00962000
   END;                                                                 00964000
                                                                        00966000
SUBROUTINE  RUN;                                                        00968000
   BEGIN                                                                00970000
<< THIS STARTS THE TASK DEFINED AT I >>                                 00972000
   @BUF := TASK(I +1);                                         <<14.EB>>00974000
   @CHAR := @BUF(CHAROFFSET) & LSL(1);                         <<02564>>00976000
   TOS := RA;   << GET ADDRESS TO CONTINUE AT >>                        00978000
   END;   << EXIT USING RA, SAVING CALLER ON STACK >>                   00980000
                                                                        00982000
SUBROUTINE  IO(P1,P2,P3,P4,P5,P6,P7);                                   00984000
   VALUE P1,P2,P3,P4,P5,P6,P7;                                          00986000
   INTEGER P1,P2,P3,P4,P5,P6,P7;                                        00988000
   BEGIN                                                                00990000
<< STARTS THE I/O, SAVES THE TASK STATE, RETURNS TO CALLER OF RUN >>    00992000
   TOS := ATTACHIO(P1,P2,P3,P4,P5,P6,P7,0 , 2);                         00994000
   DEL;                                                                 00996000
   TASK(I) := S0;  << SAVE IOQ INDEX >>                                 00998000
   L := IOSTATUS(S0);                                                   01000000
   DEL;                                                                 01002000
   IF  =  THEN                                                          01004000
     BEGIN  << IMMEDIATE COMPLETION, DO NOT SUSPEND >>                  01006000
      IF FLAGS.IGNORERR   << AVR of tape >>                    <<03517>>01008000
            OR                                                 <<03517>>01010000
         STATUS.GSTATUS = OK'STATUS THEN RETURN;               <<03517>>01012000
      IOFAIL;                                                           01014000
     END                                                                01016000
   ELSE RA := S0;  << SAVE ADDR FOR CONTINUATION >>                     01018000
                                                                        01020000
   << RETURN TO CALLER OF RUN >>                                        01022000
   ASSEMBLE( SUBS 8 );                                                  01024000
   RETURN 0;                                                            01026000
   END;                                                                 01028000
                                                                        01030000
SUBROUTINE  SETSTATE(A);                                                01032000
   VALUE A;                                                             01034000
   INTEGER A;                                                           01036000
   BEGIN                                                                01038000
<< SETS THE NEW LPDT STATE, DECREMENTS SERVICE COUNT >>                 01040000
   DISABLE;                                                             01042000
   LPDT(I+1).SS := A;                                                   01044000
   SERVICECNT := SERVICECNT-1;                                          01046000
   ENABLE;                                                              01048000
   END;                                                                 01050000
LOGICAL SUBROUTINE TASK'PENDING;                               <<01662>>01052000
   BEGIN                                                       <<01662>>01054000
<< THIS ROUTINE RETURNS TRUE IF THERE IS WORK FOR DEVREC >>    <<01662>>01056000
   TASK'PENDING := FALSE;                                      <<01662>>01058000
   IF SERVICECNT <> 0 THEN TASK'PENDING := TRUE                <<01662>>01060000
   ELSE IF PSTOP THEN TASK'PENDING := TRUE                     <<01662>>01062000
   ELSE                                                        <<01662>>01064000
      BEGIN                                                    <<01662>>01066000
      I := -2;                                                 <<01662>>01068000
      WHILE (I:=I+2) < FTASK AND NOT S1 <<TASK'PENDING>> DO    <<01662>>01070000
         BEGIN                                                 <<01662>>01072000
         IF TASK(I) = -1 THEN TASK'PENDING := TRUE             <<01662>>01074000
         ELSE                                                  <<01662>>01076000
            BEGIN << CHECK FOR IO COMPLETION >>                <<01662>>01078000
                  << SETWAKE RETURNS CCL IF  >>                <<01662>>01080000
                  << IO COMPLETED ELSE JUST  >>                <<01662>>01082000
                  << RESETS WAKE FLAG IN IOQ >>                <<01662>>01084000
            SETWAKE(TASK(I));                                  <<01662>>01086000
            IF < THEN TASK'PENDING := TRUE;                    <<01662>>01088000
            END;                                               <<01662>>01090000
         END;                                                  <<01662>>01092000
      END;                                                     <<01662>>01094000
   END;                                                        <<01662>>01096000
$PAGE "OUTER BLOCK"                                            <<02857>>01100000
   << SET NDEV, & ALLOCATE ARRAY TASK NDEV*2 >>                <<14.EB>>01102000
ASSEMBLE( ZERO; LRA S-0 );                                     <<14.EB>>01104000
@TASK := TOS;                                                  <<14.EB>>01106000
TOS := NDEV := LPDT(0).(0:8)&LSL(1);                                    01108000
ASSEMBLE( ADDS 0 );                                                     01110000
FTASK := 0;                                                             01112000
INITBUFFERS;                                                   <<14.EB>>01114000
                                                                        01116000
<<                                                                      01118000
   EXECUTION LOOP, CHECK LPDT FOR REQUESTS                              01120000
>>                                                                      01122000
                                                                        01124000
BICYCLE:                                                                01126000
                                                                        01128000
RF := FALSE;                                                            01130000
I := 0;                                                                 01132000
WHILE  SERVICECNT <> 0  AND  (I:=I+2) <= NDEV  DO                       01134000
   IF  LPDT(I+1).SS = 2  THEN                                           01136000
      BEGIN  << REQUESTING SERVICE >>                                   01138000
      TOS := @J; << LDT(2) & LDT(3) >>                         <<07.EB>>01140000
      TOS := LDT;                                                       01142000
      TOS := I&LSR(1)*LDTENT+2;                                <<RH.PV>>01144000
      TOS := 2;                                                <<RH.PV>>01146000
      ASSEMBLE( MFDS 4 );                                               01148000
      DTYPE := J.DEVTYPE;                                      <<03517>>01150000
      STYPE := LPDT(I+1).SUBTYPE;                              <<03517>>01152000
      IF DTYPE = MAGTAPE OR LPDT(I+1).(2:2)<>0 THEN            <<03517>>01154000
      BEGIN   << MAGTAPE OR JOB OR DATA ACCEPTING >>           <<07.EB>>01156000
         IF LOGICAL(K.(2:1)) << AVAILABLE >> THEN              <<07.EB>>01158000
         BEGIN  << DEVREC CAN TRY TO SET UP DEVICE >>                   01160000
         IF CHECKBUFFS THEN                                    <<04704>>01162000
            BEGIN  << SYSTEM BUFFER AVAILABLE >>                        01164000
            TASK(FTASK) := -1;                                          01166000
            GETBUFF; << NEW BUFFER POINTED TO BY BUF >>        <<14.EB>>01168000
            TASK(FTASK +1) := @BUF;                            <<14.EB>>01170000
            NC := 0;                                           <<14.EB>>01172000
            INDEV := I&LSR(1);                                          01174000
            OUTDEV := K.(7:9);  << FROM LDT >>                          01176000
            FLAGS := 0; << VAVREC,COMPEND =FALSE >>            <<07.EB>>01178000
            FLAGS.(11:5) := LPDT(I +1).(2:5);                  <<07.EB>>01180000
            TYPE := DTYPE;                                     <<03517>>01182000
            IF TYPE = TERMINAL THEN                            <<02857>>01184000
               SPECIAL'TERM := SPECIAL'TERMINAL(INDEV);        <<02857>>01186000
            IF DTYPE = MAGTAPE  AND        << Try AVR >>       <<03517>>01188000
               NOT LOGICAL(LPDT(I+1).TAPEREC)    THEN          <<03517>>01190000
            BEGIN                                              <<14.EB>>01192000
               DISABLE;                                        <<02857>>01194000
               LPDT(I +1).TAPEREC := TRUE;                     <<14.EB>>01196000
               ENABLE;                                         <<02857>>01198000
               FLAGS.IGNORERR := TRUE;                         <<14.EB>>01200000
               RA := @DOTAPE  << P ADDRESS OF TASK FOR TAPE >> <<07.EB>>01202000
            END                                                <<14.EB>>01204000
            ELSE                                               <<07.EB>>01206000
            BEGIN << JOB/HELLO/DATA FROM TERMINAL >>           <<07.EB>>01208000
                                                               <<07.EB>>01210000
            << COMMAND PENDING INDICATION FROM LPDT EOF >>              01212000
            IF NOT (LOGICAL (LPDT (I+1).(9:1))) AND                     01214000
                  LPDT (I+1).(7:3) <> 0 THEN                            01216000
               COMPEND := TRUE;                                <<07.EB>>01218000
                                                               <<07.EB>>01220000
            RA := @START;                                               01222000
            IF  INT  AND  INDEV = OUTDEV  THEN                          01224000
               BEGIN  << PRINT LF ON OUTDEV >>                          01226000
               TOS := ATTACHIO(OUTDEV,0,0,0,1,0,0,0,2);                 01228000
               DEL;                                                     01230000
               TASK(FTASK) := TOS;  << SAVE IOQ INDEX >>                01232000
               END;                                                     01234000
            END; << JOB/HELLO/DATA FROM TERMINAL >>            <<07.EB>>01236000
                                                               <<02857>>01238000
            SETSTATE(SERV'GRANTED);                            <<02857>>01240000
                                                               <<02857>>01242000
            IF SPECIAL'TERM THEN                               <<02857>>01244000
               BEGIN   << Terminal is logging on. >>           <<02857>>01246000
               DISABLE;                                        <<02857>>01248000
               LPDT(I+1).LOGON := TRUE;                        <<02857>>01250000
               ENABLE;                                         <<02857>>01252000
               END;                                            <<02857>>01254000
                                                               <<02857>>01256000
            FTASK := FTASK+2;                                           01258000
            END                                                         01260000
         ELSE                                                           01262000
            BEGIN  << DEFER REQUEST, NO BUFFER AVAILABLE >>             01264000
            RF := TRUE;                                                 01266000
            END                                                         01268000
         END                                                   <<00431>>01270000
         ELSE   <<DEVICE IS DOWN>>                             <<00431>>01272000
         BEGIN  <<SEE IF OWNED BY DIAGNOSTICS>>                <<00431>>01274000
            IF K.(3:1)=0  THEN  <<OWNER NOT DIAG>>             <<00431>>01276000
                 BEGIN                                         <<04632>>01278000
                 ATTACHIO(OUTDEV,0,0,0,DCLOSE,0,0,0,%13);      <<04632>>01280000
               SETSTATE(UNOWNED);                              <<03517>>01282000
                 END;                                          <<04632>>01284000
         END                                                   <<00431>>01286000
      END                                                      <<07.EB>>01288000
      ELSE                                                              01290000
                                                               <<03517>>01294000
      IF DIT'DISC'FLAG AND NOT'SYS'DISC OR SPLITDISC THEN      <<03517>>01296000
         BEGIN      << Handle non-system domain discs >>       <<03517>>01298000
                                                               <<03517>>01300000
<< DEVREC generally handles non-system domain disc       >>    <<04157>>01302000
<< interrupts by passing the buck to PVPROC.  This is    >>    <<04157>>01304000
<< is because DEVREC can't know whether the device was   >>    <<04157>>01306000
<< owned or unowned before its state became "service     >>    <<04157>>01308000
<< requested."  PVPROC will handle all interrupts for    >>    <<04157>>01310000
<< this case and will restore the device state properly. >>    <<04157>>01312000
         SETSTATE( SERV'GRANTED );                             <<04157>>01314000
         DISABLE;                                              <<04157>>01316000
         ABSOLUTE( PVRECG'CNT ) := ABSOLUTE( PVRECG'CNT )+1;   <<04157>>01318000
         ENABLE;                                               <<04157>>01320000
         AWAKE( ABSOLUTE(PVPROCPINX), %20, 0 );                <<04157>>01322000
                                                               <<04157>>01324000
      END     << of handling non-sys discs. >>                 <<04157>>01326000
                                                               <<04157>>01328000
      ELSE                                                     <<RH.PV>>01332000
         BEGIN  << CLEAR THE REQUEST, CLOSE DEVICE, MAKE AVAIL >>       01334000
         ATTACHIO(I&LSR(1),0,0,0,4,0,0,0,%13);                          01336000
         SETSTATE(UNOWNED);                                    <<03517>>01338000
         END;                                                           01340000
      END;                                                              01342000
                                                                        01344000
<<                                                                      01346000
   TASK DRIVER, POLLS FOR I/O COMPLETIONS, HANDLES ERRORS               01348000
>>                                                                      01350000
                                                                        01352000
I := -2;                                                                01354000
WHILE  (I:=I+2) < FTASK  DO                                             01356000
   IF  TASK(I) = -1  THEN  RUN                                          01358000
   ELSE                                                                 01360000
      BEGIN  << TEST I/O STATUS BEFORE RUNNING >>                       01362000
      L := IOSTATUS(TASK(I));                                           01364000
      IF  =  THEN   << COMPLETED >>                                     01366000
      BEGIN                                                    <<14.EB>>01368000
         @BUF := TASK(I +1); << GET FLAGS ADR. >>              <<14.EB>>01370000
         IF FLAGS.IGNORERR   << AVR of tape >>                 <<03517>>01372000
               OR                                              <<03517>>01374000
            STATUS.GSTATUS = OK'STATUS THEN RUN                <<03517>>01376000
         ELSE  IOFAIL;                                                  01378000
      END;                                                     <<07.EB>>01380000
      END;                                                              01382000
                                                                        01384000
<<                                                                      01386000
   ALL ITEMS HAVE BEEN CHECKED, CHECK FOR PROCESS STOP                  01388000
>>                                                                      01390000
                                                                        01392000
IF  PSTOP  THEN                                                         01394000
   BEGIN  << PROCESS STOP TIME >>                                       01396000
   WHILE  (I:=0) < FTASK  DO                                            01398000
      BEGIN                                                             01400000
      IF  TASK(I) <> -1 THEN                                   <<15.EB>>01402000
         BEGIN  << ABORT THE I/O IN PROGRESS >>                         01404000
         @BUF := TASK(I +1); << SET BUFFER ENVIRONMENT >>      <<15.EB>>01406000
         ABORTIO(INDEV);                                       <<15.EB>>01408000
         DO  IOSTATUS(TASK)  UNTIL  <=;                                 01410000
         END;                                                           01412000
      STOP;                                                             01414000
      END;                                                              01416000
   AWAKE(PROGEN,2,0);  << WAKE UP PROGENITOR >>                         01418000
   WAIT(0,0);                                                           01420000
   END;                                                                 01422000
                                                                        01424000
<<                                                                      01426000
   WAIT FOR MORE TO DO                                                  01428000
>>                                                                      01430000
                                                                        01432000
COMMENT:                                                       <<01662>>01434000
   BEFORE DOING A 'WAIT' CHECK WHETHER ALL TASKS ARE           <<01662>>01436000
   COMPLETED. (THE WWS FOR SERVICE REQUESTED OR                <<01662>>01438000
   COMPLETION OF UNBLOCKED IO MAY HAVE BEEN CLEARED            <<01662>>01440000
   WHEN BLOCKED IO WAS PERFORMED -- AS IS DONE IN              <<01662>>01442000
   STARTDEVICE.);                                              <<01662>>01444000
                                                               <<01662>>01446000
IF  RF  THEN  DELAY(1000D)                                     <<01662>>01448000
ELSE IF NOT TASK'PENDING THEN WAIT(-%120,0);                   <<01662>>01450000
GO BICYCLE;                                                             01452000
HELP;                                                                   01454000
$PAGE "MAG TAPE AUTO VOLUME RECOGNITION CODE"                  <<02857>>01458000
DOTAPE:                                                        <<14.EB>>01460000
                                                               <<02564>>01462000
   << Make sure that tape is rewound before start. >>          <<02564>>01464000
   IO(INDEV,0,0,0,REWIND,0,0);                                 <<02564>>01466000
                                                               <<02564>>01468000
   CASE CHECK'AVR'STATUS(INDEV,STATUS.(8:8),FALSE) OF          <<02721>>01472000
      BEGIN                                                    <<02721>>01474000
                                                               <<02721>>01476000
      ;           << 0 - OK, continue >>                       <<02721>>01478000
                                                               <<02721>>01480000
      GO DOTAPE;  << 1 - Restart on power problems >>          <<02721>>01482000
                                                               <<02721>>01484000
      BEGIN       << 2 - I/O error.  Quit >>                   <<02721>>01486000
      CLEANLDEV(INDEV);   << Zero out TLT entry >>             <<02721>>01488000
      IOFAIL;             << Free device and task buffer >>    <<02721>>01490000
      ASSEMBLE(SXIT 0);   << Return to task driver >>          <<02721>>01492000
      END;                                                     <<02721>>01494000
                                                               <<02721>>01496000
      ;           << 3 - Can't happen, IGNORE = FALSE >>       <<02721>>01498000
                                                               <<02721>>01500000
      END;   << of case statement >>                           <<02721>>01502000
                                                               <<02721>>01504000
                                                               <<02721>>01506000
   FLAGS.VAVREC := FALSE;   << First record on tape >>         <<02721>>01508000
                                                               <<02721>>01510000
MORE'LABELS:                                                   <<02721>>01512000
                                                               <<14.EB>>01514000
IO(INDEV,0,0,@BUF(CHAROFFSET),0,40,0);                         <<14.EB>>01516000
   << READ 40 WORDS ON INDEV INTO BUF AT CHAROFFSET >>         <<14.EB>>01518000
                                                               <<02721>>01522000
CASE CHECK'AVR'STATUS(INDEV,STATUS.(8:8),TRUE) OF              <<02721>>01524000
   BEGIN                                                       <<02721>>01526000
                                                               <<02721>>01528000
   ;           << 0 - OK, continue >>                          <<02721>>01530000
                                                               <<02721>>01532000
   GO DOTAPE;  << 1 - Restart on power problems >>             <<02721>>01534000
                                                               <<02721>>01536000
   BEGIN       << 2 - I/O error.  Quit >>                      <<02721>>01538000
   CLEANLDEV(INDEV);   << Zero out TLT entry >>                <<02721>>01540000
   IOFAIL;             << Free device and task buffer >>       <<02721>>01542000
   ASSEMBLE(SXIT 0);   << Return to task driver >>             <<02721>>01544000
   END;                                                        <<02721>>01546000
                                                               <<02721>>01548000
   TLOG := 0;  << 3 - Ignored error >>                         <<02721>>01550000
                                                               <<02721>>01552000
   END;   << of case statement >>                              <<02721>>01554000
                                                               <<02721>>01556000
IF NOT AVREC(INDEV,BUF(CHAROFFSET),TLOG,1 +FLAGS.VAVREC) THEN  <<14.EB>>01558000
   BEGIN  << Must read another record >>                       <<02564>>01562000
   FLAGS.VAVREC := TRUE;  << Signal 2nd or greater to AVREC >> <<02564>>01564000
   GO MORE'LABELS;                                             <<02564>>01566000
   END;                                                        <<02564>>01568000
                                                               <<14.EB>>01570000
<< AVREC has taken care of marking the BOT bit for all >>      <<02564>>01572000
<< tape drives.  Now, if variable density drive, must  >>      <<02564>>01574000
<< determine density of tape on drive.                 >>      <<02564>>01576000
                                                               <<02564>>01578000
IF (VARIABLE'DENSITY) THEN                                     <<02564>>01580000
   BEGIN                                                       <<02564>>01582000
                                                               <<02564>>01584000
   IO(INDEV,0,0,@BUF(CHAROFFSET),READ'STATUS,-5,0);            <<02564>>01586000
                                                               <<02564>>01588000
   CASE CHECK'AVR'STATUS(INDEV,STATUS.(8:8),FALSE) OF          <<02721>>01592000
      BEGIN                                                    <<02721>>01594000
                                                               <<02721>>01596000
      ;           << 0 - OK, continue >>                       <<02721>>01598000
                                                               <<02721>>01600000
      GO DOTAPE;  << 1 - Restart on power problems >>          <<02721>>01602000
                                                               <<02721>>01604000
      BEGIN       << 2 - I/O error.  Quit >>                   <<02721>>01606000
      CLEANLDEV(INDEV);   << Zero out TLT entry >>             <<02721>>01608000
      IOFAIL;             << Free device and task buffer >>    <<02721>>01610000
      ASSEMBLE(SXIT 0);   << Return to task driver >>          <<02721>>01612000
      END;                                                     <<02721>>01614000
                                                               <<02721>>01616000
      ;           << 3 - Can't happen, IGNORE = FALSE >>       <<02721>>01618000
                                                               <<02721>>01620000
      END;   << of case statement >>                           <<02721>>01622000
                                                               <<02721>>01624000
   << Put density into data structure. >>                      <<02721>>01626000
   STORE'DENSITY(INDEV,BUF(CHAROFFSET),1);                     <<02721>>01628000
                                                               <<02721>>01630000
   END;   << of variable density drive. >>                     <<02721>>01632000
                                                               <<02721>>01634000
   << AVREC HAS TAKEN PLACE. TAPE IS AS IF NOTHING HAPPENED >> <<14.EB>>01636000
   << NOW TRY TO READ JOB/DATA ACCEPTING TAPES              >> <<14.EB>>01638000
IF LPDT(INDEV*2 +1).(2:2) = 0 THEN                             <<14.EB>>01640000
BEGIN      << Not job/data accepting.  Done with tape. >>      <<02721>>01642000
   CLEAR'LPDT;      << Set device unowned >>                   <<02564>>01644000
   LABELED'DEV'MOUNTED(INDEV);  << Tell LABSEG tape mounted >> <<03617>>01646000
   STOP;            << Release task buffer >>                  <<02564>>01648000
   ASSEMBLE( SXIT 0); << RETURN CONTROL TO TASK DRIVER, >>     <<14.EB>>01652000
                      << WHO CALLED RUN SUBROUTINE     >>      <<14.EB>>01654000
END;                                                           <<14.EB>>01656000
                                                               <<14.EB>>01658000
   << FALL THROUGH TO TRY TO READ :JOB OR :DATA ON TAPE >>     <<14.EB>>01660000
RA := @START;  << CHANGE TASK CODE >>                          <<14.EB>>01662000
FLAGS.IGNORERR := FALSE; << CLEAR THIS >>                      <<14.EB>>01664000
                                                               <<14.EB>>01666000
                                                               <<14.EB>>01668000
$PAGE "JOB/HELLO/DATA/(CMD) RECOGNITION CODE"                  <<02857>>01672000
START:                                                                  01674000
                                                                        01676000
ERRNUM := PARMNUM := 0;                                        <<00723>>01678000
IF  INT  AND  (OUTDEV = INDEV)  THEN  << P R O M P T >>                 01680000
   IO(OUTDEV,0,0,@PROMPT,25,(INTEGER(COMPEND)-1),%320);                 01682000
COMPEND := FALSE;    <<1ST READ GETS PENDING COMMAND>>                  01684000
                                                                        01686000
READ'LOGON:                                                    <<02564>>01688000
                                                                        01690000
CHAR(NC) := " ";  << BLANK OUT FIRST CHARACTER >>                       01692000
IO(INDEV,0,0,@BUF(CHAROFFSET +NC&LSR(1)),0,NC -MAXL,1);        <<14.EB>>01694000
IF  NOT INT  AND  CHAR(NC) <> ":"  THEN                                 01696000
   BEGIN  << FLUSHING >>                                                01698000
   NC := 0;                                                             01700000
   GO READ'LOGON;                                              <<02564>>01702000
   END;                                                                 01704000
NC := NC-TLOG;                                                          01706000
IF CHAR(NC-1) = " " THEN                                                01708000
   BEGIN  <<STRIP TRAILING BLANKS>>                                     01710000
   IF CHAR(NC-2) <> CHAR(NC-1) , (1-NC) , 0                             01712000
         THEN TOS := -TOS;                                              01714000
   NC := TOS;                                                           01716000
   DDEL;                                                                01718000
   END;                                                                 01720000
                                                               <<01110>>01722000
LPAREN := 0;                                                   <<00.04>>01724000
IF INT THEN                                                    <<00.04>>01726000
   BEGIN    <<INTERACTIVE>>                                    <<00.04>>01728000
   IF CHAR = "(" THEN LPAREN := 1;  <<NORMAL ASCII>>           <<00.04>>01730000
   IF CHAR = %53 THEN LPAREN := 2;  <<APL BIT PAIR>>           <<00.04>>01732000
   IF CHAR = %72 THEN                                          <<01110>>01734000
     BEGIN                                                     <<01110>>01736000
                                                               <<01110>>01738000
     COMMENT  THE  FIRST CHARACTER COULD BE A %72 IF THE       <<01110>>01740000
      DEVICE IS AN APL TYP PAIR TERMINAL OR A JOB COMMAND WAS  <<01110>>01742000
      ISSUED FROM WITHIN A JOB ON AN INTERACTIVE DEVICE.;      <<01110>>01744000
                                                               <<01110>>01746000
     MOVE TEMP := CHAR(1),(3);                                 <<01110>>01748000
     TEMP(3) := 0;                                             <<01110>>01750000
     MOVE TEMP := TEMP WHILE AS;                               <<01110>>01752000
     IF TEMP = "JOB" THEN                                      <<01110>>01754000
       FLAGS.(15:1) := 0        << JOB COMMAND. INT OFF >>     <<01110>>01756000
     ELSE                                                      <<01110>>01758000
       LPAREN := 3              << APL TYP PAIR >>             <<01110>>01760000
     END                                                       <<01110>>01762000
   END;                                                        <<00.04>>01764000
IF  NC >= MAXL  THEN                                                    01766000
   BEGIN  << IMAGE TOO LONG >>                                          01768000
   ERRNUM := TOOLONG;                                          <<00534>>01770000
   GO ERROR;                                                            01772000
   END;                                                                 01774000
IF LPAREN <= 1 AND CHAR(NC-1) = "&" THEN                       <<00.04>>01776000
   BEGIN  << CONTINUATION EXPECTED >>                                   01778000
    IF NC = MAXL-1 THEN  << TOO LONG BECAUSE CONTINUATION IN 24<<02328>>01780000
        BEGIN                                                  <<02328>>01782000
        ERRNUM := TOOLONG;                                     <<02328>>01784000
        GO ERROR;                                              <<02328>>01786000
        END;                                                   <<02328>>01788000
   IF  LOGICAL( NC )  THEN                                              01790000
      BEGIN  << ODD READ, PAD WITH A BLANK >>                           01792000
      CHAR(NC) := " ";                                                  01794000
      NC := NC+1;                                                       01796000
      END;                                                              01798000
   GO START;                                                            01800000
   END;                                                                 01802000
                                                                        01804000
<< COMMAND IMAGE IN, NOW PROCESS IT >>                                  01806000
J := K := 0;                                                            01808000
                                                               <<00.04>>01810000
IF LPAREN > 1 THEN                                             <<00.04>>01812000
   BEGIN                                                       <<00.04>>01814000
   K :=  NC;                                                   <<00.04>>01816000
   GOTO LP1;                                                   <<00.04>>01818000
   END;                                                        <<00.04>>01820000
                                                                        01822000
WHILE  J < NC  DO                                                       01824000
   BEGIN                                                                01826000
   IF  CHAR(J) = "&" THEN  CHAR(J) := " ";                              01828000
   IF  CHAR(J) <> ":"  THEN                                             01830000
      BEGIN  << MOVE IT >>                                              01832000
      CHAR(K) := CHAR(J);                                               01834000
      K := K+1;                                                         01836000
      END;                                                              01838000
   J := J+1;                                                            01840000
   END;                                                                 01842000
                                                                        01844000
LP1:                                                           <<00.04>>01846000
<< IMAGE MOVED, COLONS AND &'S REMOVED, K = #CHARS >>                   01848000
IF  K = 0  THEN                                                         01850000
   BEGIN  << NULL IMAGE >>                                              01852000
   ERRNUM := 0;                                                <<00534>>01854000
   GO ERROR;                                                            01856000
   END;                                                                 01858000
                                                                        01860000
CHAR(K) := %15;   << STOPPER FOR STARTDEVICE >>                         01862000
IF LPAREN <> 0 THEN                                            <<00.04>>01864000
   BEGIN                                                       <<00.04>>01866000
   J := @CHAR;                                                 <<00.04>>01868000
   K := LPAREN+2;                                              <<00.04>>01870000
   GOTO LP2;                                                   <<00.04>>01872000
   END;                                                        <<00.04>>01874000
                                                               <<00.04>>01876000
MOVE  CHAR := CHAR WHILE AS,1;  << UPSHIFT THE COMMAND >>               01878000
J := S0;   << PARAMETER LIST POINTER >>                                 01880000
K := TOS-@CHAR-3; << COMMAND LENGTH-3 >>                                01882000
                                                                        01884000
IF  <  OR  K > 2  OR  CHAR <> COM(K*8),(K+3)  THEN                      01886000
   BEGIN  << ILLEGAL COMMAND >>                                         01888000
   ERRNUM := INVCOMMAND;                                       <<00534>>01890000
   GO ERROR;                                                            01892000
   END;                                                                 01894000
LP2:                                                           <<00.04>>01896000
K := K*8 +7; << CHECK IF DEVICE IS CONFIGURED OK >>            <<14.EB>>01898000
IF (LOGICAL(COM(K)) LAND FLAGS.(11:5)) <> LOGICAL(COM(K))      <<14.EB>>01900000
   THEN <<J & NOT J, S & NOT J OR NOT I, D & NOT A >>          <<07.EB>>01902000
   BEGIN  << DEVICE CAN'T DO IT >>                                      01904000
   ERRNUM := DEVCANT;                                          <<00534>>01906000
   GO ERROR;                                                            01908000
   END;                                                                 01910000
STARTDEVICE(COM(X:=X-1),J,INDEV,,,,,ERRNUM,PARMNUM);           <<00534>>01912000
IF ERRNUM <= 0 THEN                                            <<00558>>01914000
   BEGIN  << DEVICE RECOGNIZED, DEVREC IS THROUGH >>                    01916000
   STOP;                                                                01918000
   ASSEMBLE( SXIT 0 );  << RETURN TO CALLER OF RUN >>                   01920000
   END;                                                                 01922000
                                                                        01924000
ERROR:   << SET UP AND PRINT THE ERROR MESSAGE >>                       01926000
                                                                        01928000
IF INDEV <> OUTDEV THEN OUTDEV := 0;<<CONSOLE>>                <<14.EB>>01930000
IF ERRNUM < 0 THEN ERRNUM := -ERRNUM;                          <<00534>>01932000
IF 1 <= ERRNUM <= MAXDEVRECERR THEN                            <<00534>>01934000
   GENMSG(CISET,ERRNUM,,,,,,,OUTDEV);                          <<00534>>01936000
NC := 0; << ZERO CHARACTER COUNT >>                                     01938000
GO START;  << CONTINUE READING >>                              <<14.EB>>01940000
END.  << Program DEVREC >>                                     <<02564>>01942000
