$CONTROL USLINIT,CODE,MAP                                      <<01549>>00010000
<<ALLOCATE - MODULE 54>>                                       <<01549>>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
                                                               <<04620>>00028000
                                                               <<04620>>00030000
$THIRTY                                                                 00032000
$CONTROL PRIVILEGED                                            <<00652>>00034000
$CONTROL MAIN=ALOCATE                                          <<00652>>00036000
BEGIN                                                                   00038000
                                                               <<03698>>00040000
<<  Changes made to ALLOCATE module since 1/19/82          >>  <<03698>>00042000
                                                               <<03698>>00044000
<<  Fix the check made for tapes and serial discs for      >>  <<03698>>00046000
<<  unlabeled "tapes".                                     >>  <<03698>>00048000
                                                               <<03698>>00050000
<< Make sure a request for disc (fdisc/sdisc) fails if PV  >>  <<03788>>00052000
<<  is on the ldev.                                        >>  <<03788>>00054000
<< New option in DEALLOCATE for MORGUE.                    >>  <<04201>>00056000
<< Release LDTSIR before ATTACHIO calls in DEALLOCATE.       >><<04843>>00058000
<< Take out Halt 0                                         >>  <<04622>>00060000
                                                               <<04622>>00062000
$PAGE "***  GENERAL/GLOBAL EQUIVALENCES   ***"                          00064000
DEFINE                                                                  00066000
           A                 = ABSOLUTE          #,                     00068000
           ASMB              = ASSEMBLE          #,                     00070000
           ENAPROC           = ASSEMBLE(PSEB)    #,                     00072000
           DISAPROC          = ASSEMBLE(PSDB)    #,                     00074000
           DISABLE           = ASSEMBLE(SED 0)   #,                     00076000
           ENABLE            = ASSEMBLE(SED 1)   #;                     00078000
DEFINE                                                         <<03546>>00080000
           LOCK             = 16                 #,            <<03546>>00082000
           UNLOCK           = 17                 #;            <<03546>>00084000
INTEGER                                                                 00086000
           DB0               = DB+0  ,                                  00088000
           DB1               = DB+1  ,                                  00090000
           DB2               = DB+2  ,                                  00092000
           DB3               = DB+3  ,                                  00094000
           DB4               = DB+4  ,                                  00096000
           DB5               = DB+5  ,                                  00098000
           S0                = S-0   ,                                  00100000
           X                 = X     ,                                  00102000
           XREG              = X     ;                                  00104000
LOGICAL                                                                 00106000
           LDB3              = DB+3  ;                                  00108000
INTEGER POINTER                                                         00110000
           PDB0              = DB+0  ,                                  00112000
           PDB1              = DB+1  ,                                  00114000
           PDB2              = DB+2  ,                                  00116000
           PS0               = S-0   ;                                  00118000
DOUBLE     DS1               = S-1;                                     00120000
$PAGE "***   SPOOLING CONSTANTS   ***"                                  00122000
EQUATE                                                                  00124000
<< SPOOLING SIRS >>                                                     00126000
           LDTSIR            = 10    ,                                  00128000
           LPDTSIR           = 9     ,                                  00130000
           LPDSIR            = 9     ,                                  00132000
           IDDSIR            = 3     ,                                  00134000
           ODDSIR            = 4     ,                                  00136000
           MVTABSIR          = 27    ,                         <<RH.PV>>00138000
<< DATA SEGMENT NUMBERS >>                                              00140000
           IDDDST            = 45    ,                                  00142000
           ODDDST            = 46    ,                                  00144000
           LDTDST            = 14    ,                                  00146000
           LDTDSTN           = 14    ,                                  00148000
           LPDTDST           = 13    ,                                  00150000
           LPDDSTN           = 13    ,                                  00152000
           MVTABDST          = 53    ,                         <<RH.PV>>00154000
<< TABLE SIZE CONSTANTS >>                                              00156000
           LPDTSIZE          = 2     ,                                  00158000
           LDTSIZE           = 5     ,                                  00160000
           LDTXSIZE          = 5     ,                         <<SD.00>>00162000
           PCBSIZE           = 16    ,                                  00164000
           XDDHSIZE          = 4     ,                                  00166000
           IDDHSIZE          = XDDHSIZE ,                               00168000
           ODDHSIZE          = XDDHSIZE ,                               00170000
           XDDSIZE           = 30    ,                                  00172000
           IDDSIZE           = XDDSIZE  ,                               00174000
           ODDSIZE           = XDDSIZE  ,                               00176000
           MVTABSIZE         = 21    ,                         <<RH.PV>>00178000
           MAXVOLNUM         =  8    ,                         <<RH.PV>>00180000
<< LOW MAIN MEMORY >>                                                   00182000
           CSTB              = 0     ,                                  00184000
           XCSTB             = 1     ,                                  00186000
           DSTB              = 2     ,                                  00188000
           PCBB              = 3     ,                                  00190000
           CPCB              = 4     ;                                  00192000
$PAGE "***   SYSTEM GLOBAL TABLE - SYSDB   ***"                         00194000
<< SYSTEM GLOBAL TABLE - SYSDB >>                                       00196000
EQUATE                                                                  00198000
           AVR               = %1346,                          <<TL.02>>00200000
           LPDTBASE          = %10   ,                                  00202000
           MAXSSECT          = %100,                                    00204000
           NUMSSECT          = %102,                                    00206000
           EXTSSECT          = %104,                                    00208000
           SPOOLINDEX        = %132,                                    00210000
           JOBSYNC           = %121  ,                                  00212000
           SPOOLLOGM         = %167  ;                                  00214000
DEFINE                                                                  00216000
           ABSYS             = %1000              #,                    00218000
           ABSYS'LPDTBASE    = A(ABSYS+LPDTBASE)  #,                    00220000
           ABSYS'MAXSS       = A(ABSYS+MAXSSECT)  #,                    00222000
           ABSYS'NUMSS       = A(ABSYS+NUMSSECT)  #,                    00224000
           ABSYS'EXTSS       = A(ABSYS+EXTSSECT)  #,                    00226000
           ABSYS'SINDEX      = A(ABSYS+SPOOLINDEX)#,                    00228000
           PUSHMAXSS         = TOS := ABSYS'MAXSS;                      00230000
                               TOS := A (XREG+1)  #,                    00232000
           PUSHNUMSS         = TOS := ABSYS'NUMSS;                      00234000
                               TOS := A (XREG+1)  #,                    00236000
           POPNUMSS          = A(ABSYS+NUMSSECT+1) := TOS;              00238000
                               A (XREG-1) := TOS  #,                    00240000
           ABSYS'JOBSYNC     = A(ABSYS+JOBSYNC)   #,                    00242000
             JOBREADY'F      = 13:1               #,                    00244000
             DEVFDREED'F     = 14:1               #,                    00246000
             JOBWAITING'F    = 15:1               #,                    00248000
           ABSYS'UCOPPCBT    = A(ABSYS+PCBT+UCOPPCBT)#,                 00250000
           ABSYS'DRECPCBT    = A(ABSYS+PCBT+DRECPCBT)#,                 00252000
           ABSYS'SPOOLLOGM   = A(ABSYS+SPOOLLOGM) #;                    00254000
POINTER                                                                 00256000
           SYS'LPDTP         = LPDTBASE  ;                              00258000
$PAGE "***   PROCESS CONTROL BLOCK - PCB   ***"                         00260000
<< PROCESS CONTROL BLOCK - PCB >>                                       00262000
DEFINE                                                                  00264000
           ABPCB             = A(PCBB)   #,                             00266000
           ABCPCB            = A(CPCB)   #,                             00268000
           ABCURPIN          = (ABCPCB-ABPCB)/PCBSIZE #;                00270000
EQUATE                                                                  00272000
           DADWAIT           = 1     ,                                  00274000
           SONWAIT           = 2     ,                                  00276000
           JUNKWAIT          = %20   ;                                  00278000
EQUATE                                                                  00280000
           UCOPLPIN          = 2     ,                                  00282000
           DRECLPIN          = 4     ;                                  00284000
DEFINE                                                                  00286000
           PCB'XDST          = 2).(1:10    #;                           00288000
$PAGE "***   LOGICAL - PHYSICAL DEVICE TABLE - LPDT   ***"              00290000
<< LOGICAL - PHYSICAL DEVICE TABLE - LPDT >>                            00292000
INTEGER POINTER LPDT' = 8;                                     <<03681>>00294000
DEFINE                                                                  00296000
  << Used in ASKOP >>                                          <<03681>>00298000
           LPDT'1=LPDT'(DEVTOCONSIDER*LPDT'ENTRYSIZE+1)#,      <<03681>>00300000
   << PREFIX >>                                                         00302000
           LPDT'HIENTRY      = DB0.(0:8)         #,                     00304000
           LPDT'ENTRYSIZE    = DB0.(8:8)         #,                     00306000
           LPDT'SERVREQS     = DB1               #,                     00308000
           LPDT'SERVREQ      = 1                 #,                     00310000
   << ENTRY >>                                                          00312000
           LP'DITP           = 0                 #,                     00314000
           LP'VIRTUALF       = 0:1               #,                     00316000
           LP'IDD'ODDF       = 1:1               #,                     00318000
           LP'XDDPF          = 2:14              #,                     00320000
           LP'VIRTDEV        = 1                 #,                     00322000
           LP'SS             = 1).(0:2           #,                     00324000
              DEVAVAIL       = 0                 #,                     00326000
              DEVOWNED       = 1                 #,                     00328000
              DEVSERVICE     = 2                 #,                     00330000
              DEVRESERVED    = 3                 #,                     00332000
           LP'J              = 1).(2:1           #,                     00334000
           LP'A              = 1).(3:1           #,                     00336000
           LP'JA             = 1).(2:2           #,                     00338000
           LP'CTLY           = 1).(4:1           #,                     00340000
           LP'D              = 1).(5:1           #,                     00342000
           LP'M              =    (5:1)          #,            <<03681>>00344000
           LP'I              = 1).(6:1           #,                     00346000
           LP'EOF            = 1).(7:3           #,                     00348000
           LP'B              = 1).(10:1          #,                     00350000
           LP'L              = 1).(11:1          #,                     00352000
SDLF=(10:1)#,                                                  <<SD.00>>00354000
FORS=(11:1)#,                                                  <<01115>>00356000
           LP'SUBTYPE  = 1).(12:4                #,            <<04620>>00358000
           LP'AUTOALLOC      = 1).(12:1          #;            <<02566>>00360000
$PAGE "***   LOGICAL DEVICE TABLE - LDT / DCT   ***"                    00362000
<< LOGICAL DEVICE TABLE - LDT / DCT >>                                  00364000
DEFINE                                                                  00366000
   << PREFIX >>                                                         00368000
           LDT'HIENTRY       = DB0.(0:8)         #,                     00370000
           LDT'ENTRYSIZE     = DB0.(8:8)         #,                     00372000
           LDT'DCTP          = PDB1              #,                     00374000
          LDT'DCT           = DB1               #,             <<SD.00>>00376000
           LDT'NUMCLASS      = DB2               #,                     00378000
           LDT'DCTSIZE       = DB3               #,                     00380000
           LDT'STREAMDEV     = DB4.(8:8)         #,                     00382000
   << ENTRY >>                                                          00384000
           LD'USECOUNT       = 0                 #,                     00386000
           LD'MAINPIN        = 1).(0:8           #,                     00388000
           LD'VTABX          = 1).(0:8           #,                     00390000
           LD'CTLYPIN        = 1).(8:8           #,                     00392000
           LD'RWIDTH         = 2).(0:8           #,                     00394000
           LD'CS             = 2).(8:1           #,                     00396000
           LD'FO             = 2).(9:1           #,                     00398000
           LD'DEVTYPE        = 2).(10:6          #,                     00400000
              PRINTER        = 32                #,                     00402000
              CARDPUNCH      = 33                #,                     00404000
              PLOTTER        = 35                #,                     00406000
              READERPUNCH    = 20                #,                     00408000
              CARDREADER     = 8                 #,                     00410000
              MAGTAPE        = 24                #,                     00412000
              SDISC          = 31                #,            <<SD.00>>00414000
              FDISC          = 07                #,            <<01115>>00416000
              DISC           = 0                 #,            <<SD.00>>00418000
              DISC2          = 2                 #,            <<03512>>00420000
              DISC3          = 3                 #,            <<03512>>00422000
              SDISCTYPE      = 3                 #,            <<SD.00>>00424000
              CS80'DEVICE    = 3                 #,            <<03607>>00426000
              NOT'PV'OR'SYS  = 4                 #,            <<SD.00>>00428000
              TERMINAL       = 16                #,            <<00.05>>00430000
           LD'BASICTYPE'F    = 10:3              #,                     00432000
           LD'BASICTYPE      = 2).(LD'BASICTYPE'F #,                    00434000
              DEVDISC        = 0                 #,            <<01899>>00436000
              DEVIN          = 1                 #,                     00438000
              DEVCONIO       = 2                 #,                     00440000
              DEVSERIO       = 3                 #,                     00442000
              DEVOUT         = 4                 #,                     00444000
           LD'SP             = 3).(0:2           #,                     00446000
             NOSPOOLER       = 0                 #,                     00448000
             INPUTSPOOLER    = 1                 #,                     00450000
             INPUTSPOOFLE    = 1                 #,                     00452000
             OUTPUTSPOOLER   = 2                 #,                     00454000
             OUTPUTSPOOFLE   = 2                 #,                     00456000
           LD'F              = 3).(2:1           #,                     00458000
           LD'M              = 3).(3:1           #,                     00460000
           LD'R              = 3).(4:1           #,                     00462000
           LD'HTOFF          = 3).(5:2           #,                     00464000
           LD'C              = 3).(7:1           #,                     00466000
           LD'OUTDEV         = 3).(8:8           #,                     00468000
           LD'SQ             = 4).(7:1           #,                     00470000
           LD'XDDHEADX       = 4).(8:8           #,                     00472000
<< DEVICE CLASS TABLE - DCT >>                                          00474000
   << ENTRY >>                                                          00476000
           DC'CLASSNAME      = 0                 #,                     00478000
           DC'CLASSNAME'B    = 0                 #,                     00480000
           DC'CYCLICALP      = 4).(1:7           #,                     00482000
            DC'SQ             = 4).(8:1           #,           <<00635>>00484000
           DC'CLASSTYPE      = 4).(10:6          #,                     00486000
           DC'BASICTYPE      = 4).(10:3          #,                     00488000
           DC'NUMDEVS        = 5).(0:8           #,                     00490000
           DC'FIRSTDEV       = 5).(8:8           #,                     00492000
           DC'FIRSTDEV'B     = 11                #;                     00494000
$INCLUDE INCLLDT                                               <<04426>>00496000
$INCLUDE INCLLDTX                                              <<04426>>00498000
$PAGE "***   COMMON FIELDS OF JMAT, IDD, ODD   ***"                     00500000
DEFINE                                                                  00502000
   << PREFIX >>                                                         00504000
           TBL'MAXSIZE       = DB0.(0:8)         #,                     00506000
           TBL'CURSIZE       = DB0.(8:8)         #,                     00508000
              TBLQUANTUM     = 128               #,                     00510000
           TBL'ENTRYSIZE     = DB1.(8:8)         #,                     00512000
           TBL'ENTRYAREAP    = PDB2              #,                     00514000
           << CHAINS DEFINED BY "HEAD" POINTER,                         00516000
              IMMEDIATELY FOLLOWED BY "TAIL" POINTER.                   00518000
              EACH POINTS TO WD 0 OF ENTRY.                             00520000
              NULL CHAIN:  HEAD = 0;  TAIL = @HEAD.                     00522000
              CHAIN TERMINATED BY 0 LINK.                               00524000
           >>                                                           00526000
           TTCHAINEND        = 0                 #,                     00528000
           TT'INUSEWORD      = 0                 #,                     00530000
              FREEENTRY      = 0                 #,                     00532000
           TT'JTYPE          = 1).(0:2           #,                     00534000
              SESSIONTYPE    = 1                 #,                     00536000
              BATCHTYPE      = 2                 #,                     00538000
           TT'JNUM           = 1).(2:14          #,                     00540000
           TT'JOBNUM         = 1                 #,                     00542000
           TT'UNAME          = 2                 #,                     00544000
           TT'ANAME          = 6                 #,                     00546000
           TT'JNAME          = 10                #,                     00548000
           TT'LINKP'W        = 25                #,                     00550000
           TT'LINKP          = TT'LINKP'W        #;                     00552000
$PAGE "***   DEVICE DIRECTORIES: GENERAL - XDD   ***"                   00554000
<< DEVICE DIRECTORIES: GENERAL - XDD >>                                 00556000
DEFINE                                                                  00558000
   << PREFIX >>                                                         00560000
           XDD'MAXSIZE       = TBL'MAXSIZE       #,                     00562000
           XDD'CURSIZE       = TBL'CURSIZE       #,                     00564000
           XDD'HEADSIZE      = DB1.(0:8)         #,                     00566000
           XDD'SUBSIZE       = TBL'ENTRYSIZE     #,                     00568000
           XDD'SUBAREAP      = TBL'ENTRYAREAP    #,                     00570000
           XDD'ODD           = LDB3.(0:1)        #,                     00572000
           XDD'NEXTDFID      = DB3               #,                     00574000
           XDD'OUTFENCE      = DB4.(12:4)        #,                     00576000
   << HEAD ENTRY >>                                                     00578000
           XD'HLDEV          = 0).(8:8           #,                     00580000
           XD'HHEADP         = 1                 #,                     00582000
              DEVCHAINEND    = TTCHAINEND        #,                     00584000
           XD'HTAILP         = 2                 #,                     00586000
           XD'HREALP         = 3                 #,                     00588000
   << SUBENTRY >>                                                       00590000
           XD'STATE          = 0).(1:2           #,                     00592000
              DFACTIVE       = 0                 #,                     00594000
              DFREADY        = 1                 #,                     00596000
              DFOPENED       = 2                 #,                     00598000
              DFRESERVED     = 3                 #,                     00600000
           XD'OUTPRI         = 0).(3:4           #,                     00602000
           XD'C              = 0).(7:1           #,                     00604000
           XD'DEVICE         = 0).(8:8           #,                     00606000
           XD'JTYPE          = TT'JTYPE          #,                     00608000
           XD'JNUM           = TT'JNUM           #,                     00610000
           XD'JOBNUM         = TT'JOBNUM         #,                     00612000
           XD'UNAME          = TT'UNAME          #,                     00614000
           XD'ANAME          = TT'ANAME          #,                     00616000
           XD'JNAME          = TT'JNAME          #,                     00618000
           XD'FNAME          = 14                #,                     00620000
           XD'DEVFILEID      = 18                #,                     00622000
           XD'TEF            = 19).(0:1          #,                     00624000
           XD'DATA           = 19).(1:1          #,                     00626000
           XD'XDDHEADX       = 19).(8:8          #,                     00628000
   << SPOOFLE EXTENSION >>                                              00630000
           XD'SPOOLFILE      = 20                #,                     00632000
           XD'LOGDEV         = 20).(0:8          #,                     00634000
           XD'HIGHADDR       = 20).(8:8          #,                     00636000
           XD'SPOOLFILE'D    = 10                #,                     00638000
           XD'LOWADDR        = 21                #,                     00640000
           XD'NUMEXT         = 22).(0:8          #,                     00642000
           XD'VDEV           = 22).(8:8          #,                     00644000
           XD'LASTEXT        = 23                #,                     00646000
           XD'RECOVERY       = 24                #,                     00648000
           XD'SQEEZE         = 24).(0:1          #,                     00650000
           XD'RESTART        = 24).(2:1          #,                     00652000
           XD'FOD            = 24).(3:1          #,                     00654000
           XD'NOSPACE        = 24).(4:1          #,                     00656000
           XD'ABORT          = 24).(5:1          #,            <<SP.SZ>>00658000
           XD'NUMCOPIES      = 24).(8:8          #,                     00660000
           XD'LINKP'W        = TT'LINKP'W        #,                     00662000
           XD'LINKP          = TT'LINKP          #,                     00664000
           XD'NUMLINES0      = 26                #,                     00666000
           XD'NUMLINES1      = 27                #,                     00668000
           XD'NUMLINES'D     = 13                #,                     00670000
           XD'TIMEREADY0     = 28                #,                     00672000
           XD'TIMEREADY1     = 29                #,                     00674000
           XD'TIMEREADY'D    = XD'TIMEREADY0/2   #;                     00676000
$PAGE "***   INPUT DEVICE DIRECTORY - IDD   ***"                        00678000
<<INPUT DEVICE DIRECTORY - IDD >>                                       00680000
DEFINE                                                                  00682000
   << PREFIX >>                                                         00684000
           IDD'MAXSIZE       = XDD'MAXSIZE       #,                     00686000
           IDD'CURSIZE       = XDD'CURSIZE       #,                     00688000
           IDD'HEADSIZE      = XDD'HEADSIZE      #,                     00690000
           IDD'SUBSIZE       = XDD'SUBSIZE       #,                     00692000
           IDD'SUBAREAP      = XDD'SUBAREAP      #,                     00694000
           IDD'NEXTDFID      = XDD'NEXTDFID      #,                     00696000
   << HEAD ENTRY >>                                                     00698000
           ID'HLDEV          = XD'HLDEV          #,                     00700000
           ID'HHEADP         = XD'HHEADP         #,                     00702000
           ID'HTAILP         = XD'HTAILP         #,                     00704000
           ID'HREALP         = XD'HREALP         #,                     00706000
   << SUBENTRY >>                                                       00708000
           ID'STATE          = XD'STATE          #,                     00710000
           ID'DEVICE         = XD'DEVICE         #,                     00712000
           ID'JTYPE          = XD'JTYPE          #,                     00714000
           ID'JNUM           = XD'JNUM           #,                     00716000
           ID'JOBNUM         = XD'JOBNUM         #,                     00718000
           ID'UNAME          = XD'UNAME          #,                     00720000
           ID'ANAME          = XD'ANAME          #,                     00722000
           ID'JNAME          = XD'JNAME          #,                     00724000
           ID'FNAME          = XD'FNAME          #,                     00726000
           ID'DEVFILEID      = XD'DEVFILEID      #,                     00728000
           ID'DATA           = XD'DATA           #,                     00730000
           ID'XDDHEADX       = XD'XDDHEADX       #,                     00732000
   << SPOOFLE EXTENSION >>                                              00734000
           ID'SPOOLFILE      = XD'SPOOLFILE      #,                     00736000
           ID'LOGDEV         = XD'LOGDEV         #,                     00738000
           ID'HIGHADDR       = XD'HIGHADDR       #,                     00740000
           ID'LOWADDR        = XD'LOWADDR        #,                     00742000
           ID'NUMEXT         = XD'NUMEXT         #,                     00744000
           ID'VDEV           = XD'VDEV           #,                     00746000
           ID'LASTEXT        = XD'LASTEXT        #,                     00748000
           ID'RESTART        = XD'RESTART        #,                     00750000
           ID'LINKP          = XD'LINKP          #,                     00752000
           ID'NUMLINES0      = XD'NUMLINES0      #,                     00754000
           ID'NUMLINES1      = XD'NUMLINES1      #,                     00756000
           ID'TIMEREADY0     = XD'TIMEREADY0     #,                     00758000
           ID'TIMEREADY1     = XD'TIMEREADY1     #;                     00760000
$PAGE "***   OUTPUT DEVICE DIRECTORY - ODD   ***"                       00762000
<< OUTPUT DEVICE DIRECTORY - ODD >>                                     00764000
DEFINE                                                                  00766000
   << PREFIX >>                                                         00768000
           ODD'MAXSIZE       = XDD'MAXSIZE       #,                     00770000
           ODD'CURSIZE       = XDD'CURSIZE       #,                     00772000
           ODD'HEADSIZE      = XDD'HEADSIZE      #,                     00774000
           ODD'SUBSIZE       = XDD'SUBSIZE       #,                     00776000
           ODD'SUBAREAP      = XDD'SUBAREAP      #,                     00778000
           ODD'ODD           = XDD'ODD           #,                     00780000
           ODD'NEXTDFID      = XDD'NEXTDFID      #,                     00782000
           ODD'OUTFENCE      = XDD'OUTFENCE      #,                     00784000
   << HEAD ENTRY >>                                                     00786000
              ODDCLASSHEADX  = 2                 #,                     00788000
           OD'HLDEV          = XD'HLDEV          #,                     00790000
              DEVCLASSCHAIN  = 0                 #,                     00792000
           OD'HHEADP         = XD'HHEADP         #,                     00794000
           OD'HTAILP         = XD'HTAILP         #,                     00796000
           OD'HREALP         = XD'HREALP         #,                     00798000
   << SUBENTRY >>                                                       00800000
           OD'STATE          = XD'STATE          #,                     00802000
           OD'OUTPRI         = XD'OUTPRI         #,                     00804000
           OD'C              = XD'C              #,                     00806000
           OD'DEVICE         = XD'DEVICE         #,                     00808000
           OD'JTYPE          = XD'JTYPE          #,                     00810000
           OD'JNUM           = XD'JNUM           #,                     00812000
           OD'JOBNUM         = XD'JOBNUM         #,                     00814000
           OD'UNAME          = XD'UNAME          #,                     00816000
           OD'ANAME          = XD'ANAME          #,                     00818000
           OD'JNAME          = XD'JNAME          #,                     00820000
           OD'FNAME          = XD'FNAME          #,                     00822000
           OD'DEVFILEID      = XD'DEVFILEID      #,                     00824000
           OD'TEF            = XD'TEF            #,                     00826000
           OD'XDDHEADX       = XD'XDDHEADX       #,                     00828000
   << SPOOFLE EXTENSION >>                                              00830000
           OD'SPOOLFILE      = XD'SPOOLFILE      #,                     00832000
           OD'LOGDEV         = XD'LOGDEV         #,                     00834000
           OD'HIGHADDR       = XD'HIGHADDR       #,                     00836000
           OD'LOWADDR        = XD'LOWADDR        #,                     00838000
           OD'NUMEXT         = XD'NUMEXT         #,                     00840000
           OD'VDEV           = XD'VDEV           #,                     00842000
           OD'LASTEXT        = XD'LASTEXT        #,                     00844000
           OD'RECOVERY       = XD'RECOVERY       #,                     00846000
           OD'SQEEZE         = XD'SQEEZE         #,                     00848000
           OD'FOD            = XD'FOD            #,                     00850000
           OD'NOSPACE        = XD'NOSPACE        #,                     00852000
           OD'NUMCOPIES      = XD'NUMCOPIES      #,                     00854000
           OD'LINKP          = XD'LINKP          #,                     00856000
           OD'NUMLINES0      = XD'NUMLINES0      #,                     00858000
           OD'NUMLINES1      = XD'NUMLINES1      #,                     00860000
           OD'TIMEREADY0     = XD'TIMEREADY0     #,                     00862000
           OD'TIMEREADY1     = XD'TIMEREADY1     #,                     00864000
           OD'TIMEREADY'D    = XD'TIMEREADY'D    #;                     00866000
$PAGE "***   FURTHER EQUIVALENCES   ***"                                00868000
   EQUATE                                                               00870000
         DSPseudoterm = 3  ,<< DS device type  >>              <<01549>>00872000
         INPUTONLY    = 0  ,<< FROM AOPTIONS >>                         00874000
         OUTPUTONLY   = 1  ,<< .             >>                         00876000
         IN'OUT       = 2  ,<< .             >>                         00878000
         NOMATCH      = 0  ,<< FROM SCANIDD >>                          00880000
         CLOSEMATCH   = 1  ,<< .            >>                          00882000
         EXACTMATCH   = 2  ,<< .            >>                          00884000
         GOTREADY     = 0  ,<< "OLD" LOOP >>                            00886000
         GOTOPENED    = 1  ,<< .          >>                            00888000
         TRYOPENED    = 2  ,<< .          >>                            00890000
         TRYREADY     = 3  ,<< .          >>                            00892000
         OPASSIGNED   = 2  ,<< FROM ASKOP >>                            00894000
         REALLOC      = 1  ,<< .          >>                            00896000
         OLDDATA      = 0  ;<< .          >>                            00898000
   DEFINE                                                               00900000
         OWNEDBYCALLER= JMPIN=TJMPIN AND                       <<DL003>>00902000
                        (SS=1 OR LDTX1<>0)#,                   <<DL003>>00904000
         PX'RESTART   = 6).(1:1  #,                                     00906000
         SS           = LPDT1.(0:2)#,                                   00908000
         OWNED        = SS<>0#,                                         00910000
         CONDCODE     = STATUS.(6:2)#,                                  00912000
         CCE          = 2 #,                                            00914000
         CCG          = 0 #,                                            00916000
         CCL          = 1 #,                                            00918000
         TJMPIN       = LDT1.(0:8)#,                                    00920000
         LOGF         = LDT3.(2:1)#,                                    00922000
         LOGM         = LDT3.(3:1)#,                                    00924000
         LOGR         = LDT3.(4:1)#,                                    00926000
         CS           = LDT4.(7:1)#,                                    00928000
         LDHEADX      = LDT4.(8:8) #,                                   00930000
         FO           = LDT2.(9:1)#,                                    00932000
         USECOUNT     = LDT0#;                                          00934000
   DEFINE                                                      <<RH.PV>>00936000
         PVCLASSF     = (0:1)#,                                <<RH.PV>>00938000
         MVTABXF      = (4:4)#,                                <<RH.PV>>00940000
         VMASKF       = (8:8)#,                                <<RH.PV>>00942000
         CYCPF        = (1:4)#;                                <<RH.PV>>00944000
   EQUATE                                                      <<SD.00>>00946000
      MEMSIZE = %77700,    << Max size for sdisc XDS >>        <<03563>>00948000
         VDSIZE  = 0;                                          <<SD.00>>00950000
$PAGE "ASSOCIATION TABLE DEFINITIONS AND DECLARATIONS"         <<01647>>00952000
                                                               <<01647>>00954000
EQUATE                                                         <<01647>>00956000
   ASS'DST       = 34,          << ASSOC. TABLE DST.     >>    <<01647>>00958000
   ASS'ENTRYSIZE = 7,           << IN WORDS.             >>    <<01647>>00960000
   ASS'CLASS     = 3,           << CLASSNAME INDEX       >>    <<01647>>00962000
   ASS'SIR       = 24;          << ASSOC. TABLE SIR.     >>    <<01647>>00964000
                                                               <<01647>>00966000
DEFINE                                                         <<01647>>00968000
   ASS'JMAT      = 0).(8:8 #,   << JMAT INDEX IN ENTRY.  >>    <<01647>>00970000
   ASS'JIT       = 1).(6:10 #;  << JIT INDEX IN ENTRY.   >>    <<01647>>00972000
                                                               <<01647>>00974000
DEFINE                                                         <<01647>>00976000
   LOCK'ASS'TABLE  = ASSOC'SIR := GETSIR( ASS'SIR ) #,         <<01647>>00978000
   FREE'ASS'TABLE  = RELSIR( ASS'SIR, ASSOC'SIR )   #;         <<01647>>00980000
                                                               <<01647>>00982000
$PAGE "***   EXTERNAL PROCEDURES   ***"                                 00984000
                                                                        00986000
PROCEDURE ABORTIO (LDEV);                                               00988000
   VALUE   LDEV;                                                        00990000
   INTEGER LDEV;                                                        00992000
   OPTION EXTERNAL;                                                     00994000
                                                                        00996000
LOGICAL PROCEDURE ALTDSEGSIZE(DSTX,SIZE);                               00998000
   VALUE DSTX,SIZE;                                                     01000000
   INTEGER DSTX,SIZE;                                                   01002000
   OPTION EXTERNAL;                                                     01004000
                                                                        01006000
DOUBLE PROCEDURE ATTACHIO (LDEV,QM,D,B,F,C,P1,P2,FL);                   01008000
   VALUE   LDEV,QM,D,B,F,C,P1,P2,FL;                                    01010000
   INTEGER LDEV,QM,D,B,F,C,P1,P2,FL;                                    01012000
   OPTION EXTERNAL;                                                     01014000
                                                                        01016000
DOUBLE PROCEDURE REQSTATUS(LDEV);                              <<03698>>01018000
  VALUE LDEV;                                                  <<03698>>01020000
  INTEGER LDEV;                                                <<03698>>01022000
  OPTION EXTERNAL;                                             <<03698>>01024000
                                                               <<03698>>01026000
PROCEDURE AWAKE(PCBPT,N,WAITF);                                         01028000
   VALUE PCBPT,N,WAITF;                                                 01030000
   INTEGER PCBPT,N,WAITF;                                               01032000
   OPTION EXTERNAL;                                                     01034000
                                                                        01036000
LOGICAL PROCEDURE CALENDAR;                                             01038000
   OPTION EXTERNAL;                                                     01040000
                                                                        01042000
                                                                        01044000
PROCEDURE CLEAN'MESSAGE(MSG,LEN);                                       01046000
   VALUE LEN;                                                           01048000
   INTEGER LEN;                                                         01050000
   BYTE ARRAY MSG;                                                      01052000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                               01054000
                                                                        01056000
DOUBLE PROCEDURE CLOCK;                                                 01058000
   OPTION EXTERNAL;                                                     01060000
                                                                        01062000
LOGICAL PROCEDURE EXCHANGEDB(DSTX);                                     01064000
   VALUE DSTX;                                                          01066000
   LOGICAL DSTX;                                                        01068000
   OPTION EXTERNAL;                                                     01070000
                                                               <<0U.EB>>01072000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,B,C,D,E,F,           <<0U.EB>>01074000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>01076000
   VALUE SETNO,MSGNO,MASK,B,C,D,E,F,DEST,REPLY,BUFF,           <<0U.EB>>01078000
      DST,IOTYPE;                                              <<0U.EB>>01080000
   LOGICAL SETNO,MSGNO,MASK,B,C,D,E,F,DEST,REPLY,BUFF,         <<0U.EB>>01082000
      DST,IOTYPE;                                              <<0U.EB>>01084000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>01086000
                                                               <<01549>>01088000
Integer Procedure Get'DSDEVICE(Ldev);                          <<01549>>01090000
   Value Ldev;                                                 <<01549>>01092000
   Integer Ldev;                                               <<01549>>01094000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<01549>>01096000
                                                               <<01549>>01098000
LOGICAL PROCEDURE GETSIR(SIRNUM);                                       01100000
   VALUE SIRNUM;                                                        01102000
   INTEGER SIRNUM;                                                      01104000
   OPTION EXTERNAL;                                                     01106000
                                                                        01108000
LOGICAL PROCEDURE HEADER (ODDSUBP, LDEV, DEVTYPE, DEVRSIZE);            01110000
   VALUE ODDSUBP, LDEV, DEVTYPE, DEVRSIZE;                              01112000
   INTEGER POINTER ODDSUBP;                                             01114000
   INTEGER LDEV, DEVTYPE, DEVRSIZE;                                     01116000
   OPTION EXTERNAL;                                                     01118000
INTEGER PROCEDURE LDEVTOTYPE(LDEV);                            <<01357>>01120000
VALUE LDEV;                                                    <<01357>>01122000
INTEGER LDEV;                                                  <<01357>>01124000
OPTION EXTERNAL;                                               <<01357>>01126000
                                                               <<01357>>01128000
INTEGER PROCEDURE LDEVTOSUBTYPE(LDEV);                         <<01357>>01130000
VALUE LDEV;                                                    <<01357>>01132000
INTEGER LDEV;                                                  <<01357>>01134000
OPTION EXTERNAL;                                               <<01357>>01136000
                                                               <<01357>>01138000
INTEGER PROCEDURE LINKLABEL(LDEVN,ACC);                        <<TL.02>>01140000
  VALUE ACC;                                                   <<TL.02>>01142000
  INTEGER LDEVN,ACC;                                           <<TL.02>>01144000
  OPTION EXTERNAL;                                             <<TL.02>>01146000
                                                               <<TL.02>>01148000
LOGICAL PROCEDURE CKFORLABEL(LDEV,RDWR,LBLED);                 <<TL.02>>01150000
 VALUE LDEV,RDWR,LBLED;                                        <<TL.02>>01152000
 INTEGER LDEV,RDWR,LBLED;                                      <<TL.02>>01154000
 OPTION EXTERNAL;                                              <<TL.02>>01156000
                                                               <<TL.02>>01158000
PROCEDURE SET'LPDT'BOT(LDEV,VAL);                              <<02566>>01160000
   VALUE LDEV,VAL;                                             <<02566>>01162000
   INTEGER LDEV,VAL;                                           <<02566>>01164000
   OPTION EXTERNAL;                                            <<02566>>01166000
                                                               <<02566>>01168000
PROCEDURE STORE'DENSITY(LDEV,BUFFER,MODE);                     <<02566>>01170000
   VALUE LDEV,MODE;                                            <<02566>>01172000
   INTEGER LDEV,MODE;                                          <<02566>>01174000
   ARRAY BUFFER;                                               <<02566>>01176000
   OPTION EXTERNAL;                                            <<02566>>01178000
                                                               <<02566>>01180000
PROCEDURE MMSTAT(EVENTNUM,P1,P2,P3);                           <<00652>>01182000
  VALUE EVENTNUM,P1,P2,P3;                                     <<00652>>01184000
  INTEGER EVENTNUM,P1,P2,P3;                                   <<00652>>01186000
  OPTION EXTERNAL;                                             <<00652>>01188000
                                                                        01190000
PROCEDURE RELSIR(SIRNUM,ALREADY);                                       01192000
   VALUE SIRNUM,ALREADY;                                                01194000
   INTEGER SIRNUM;                                                      01196000
   LOGICAL ALREADY;                                                     01198000
   OPTION EXTERNAL;                                                     01200000
                                                                        01202000
LOGICAL PROCEDURE SYSPROC (LPIN);                                       01204000
   VALUE   LPIN;                                                        01206000
   LOGICAL LPIN;                                                        01208000
   OPTION EXTERNAL;                                                     01210000
                                                                        01212000
PROCEDURE SUDDENDEATH(ERRNUM);                                          01214000
   VALUE ERRNUM;                                                        01216000
   INTEGER ERRNUM;                                                      01218000
   OPTION EXTERNAL;                                                     01220000
                                                                        01222000
LOGICAL PROCEDURE TRAILER (ODDSUBP, LDEV, DEVTYPE, DEVRSIZE);           01224000
   VALUE ODDSUBP, LDEV, DEVTYPE, DEVRSIZE;                              01226000
   INTEGER POINTER ODDSUBP;                                             01228000
   INTEGER LDEV, DEVTYPE, DEVRSIZE;                                     01230000
   OPTION EXTERNAL;                                                     01232000
                                                                        01234000
PROCEDURE WAIT(WF,JPCNTX);                                              01236000
   VALUE WF,JPCNTX;                                                     01238000
   INTEGER WF,JPCNTX;                                                   01240000
   OPTION EXTERNAL;                                                     01242000
                                                                        01244000
INTEGER PROCEDURE SETCRITICAL;                                          01246000
   OPTION EXTERNAL;                                                     01248000
                                                                        01250000
PROCEDURE RESETCRITICAL (WAS);                                          01252000
   VALUE WAS;                                                           01254000
   INTEGER WAS;                                                         01256000
   OPTION EXTERNAL;                                                     01258000
                                                                        01260000
INTEGER PROCEDURE ASSOC'CLASS(CLASSNAME);                      <<00552>>01262000
INTEGER ARRAY CLASSNAME;                                       <<00552>>01264000
OPTION EXTERNAL,PRIVILEGED;                                    <<00552>>01266000
                                                               <<00552>>01268000
PROCEDURE WRITEDSEG(D);                                                 01270000
   VALUE   D;                                                           01272000
   INTEGER D;                                                           01274000
   OPTION  EXTERNAL;                                                    01276000
                                                                        01278000
                                                               <<00453>>01280000
integer procedure SETSYSDB;                                    <<00453>>01282000
   option  external;                                           <<00453>>01284000
                                                               <<00453>>01286000
procedure RESETDB( DST );                                      <<00453>>01288000
   value   DST;                                                <<00453>>01290000
   integer DST;                                                <<00453>>01292000
   option  external;                                           <<00453>>01294000
                                                               <<00453>>01296000
INTEGER PROCEDURE GETDATASEG(MEMSIZE,VDSIZE);                  <<SD.00>>01298000
VALUE MEMSIZE,VDSIZE;                                          <<SD.00>>01300000
INTEGER MEMSIZE,VDSIZE;                                        <<SD.00>>01302000
OPTION EXTERNAL;                                               <<SD.00>>01304000
                                                               <<SD.00>>01306000
PROCEDURE RELDATASEG(DSTN);                                    <<SD.00>>01308000
VALUE DSTN;                                                    <<SD.00>>01310000
INTEGER DSTN;                                                  <<SD.00>>01312000
OPTION EXTERNAL;                                               <<SD.00>>01314000
                                                               <<SD.00>>01316000
LOGICAL PROCEDURE PUTDEV(LDEV,TABLE,BUF);                      <<SP.01>>01318000
   VALUE LDEV,TABLE;                                           <<SP.01>>01320000
   INTEGER LDEV,TABLE;                                         <<SP.01>>01322000
   INTEGER ARRAY BUF;                                          <<SP.01>>01324000
   OPTION FORWARD;                                             <<SP.01>>01326000
                                                               <<SP.01>>01328000
LOGICAL PROCEDURE GETDEV(LDEV,TABLE,BUF);                      <<SP.01>>01330000
   VALUE LDEV,TABLE;                                           <<SP.01>>01332000
   INTEGER LDEV,TABLE;                                         <<SP.01>>01334000
   INTEGER ARRAY BUF;                                          <<SP.01>>01336000
   OPTION FORWARD;                                             <<SP.01>>01338000
                                                               <<SP.01>>01340000
INTEGER PROCEDURE Get'Disc'Space (ldev, number'of'sectors,     <<03507>>01342000
                                  disc'address);               <<03507>>01344000
   VALUE ldev, number'of'sectors;                              <<03507>>01346000
   INTEGER ldev;                                               <<03507>>01348000
   DOUBLE number'of'sectors, disc'address;                     <<03507>>01350000
   OPTION EXTERNAL;                                            <<03507>>01352000
                                                               <<03507>>01354000
PROCEDURE Return'Disc'Space (ldev, disc'address,               <<03507>>01356000
                             number'of'sectors);               <<03507>>01358000
   VALUE ldev, disc'address, number'of'sectors;                <<03507>>01360000
   INTEGER ldev;                                               <<03507>>01362000
   DOUBLE disc'address, number'of'sectors;                     <<03507>>01364000
   OPTION EXTERNAL;                                            <<03507>>01366000
                                                               <<03507>>01368000
LOGICAL PROCEDURE Deallocate'Dfs'Data'Seg (ldev);              <<03507>>01370000
   VALUE ldev;                                                 <<03507>>01372000
   INTEGER ldev;                                               <<03507>>01374000
   OPTION EXTERNAL;                                            <<03507>>01376000
                                                               <<03507>>01378000
PROCEDURE Delete'Dfs'Data'Seg (ldev);                          <<03507>>01380000
   VALUE ldev;                                                 <<03507>>01382000
   INTEGER ldev;                                               <<03507>>01384000
   OPTION EXTERNAL;                                            <<03507>>01386000
                                                               <<03507>>01388000
PROCEDURE PROCESS'DFS'ERROR (LDEV,ERROR'STATUS,TYPE'OF'ERROR); <<04811>>01390000
   VALUE LDEV,ERROR'STATUS,TYPE'OF'ERROR;                      <<04811>>01392000
   INTEGER LDEV;                                               <<04811>>01394000
   LOGICAL ERROR'STATUS;                                       <<04811>>01396000
   INTEGER TYPE'OF'ERROR;                                      <<04811>>01398000
   OPTION EXTERNAL;                                            <<04811>>01400000
                                                               <<04811>>01402000
PROCEDURE SOFT'DEATH (NUM);                                    <<04811>>01404000
   VALUE NUM;                                                  <<04811>>01406000
   INTEGER NUM;                                                <<04811>>01408000
   OPTION EXTERNAL;                                            <<04811>>01410000
                                                               <<04811>>01412000
                                                               <<00652>>01416000
PROCEDURE HELP;                                                <<00868>>01418000
  OPTION EXTERNAL;                                             <<00868>>01420000
                                                               <<00868>>01422000
INTRINSIC ASCII,TIMER;                                                  01424000
INTRINSIC BINARY;                                              <<04180>>01426000
                                                                        01428000
$PAGE "***   UTILITY PROCEDURES   ***"                                  01430000
$CONTROL SEGMENT= ALLOCUTIL                                             01432000
                                                                        01434000
                                                                        01436000
PROCEDURE SROOSTER(DEVSET);                                             01438000
VALUE DEVSET;                                                           01440000
INTEGER DEVSET;                                                         01442000
OPTION UNCALLABLE,PRIVILEGED;                                           01444000
   BEGIN <<SROOSTER>>                                                   01446000
   INTEGER C ,                                                          01448000
           B ,                                                          01450000
           I ,                                                          01452000
           INDST := -1 ;                                                01454000
   INTEGER POINTER ENTRYP ;                                             01456000
   INTEGER POINTER CLASSP;                                              01458000
   BYTE POINTER CLASSPB = CLASSP;                                       01460000
   << >>                                                                01462000
   LOGICAL SUBROUTINE SROOST (LDEV);                                    01464000
   VALUE   LDEV;                                                        01466000
   INTEGER LDEV;                                                        01468000
      BEGIN                                                             01470000
      SROOST := FALSE;                                                  01472000
      IF INTEGER(SYS'LPDTP(LDEV*LPDTSIZE)) >= 0 THEN                    01474000
         BEGIN  <<REAL DEVICE>>                                         01476000
         @ENTRYP := LDEV*LDTSIZE;                                       01478000
         IF ENTRYP(LD'SP) = OUTPUTSPOOLER AND                  <<00242>>01480000
            ENTRYP(LD'MAINPIN) <> 0 THEN                       <<00242>>01482000
            BEGIN                                                       01484000
            AWAKE(ENTRYP(LD'MAINPIN)*PCBSIZE,SONWAIT,0);                01486000
            IF = THEN SROOST := TRUE;                                   01488000
            END;                                                        01490000
         END;                                                           01492000
      END;                                                              01494000
   << >>                                                                01496000
   IF A(ABCPCB+PCB'XDST) <> LDTDST THEN                                 01498000
         INDST := EXCHANGEDB(LDTDST);                                   01500000
   C := GETSIR(LDTSIR);                                                 01502000
   B := GETSIR(ODDSIR);                                                 01504000
   IF DEVSET > 0 THEN SROOST(DEVSET)                                    01506000
   ELSE                                                                 01508000
      IF < THEN                                                         01510000
         BEGIN <<WAKE SPOOLERS IN A CLASS>>                             01512000
         IF (I:=-DEVSET) <= LDT'NUMCLASS THEN                           01514000
            BEGIN                                                       01516000
            @CLASSP := @LDT'DCTP;                                       01518000
            WHILE (I:=I-1) > 0 DO @CLASSP := @CLASSP                    01520000
               +(CLASSP(DC'NUMDEVS)&ASR(1))+6;                          01522000
            @CLASSPB := @CLASSP&LSL(1)+DC'FIRSTDEV'B-1;                 01524000
            I := 1;                                                     01526000
            DO SROOST( CLASSPB(I) )                            <<02620>>01528000
            UNTIL ( I := I + 1 ) > INTEGER( CLASSPB );         <<02620>>01530000
                                                               <<02620>>01532000
            END;                                                        01534000
         END <<WAKE SPOOLERS IN A CLASS>>                               01536000
      ELSE                                                              01538000
         BEGIN <<WAKE ALL OUTPUT SPOOLERS>>                             01540000
         I := 2;                                                        01542000
         DO SROOST(I) UNTIL (I:=I+1) > LDT'HIENTRY;                     01544000
         END <<WAKE ALL OUTPUT SPOOLERS>>;                              01546000
   RELSIR(ODDSIR,B);                                                    01548000
   RELSIR(LDTSIR,C);                                                    01550000
   IF INDST <> -1 THEN EXCHANGEDB(INDST);                               01552000
<<***CALL TO HELP FOR STT ENTRY--WILL NEVER BE EXECUTED***>>   <<00868>>01554000
<<***>>  IF FALSE THEN HELP;                                   <<00868>>01556000
   END <<SROOSTER>>;                                                    01558000
$PAGE "   ***   XDD/JMAT MANAGEMENT   ***"                              01560000
                                                                        01562000
                                                                        01564000
LOGICAL PROCEDURE ALLOCENTRY;                                           01566000
   OPTION PRIVILEGED, UNCALLABLE;                                       01568000
<< RETURNS POINTER TO ALLOC'D ENTRY SPACE >>                            01570000
<< CCE => OKAY;                                                         01572000
   CCL => NO ROOM. >>                                                   01574000
BEGIN                                                                   01576000
   INTEGER POINTER   MAXP,             <<PNTR TO LAST POSSIBLE ENTRY>>  01578000
                     EXTENSIONP,       <<PNTR TO 1ST WD OF EXTENSION>>  01580000
                     TESTP  = ALLOCENTRY; << TEST ENTRY; POINTER >>     01582000
   INTEGER           << CURRENT SEG SIZE (WDS) = EXTENSION PNTR >>      01584000
                     CURWSIZE  = EXTENSIONP,                            01586000
                     NUMQUAN;          <<NUM OF QUAN TO EXTEND>>        01588000
   INTEGER STAT=Q-1;                                                    01590000
   DEFINE  CC=STAT.(6:2)#;                                              01592000
<< >>                                                                   01594000
   @TESTP := @TBL'ENTRYAREAP -TBL'ENTRYSIZE;                            01596000
   @MAXP := (CURWSIZE := TBL'CURSIZE *TBLQUANTUM) -TBL'ENTRYSIZE;       01598000
   DO BEGIN    <<SCAN 4 AVAIL ENTRY (ENTRY(0) = 0) >>                   01600000
      IF (@TESTP := @TESTP +TBL'ENTRYSIZE) > @MAXP THEN                 01602000
         BEGIN    << NO ROOM FOR ENTRY IN TABLE: EXPAND >>              01604000
         << NUMQUAN := CEIL ((ADD'L-ROOM-NEEDED)/TBLQUANTUM) >>         01606000
         NUMQUAN := ((@TESTP +TBL'ENTRYSIZE -CURWSIZE) +(TBLQUANTUM-1)) 01608000
               /TBLQUANTUM;                                             01610000
         IF (TOS := TBL'CURSIZE +NUMQUAN) > (TBL'MAXSIZE-1) THEN        01612000
            BEGIN    <<NO ROOM FOR EXPANSION>>                          01614000
            @TESTP := 0;                                                01616000
            CC := CCL;                                                  01618000
            RETURN;                                                     01620000
            END;                                                        01622000
         << CHANGE SEGMENT SIZE >>                                      01624000
         ALTDSEGSIZE (A(ABCPCB+PCB'XDST), +(NUMQUAN                     01626000
                  *TBLQUANTUM));                                        01628000
         IF <> THEN SUDDENDEATH (350);                                  01630000
         << CLEAR EXTENSION >>                                          01632000
         << @EXTENSIONP := CURWSIZE; BY EQUIVALENCE >>                  01634000
         EXTENSIONP := 0;                                               01636000
         MOVE EXTENSIONP(1) := EXTENSIONP, ((NUMQUAN *TBLQUANTUM) -1);  01638000
         TBL'CURSIZE := TOS;                                            01640000
         END;                                                           01642000
      END                                                               01644000
   UNTIL TESTP = 0;                                                     01646000
   << GOT ONE >>                                                        01648000
   << ALLOCENTRY := @TESTP;  BY EQUIVALENCE >>                          01650000
   CC := CCE;                                                           01652000
   END    <<ALLOCENTRY>>;                                               01654000
                                                                        01656000
                                                                        01658000
PROCEDURE DEALLOCENTRY (ENTRYP);                                        01660000
   VALUE ENTRYP;                                                        01662000
   INTEGER POINTER ENTRYP;   <<ADDR OF ENTRY 2 B DEALLOC'D>>            01664000
   OPTION PRIVILEGED, UNCALLABLE;                                       01666000
<< PROCEDURE TO RELEASE ENTRY SPACE POINTED TO BY <ENTRYP>.>>           01668000
BEGIN                                                                   01670000
   INTEGER POINTER   MAXP,             <<PNTR 2 LAST POSSIBLE ENTRY>>   01672000
                     NEXTP;            <<SCAN PNTR 4 LAST AVAIL>>       01674000
   INTEGER           DELTAQUAN;        <<AMOUNT OF TRAILING FREE>>      01676000
<< >>                                                                   01678000
   ENTRYP := 0;                                                         01680000
   @MAXP := (TBL'CURSIZE *TBLQUANTUM) -TBL'ENTRYSIZE;                   01682000
   << CHECK IF ENTRYP IS LAST ALLOC'D ENTRY >>                          01684000
   @NEXTP := @ENTRYP;                                                   01686000
   WHILE (@NEXTP := @NEXTP +TBL'ENTRYSIZE) <= @MAXP DO                  01688000
      IF NEXTP <> 0 THEN GO TO WRITE'SEGMENT;                  <<04621>>01690000
   << ENTRYP IS LAST; FIND PRECEDING USED ONE >>                        01692000
   DO @ENTRYP := @ENTRYP -TBL'ENTRYSIZE                                 01694000
   UNTIL (@ENTRYP < @TBL'ENTRYAREAP)  OR  (ENTRYP <> 0);                01696000
   @ENTRYP := @ENTRYP +TBL'ENTRYSIZE;                                   01698000
   << ENTRYP IS NOW LAST ALLOC'D >>                                     01700000
   IF (DELTAQUAN := ((TBL'CURSIZE *TBLQUANTUM) -@ENTRYP) /TBLQUANTUM)   01702000
      > 0 THEN                                                          01704000
      BEGIN   <<AT LEAST 1 QUANTUM SLACK; CONTRACT >>                   01706000
      TBL'CURSIZE := TBL'CURSIZE -DELTAQUAN;                            01708000
      ALTDSEGSIZE (A(ABCPCB+PCB'XDST), -(DELTAQUAN                      01710000
            *TBLQUANTUM));                                              01712000
      IF <> THEN SUDDENDEATH (351);                                     01714000
      END;                                                              01716000
                                                               <<04621>>01718000
WRITE'SEGMENT:                                                 <<04621>>01720000
                                                               <<04621>>01722000
   WRITEDSEG(A(ABCPCB+PCB'XDST));                                       01724000
   END   <<DEALLOCENTRY>>;                                              01726000
                                                                        01728000
                                                                        01730000
PROCEDURE SLINKXDD (XDDHEADX, XDDENTRYP);                               01732000
   VALUE XDDHEADX, XDDENTRYP;                                           01734000
   INTEGER XDDHEADX;                                                    01736000
   INTEGER POINTER XDDENTRYP;                                           01738000
   OPTION  UNCALLABLE;                                                  01740000
<< LINKS XDD SUBENTRY <XDDENTRYP> INTO CHAIN <XDDHEADX>. >>             01742000
BEGIN                                                                   01744000
   INTEGER POINTER   HEADP = XDDHEADX,                                  01746000
                     PREP,             <<TRAILING PNTR (TO LINK WD) >>  01748000
                     NEXTP;            <<LEADING PNTR (TO WD 0) >>      01750000
   INTEGER           XDDDST;                                            01752000
<< >>                                                                   01754000
   @HEADP := XDDHEADX *XDD'HEADSIZE;                                    01756000
                                                                        01758000
   << LEAVE <PREP> POINTING TO PRECEDING SUBENTRY LINK WORD >>          01760000
   IF XDD'ODD THEN                                                      01762000
      BEGIN    << ODD: SCAN DOWN, LOOKING FOR FIRST OF LOWER PRI >>     01764000
      XDDDST := ODDDST;                                                 01766000
      @PREP := @HEADP (XD'HHEADP);                                      01768000
      @NEXTP := PREP;                                                   01770000
      WHILE (@NEXTP <> DEVCHAINEND)  AND                                01772000
            (NEXTP (XD'OUTPRI) >= XDDENTRYP (XD'OUTPRI))  DO            01774000
         BEGIN    << ADVANCE POINTERS >>                                01776000
         @PREP := @NEXTP +XD'LINKP'W;                                   01778000
         @NEXTP := PREP;                                                01780000
         END;                                                           01782000
      END                                                               01784000
   ELSE                                                                 01786000
      BEGIN    << IDD: PUT AT TAIL >>                                   01788000
      XDDDST := IDDDST;                                                 01790000
      @PREP := HEADP (XD'HTAILP);                                       01792000
      IF PREP = DEVCHAINEND THEN                                        01794000
         << SPECIAL CASE: NULL CHAIN: LEAVE PREP AT CHAIN HEAD >>       01796000
      ELSE                                                              01798000
         @PREP := @PREP +XD'LINKP'W;                                    01800000
      END;                                                              01802000
   IF (XDDENTRYP (XD'LINKP) := PREP) = DEVCHAINEND THEN                 01804000
      HEADP (XD'HTAILP) := @XDDENTRYP;                                  01806000
   PREP := @XDDENTRYP;                                                  01808000
   WRITEDSEG(XDDDST);                                                   01810000
   END   <<SLINKXDD >>;                                                 01812000
                                                                        01814000
                                                                        01816000
PROCEDURE DELINKENTRY (CHAINP, ENTRYP);                                 01818000
   VALUE ENTRYP;                                                        01820000
   INTEGER POINTER CHAINP, ENTRYP;                                      01822000
   OPTION  UNCALLABLE;                                                  01824000
<< DELINKS JMAT/XDD ENTRY <ENTRYP> FROM CHAIN DEFINED BY                01826000
   2-WORD ARRAY <CHAINP>. >>                                            01828000
BEGIN                                                                   01830000
   INTEGER POINTER  PREP;                                               01832000
   INTEGER POINTER  CHAINPP    = CHAINP;                                01834000
<< >>                                                                   01836000
   << FIND PRECEDING ENTRY'S LINK WD. >>                                01838000
   @PREP := @CHAINPP;                                                   01840000
   WHILE PREP <> @ENTRYP DO                                             01842000
      @PREP := PREP +TT'LINKP'W;                                        01844000
   IF (PREP := ENTRYP (TT'LINKP)) = TTCHAINEND THEN                     01846000
      BEGIN    << UPDATE TAIL >>                                        01848000
      TOS := @PREP;                                                     01850000
      IF S0 <> @CHAINPP THEN                                            01852000
         TOS := TOS -TT'LINKP'W;                                        01854000
      CHAINPP (1) := TOS;                                               01856000
      END;                                                              01858000
   END   << DELINKENTRY >>;                                             01860000
                                                                        01862000
PROCEDURE SRELINKODD(ODDENTRYP,NEWDEV);                                 01864000
   VALUE   NEWDEV,ODDENTRYP;                                            01866000
   INTEGER NEWDEV;                                                      01868000
   INTEGER POINTER ODDENTRYP;                                           01870000
   OPTION PRIVILEGED,UNCALLABLE;                               <<SP.SZ>>01872000
   BEGIN                                                                01874000
   INTEGER B, LDTSAVESIR,                                      <<02587>>01876000
           HEADX ,                                                      01878000
            VDEV,                                              <<00671>>01880000
           INDST := -1 ;                                                01882000
   INTEGER POINTER HEADP = HEADX ;                                      01884000
   INTEGER POINTER LDTP;                                       <<00671>>01886000
   << >>                                                                01888000
   LDTSAVESIR := GETSIR( LDTSIR );                             <<02587>>01890000
   B := GETSIR(ODDSIR);                                                 01892000
   IF A(ABCPCB+PCB'XDST) <> ODDDST THEN                                 01894000
         INDST := EXCHANGEDB(ODDDST);                                   01896000
   HEADX := ODDCLASSHEADX;                                              01898000
   IF NEWDEV > 0 THEN                                                   01900000
      BEGIN                                                             01902000
      @HEADP := (ODDCLASSHEADX+1)*ODDHSIZE;                             01904000
      WHILE HEADP(OD'HLDEV) <> NEWDEV DO                                01906000
            @HEADP := @HEADP+ODDHSIZE;                                  01908000
      IF @HEADP > @ODD'SUBAREAP THEN SUDDENDEATH (352);                 01910000
      HEADX := @HEADP/ODDHSIZE;                                         01912000
      END;                                                              01914000
   TOS := ODDENTRYP(OD'XDDHEADX)*ODDHSIZE+OD'HHEADP;                    01916000
   DELINKENTRY(*,ODDENTRYP);                                            01918000
   IF NEWDEV <> 0 THEN                                         <<00671>>01920000
   BEGIN    <<RELINK TO NEW DEVICE CHAIN>>                     <<00671>>01922000
      VDEV := ODDENTRYP(OD'VDEV);                              <<00671>>01924000
      IF ODDENTRYP(OD'STATE) = DFOPENED AND                    <<00671>>01926000
         VDEV <> 0 THEN                                        <<00671>>01928000
      BEGIN      <<FIX LDT TO REFLECT NEWDEV>>                 <<00671>>01930000
         EXCHANGEDB(LDTDST);                                   <<00671>>01932000
         @LDTP := VDEV * LDTSIZE;                              <<00671>>01934000
         LDTP(LD'XDDHEADX) := HEADX;                           <<00671>>01936000
         EXCHANGEDB(ODDDST);                                   <<00671>>01938000
      END;                                                     <<00671>>01940000
   END;                                                        <<00671>>01942000
   TOS := NEWDEV;                                                       01944000
   IF < THEN                                                            01946000
      BEGIN                                                             01948000
      TOS := -TOS;                                                      01950000
      TOS := TRUE;                                                      01952000
      END                                                               01954000
   ELSE                                                                 01956000
      TOS := FALSE;                                                     01958000
   ODDENTRYP(OD'C) := TOS;                                              01960000
   ODDENTRYP(OD'DEVICE) := TOS;                                         01962000
   ODDENTRYP(OD'XDDHEADX) := HEADX;                                     01964000
   SLINKXDD(HEADX,ODDENTRYP);                                           01966000
   IF INDST <> -1 THEN EXCHANGEDB(INDST);                               01968000
   RELSIR(ODDSIR,B);                                                    01970000
   RELSIR( LDTSIR, LDTSAVESIR );                               <<02587>>01972000
   END; <<SRELINKODD>>                                                  01974000
                                                                        01976000
                                                                        01978000
INTEGER PROCEDURE SPUTXDD (ODD, DEVICE, SUBENTRY, XDDSUBP);             01980000
   VALUE ODD, DEVICE;                                                   01982000
   LOGICAL ODD;                                                         01984000
   INTEGER DEVICE;                                                      01986000
   INTEGER ARRAY SUBENTRY;                                              01988000
   INTEGER POINTER XDDSUBP;                                             01990000
   OPTION PRIVILEGED, UNCALLABLE;                                       01992000
BEGIN                                                                   01994000
   INTEGER           XDDSIR,                                            01996000
                     XDDDST;                                            01998000
   INTEGER POINTER   XDDHP,            <<XDD HEAD POINTER>>             02000000
                     XDDEP;            <<XDD SUBENTRY POINTER>>         02002000
   DOUBLE POINTER    XDDEPD  = XDDEP;                                   02004000
   INTEGER           XDDHX  = XDDHP,   <<XDD HEAD ENTRY INDEX>>         02006000
                     SIRFLAGS;                                          02008000
   INTEGER ARRAY LDTENTRY(0:LDTSIZE-1);                        <<SP.01>>02010000
   INTEGER ARRAY LPDTENTRY(0:LPDTSIZE-1);                      <<SP.01>>02012000
   EQUATE            OKAY  = 0,                                         02014000
               ILLEGAL'DEV = 3,                                <<SP.01>>02016000
                     NOROOM  = 1;                                       02018000
<< >>                                                                   02020000
   PUSH (DL);     <<SETUP FOR MOVE>>                                    02022000
   @SUBENTRY := -TOS +@SUBENTRY;                                        02024000
   IF ODD THEN                                                          02026000
      BEGIN    << ODD >>                                                02028000
      TOS := ODDDST;                                                    02030000
      TOS := ODDSIR;                                                    02032000
      END                                                               02034000
   ELSE                                                                 02036000
      BEGIN    << IDD >>                                                02038000
      TOS := IDDDST;                                                    02040000
      TOS := IDDSIR;                                                    02042000
      END;                                                              02044000
   XDDSIR := TOS;                                                       02046000
   XDDDST := TOS;                                                       02048000
   EXCHANGEDB (XDDDST);                                                 02050000
   XDDHX := ODDCLASSHEADX;                                              02052000
   IF DEVICE > 0 THEN                                                   02054000
      BEGIN    <<NOT CLASS>>                                            02056000
      @XDDHP := XDDHX *XDD'HEADSIZE;                                    02058000
      DO  @XDDHP := @XDDHP +XDD'HEADSIZE                                02060000
      UNTIL XDDHP (XD'HLDEV) = DEVICE;                                  02062000
      IF @XDDHP > @XDD'SUBAREAP THEN                                    02064000
         IF NOT GETDEV(DEVICE,LDTDST,LDTENTRY)                 <<SP.01>>02066000
            OR NOT GETDEV(DEVICE,LPDTDST,LPDTENTRY) THEN       <<SP.01>>02068000
               BEGIN                                           <<SP.01>>02070000
               TOS := 0;                                       <<SP.01>>02072000
               SPUTXDD := ILLEGAL'DEV;                         <<SP.01>>02074000
               GO TO LX;                                       <<SP.01>>02076000
               END                                             <<SP.01>>02078000
         ELSE                                                  <<SP.01>>02080000
         SUDDENDEATH (353);                                             02082000
      XDDHX := @XDDHP /XDD'HEADSIZE;                                    02084000
      END;                                                              02086000
   SIRFLAGS := GETSIR (XDDSIR);                                         02088000
   @XDDEP := ALLOCENTRY;      <<GET ENTRY SPACE>>                       02090000
   IF = THEN                                                            02092000
      BEGIN    <<GOT SPACE>>                                            02094000
                                                                        02096000
      << MOVE SUBENTRY >>                                               02098000
      TOS := @XDDEP;                                                    02100000
      TOS := @SUBENTRY;                                                 02102000
      TOS := XDD'SUBSIZE;                                               02104000
      ASSEMBLE (MVLB);                                                  02106000
                                                                        02108000
      << SET SOME SUBENTRY FIELDS >>                                    02110000
      XDDEP (XD'C) := DEVICE.(0:1);    <<SET C>>                        02112000
      XDDEP (XD'DEVICE) := \DEVICE\;    <<SET DEVICE>>                  02114000
      XDDEP (XD'DEVFILEID) := XDD'NEXTDFID;     <<SET DEV FILE ID>>     02116000
      TOS := XDD'NEXTDFID +1;    <<ADVANCE CNTR>>                       02118000
      IF = OR OVERFLOW THEN                                             02120000
         << COMPLEMENT IDD/ODD BIT; AND WRAP AROUND TO 1 >>             02122000
         ASSEMBLE (TCBC 0; TSBC 15);                                    02124000
      XDD'NEXTDFID := TOS;                                              02126000
      XDDEP (XD'XDDHEADX) := XDDHX;    <<SET HEAD INDEX>>               02128000
                                                                        02130000
      << LINK INTO DEVICE CHAIN >>                                      02132000
      SLINKXDD (XDDHX, XDDEP);                                          02134000
      TOS := @XDDEP;                                                    02136000
      TOS.(0:1) := ODD;                                                 02138000
      TOS := OKAY;                                                      02140000
      END                                                               02142000
   ELSE                                                                 02144000
      BEGIN                                                             02146000
      TOS := 0;                                                         02148000
      TOS := NOROOM;                                                    02150000
      END;                                                              02152000
   SPUTXDD := TOS;                                                      02154000
   RELSIR (XDDSIR, SIRFLAGS);                                           02156000
LX:                                                            <<SP.01>>02158000
   EXCHANGEDB (0);                                                      02160000
   @XDDSUBP := TOS;                                                     02162000
   END   <<SPUTXDD>>;                                                   02164000
                                                                        02166000
                                                                        02168000
PROCEDURE SREMOVEXDD (XDDSUBP);                                         02170000
   VALUE XDDSUBP;                                                       02172000
   INTEGER POINTER XDDSUBP;                                             02174000
   OPTION PRIVILEGED, UNCALLABLE;                                       02176000
<< REMOVE XDD SUB ENTRY <XDDSUBP>. >>                                   02178000
BEGIN                                                                   02180000
   INTEGER           XDDDST,                                            02182000
                     XDDSIR,                                            02184000
                     INCOMINGDST,                                       02186000
                     SIRFLAGS;                                          02188000
<< >>                                                                   02190000
   TOS := @XDDSUBP;                                                     02192000
   ASSEMBLE (TRBC 0);                                                   02194000
   @XDDSUBP := TOS;                                                     02196000
   IF = THEN                                                            02198000
      BEGIN    << IDD >>                                                02200000
      TOS := IDDSIR;                                                    02202000
      TOS := IDDDST;                                                    02204000
      END                                                               02206000
   ELSE                                                                 02208000
      BEGIN    << ODD >>                                                02210000
      TOS := ODDSIR;                                                    02212000
      TOS := ODDDST;                                                    02214000
      END;                                                              02216000
   XDDDST := TOS;                                                       02218000
   XDDSIR := TOS;                                                       02220000
   INCOMINGDST := EXCHANGEDB (XDDDST);                                  02222000
   SIRFLAGS := GETSIR (XDDSIR);                                         02224000
   TOS := XDDSUBP (XD'XDDHEADX) *XDD'HEADSIZE +XD'HHEADP;               02226000
   DELINKENTRY (*, XDDSUBP);                                            02228000
   DEALLOCENTRY (XDDSUBP);                                              02230000
   RELSIR (XDDSIR, SIRFLAGS);                                           02232000
   IF INCOMINGDST <> XDDDST THEN EXCHANGEDB (INCOMINGDST);              02234000
   END   << SREMOVEXDD >>;                                              02236000
LOGICAL PROCEDURE SFINDODD(DFID,XDDEP);                        <<SP.SZ>>02238000
<<FINDS ODD ENTRY FROM DEVICEFILEID>>                          <<SP.SZ>>02240000
VALUE DFID;                                                    <<SP.SZ>>02242000
INTEGER XDDEP;                                                 <<SP.SZ>>02244000
INTEGER DFID;                                                  <<SP.SZ>>02246000
OPTION PRIVILEGED,UNCALLABLE;                                  <<SP.SZ>>02248000
                                                               <<SP.SZ>>02250000
BEGIN                                                          <<SP.SZ>>02252000
INTEGER SAVESIR;                                               <<SP.SZ>>02254000
                                                               <<SP.SZ>>02256000
INTEGER POINTER ENTRYP,LIMITP;                                 <<SP.SZ>>02258000
SFINDODD := FALSE;                                             <<SP.SZ>>02260000
                                                               <<SP.SZ>>02262000
                                                               <<SP.SZ>>02264000
EXCHANGEDB(ODDDST);                                            <<SP.SZ>>02266000
SAVESIR := GETSIR(ODDSIR);                                     <<SP.SZ>>02268000
@ENTRYP := @XDD'SUBAREAP;                                      <<SP.SZ>>02270000
@LIMITP := XDD'CURSIZE * TBLQUANTUM - XDD'SUBSIZE;             <<SP.SZ>>02272000
DO   <<FIND SUBENTRY>>                                         <<SP.SZ>>02274000
   UNTIL (ENTRYP<> 0) AND (ENTRYP(OD'DEVFILEID) = DFID)        <<SP.SZ>>02276000
         OR ((@ENTRYP := @ENTRYP + XDD'SUBSIZE) > @LIMITP);    <<SP.SZ>>02278000
IF <> THEN TOS := 0 <<DIDN'T GET REQUESTED ENTRY>>             <<SP.SZ>>02280000
 ELSE   <<GOT REQUESTED ENTRY>>                                <<SP.SZ>>02282000
          BEGIN                                                <<SP.SZ>>02284000
          SFINDODD := TRUE;                                    <<SP.SZ>>02286000
          TOS    := @ENTRYP;                                   <<SP.SZ>>02288000
          TOS    := TOS LOR %100000;                           <<SP.SZ>>02290000
          END;                                                 <<SP.SZ>>02292000
EXCHANGEDB(0);                                                 <<SP.SZ>>02294000
RELSIR(ODDSIR,SAVESIR);                                        <<SP.SZ>>02296000
XDDEP := TOS;      <<WANTED ENTRY POINTER>>                    <<SP.SZ>>02298000
END;                                                           <<SP.SZ>>02300000
                                                               <<SP.SZ>>02302000
LOGICAL PROCEDURE SFINDIDD(DFID,XDDEP);                        <<00552>>02304000
<<FINDS IDD ENTRY FROM DEVICEFILEID>>                          <<00552>>02306000
VALUE DFID;                                                    <<00552>>02308000
INTEGER XDDEP;                                                 <<00552>>02310000
INTEGER DFID;                                                  <<00552>>02312000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00552>>02314000
                                                               <<00552>>02316000
BEGIN                                                          <<00552>>02318000
INTEGER SAVESIR;                                               <<00552>>02320000
                                                               <<00552>>02322000
INTEGER POINTER ENTRYP,LIMITP;                                 <<00552>>02324000
SFINDIDD := FALSE;                                             <<00552>>02326000
                                                               <<00552>>02328000
                                                               <<00552>>02330000
EXCHANGEDB(IDDDST);                                            <<00552>>02332000
SAVESIR := GETSIR(IDDSIR);                                     <<00552>>02334000
@ENTRYP := @XDD'SUBAREAP;                                      <<00552>>02336000
@LIMITP := XDD'CURSIZE * TBLQUANTUM - XDD'SUBSIZE;             <<00552>>02338000
DO   <<FIND SUBENTRY>>                                         <<00552>>02340000
   UNTIL (ENTRYP<> 0) AND (ENTRYP(ID'DEVFILEID) = DFID)        <<00552>>02342000
         OR ((@ENTRYP := @ENTRYP + XDD'SUBSIZE) > @LIMITP);    <<00552>>02344000
IF <> THEN TOS := 0 <<DIDN'T GET REQUESTED ENTRY>>             <<00552>>02346000
 ELSE   <<GOT REQUESTED ENTRY>>                                <<00552>>02348000
          BEGIN                                                <<00552>>02350000
          SFINDIDD := TRUE;                                    <<00552>>02352000
          TOS    := @ENTRYP;                                   <<00552>>02354000
          END;                                                 <<00552>>02356000
EXCHANGEDB(0);                                                 <<00552>>02358000
RELSIR(IDDSIR,SAVESIR);                                        <<00552>>02360000
XDDEP := TOS;      <<WANTED ENTRY POINTER>>                    <<00552>>02362000
END;                                                           <<00552>>02364000
LOGICAL PROCEDURE SFINDACTIVE(LDEV,DFID);                      <<00903>>02366000
<<FINDS THE ACTIVE DEVICE FILE ID ON LDEV>>                    <<00903>>02368000
<<RETURNS FALSE IF LDEV IS NOT ACTIVE>>                        <<00903>>02370000
    VALUE LDEV;                                                <<00903>>02372000
    INTEGER LDEV,DFID;                                         <<00903>>02374000
    OPTION PRIVILEGED,UNCALLABLE;                              <<00903>>02376000
                                                               <<00903>>02378000
BEGIN                                                          <<00903>>02380000
                                                               <<00903>>02382000
   LOGICAL DEVFOUND,                                           <<00903>>02384000
           RESULT = SFINDACTIVE,                               <<00903>>02386000
           ODDSIRINUSE;                                        <<00903>>02388000
   INTEGER I;                                                  <<00903>>02390000
   INTEGER POINTER                                             <<00903>>02392000
           DEVEP,                                              <<00903>>02394000
           DEVHPQ,                                             <<00903>>02396000
           DEVHP;                                              <<00903>>02398000
                                                               <<00903>>02400000
<<>>                                                           <<00903>>02402000
                                                               <<00903>>02404000
SFINDACTIVE := FALSE;                                          <<00903>>02406000
DEVFOUND := 0;                                                 <<00903>>02408000
I := 0;                                                        <<00903>>02410000
TOS := LDEV * LDTSIZE;                                         <<00903>>02412000
EXCHANGEDB(LDTDST);                                            <<00903>>02414000
TOS := PS0(LD'XDDHEADX);                                       <<00903>>02416000
EXCHANGEDB(ODDDST);                                            <<00903>>02418000
@DEVHP := TOS * ODD'HEADSIZE;                                  <<00903>>02420000
@DEVEP :=  DEVHP(XD'HHEADP);                                   <<00903>>02422000
IF @DEVEP <> 0 THEN                                            <<00903>>02424000
DO                                                             <<00903>>02426000
  BEGIN                                                        <<00903>>02428000
     IF DEVEP(XD'STATE) = DFACTIVE THEN                        <<00903>>02430000
     BEGIN                                                     <<00903>>02432000
        DEVFOUND := DEVEP(XD'DEVFILEID);                       <<00903>>02434000
        SFINDACTIVE := TRUE;                                   <<00903>>02436000
     END;                                                      <<00903>>02438000
  END                                                          <<00903>>02440000
UNTIL (@DEVEP := DEVEP(XD'LINKP)) = DEVHP(XD'HTAILP) OR        <<00903>>02442000
   RESULT = TRUE OR                                            <<00903>>02444000
   @DEVEP = 0;                                                 <<00903>>02446000
EXCHANGEDB(0);                                                 <<00903>>02448000
DFID := DEVFOUND;                                              <<00903>>02450000
END;   <<SFINDACTIVE>>                                         <<00903>>02452000
DOUBLE PROCEDURE XDDSPOOLINFO(DVALUE,ITEM,XDDSUBP);                     02454000
   VALUE   DVALUE,ITEM,XDDSUBP;                                         02456000
   LOGICAL ITEM;                                                        02458000
   DOUBLE DVALUE;                                                       02460000
   INTEGER POINTER XDDSUBP;                                             02462000
   OPTION PRIVILEGED,UNCALLABLE;                               <<SP.SZ>>02464000
   << ITEM.(15:1) = 0 GET                                               02466000
                  = 1 PUT                                               02468000
          .(14:1) = 1 DISK LABEL                                        02470000
          .(13:1) = 1 DECR / TEST NUMCOPIES                             02472000
          .(12:1) = 1 READY BIT SET                                     02474000
          .(11:1) = 1 NUM OF RECORDS                                    02476000
          .(10:1) = 1 FILE SIZE                                         02478000
          .( 9:1) = 1 INCR # EXTS                                       02480000
          .( 8:1) = 1 SET NO SPACE BIT                                  02482000
          .( 7:1) = 1 TEST NO SPACE BIT                                 02484000
          .( 6:1) = 1 TEST/SET SQEEZE BIT                               02486000
          .( 5:1) = 1 INCR/DECR # EXTENTS/RECS                          02488000
          .( 4:1) = 1 GET DEVICEFILEID                         01.02    02490000
          .( 3:1) = 1 TEST/SET ABORT BIT                       SP.SZ    02492000
   >>                                                                   02494000
BEGIN                                                                   02496000
   DOUBLE POINTER XDDSUBPD = XDDSUBP;                                   02498000
   INTEGER    XDDDST    ,                                               02500000
              XDDSIR    ,                                               02502000
              OLDDST    ,                                               02504000
              SIRFLAGS  ;                                               02506000
   << >>                                                                02508000
   XDDSPOOLINFO := 0D;                                                  02510000
   TOS := @XDDSUBP;                                                     02512000
   ASSEMBLE(TRBC 0);                                                    02514000
   @XDDSUBP := TOS;                                                     02516000
   IF = THEN                                                            02518000
      BEGIN                                                             02520000
      TOS := IDDSIR;                                                    02522000
      TOS := IDDDST;                                                    02524000
      END                                                               02526000
   ELSE                                                                 02528000
      BEGIN                                                             02530000
      TOS := ODDSIR;                                                    02532000
      TOS := ODDDST;                                                    02534000
      END;                                                              02536000
   XDDDST := TOS;                                                       02538000
   XDDSIR := TOS;                                                       02540000
   OLDDST := EXCHANGEDB(XDDDST);                                        02542000
   SIRFLAGS := GETSIR(XDDSIR);                                          02544000
                                                               <<04275>>02546000
   IF XDDSUBP(0) = 0  << Invalid XDD entry, return!         >> <<04275>>02548000
      THEN GO FIN;                                             <<04275>>02550000
                                                               <<04275>>02552000
   TOS := ITEM;                                                         02554000
   ASSEMBLE(TBC 14);                                                    02556000
   IF <> THEN                                                           02558000
      BEGIN                                                             02560000
      X := XD'SPOOLFILE'D;                                              02562000
      IF TOS THEN                                                       02564000
         BEGIN                                                          02566000
         XDDSUBPD(X) := DVALUE;                                         02568000
         WRITEDSEG(XDDDST);                                             02570000
         END                                                            02572000
      ELSE                                                              02574000
         XDDSPOOLINFO := XDDSUBPD(X);                                   02576000
      GOTO FIN;                                                         02578000
      END;                                                              02580000
   ASSEMBLE(TBC 13);                                                    02582000
   IF <> THEN                                                           02584000
      BEGIN                                                             02586000
      ASSEMBLE(DEL,ZERO);                                               02588000
      TOS := XDDSUBP(XD'NUMCOPIES) - 1;                                 02590000
      IF < THEN ASSEMBLE(DEL,ZERO);                                     02592000
      ASSEMBLE(DUP);                                                    02594000
      XDDSUBP(XD'NUMCOPIES) := TOS;                                     02596000
      XDDSPOOLINFO := TOS;                                              02598000
      GOTO FIN;                                                         02600000
      END;                                                              02602000
   ASSEMBLE(TBC 12);                                                    02604000
   IF <> THEN                                                           02606000
      BEGIN                                                             02608000
      DEL;                                                              02610000
      XDDSUBP(XD'STATE) := DFREADY;                                     02612000
      WRITEDSEG(XDDDST);                                       <<01.02>>02614000
      GOTO FIN;                                                         02616000
      END;                                                              02618000
   ASSEMBLE(TBC 11);                                                    02620000
   IF <> THEN                                                           02622000
      BEGIN                                                             02624000
      X := XD'NUMLINES'D;                                               02626000
      IF TOS THEN XDDSUBPD(X) := DVALUE                                 02628000
             ELSE XDDSPOOLINFO := XDDSUBPD(X);                          02630000
      GOTO FIN;                                                         02632000
      END;                                                              02634000
   ASSEMBLE(TBC 10);                                                    02636000
   IF <> THEN                                                           02638000
      BEGIN                                                             02640000
      IF TOS THEN                                                       02642000
         BEGIN                                                          02644000
         TOS := DVALUE;                                                 02646000
         XDDSUBP(XD'LASTEXT) := TOS;                                    02648000
         XDDSUBP(XD'NUMEXT) := TOS;                                     02650000
         WRITEDSEG(XDDDST);                                             02652000
         END                                                            02654000
      ELSE                                                              02656000
         BEGIN                                                          02658000
         TOS := XDDSUBP(XD'NUMEXT);                                     02660000
         TOS := XDDSUBP(XD'LASTEXT);                                    02662000
         XDDSPOOLINFO := TOS;                                           02664000
         END;                                                           02666000
      GOTO FIN;                                                         02668000
      END;                                                              02670000
   ASSEMBLE(TBC 9);                                                     02672000
   IF <> THEN                                                           02674000
      BEGIN                                                             02676000
      DEL;                                                              02678000
      XDDSUBP(XD'NUMEXT) := XDDSUBP(XD'NUMEXT)+1;                       02680000
      WRITEDSEG(XDDDST);                                                02682000
      GOTO FIN;                                                         02684000
      END;                                                              02686000
   ASSEMBLE(TBC 8);                                                     02688000
   IF <> THEN                                                           02690000
      BEGIN                                                             02692000
      DEL;                                                              02694000
      XDDSUBP(XD'NOSPACE) := 1;                                         02696000
      GOTO FIN;                                                         02698000
      END;                                                              02700000
   ASSEMBLE(TBC 7);                                                     02702000
   IF <> THEN                                                           02704000
      BEGIN                                                             02706000
      DEL;                                                              02708000
      XDDSPOOLINFO := IF XDDSUBP(XD'NOSPACE)=1                          02710000
         THEN 1D ELSE 0D;                                               02712000
      GOTO FIN;                                                         02714000
      END;                                                              02716000
   ASSEMBLE(TBC 6);                                                     02718000
   IF <> THEN                                                           02720000
      BEGIN                                                             02722000
      IF TOS THEN                                                       02724000
         BEGIN                                                          02726000
         XDDSUBP(XD'SQEEZE) := 1;                              <<01549>>02728000
         WRITEDSEG(XDDDST);                                             02730000
         END                                                            02732000
      ELSE                                                              02734000
         XDDSPOOLINFO := IF XDDSUBP(XD'SQEEZE)=1                        02736000
            THEN 1D ELSE 0D;                                            02738000
      GOTO FIN;                                                         02740000
      END;                                                              02742000
   ASSEMBLE(TBC 5);                                                     02744000
   IF <> THEN                                                           02746000
      BEGIN                                                             02748000
      IF TOS THEN                                                       02750000
         BEGIN                                                          02752000
         XDDSUBP(XD'NUMEXT) := XDDSUBP(XD'NUMEXT)-1;                    02754000
         END                                                            02756000
      ELSE                                                              02758000
         BEGIN                                                          02760000
         XDDSUBP(XD'NUMEXT) := XDDSUBP(XD'NUMEXT)+1;                    02762000
         XDDSUBPD(XD'NUMLINES'D) := XDDSUBPD(XD'NUMLINES'D)             02764000
            +DVALUE;                                                    02766000
         END;                                                           02768000
      WRITEDSEG(XDDDST);                                                02770000
      GOTO FIN;                                                         02772000
      END;                                                              02774000
   ASSEMBLE(TBC 4);                                            <<01.02>>02776000
   IF <> THEN                                                  <<01.02>>02778000
      BEGIN                                                    <<01.02>>02780000
      ASSEMBLE(DEL,ZERO);                                      <<01.02>>02782000
      TOS := XDDSUBP(XD'DEVFILEID);                            <<01.02>>02784000
      XDDSPOOLINFO := TOS;                                     <<01.02>>02786000
      GO TO FIN;                                               <<SP.SZ>>02788000
      END;                                                     <<01.02>>02790000
   ASSEMBLE(TBC 3);                                            <<SP.SZ>>02792000
   IF <> THEN                                                  <<SP.SZ>>02794000
      BEGIN                                                    <<SP.SZ>>02796000
      IF TOS THEN                                              <<SP.SZ>>02798000
         XDDSUBP(XD'ABORT) := 1                                <<SP.SZ>>02800000
      ELSE                                                     <<SP.SZ>>02802000
         XDDSPOOLINFO := IF XDDSUBP(XD'ABORT) = 1              <<SP.SZ>>02804000
             THEN 1D ELSE 0D;                                  <<SP.SZ>>02806000
      GO TO FIN;                                               <<SP.SZ>>02808000
      END;                                                     <<SP.SZ>>02810000
                                                               <<SP.SZ>>02812000
FIN:                                                                    02814000
   RELSIR(XDDSIR,SIRFLAGS);                                             02816000
   IF OLDDST <> XDDDST THEN EXCHANGEDB(OLDDST);                         02818000
   END;                                                                 02820000
                                                                        02822000
$PAGE "   ***   ALLOCATE UTILITIES   ***"                               02824000
LOGICAL PROCEDURE SPOOLEDDEV (DEVICE);                                  02826000
   VALUE DEVICE;                                                        02828000
   INTEGER DEVICE;                                                      02830000
   OPTION PRIVILEGED, UNCALLABLE;                                       02832000
BEGIN                                                                   02834000
   LOGICAL           RESULT  = SPOOLEDDEV;                              02836000
   INTEGER           INCOMINGDST,                                       02838000
                     SAVESIR,                                           02840000
                     NUMDEVS;                                           02842000
   INTEGER POINTER   CLASSP,                                            02844000
                     DEVP;                                              02846000
   LOGICAL POINTER   DEVPL  = DEVP;                                     02848000
   BYTE POINTER      CLASSPB  = CLASSP;                                 02850000
                                                                        02852000
                                                                        02854000
SUBROUTINE DODEV (DEV);                                                 02856000
   VALUE DEV;                                                           02858000
   INTEGER DEV;                                                         02860000
BEGIN                                                                   02862000
   @DEVP := DEV *LDTSIZE;                                               02864000
   IF DEVP (LD'SP) <> NOSPOOLER THEN                                    02866000
      IF DEVP (LD'SP) = OUTPUTSPOOLER THEN                              02868000
         SPOOLEDDEV.(14:1) := TRUE                                      02870000
      ELSE                                                              02872000
         SPOOLEDDEV.(13:1) := TRUE;                                     02874000
   IF DEVPL (LD'SQ) THEN SPOOLEDDEV.(15:1) := TRUE;                     02876000
   END;    <<DODEV>>                                                    02878000
                                                                        02880000
                                                                        02882000
   SPOOLEDDEV := 0;                                                     02884000
   INCOMINGDST := EXCHANGEDB (LDTDSTN);                                 02886000
   SAVESIR := GETSIR (LDTSIR);                                          02888000
   IF DEVICE < 0 THEN                                                   02890000
      BEGIN    <<CLASS>>                                                02892000
      @CLASSP := @LDT'DCTP;                                             02894000
      WHILE (DEVICE := DEVICE +1) < 0 DO                                02896000
         @CLASSP := @CLASSP +(CLASSP (DC'NUMDEVS) &ASR(1)) +6;          02898000
      IF LOGICAL(CLASSP(DC'SQ)) THEN                           <<00635>>02900000
         SPOOLEDDEV.(15:1) := TRUE                             <<00635>>02902000
      ELSE                                                     <<00635>>02904000
      BEGIN                                                    <<00635>>02906000
      NUMDEVS := CLASSP (DC'NUMDEVS);                                   02908000
      @CLASSPB := @CLASSP &LSL(1) +DC'FIRSTDEV'B;                       02910000
      WHILE (NUMDEVS := NUMDEVS -1) >= 0 DO                             02912000
         DODEV (CLASSPB (NUMDEVS));                                     02914000
      END;                                                     <<00635>>02916000
      END                                                               02918000
   ELSE                                                                 02920000
      DODEV (DEVICE);                                                   02922000
   RELSIR (LDTSIR, SAVESIR);                                            02924000
   EXCHANGEDB (INCOMINGDST);                                            02926000
   END;    <<SPOOLEDDEV>>                                               02928000
$PAGE                                                          <<04377>>02930000
INTEGER PROCEDURE ATOB (NUMBER'STRING, NUMBER'OF'DIGITS);      <<04377>>02932000
   VALUE NUMBER'OF'DIGITS;                                     <<04377>>02934000
   INTEGER NUMBER'OF'DIGITS;                                   <<04377>>02936000
   BYTE ARRAY NUMBER'STRING;                                   <<04377>>02938000
   OPTION INTERNAL, UNCALLABLE;                                <<04377>>02940000
                                                               <<04377>>02942000
BEGIN COMMENT --                                               <<04377>>02944000
  Converts the first NUMBER'OF'DIGITS or  less  ASCII  decimal <<04377>>02946000
digits  in NUMBER'STRING to binary.  NUMBER'STRING may be ter- <<04377>>02948000
minated by any non-numeric character.                          <<04377>>02950000
;                                                              <<04377>>02952000
INTEGER                                                        <<04377>>02954000
   LOOP'COUNTER,                                               <<04377>>02956000
   RESULT,                                                     <<04377>>02958000
   THIS'DIGIT;                                                 <<04377>>02960000
                                                               <<04377>>02962000
RESULT := 0;                                                   <<04377>>02964000
FOR LOOP'COUNTER := 0 STEP 1 UNTIL NUMBER'OF'DIGITS - 1 DO     <<04377>>02966000
   BEGIN                                                       <<04377>>02968000
   THIS'DIGIT := NUMBER'STRING (LOOP'COUNTER) - "0";           <<04377>>02970000
   IF (0 <= THIS'DIGIT <= 9)                                   <<04377>>02972000
      THEN RESULT := RESULT*10 + THIS'DIGIT                    <<04377>>02974000
      ELSE LOOP'COUNTER := NUMBER'OF'DIGITS;   << Stop loop >> <<04377>>02976000
   END;                                                        <<04377>>02978000
ATOB := RESULT;                                                <<04377>>02980000
END;              << of ATOB.                               >> <<04377>>02982000
$PAGE                                                          <<04377>>02984000
LOGICAL PROCEDURE GETCLASS(BUF,EVERYTHING,CLADR,CLINX,CLNAME);          02986000
    VALUE EVERYTHING,CLADR,CLINX;                                       02988000
    INTEGER CLADR,CLINX;                                                02990000
    LOGICAL EVERYTHING;                                                 02992000
    INTEGER ARRAY CLNAME,BUF;                                           02994000
    OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                              02996000
         <<RETRIEVE DEVICE CLASS INFO FOR PARTICULAR DEVICE CLASS.    >>02998000
         <<                                                           >>03000000
         <<INPUT:                                                     >>03002000
         <<      EVERYTHING = TRUE  - RETURN ALL DATA SPECIFIED IN BUF>>03004000
         <<                 = FALSE - RETURN ONLY WORDS(0)-(3) IN BUF >>03006000
         <<      CLADR              - POINTER TO CLASS ENTRY          >>03008000
         <<      CLNAME             - CLASS NAME                      >>03010000
         <<      CLINX              - CLASS INDEX                     >>03012000
         <<     NOTE: ONE AND ONLY ONE OF THE ABOVE 3 PARMS MUST BE   >>03014000
         <<                                                    PASSED.>>03016000
         <<OUTPUT:                                                    >>03018000
         <<      BUF(0)             - POINTER TO ENTRY                >>03020000
         <<         (1)             - CLASS INDEX (NOT RETURNED IF    >>03022000
         <<                                          CLADR INPUT)     >>03024000
         <<         (2)             - WORD 4 OF ENTRY (S,CYCLICAL PNTR>>03026000
         <<                                            ,CLASS DEVTYPE >>03028000
         <<         (3)             - #DEVICES,LDEV#1                 >>03030000
         <<     NOTE: REST OF BUF   RETURNED ONLY IF EVERYTHING=TRUE: >>03032000
         <<      BUF(4)             - LDEV#2,LDEV#3                   >>03034000
         <<        ETC.                                               >>03036000
         <<      GETCLASS = FALSE   - CANT FIND ENTRY, SOMETHING'S BAD>>03038000
         <<               = TRUE    - EVERYTHING OK.                  >>03040000
         <<     NOTE: LDTSIR MUST BE LOCKED EXTERNALLY.               >>03042000
         <<           DB MUST BE AT STACK - SAME ON EXIT.             >>03044000
   BEGIN                                                                03046000
   INTEGER                                                              03048000
         SAVEDL,   <<DB-ADR.OF DL>>                                     03050000
         METHOD,   <<4-USE CLADR, 2-USE CLINX, 1-USE CLNAME>>           03052000
         Q4 = Q-4,   <<BIT MAP>>                                        03054000
         I _ 0,                                                         03056000
         J,                                                             03058000
         N,                                                             03060000
         L;                                                             03062000
   INTEGER ARRAY                                                        03064000
         DTAB(*),                                                       03066000
         LCLNAME(0:3)=Q;                                                03068000
   IF Q4<25 THEN                                                        03070000
      SUDDENDEATH(367);  <<BAD CALL>>                          <<04622>>03072000
   METHOD _ Q4.(13:3);                                                  03074000
   PUSH(DL);                                                            03076000
   SAVEDL _TOS;                                                         03078000
   IF METHOD =1 THEN                                                    03080000
      MOVE LCLNAME _ CLNAME,(4);   <<MOVE NAME TO LOCAL ARRAY>>         03082000
   EXCHANGEDB(LDTDSTN);                                                 03084000
   @DTAB _ 0;                                                           03086000
   IF METHOD = 4 THEN                                                   03088000
      BEGIN   <<USE CLADR>>                                             03090000
      IF (CLADR<DTAB(1)) OR (CLADR >= DTAB(1)+DTAB(3)) THEN             03092000
         SUDDENDEATH(360);   <<BAD POINTER>>                            03094000
      @DTAB _ CLADR;                                                    03096000
      L _ (DTAB(5).(0:8)+2)&LSR(1)+5;   <<#WORDS IN ENTRY>>             03098000
      END                                                               03100000
   ELSE                                                                 03102000
      BEGIN   <<CLNAME OR CLINX>>                                       03104000
      N _ DTAB(2);   <<#CLASS ENTRIES>>                                 03106000
      @DTAB _ DTAB(1);   <<CLASS TABLE>>                                03108000
       <<NOTE: I=0>>                                                    03110000
      WHILE (I_I+1) < N+1 DO                                            03112000
         BEGIN   <<SIFT THROUGH CLASSES>>                               03114000
         L _ (DTAB(5).(0:8)+2)&LSR(1)+5;   <<#WORDS IN THIS ENTRY>>     03116000
         IF METHOD = 1 THEN                                             03118000
            BEGIN   <<CLNAME>>                                          03120000
            IF LCLNAME=DTAB AND LCLNAME(1)=DTAB(1) AND LCLNAME(2)       03122000
                     =DTAB(2) AND LCLNAME(3)=DTAB(3) THEN               03124000
               BEGIN   <<FOUND IT BY NAME>>                             03126000
               GO OUT;                                                  03128000
               END;                                                     03130000
            END                                                         03132000
         ELSE                                                           03134000
            IF METHOD = 2 THEN                                          03136000
               BEGIN   <<CLINX>>                                        03138000
               IF I=CLINX THEN                                          03140000
                  GO OUT;   <<FOUND>>                                   03142000
               END                                                      03144000
            ELSE                                                        03146000
               SUDDENDEATH (365);  <<BAD CALL>>                         03148000
         @DTAB _ @DTAB + L;   <<NEXT ENTRY>>                            03150000
         END;                                                           03152000
      EXCHANGEDB(0);                                                    03154000
      RETURN;   <<CAN'T FIND IT>>                                       03156000
      END;                                                              03158000
OUT:                                                                    03160000
   TOS _ @BUF(2) - SAVEDL;   <<DL-TARGET>>                              03162000
   TOS _ @DTAB(4);   <<DB-SOURCE>>                                      03164000
   TOS _ 2;   <<COUNT>>                                                 03166000
   ASMB(MVBL 1);   <<WORDS 4&5 OF ENTRY>>                               03168000
   IF EVERYTHING THEN                                                   03170000
      BEGIN                                                             03172000
      TOS _ L-6;   <<REST OF ENTRY>>                                    03174000
      ASMB(MVBL 3);                                                     03176000
      END;                                                              03178000
   EXCHANGEDB(0);                                                       03180000
   BUF _ @DTAB;   <<POINTER>>                                           03182000
   BUF(1) _ I;   <<CLASS INDEX>>                                        03184000
   GETCLASS _ TRUE;                                                     03186000
   END;   <<..................................................GETCLASS>>03188000
LOGICAL PROCEDURE PUTDEV  << & GETDEV >>  (LDEV, TABLE, BUF);           03190000
   VALUE LDEV, TABLE;                                                   03192000
   INTEGER LDEV;      << LOG. DEVICE NO. >>                             03194000
   INTEGER TABLE;     << DST # OF LPDT (13) OR LDT (14) >>              03196000
   INTEGER ARRAY BUF; << TABLE ENTRY DESTINATION OR SOURCE >>           03198000
   OPTION PRIVILEGED, UNCALLABLE;                                       03200000
                                                                        03202000
<< PUTDEV MOVES DEVICE ENTRY IN <BUF> INTO ENTRY <LDEV> OF              03204000
      TABLE <TABLE> (LPDT/LDT).                                         03206000
   GETDEV MOVES ENTRY <LDEV> OF TABLE <TABLE> INTO <BUF>.               03208000
   ENTRY DB MUST BE STACK.                                              03210000
   CALLER MUST HAVE APPROPRIATE SIR, IF DESIRED.                        03212000
   RETURNS:                                                             03214000
      TRUE- EVERYTHING WAS SWELL.  GETDEV: <BUF> SET.                   03216000
      FALSE- ILLEGAL <LDEV>:                                            03218000
         <= 0;  > MAX ENTRY;  GETDEV: UNASSIGNED <LDEV>.                03220000
   >>                                                                   03222000
                                                                        03224000
BEGIN                                                                   03226000
   ENTRY GETDEV;                                                        03228000
   LOGICAL           GET    := FALSE;    <<GET/PUT FLAG>>               03230000
   INTEGER           SIZE    := LPDTSIZE;    <<ENTRY SIZE>>             03232000
                                                                        03234000
   GOTO START;                                                          03236000
                                                                        03238000
GETDEV:                                                                 03240000
   GET := TRUE;    <<INDICATE THAT GETDEV>>                             03242000
                                                                        03244000
START:                                                                  03246000
   PUTDEV := FALSE;    <<INITIALIZE RETURN>>                            03248000
   IF LDEV > 0 THEN                                                     03250000
      BEGIN    << AT LEAST IT'S >0 >>                                   03252000
      << SET <SIZE>, AND LEAVE TOS AT MAX ENTRY >>                      03254000
      IF TABLE = LPDTDST THEN                                           03256000
         BEGIN                                                          03258000
         << SIZE := LPDTSIZE; BY INITIALIZATION >>                      03260000
         TOS := SYS'LPDTP(0).(0:8);    <<LPDT MAXENTRY>>                03262000
         END                                                            03264000
      ELSE                                                              03266000
         BEGIN    <<ACCESS LDT>>                                        03268000
         SIZE := LDTSIZE;                                               03270000
         TOS := 0;    <<SPACE FOR LDT(0)>>                              03272000
         TOS := @S0;    <<SETUP MOVE>>                                  03274000
         TOS := LDTDST;                                                 03276000
         TOS := 0;                                                      03278000
         TOS := 1;    <<JUST 1ST WD>>                                   03280000
         ASSEMBLE (MFDS 4);                                             03282000
         TOS := TOS.(0:8);    <<EXTRACT MAXENTRY>>                      03284000
         END;                                                           03286000
      IF TOS >= LDEV THEN                                               03288000
         BEGIN    << WITHIN MAXENTRY: MOVE ENTRY >>                     03290000
         TOS := @BUF;    <<SETUP MOVE, ASSUMING GET>>                   03292000
         TOS := TABLE;                                                  03294000
         TOS := LDEV *SIZE;                                             03296000
         IF GET THEN                                                    03298000
            BEGIN    << GETDEV: MOVE & CHECK ASSIGNED LDEV >>           03300000
            TOS := SIZE;                                                03302000
            ASSEMBLE (MFDS 4);                                          03304000
            IF TABLE = LPDTDST THEN                                     03306000
               TOS := BUF    <<LPDT: WD(0) DETERMINES OK>>              03308000
            ELSE                                                        03310000
               TOS := BUF (2);    <<LDT: CHECK WD(2)>>                  03312000
            IF <> THEN S0 := TRUE    <<SUCCESS SIGNAL>>                 03314000
            << ELSE TOS := 0 (I.E. FALSE), ALREADY >>;                  03316000
            END                                                         03318000
         ELSE                                                           03320000
            BEGIN    << PUTDEV: MOVE TO TABLE; NO CHECK >>              03322000
            ASSEMBLE (CAB);    <<GET SOURCE/DEST RIGHT>>                03324000
            TOS := SIZE;                                                03326000
            ASSEMBLE (MTDS 4);                                          03328000
            TOS := TRUE;    <<SIGNAL SUCCESS>>                          03330000
            END;                                                        03332000
         PUTDEV := TOS;    <<SET RETURN. THIS IS ONLY PLACE>>           03334000
         END;                                                           03336000
      END;                                                              03338000
   END;      << GETDEV / PUTDEV >>                                      03340000
INTEGER PROCEDURE GETDEVINFO(DEVICE,DEVINFO);                           03342000
    BYTE ARRAY DEVICE;                                                  03344000
    INTEGER ARRAY DEVINFO;                                              03346000
    OPTION PRIVILEGED,UNCALLABLE;                                       03348000
         <<RETURNS PERTINENT INFORMATION ABOUT A DEVICE.              >>03350000
         <<INPUT:.....................................................>>03352000
         <<DEVICE         - ASCII DEVICE SPECIFICATION (SAME AS FOPEN)>>03354000
         <<DEVINFO        - WORD ARRAY WHERE INFO IS TO BE STORED.    >>03356000
         <<OUTPUT:....................................................>>03358000
         <<    NOTE: THE FOLLOWING APPLIES IFF "DEVICE" = CLASS NAME. >>03360000
         <<DEVINFO(0)     - INDEX INTO DEVICE CLASS TABLE (NEGATIVE.) >>03362000
         <<       (1)     - DEVICE TYPE (AS IT APPEARS IN THE DCT).   >>03364000
         <<       (2)     - WORD 4 OF DEVICE CLASS TABLE (DCT) ENTRY. >>03366000
         <<       (4)-(8) - LDT ENTRY OF 1ST DEVICE IN CLASS>>          03368000
         <<    NOTE: THE FOLLOWING APPLIES IFF "DEVICE" = LOG.DEV.#.  >>03370000
         <<DEVINFO(0)     - LOGICAL DEVICE NUMBER (POSITIVE).         >>03372000
         <<       (1)     - DEVICE TYPE (AS IT APPEARS IN THE LDT).   >>03374000
         <<       (2)-(3) - LPDT ENTRY.                               >>03376000
         <<       (4)-(8) - LDT ENTRY.                                >>03378000
         <<     NOTE: THE FOLLOWING ALWAYS APPLIES.                   >>03380000
         <<GETDEVINFO = 0 - OK, NO ERRORS.                            >>03382000
         <<           = 1 - INVALID DEVICE CLASS SPECIFICATION <<U.RAO>>03384000
         <<           = 2 - UNKNOWN DEVICE CLASS            >> <<U.RAO>>03386000
         <<           = 3 - UNKNOWN LOGICAL DEVICE          >> <<U.RAO>>03388000
         <<           = -1 -VIRTUAL DEVICE                            >>03390000
   BEGIN                                                                03392000
    DEFINE                                                     <<SD.00>>03394000
         <<DEVINFO ARRAY>>                                     <<SD.00>>03396000
         DEVTYPE       = 1#, <<DEVICE TYPE>>                   <<SD.00>>03398000
         DEVACCCL      = 1).(10:3#, << Device access class >>  <<03512>>03400000
         DISCTYPE      = 3).(4:3#;                             <<SD.00>>03402000
                         <<NON/SYS DOMAIN,PVMOUNT,PVRESERVE>>  <<SD.00>>03404000
    EQUATE                                                              03406000
         LDSIZE1 = LDTSIZE-1                                            03408000
        ,PDSIZE1 = LPDTSIZE-1                                           03410000
   ;INTEGER                                                             03412000
         LDEV   <<LOGICAL DEVICE NUMBER>>                               03414000
        ,I,J,K                                                          03416000
   ;LOGICAL                                                             03418000
         ANYDEV _ FALSE   <<TRUE IF "DEVICE" IS A CLASS NAME>>          03420000
        ,B   <<GETSIR RETURN VALUE>>                                    03422000
   ;INTEGER ARRAY                                                       03424000
         IDCLASS(0:3) = Q   <<DEVICE CLASS>>                            03426000
        ,TENTRY(0:LDSIZE1) = Q   <<LOG.OR PHYS.DEV.TABLE ENTRY>>        03428000
        ,LDENTRY(*) = TENTRY                                            03430000
        ,PDENTRY(*) = TENTRY                                            03432000
        ,ICLASS(0:3) = Q                                                03434000
   ;BYTE ARRAY                                                          03436000
         DCLASS(*) = IDCLASS                                            03438000
        ,CLASS(*) = ICLASS                                              03440000
   ;                                                                    03442000
                                                               <<04288>>03444000
   BYTE POINTER STKBUF;                                        <<04288>>03446000
                                                               <<04288>>03448000
   GETDEVINFO := 0;                                                     03450000
   I _ -1;                                                              03452000
   WHILE (I_I+1) < 4 DO IDCLASS(I) _ %20040;                            03454000
   IF (LDEV := ATOB (DEVICE, 3)) = 0 THEN                      <<04377>>03456000
      BEGIN   << Device class.                              >> <<04377>>03458000
      ANYDEV := TRUE;                                          <<04377>>03460000
      MOVE DEVICE := DEVICE WHILE ANS, 1;                      <<04377>>03462000
      I := TOS - @DEVICE;   << Save length of A/N string.   >> <<04377>>03464000
      IF I > 8 THEN                                            <<04377>>03466000
         BEGIN   << Too many chars -- invalid device spec.  >> <<04377>>03468000
         GETDEVINFO := 1;                                      <<04377>>03470000
         RETURN;                                               <<04377>>03472000
         END;                                                  <<04377>>03474000
      MOVE DCLASS := DEVICE WHILE AN;                          <<04377>>03476000
      END;    << Device class.                              >> <<04377>>03478000
   B _ GETSIR(LDTSIR);                                                  03482000
   IF NOT ANYDEV THEN GO SPECDEV;   <<SPECIFIC DEVICE>>                 03484000
   IF NOT GETCLASS(ICLASS,FALSE,,,IDCLASS) THEN                         03486000
      BEGIN   <<INVALID DEVICE SPEC.>>                                  03488000
      RELSIR(LDTSIR,B);                                                 03490000
      PUSH(S);  << SEE IF DS NODE NAME >>                      <<04288>>03492000
      @STKBUF := (TOS+1) & ASL(1);                             <<04288>>03494000
      ASSEMBLE(ADDS 5);                                        <<04288>>03496000
      MOVE STKBUF := DEVICE, (I+1), 2;                         <<04288>>03498000
      MOVE * := %15;                                           <<04288>>03500000
      SCAN STKBUF UNTIL %6443;  << SCAN FOR "#" >>             <<04358>>03502000
      IF CARRY THEN                                            <<04288>>03504000
        GETDEVINFO := 2  << NOT DS, INVALID DEVICE CLASS >>    <<04288>>03506000
      ELSE                                                     <<04288>>03508000
        BEGIN  << POSSIBLE DS NODE NAME >>                     <<04288>>03510000
        DEVINFO := 0;                                          <<04288>>03512000
        MOVE DEVINFO(2) := DEVINFO, (7);                       <<04288>>03514000
        DEVINFO(1) := 41;  << DS DEVICE >>                     <<04288>>03516000
        END;                                                   <<04288>>03518000
      RETURN;                                                  <<U.RAO>>03520000
      END;                                                              03522000
   DEVINFO _ -ICLASS(1);                                                03524000
   DEVINFO(2) _ ICLASS(2);   <<WORD 4 OF ENTRY>>                        03526000
   LDEV _ CLASS(7);   <<1ST LOG.DEV.IN CLASS>>                          03528000
   GETDEV(LDEV,LDTDSTN,TENTRY);                                         03530000
   DEVINFO(1) _ ICLASS(2).(10:6);                                       03532000
   MOVE DEVINFO(4) _ TENTRY,(5);                                        03534000
   RELSIR(LDTSIR,B);                                                    03536000
   RETURN;                                                              03538000
SPECDEV:   <<SPECIFIC DEVICE>>                                          03540000
   IF NOT GETDEV(LDEV,LDTDSTN,TENTRY) THEN                              03542000
      BEGIN   <<BAD DEVICE SPEC>>                                       03544000
      RELSIR(LDTSIR,B);                                                 03546000
      GETDEVINFO := 3;   <<UNKNOWN LOGICAL DEVICE>>            <<U.RAO>>03548000
      RETURN;                                                  <<U.RAO>>03550000
      END;                                                              03552000
   DEVINFO(0) _ LDEV;   <<LOG.DEV.#>>                                   03554000
   DEVINFO(1) _ TENTRY(2).(10:6);   <<DEVICE TYPE>>                     03556000
                                                                        03558000
   MOVE DEVINFO(4) _ TENTRY,(5);                                        03560000
      RELSIR(LDTSIR,B);                                                 03562000
   B _ GETSIR(LPDSIR);                                                  03564000
   GETDEV(LDEV,LPDDSTN,TENTRY);                                         03566000
   DEVINFO(2) _ TENTRY(0);   <<LPDT ENTRY>>                             03568000
   DEVINFO(3) _ TENTRY(1);                                              03570000
   RELSIR(LPDSIR,B);                                                    03572000
   IF (DEVINFO(DEVACCCL) = DEVDISC) AND                        <<03512>>03574000
      (DEVINFO(DISCTYPE) = NOT'PV'OR'SYS)   THEN               <<03512>>03578000
      IF SYS'LPDTP(LDEV&LSL(1)+1).FORS=0                       <<01115>>03580000
          THEN DEVINFO(DEVTYPE):=SDISC <<SPECIAL RETURNS>>     <<01115>>03582000
          ELSE DEVINFO(DEVTYPE):=FDISC;                        <<01115>>03584000
<<*************** NOTE *******************>>                   <<SD.00>>03586000
<<A PV-DISC CANNOT BE OPENED WITHOUT A PV->>                   <<SD.00>>03588000
<<PACK MOUNTED ON THE SPINDLE.  NON-SYSTEM>>                   <<SD.00>>03590000
<<VOLUMES WITHOUT DISCS SPINNING ARE      >>                   <<SD.00>>03592000
<<ASSUMED TO BE SERIAL....................>>                   <<SD.00>>03594000
<<*************** NOTE *******************>>                   <<SD.00>>03596000
   IF TENTRY < 0 THEN GETDEVINFO := -1;                                 03598000
   RETURN;                                                              03600000
   END;   <<GETDEVINFO>>                                                03602000
PROCEDURE DEALLOCATE(DEVPARM);                                          03604000
   VALUE DEVPARM;                                                       03606000
   INTEGER DEVPARM;                                                     03608000
   OPTION FORWARD;                                                      03610000
                                                                        03612000
                                                                        03614000
INTEGER PROCEDURE DISKDEALLOC(EXTSIZE,LASTEXTSIZE,NUMEXTS,MAP);  <<MV>> 03616000
    VALUE NUMEXTS,EXTSIZE,LASTEXTSIZE;                           <<MV>> 03618000
   INTEGER NUMEXTS;                                                     03620000
   LOGICAL EXTSIZE, LASTEXTSIZE;                                        03622000
   DOUBLE ARRAY MAP;                                             <<MV>> 03624000
   OPTION PRIVILEGED,UNCALLABLE;                                 <<MV>> 03626000
   BEGIN                                                         <<MV>> 03628000
   <<DEALLOCATES DISK DEVICE AND SPACE                >>         <<MV>> 03630000
   <<IF NUMEXTS>0 THEN THE DISK SPACE WILL BE RETURNED>>         <<MV>> 03632000
   <<OTHERWISE THE DEVICES WILL JUST BE DEALLOCATED   >>         <<MV>> 03634000
   <<   NOTE THAT THE USECOUNT IS NOW BUMPED FOR EACH >>         <<MV>> 03636000
   <<   EXTENT.                                                  <<MV>> 03638000
   <<DB MUST BE SET TO STACK                          >>         <<MV>> 03640000
   <<INPUT............................................>>         <<MV>> 03642000
   <<EXTSIZE          SIZE OF EACH EXTENT.                 >>           03644000
   <<LASTEXTSIZE      SIZE OF LAST EXTENT. (ALL OTHERS SAME)>>          03646000
   <<NUMEXTS         THE NUMBER OF EXTENTS IN THE MAP.   >>      <<MV>> 03648000
   <<   NEGATIVE => SIMPLY DEALLOCATE DISC DEVICES.    >>               03650000
   <<   \NUMEXTS\.(8:1) => SPOOLING CALL               >>               03652000
   <<MAP     AN ARRAY OF DISK ADDRESSES.              >>         <<MV>> 03654000
   <<        FORMAT IS : ONE BYE OF LDEV              >>         <<MV>> 03656000
   <<                    THREE BYTES OF DISKADDR.     >>         <<MV>> 03658000
   <<RETURNS..........................................>>         <<MV>> 03660000
   <<       0               OK                        >>         <<MV>> 03662000
                                                               <<03507>>03664000
   <<SPACE OF ALL EXTENTS POSSIBLE IS RETURNED.       >>        <<MV>>  03668000
   BYTE ARRAY BMAP(*)=MAP;                                      <<MV>>  03670000
   LOGICAL LDEV,COUNT;                                           <<MV>> 03672000
   INTEGER INDEX;                                               <<MV>>  03674000
   ARRAY LDTENTRY(0:3)=Q;                                               03676000
   LOGICAL USECOUNT=LDTENTRY,SAVEDSIR,RETSPACE;                <<MV>>   03678000
   DOUBLE DISKADDR;                                              <<MV>> 03680000
   BYTE BDISKADDR=DISKADDR;                                      <<MV>> 03682000
   LOGICAL DOWN:=FALSE;  <<DID I PUT THE DEV DOWN?>>                    03684000
   LOGICAL FORSPOOLING := FALSE;    <<SPOOLING CALL?>>                  03686000
   DEFINE TYPE'OF'ERROR = [8/7,8/4]#; <<ID=7,4-unexpected er>> <<04811>>03688000
   DEFINE MSG'UNEXPECTED'ERROR = %44#;                         <<04811>>03690000
                                                               <<04811>>03692000
   SUBROUTINE DECRUSECOUNT;                                      <<MV>> 03694000
      BEGIN  <<DECREMENT USECOUNT AND CALL DEALLOCATE>>          <<MV>> 03696000
             <<IF IT GOES TO ZERO.                   >>          <<MV>> 03698000
      SAVEDSIR:=GETSIR(LDTSIR);                                  <<MV>> 03700000
      TOS:=@USECOUNT;  <<DB RELATIVE>>                           <<MV>> 03702000
      TOS:=LDTDST;  <<SEG NUMBER>>                               <<MV>> 03704000
      TOS:=LDEV*LDTSIZE+LD'USECOUNT;  <<OFFSET>>                 <<MV>> 03706000
      TOS:=4;                                                    <<MV>> 03708000
      ASSEMBLE(MFDS 4);  <<GET FIRST 4 WORDS OF LDT>>            <<MV>> 03710000
      IF USECOUNT < COUNT THEN                                 <<04811>>03712000
         BEGIN                                                 <<04811>>03714000
         <<It is something wrong with LDT usage count which>>  <<04811>>03716000
         <<represents number of allocated extents of open  >>  <<04811>>03718000
         <<files. We are going to disable allocation and   >>  <<04811>>03720000
         <<deallocation disc space on such device. In case >>  <<04811>>03722000
         <<of private volume switching the drive (off-line/>>  <<04811>>03724000
         <<on-line) will enable disc space allocation.     >>  <<04811>>03726000
         PROCESS'DFS'ERROR(LDEV,MSG'UNEXPECTED'ERROR,          <<04811>>03728000
                           TYPE'OF'ERROR);                     <<04811>>03730000
         SOFT'DEATH (420);                                     <<04811>>03732000
         END                                                   <<04811>>03734000
      ELSE                                                     <<04811>>03736000
      BEGIN  <<O.K.>>                                          <<04811>>03738000
      USECOUNT:=USECOUNT-COUNT;                                  <<MV>> 03740000
      TOS:=LDTDST;  <<SEG NUMBER>>                               <<MV>> 03742000
      TOS:=LDEV*LDTSIZE+LD'USECOUNT;  <<OFFSET>>                 <<MV>> 03744000
      TOS:=@LDTENTRY;  <<DB RELATIVE>>                           <<MV>> 03746000
      IF USECOUNT=0 AND LDTENTRY(LD'R) THEN                             03748000
         BEGIN<<DOWN PENDING SO DOWN IT>>                               03750000
         LDTENTRY(LD'F):=0;                                             03752000
         LDTENTRY(LD'R):=0;                                             03754000
         DOWN:=TRUE;                                                    03756000
                                                               <<03507>>03758000
         << Deallocate and delete disc free space data >>      <<03507>>03760000
         << segment, ignore errors.                    >>      <<03507>>03762000
                                                               <<03507>>03764000
         Deallocate'Dfs'Data'Seg (ldev);                       <<03507>>03766000
                                                               <<03507>>03768000
         Delete'Dfs'Data'Seg (Ldev);                           <<03507>>03770000
                                                               <<03507>>03772000
         TOS:=4;<<MOVE COUNT>>                                          03774000
         END                                                            03776000
      ELSE TOS:=1;<<MOVE COUNT>>                                        03778000
      ASSEMBLE(MTDS 4);  <<UPDATE USECOUNT>>                     <<MV>> 03780000
      END;                                                     <<04811>>03782000
      RELSIR(LDTSIR,SAVEDSIR);                                   <<MV>> 03784000
      IF DOWN THEN BEGIN                                                03786000
                   GENMSG(1,250,%10000,LDEV,,,,,0);            <<0U.EB>>03788000
                   DOWN:=FALSE;                                         03790000
                   END;                                                 03792000
      END; <<DECRUSECOUNT>>                                      <<MV>> 03794000
                                                                        03796000
                                                                        03798000
   RETSPACE:=NUMEXTS>0;                                          <<MV>> 03800000
   NUMEXTS:=\NUMEXTS\;                                           <<MV>> 03802000
   IF LOGICAL (NUMEXTS.(8:1)) THEN                                      03804000
      BEGIN    <<SPOOLING CALL: SET TRUE EXTSIZE AND FLAG>>             03806000
      EXTSIZE := ABSYS'EXTSS;                                           03808000
      FORSPOOLING := TRUE;                                              03810000
      NUMEXTS.(8:1) := 0;                                               03812000
      END;                                                              03814000
   IF LASTEXTSIZE = 0 THEN LASTEXTSIZE := EXTSIZE;                      03816000
   COUNT:=0;                                                     <<MV>> 03818000
   LDEV:=BMAP(0);                                                <<MV>> 03820000
   INDEX:=0;                                                     <<MV>> 03822000
   WHILE INDEX<NUMEXTS DO                                        <<MV>> 03824000
   BEGIN                                                         <<MV>> 03826000
   IF BMAP(INDEX*4)<>0 THEN                                      <<MV>> 03828000
      BEGIN  <<A NON ZERO LDEV IN MAP>>                          <<MV>> 03830000
      IF LDEV=LOGICAL(BMAP(X)) THEN                              <<MV>> 03832000
         COUNT:=COUNT+1 <<NUMBER OF TIMES THIS LDEV>>            <<MV>> 03834000
      ELSE                                                       <<MV>> 03836000
         BEGIN <<NEW LDEV; SO BUMP USECOUNTER BY COUNT>>         <<MV>> 03838000
         DECRUSECOUNT;                                           <<MV>> 03840000
         LDEV:=BMAP(INDEX*4);                                    <<MV>> 03842000
         COUNT:=1;<<NEW LDEV>>                                   <<MV>> 03844000
         END;                                                    <<MV>> 03846000
      IF RETSPACE THEN                                           <<MV>> 03848000
         BEGIN                                                   <<MV>> 03850000
         DISKADDR:=MAP(INDEX);                                   <<MV>> 03852000
         BDISKADDR:=0;                                           <<MV>> 03854000
         Return'Disc'Space (ldev, diskaddr,                    <<03507>>03856000
                            (IF index < numexts-1 THEN         <<03507>>03858000
                            DOUBLE (extsize) ELSE              <<03507>>03860000
                            DOUBLE (lastextsize)));            <<03507>>03862000
                                                               <<03507>>03864000
         << The return of disc space can no longer fail >>     <<03507>>03866000
                                                               <<03507>>03868000
            BEGIN    << ALL OKAY >>                                     03872000
            IF FORSPOOLING THEN                                         03876000
               BEGIN    <<SPOOLING CALL: REDUCE COUNT>>                 03878000
               DISAPROC;                                                03880000
               PUSHNUMSS;    <<SUBTRACT FROM SYSTEM COUNT>>             03882000
               TOS := TOS - (IF INDEX >= NUMEXTS-1 THEN                 03884000
                  DOUBLE(LASTEXTSIZE) ELSE DOUBLE(EXTSIZE));            03886000
               POPNUMSS;                                                03888000
               ENAPROC;                                                 03890000
               END;                                                     03892000
            END;                                                        03894000
         END;                                                    <<MV>> 03896000
      END;                                                       <<MV>> 03898000
      INDEX:=INDEX+1;                                            <<MV>> 03900000
      END;                                                       <<MV>> 03902000
    IF COUNT <> 0 THEN DECRUSECOUNT;                             <<MV>> 03904000
    END;<<DISKDEALLOC>>                                          <<MV>> 03906000
$PAGE                                                                   03908000
INTEGER PROCEDURE DISKALLOC(INDX,NUMEXT,SPACEDATA,PVINFO);     <<RH.PV>>03910000
    VALUE INDX,NUMEXT,PVINFO;                                  <<RH.PV>>03912000
                                                            <<MV>>      03914000
    DOUBLE ARRAY SPACEDATA;                                             03916000
    INTEGER INDX,NUMEXT;                                                03918000
    LOGICAL PVINFO;                                            <<RH.PV>>03920000
    OPTION PRIVILEGED,UNCALLABLE;                                       03922000
         <<ALLOCATES DISK DEVICE AND DISK-SPACE. NO DEVICE ALLOCATION >>03924000
         <<WILL BE MADE IF SUFFICIENT DISK-SPACE CANNOT BE FOUND.     >>03926000
         <<INPUT:.....................................................>>03928000
         <<INDX < 0      - INDEX INTO DEVICE CLASS TABLE.             >>03930000
         <<     > 0      - LOGICAL DEVICE NUMBER.                     >>03932000
         <<     = 0       - SPOOLING CALL.        >>                    03934000
         <<NUMEXT        - # EXTENTS REQUIRED                         >>03936000
         <<   (SEE NOTE BELOW)   >>                                     03938000
         <<SPACEDATA     - SIZE OF EACH EXTENT (IN SECTORS)           >>03940000
         <<                (A SIZE MAY BE ZERO IN WHICH CASE NO SPACE >>03942000
         <<                IS ALLOCATED FOR THAT EXTENT - ZERO SIZES  >>03944000
         <<                DO COUNT AS FAR AS NUMEXT IS CONCERNED.)   >>03946000
         <<PVINFO.(0:1)  - USE MVTAB ENTRY AS DEV CLASS      >><<RH.PV>>03948000
         <<      .(4:4)  - MOUNTED VOLUME TABLE INDEX        >><<RH.PV>>03950000
         <<      .(8:8)  - VOLUME MASK OF ALLOWABLE VOLUMES  >><<RH.PV>>03952000
         <<NOTE..IF NUMEXT < 0 THEN SPACEDATA SHOULD  >>         <<MV>> 03954000
         <<CONTAIN THE LDEV-ADDRESS MAP (LDEV IN FIRST>>         <<MV>> 03956000
         <<BYTE OF THE DOUBLE WORD) AND THE DEVICES WILL>>       <<MV>> 03958000
         <<BE ALLOCATED BUT NO SPACE WILL BE ASSIGNED  >>        <<MV>> 03960000
         <<        DB MUST BE AT STACK.                 >>       <<MV>> 03962000
         <<OUTPUT:....................................................>>03964000
                                                                        03966000
                                                                        03968000
                                                                        03970000
         <<SPACEDATA     - DISK ADDRESS OF EACH REQUESTED EXTENT      >>03972000
         <<              NOTE. UPPER BYTE CONTAINS LDEV>>        <<MV>> 03974000
         <<DISKALLOC = 0 - OK, DEVICE AND SPACE ALLOCATED.            >>03976000
         <<           = 1 - Space not available.      >>       <<03507>>03978000
         <<           = 2 - I/O or other error.       >>       <<03507>>03980000
         <<           = 3 - Free space deallocation   >>       <<03507>>03982000
         <<                 disabled on ldev.         >>       <<03507>>03984000
         <<           = 4 - Device unavailable. (4 in >>       <<03507>>03986000
         <<                 right byte, ldev in left) >>       <<03507>>03988000
         <<          = 5 - INVALID INDX                               >>03990000
         <<IN CASE OF ERROR NO SPACE OR DEVICES ALLOCATED.            >>03992000
   BEGIN                                                                03994000
    EQUATE                                                              03996000
         LDSIZE1 = LDTSIZE-1                                            03998000
        ,PDSIZE1 = LPDTSIZE-1                                           04000000
   ;DEFINE                                                              04002000
         LPDT0 = LDT0#                                                  04004000
        ,LPDT1 = LDT1#                                                  04006000
   ;DOUBLE ARRAY                                                        04008000
         ADDR(0:31)=Q                                            <<MV>> 04010000
   ;ARRAY LADDR(*)=ADDR                                          <<MV>> 04012000
   ;BYTE ARRAY BADDR(*)=ADDR                                     <<MV>> 04014000
   ;BYTE ARRAY BSPACEDATA(*)=SPACEDATA                           <<MV>> 04016000
   ;ARRAY MVTABENT(0:MVTABSIZE-1)=Q                            <<RH.PV>>04018000
   ;DOUBLE ARRAY MVTABENTD(*)=MVTABENT(5)                      <<RH.PV>>04020000
   ;INTEGER                                                             04022000
         LDEV   <<LOGICAL DEVICE NUMBER>>                               04024000
         ,I,J:=-1 <<CURRENT EXTENT POINTER>>,K,V:=-1           <<RH.PV>>04026000
         ,COUNTER <<FOR USECOUNT>>                               <<MV>> 04028000
        ,NLDEV   <<# OF LOGICAL DEVICES IN DEVICE CLASS>>               04030000
        ,DSTX                                                           04032000
        ,CYCP   <<CYCLICAL POINTER>>                                    04034000
        ,COUNT   <<FOR STEPPING THROUGH DCT>>                           04036000
        ,LDT0                                                           04038000
        ,LDT1                                                           04040000
        ,LDT2                                                           04042000
        ,LDT3                                                           04044000
        ,LDT4                                                           04046000
        ,HVOL                                                  <<RH.PV>>04048000
        ,MVTABX                                                <<RH.PV>>04050000
   ;LOGICAL                                                             04052000
         LDEV' =  LDEV   <<LOGICAL LDEV>>                      <<RH.PV>>04054000
        ,ANYDEV   <<TRUE IF "INDX" IS A CLASS INDEX>>          <<RH.PV>>04056000
        ,B   <<GETSIR RETURN VALUE>>                                    04058000
        ,C   <<GETSIR RETURN VALUE>>                           <<RH.PV>>04060000
        ,MASK    <<VOLUME TEST MASK>>                          <<RH.PV>>04062000
        ,VMASK   <<ALLOWABLE-VOLUME MASK>>                     <<RH.PV>>04064000
        ,ERROR _ FALSE                                                  04066000
        ,FORSPOOLING _ FALSE  <<SPOOLING CALL?>>                        04068000
   ;INTEGER POINTER LPDT = 8                                   <<RH.PV>>04070000
   ;INTEGER POINTER                                                     04072000
         LDTP                                                           04074000
   , CLASSP     <<FOR DEV CLASS TABLE>>                        <<00635>>04076000
   ;INTEGER ARRAY                                                       04078000
         LDENTRY(*) = LDT0                                              04080000
        ,PDENTRY(*) = LDT0                                              04082000
        ,TENTRY(*) = LDT0                                               04084000
                                                               <<03507>>04086000
   << The following var remembers if we have tried to get >>   <<03507>>04088000
   << space on any device in the class and no space was   >>   <<03507>>04090000
   << available.  This is needed so that we return the    >>   <<03507>>04092000
   << disallocation disabled error only when all discs in >>   <<03507>>04094000
   << the class have had free space disabled.             >>   <<03507>>04096000
                                                               <<03507>>04098000
  ;LOGICAL out'of'space'on'any'dev := FALSE;                   <<03507>>04100000
                                                               <<03507>>04102000
   INTEGER return'value = diskalloc                            <<03507>>04104000
   ;INTEGER ARRAY                                                       04106000
         DTAB(*)                                                        04108000
        ,ICLASS(0:3) = Q                                                04110000
   ;BYTE ARRAY                                                          04112000
         CLASS(*) = ICLASS                                              04114000
   ;DEFINE NSDF    = (4:1)#                                    <<RH.PV>>04116000
   ;DEFINE PVALLOC = PVINFO <> 0#                              <<RH.PV>>04118000
   ;DEFINE PVCLASS = PVINFO.PVCLASSF#                          <<RH.PV>>04120000
   ;                                                                    04122000
                                                               <<03507>>04124000
<< DANGER: The array CLASS/ICLASS should be the last >>        <<03507>>04126000
<< variable in this routine, as it is expanded later >>        <<03507>>04128000
<< with an ADDS.   What shit!!!                      >>        <<03507>>04130000
                                                               <<03507>>04132000
SUBROUTINE GETDSPACE;                                                   04134000
         <<TRY TO GET ALL REQUESTED EXTENTS ON LDEV                   >>04136000
         <<LDEV MUST BE CORRECTLY SET                                 >>04138000
         <<I WILL BE MOST SIGNIFICANT RESULT FROM "DISKSPACE"         >>04140000
         <<ADDRESSES WILL BE PUT IN ADDR(*)                           >>04142000
         <<ALSO BUMPS USECOUNT FOR EACH EXTENT>>                 <<MV>> 04144000
         <<ON EXIT J POINTS TO LAST ALLOCATED EXTENT>>           <<MV>> 04146000
   BEGIN                                                                04148000
   I _ 0;   <<FOR CASE WHERE NUMEXT=0>>                                 04150000
   COUNTER := 0;                                                 <<MV>> 04152000
   IF NUMEXT >0 THEN                                             <<MV>> 04154000
      BEGIN <<GET SPACE>>                                        <<MV>> 04156000
   WHILE (J_J+1) < NUMEXT DO IF SPACEDATA(J) > 0D THEN                  04158000
      BEGIN                                                             04160000
      i := Get'Disc'Space (ldev, spacedata(j), addr(j));       <<03507>>04162000
      IF I<>0 THEN                                               <<MV>> 04164000
         BEGIN <<ERROR OR NO ROOM>>                              <<MV>> 04166000
                                                               <<03507>>04168000
          << Remember if it was a no space error >>            <<03507>>04170000
                                                               <<03507>>04172000
          IF i = 1 THEN                                        <<03507>>04174000
             out'of'space'on'any'dev := TRUE;                  <<03507>>04176000
                                                               <<03507>>04178000
         GOTO UPUSECOUNT;                                        <<MV>> 04180000
         END;                                                    <<MV>> 04182000
      BADDR(4*J):=LDEV;                                          <<MV>> 04184000
      COUNTER := COUNTER +1;                                            04186000
      END;                                                              04188000
 UPUSECOUNT:         J:=J-1;                                     <<MV>> 04190000
              USECOUNT:=USECOUNT+COUNTER;                        <<MV>> 04192000
      PUTDEV(LDEV,LDTDSTN,TENTRY);                        <<MV>>        04194000
      END                                                        <<MV>> 04196000
   ELSE                                                          <<MV>> 04198000
      BEGIN<<ALLOCATE THE DEVICES>>                              <<MV>> 04200000
      LDEV:=BSPACEDATA(0);                                       <<MV>> 04202000
      COUNTER:=0;                                                <<MV>> 04204000
      K:=0;<<POINTS TO THE LAST EXT ALLOCATED>>                  <<MV>> 04206000
      WHILE (J:=J+1)<-NUMEXT DO                                  <<MV>> 04208000
      IF BSPACEDATA(J*4)<>0 THEN                                 <<MV>> 04210000
         BEGIN                                                   <<MV>> 04212000
         IF LDEV=INTEGER(BSPACEDATA(J*4)) THEN                   <<MV>> 04214000
            COUNTER:=COUNTER+1                                   <<MV>> 04216000
         ELSE                                                    <<MV>> 04218000
            BEGIN<<NEW LDEV - BUMP USECOUNT>>                    <<MV>> 04220000
LASTDEV:    IF NOT GETDEV(LDEV,LDTDSTN,TENTRY)            <<MV>>        04222000
               THEN BEGIN                                        <<MV>> 04224000
                J:=K-1;                                          <<MV>> 04226000
                GOTO BADINDX;                                    <<MV>> 04228000
                END;                                             <<MV>> 04230000
            IF LOGF=0 OR LOGR=1THEN                              <<MV>> 04232000
               BEGIN<<DEVICE NOT AVAILABLE>>                     <<MV>> 04234000
               DISKALLOC := 4;                                 <<03507>>04236000
               DISKALLOC.(0:8):=LDEV;                            <<MV>> 04238000
               J:=K-1;<<FIX IT FOR DISKDEALLOC>>            <<MV>>      04240000
               GOTO OUT1;                                        <<MV>> 04242000
               END;                                              <<MV>> 04244000
            USECOUNT:=USECOUNT+COUNTER;                          <<MV>> 04246000
            K:=K+COUNTER;                                        <<MV>> 04248000
            COUNTER:=1;                                          <<MV>> 04250000
            PUTDEV(LDEV,LDTDSTN,TENTRY);                  <<MV>>        04252000
            LDEV:=BSPACEDATA(J*4);                               <<MV>> 04254000
            END;                                                 <<MV>> 04256000
         END;                                                    <<MV>> 04258000
      IF J =-NUMEXT THEN                                   <<MV>>       04260000
          GOTO LASTDEV <<THIS WILL BUMP THE USECOUNT>>     <<MV>>       04262000
                       <<AND THEN BUMP J            >>     <<MV>>       04264000
      ELSE J:=-NUMEXT-1; <<JUST IN CASE>>                  <<MV>>       04266000
      END;                                                       <<MV>> 04268000
   END;<<GETDSPACE>>                                             <<MV>> 04270000
                                                                        04272000
SUBROUTINE SPACEMSG (TYPE);                                             04274000
   VALUE   TYPE;                                                        04276000
   INTEGER TYPE;                                                        04278000
   BEGIN                                                                04280000
   EXCHANGEDB(LDTDST);                                                  04282000
   @LDTP := LDTSIZE;                                                    04284000
   DO LDTP(LD'SQ) := 0                                                  04286000
   UNTIL (@LDTP:=@LDTP+LDTSIZE)>LDT'HIENTRY*LDTSIZE;                    04288000
   <<RESET SPOOLER QUEUE FOR CLASSES TOO>>                     <<00635>>04290000
   @CLASSP := @LDT'DCTP;                                       <<01834>>04292000
   DO CLASSP(DC'SQ) := 0                                       <<00635>>04294000
   UNTIL (@CLASSP := @CLASSP + (CLASSP(DC'NUMDEVS)&ASR(1)) + 6)<<00635>>04296000
         > (LDT'DCTSIZE+@LDT'DCTP);                            <<00635>>04298000
   EXCHANGEDB(0);                                                       04300000
   GENMSG(1,TYPE,,,,,,,0);                                     <<0U.EB>>04302000
   END;                                                                 04304000
                                                                        04306000
   return'value := 1;  << Init to no space >>                  <<03507>>04308000
                                                               <<03507>>04310000
   IF PVALLOC THEN                                             <<RH.PV>>04312000
      BEGIN                                                    <<RH.PV>>04314000
      C:=GETSIR(MVTABSIR);                                     <<04812>>04316000
      B := GETSIR (LDTSIR);                                    <<04812>>04318000
      TOS:=PVINFO;                                             <<RH.PV>>04320000
      VMASK:=S0.VMASKF;                                        <<RH.PV>>04322000
      MVTABX:=TOS.MVTABXF;                                     <<RH.PV>>04324000
      TOS:=@MVTABENT;                                          <<RH.PV>>04326000
      TOS:=MVTABDST;                                           <<RH.PV>>04328000
      TOS:=MVTABX * MVTABSIZE;                                 <<RH.PV>>04330000
      TOS:=MVTABSIZE;                                          <<RH.PV>>04332000
      ASSEMBLE(MFDS 4);                                        <<RH.PV>>04334000
      HVOL:=MVTABENT(1).(0:4);  <<HIGHEST VOLUME INDEX>>       <<RH.PV>>04336000
      END ELSE B := GETSIR (LDTSIR);                           <<RV.PV>>04338000
   IF INDX = 0 THEN                                                     04340000
      BEGIN    << SPOOLING CALL: USE SYSGLOB VALUES & CHECK SECT CNT >> 04342000
      IF NUMEXT > 0 THEN                                                04344000
         BEGIN    << ACTUAL SECTOR ALLOCATION >>                        04346000
         DISAPROC;                                                      04348000
         PUSHNUMSS;    << CHECK & ADJUST SECT COUNT >>                  04350000
         TOS := TOS +(ABSYS'EXTSS ** LOGICAL (NUMEXT));                 04352000
         ASSEMBLE (DDUP);                                               04354000
         PUSHMAXSS;                                                     04356000
         ASSEMBLE (DCMP);                                               04358000
         IF > THEN                                                      04360000
            BEGIN                                                       04362000
            ENAPROC;                                                    04364000
            SPACEMSG(232);                                              04366000
            GOTO out1;                                         <<03507>>04368000
            END;                                                        04370000
         POPNUMSS;                                                      04372000
         ENAPROC;                                                       04374000
         SPACEDATA := DOUBLE (ABSYS'EXTSS);                             04376000
         MOVE SPACEDATA (1) := SPACEDATA, ((NUMEXT-1) &ASL(1));         04378000
         << SPL WANTS WORD COUNT, ABOVE >>                              04380000
         END;                                                           04382000
      INDX := ABSYS'SINDEX;                                             04384000
      FORSPOOLING := TRUE;                                              04386000
      END;                                                              04388000
   LADDR:=0;                                                     <<MV>> 04390000
   IF NUMEXT>0 THEN                                              <<MV>> 04392000
      MOVE LADDR(1):=LADDR,(NUMEXT*2-1)                          <<MV>> 04394000
      ELSE                                                       <<MV>> 04396000
         GOTO NOTSPACE;   <<JUST ALLOC DEVICES>>             <<MV>>     04398000
   IF PVCLASS THEN  <<USE MVTAB ENTRY AS PSEUDO DEV. CLASS>>   <<RH.PV>>04400000
      BEGIN                                                    <<RH.PV>>04402000
      MASK:=0;                                                 <<RH.PV>>04404000
      CYCP:=MVTABENT.CYCPF;                                    <<RH.PV>>04406000
NEXTV:                                                         <<RH.PV>>04408000
      WHILE (MASK LAND VMASK) = 0 DO                           <<RH.PV>>04410000
         BEGIN                                                 <<RH.PV>>04412000
         IF vmask = 0 THEN GO out1;                            <<03507>>04414000
         CYCP:=IF CYCP < HVOL THEN (CYCP+1) ELSE 0;            <<RH.PV>>04416000
         MASK:=1 & LSL(CYCP);                                  <<RH.PV>>04418000
         END;                                                  <<RH.PV>>04420000
      VMASK:=VMASK LAND NOT MASK;  <<RESET BIT JUST TESTED>>   <<RH.PV>>04422000
      LDEV:=MVTABENT((CYCP&LSL(1))+5).(0:8);                   <<RH.PV>>04424000
      GO CONT2;                                                <<RH.PV>>04426000
      END;                                                     <<RH.PV>>04428000
   IF NOT (ANYDEV _ INDX<0) THEN                                        04430000
      BEGIN   <<SPECIFIC DEVICE>>                                       04432000
      GO SPECDEV;                                                       04434000
      END;                                                              04436000
    <<DEVICE CLASS>>                                                    04438000
   INDX _ -INDX;                                                        04440000
   IF NOT GETCLASS(ICLASS,FALSE,,INDX) THEN                             04442000
      BEGIN   <<INVALID INDX>>                                          04444000
BADINDX:                                                                04446000
      DISKALLOC _ 5;                                                    04448000
OUT1:                                                                   04450000
      RELSIR(LDTSIR,B);                                                 04452000
                                                               <<03507>>04454000
      IF return'value = 3 AND out'of'space'on'any'dev          <<03507>>04456000
         THEN return'value := 1;  << Force "out-of-space" >>   <<03507>>04458000
                                                               <<03507>>04460000
      IF PVALLOC THEN RELSIR (MVTABSIR,C);                     <<RV.PV>>04462000
      IF NUMEXT>0 THEN <<RETURN SPACE>>                          <<MV>> 04464000
         BEGIN                                                          04466000
         DISKDEALLOC (LOGICAL (SPACEDATA), LOGICAL (SPACEDATA (J)),     04468000
            J+1, ADDR);                                                 04470000
         IF FORSPOOLING THEN                                            04472000
            BEGIN    << ERR WHEN SPOOLING CALL: SET CNT BACK >>         04474000
            DISAPROC;                                                   04476000
            PUSHNUMSS;                                                  04478000
            TOS := TOS -(LOGICAL (SPACEDATA) ** LOGICAL (J+1));         04480000
            POPNUMSS;                                                   04482000
            ENAPROC;                                                    04484000
            END;                                                        04486000
         END                                                            04488000
      ELSE  <<KEEP SPACE>>                                       <<MV>> 04490000
         DISKDEALLOC(0,0<<IGNORED>>,-J-1,SPACEDATA);             <<MV>> 04492000
      RETURN;                                                           04494000
      END;                                                              04496000
   I _ CLASS(6);                                                        04498000
   TOS _ I & LSR(1);                                                    04500000
   ASMB(ADDS 0);   <<GET ARRAY UP TO SIZE>>                             04502000
   GETCLASS(ICLASS,TRUE,ICLASS(0));   <<GET WHOLE ENTRY>>               04504000
   CYCP _ ICLASS(2).(1:7);   <<CYCLICAL POINTER>>                       04506000
   NLDEV _ CLASS(6);   <<#DEVICES IN CLASS>>                            04508000
   COUNT _ 0;                                                           04510000
NEXT:                                                                   04512000
   IF (COUNT_COUNT+1) > NLDEV THEN                                      04514000
      BEGIN                                                             04516000
      IF FORSPOOLING THEN SPACEMSG(233);                                04518000
      GO OUT1;                                                          04524000
      END;                                                              04526000
   IF (CYCP_CYCP+1) > NLDEV THEN CYCP_1;   <<INC.CYCLICAL POINTER>>     04528000
   LDEV _ CLASS(CYCP+6);   <<NEXT DISK TO TRY FOR>>                     04530000
   IF PVALLOC THEN                                             <<RH.PV>>04532000
      BEGIN                                                    <<RH.PV>>04534000
      V:=-1;                                                   <<RH.PV>>04536000
      WHILE (V:=V+1) <= HVOL DO                                <<RH.PV>>04538000
      IF (MVTABENT((V&LSL(1))+5).(0:8) = LDEV' LAND            <<RH.PV>>04540000
         (((1 & LSL(V)) LAND VMASK) <> 0)) THEN GO CONT2;      <<RH.PV>>04542000
      GO NEXT;                                                 <<RH.PV>>04544000
      END                                                      <<RH.PV>>04546000
   ELSE                                                        <<RH.PV>>04548000
      IF LOGICAL(LPDT((LDEV & LSL(1))+1).NSDF) THEN GO NEXT;   <<RH.PV>>04550000
CONT2:                                                         <<RH.PV>>04552000
   GETDEV(LDEV,LDTDSTN,TENTRY);                                         04554000
   IF LOGF=0 OR LOGR=1 THEN                                             04556000
      BEGIN   <<DEVICE NOT AVAILABLE>>                                  04558000
      IF PVCLASS THEN GO NEXTV ELSE GO NEXT;                   <<RH.PV>>04560000
      END;                                                              04562000
   GETDSPACE;                                                           04564000
   return'value := i;                                          <<03507>>04566000
   IF I=0 THEN GO CONT;                                                 04568000
   IF I <> 2 THEN << Not an I/O error >>                       <<03507>>04570000
      IF PVCLASS THEN GO NEXTV ELSE GO NEXT;  <<NO ROOM>>      <<RH.PV>>04574000
   ERROR _ TRUE;                                                        04578000
CONT:   <<UPDATE CYCLICAL POINTER>>                                     04580000
   IF PVCLASS THEN  <<UPDATE PV CYCP>>                         <<RH.PV>>04582000
   IF HVOL > 0 THEN  <<MORE THAN ONE POSSIBLE VALUE FOR CYCP>> <<RH.PV>>04584000
      BEGIN                                                    <<RH.PV>>04586000
      MVTABENT.CYCPF:=CYCP;                                    <<RH.PV>>04588000
      TOS:=MVTABDST;                                           <<RH.PV>>04590000
      TOS:=MVTABX * MVTABSIZE;                                 <<RH.PV>>04592000
      TOS:=@MVTABENT;                                          <<RH.PV>>04594000
      TOS:=1;  <<ONE WORD TRANSFER>>                           <<RH.PV>>04596000
      ASSEMBLE(MTDS 4);                                        <<RH.PV>>04598000
      END                                                      <<RH.PV>>04600000
    ELSE ELSE                                                  <<RH.PV>>04602000
      BEGIN                                                    <<RH.PV>>04604000
      EXCHANGEDB(LDTDSTN);                                     <<RH.PV>>04606000
      @DTAB _ ICLASS(0);   <<ADR.OF CLASS ENTRY>>              <<RH.PV>>04608000
      DTAB(4).(1:7) _ CYCP;   <<LAST DEVICE ALLOCATED>>        <<RH.PV>>04610000
      EXCHANGEDB(0);                                           <<RH.PV>>04612000
      END;                                                     <<RH.PV>>04614000
   IF ERROR THEN GO OUT1;                                               04616000
LATCHON:                                                         <<MV>> 04618000
                                                                 <<MV>> 04620000
                                                                 <<MV>> 04622000
<< PASS BACK DEV.INFO >>                                                04624000
   RELSIR(LDTSIR,B);                                                    04626000
   IF PVALLOC THEN RELSIR (MVTABSIR,C);                        <<RV.PV>>04628000
                                                       <<MV>>           04630000
                                                       <<MV>>           04632000
                                                       <<MV>>           04634000
   I _ -1;                                                              04636000
   WHILE (I_I+1) < NUMEXT DO SPACEDATA(I) _ ADDR(I);   <<EXTENT ADDR.>> 04638000
                                                        <<MV>>          04640000
                                                                 <<MV>> 04642000
                                                       <<MV>>           04644000
                                                       <<MV>>           04646000
                                                       <<MV>>           04648000
   DISKALLOC := 0;    <<OKAY RETURN>>                                   04650000
   RETURN;                                                              04652000
SPECDEV:   <<SPECIFIC DEVICE>>                                          04654000
   LDEV _ INDX;                                                         04656000
   IF PVALLOC THEN                                             <<RH.PV>>04658000
      BEGIN                                                    <<RH.PV>>04660000
      V:=-1;                                                   <<RH.PV>>04662000
      WHILE (V:=V+1) <= HVOL DO                                <<RH.PV>>04664000
      IF (MVTABENT((V&LSL(1))+5).(0:8) = LDEV' LAND            <<RH.PV>>04666000
         (((1 & LSL(V)) LAND VMASK) <> 0)) THEN  GO CONT3;     <<RH.PV>>04668000
      GO NOTAVAIL;                                             <<00565>>04670000
      END                                                      <<RH.PV>>04672000
   ELSE                                                        <<RH.PV>>04674000
      IF LOGICAL (LPDT((LDEV&LSL(1))+1).NSDF) THEN GO NOTAVAIL;<<00565>>04676000
CONT3:                                                         <<RH.PV>>04678000
   IF NOT GETDEV(LDEV,LDTDSTN,TENTRY) THEN                              04680000
      BEGIN   <<INVALID LDEV (INDX)>>                                   04682000
      GO BADINDX;                                                       04684000
      END;                                                              04686000
   IF LOGF=0 OR LOGR=1 THEN                                             04688000
NOTAVAIL:                                                      <<00565>>04690000
      BEGIN   <<DEVICE NOT AVAILABLE>>                                  04692000
      diskalloc := 4;                                          <<03507>>04694000
      DISKALLOC.(0:8):=LDEV;                                     <<MV>> 04696000
      GO OUT1;                                                          04698000
      END;                                                              04700000
NOTSPACE:                                              <<MV>>           04702000
   GETDSPACE;                                                           04704000
   IF I=0 THEN GO LATCHON;                                              04706000
   IF i=2 THEN TOS := 2  ELSE  << I/O error >>                 <<03507>>04708000
   IF i=3 THEN TOS := 3  ELSE  << Allocation disabled >>       <<03507>>04710000
   IF i=1 THEN TOS := 1;       << Space not available >>       <<03507>>04712000
   DISKALLOC _ TOS;                                                     04714000
   GO OUT1;                                                             04716000
   END;   <<DISKALLOC>>                                                 04718000
$CONTROL SEGMENT= ALLOCATE                                              04720000
                                                                        04722000
                                                                        04724000
PROCEDURE FORMSALIGN(LDEV);                                             04726000
    VALUE LDEV;                                                         04728000
    INTEGER LDEV;                                                       04730000
    OPTION PRIVILEGED,UNCALLABLE;                                       04732000
   BEGIN                                                                04734000
   INTEGER ARRAY                                                        04736000
         IBUF(0:65),                                           <<04620>>04738000
         LPDT(0:4),   << Logical to Physical Device Table   >> <<04620>>04740000
         LDT(0:4);    << Logical Device Table Array.        >> <<04620>>04742000
   BYTE POINTER BBUF;                                                   04744000
   LOGICAL OK;                                                 <<04620>>04746000
   INTEGER                                                     <<04620>>04748000
      RSIZE,          << Record size of the device.         >> <<04620>>04752000
          I;          << General purpose index.             >> <<04620>>04754000
                                                               <<04620>>04756000
   GETDEV(LDEV,LDTDSTN,LDT);  << Copy LDT entry into array  >> <<04620>>04758000
   GETDEV(LDEV,LPDDSTN,LPDT); << Copy LPDT entry into array.>> <<04620>>04760000
                                                               <<04620>>04762000
   <<*******************************************************>> <<04620>>04764000
   << Only printer and output spooled terminals allowed!    >> <<04620>>04766000
   << Do not print forms allign for 2608B printer because   >> <<04620>>04768000
   << the function exists on the printer itself.            >> <<04620>>04770000
   <<*******************************************************>> <<04620>>04772000
                                                               <<04620>>04774000
   IF (LDT(LD'DEVTYPE) = PRINTER LAND LPDT(LP'SUBTYPE) <> 9)   <<04620>>04776000
      LOR (LDT(LD'DEVTYPE) = TERMINAL LAND                     <<04620>>04778000
           LDT(LD'SP) = OUTPUTSPOOLER) THEN                    <<04620>>04780000
        BEGIN                                                  <<04620>>04782000
        RSIZE := LDT(LD'RWIDTH) * 2; <<Record size in bytes >> <<04620>>04784000
        @BBUF := (@IBUF &LSL(1)) -1;                           <<04620>>04786000
        MOVE IBUF := "....:....#";                             <<04620>>04788000
        MOVE IBUF (5) := IBUF, (61);                           <<04620>>04790000
        I := 10;                                               <<04620>>04792000
        DO BBUF (I) := (I/10) MOD 10 + "0"                     <<04620>>04794000
        UNTIL (I := I + 10) > 130;                             <<04620>>04796000
        DO                                                     <<04620>>04798000
           BEGIN                                               <<04620>>04800000
           ATTACHIO(LDEV,0,0,@IBUF,1,-RSIZE,0,0,1);            <<04620>>04802000
           GENMSG(1,216,%10000,LDEV,,,,,0,1,@OK);              <<04620>>04804000
           END                                                 <<04620>>04806000
        UNTIL OK;                                              <<04620>>04808000
                                                               <<04620>>04810000
        << Call to HELP for STT entry, never executed       >> <<04620>>04812000
                                                               <<04620>>04814000
        IF FALSE THEN HELP;                                    <<04620>>04816000
        END;                                                   <<04620>>04818000
                                                               <<04620>>04820000
   END;   <<FORMS ALIGN>>                                               04822000
<<>>                                                                    04824000
<<>>                                                                    04826000
LOGICAL PROCEDURE ASKOP(REQDEV,FNAME,OLDFLAG,ALLOCDEV,TYPE,JMPIN,       04828000
    SPOOLERNUM,JOBNUM,FLAGS,PTYPE,STRIN,RESPONSE);             <<SD.00>>04830000
    VALUE REQDEV,OLDFLAG,SPOOLERNUM,JOBNUM,JMPIN,FLAGS,PTYPE;  <<SD.00>>04832000
    INTEGER REQDEV,ALLOCDEV,TYPE,SPOOLERNUM,JOBNUM,JMPIN,FLAGS,<<SD.00>>04834000
            PTYPE;                                             <<SD.00>>04836000
    LOGICAL OLDFLAG;                                                    04838000
    INTEGER ARRAY FNAME;                                                04840000
    BYTE ARRAY STRIN,RESPONSE;                                 <<SD.00>>04842000
    OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                              04844000
         <<REQUESTS DEVICE OR DEVICE IN CLASS. IF CLASS, INSURES THAT >>04846000
         <<DEVICE IS IN CLASS.IF REALEE, THEN CHECKS OWNERSHIP AND    >>04848000
         <<WHETHER OLD-DATA ACCEPTING. OPERATOR IS HARASSED UNTIL     >>04850000
         <<HE/SHE/IT GIVES A VALID RESPONSE.                          >>04852000
         <<INPUT:                                                     >>04854000
         <<      REQDEV             - +LDEV OR -CLASS INDEX           >>04856000
         <<      FNAME              - FILE NAME (8BYTES,1ST BLANK     >>04858000
         <<                                               TERMINATES) >>04860000
         <<      OLDFLAG            - TRUE IF OLD REQUEST             >>04862000
         <<      JMPIN              - JOB MAIN PROCESS#               >>04864000
         <<      PTYPE=0#             NO PARAMETER SOUGHT             >>04866000
         <<           =1            - NUMERIC PARM SOUGHT             >>04868000
         <<           =2            - YES/NO PARM SOUGHT              >>04870000
         <<           =3            - STRING PARM SOUGHT              >>04872000
         <<      STRIN !            - FORMATTED PARAMETER DEFINING    >>04874000
         <<                           OPERATOR RESPONSE DESIRED.      >>04876000
         <<                         I.E. ",WRITE RING? (Y/N)",0       >>04878000
         <<                           BYTE ARRAY DELIMITED BY A ZERO  >>04880000
         <<      SPOOLERNUM*        - SPOOLEE LDEV                    >>04882000
         <<      JOBNUM*            - SPOOFLE'S JOB#                  >>04884000
         <<  * SPOOLER CALLERS ONLY                                   >>04886000
         <<  # ONLY NEEDED IF A PARM AFTER LDEV IS WANTED             >>04888000
         <<  ! ONLY NEEDED IF PTYPE=3                                 >>04890000
         <<OUTPUT:                                                    >>04892000
         <<      ASKOP = TRUE       - NOT REJECTED (SEE TYPE)         >>04894000
         <<            = FALSE      - OP.REJECTED (REPLIED "0"OR"NO)  >>04896000
         <<      ALLOCDEV           - +LDEV# (THE ONE OP.GAVE YOU)    >>04898000
         <<      TYPE = 0           - OLD & DATA ACCEPTING            >>04900000
         <<           = 1           - RE-ALLOCATION                   >>04902000
         <<           = 2           - INITIAL ALLOCATION (RESERVED)   >>04904000
         <<                                     (I.E. SS_3)           >>04906000
         <<      RESPONSE           - MINUS ONE (-1) FOR "YES"        >>04908000
         <<                           ZERO (0) FOR "NO"               >>04910000
         <<                           THE NUMBER INPUT BY OP (INTEGER)>>04912000
         <<                           OR                              >>04914000
         <<                           STRING WITH LENGTH IN FIRST WORD>>04916000
         <<                           AND CHARACTERS BEGINNING IN     >>04918000
         <<                           SECOND.  MAXLEN=20CHAR          >>04920000
         <<     NOTE: DB AT STACK COMING IN & GOING OUT.              >>04922000
   BEGIN                                                                04924000
   EQUATE                                                               04926000
         OKAY = OPASSIGNED,                                             04928000
         REJECTED = 3,                                                  04930000
         INVALID = 4;                                                   04932000
    DEFINE ACCESS  = FLAGS.(14:2)#;                            <<TL.02>>04934000
    DEFINE LABELED = FLAGS.(7:1)#;                             <<TL.02>>04936000
   DEFINE      <<OPTIONAL PARAMETER BITMAP>>                   <<SD.00>>04938000
         SPOOLERBITS=(10:2)#,                                  <<SD.00>>04940000
         RESPONSEBIT=(15:1)#,                                  <<SD.00>>04942000
         STRINBIT=(14:1)#,                                     <<SD.00>>04944000
         PTYPEBIT=(13:1)#;                                     <<SD.00>>04946000
   LOGICAL                                                              04948000
         CLASSREQ,   <<CLASS REQUEST>>                                  04950000
         SPOOLDEV,   <<CALL FROM SPOOLER>>                              04952000
      AUTOALLOC,  <<AUTOMATICALLY ALLOCATED MAG TAPE>>         <<TL.03>>04954000
      CHECK'FOR'AVR,  <<Check for AVR on tape and sdisc>>      <<03681>>04956000
         C,   <<GETSIR RETURN - LPDT>>                                  04958000
         B;   <<GETSIR RETURN - LDT>>                                   04960000
   DOUBLE DSTAT'RET;                                           <<03698>>04962000
   INTEGER STAT'RET0=DSTAT'RET;                                <<03698>>04964000
   INTEGER STAT'RET1=STAT'RET0+1;                              <<03698>>04966000
   DEFINE ON'LINE=(STAT'RET1.(14:1)=0)#;                       <<03698>>04968000
   INTEGER                                                              04970000
         I,J,                                                           04972000
         Q4 = Q-4,   <<BIT MAP>>                                        04974000
         ANSWER,   <<OP.RESPONSE>>                                      04976000
      CLASSLEN,                                                <<00552>>04978000
         DLOFCLASSNAME,   <<DL.REL.ADR.OF CLASSNAME(*)>>                04980000
         RESP,   <<TEMP.STORAGE OF TYPE>>                               04982000
         DEVTOCONSIDER,   <<DEVICE CURRENTLY BEING CONSIDERED>>         04984000
      LDEVN,                                                   <<TL.02>>04986000
         LPDT0,                                                         04988000
         LPDT1,                                                         04990000
         LDT0,                                                          04992000
         LDT1,                                                          04994000
         LDT2,                                                          04996000
         LDT3,                                                          04998000
         LDT4;                                                          05000000
   LOGICAL                                                     <<01647>>05002000
      ASSOC'SIR;                   << SAVE SIR FOR ASSOC.   >> <<01647>>05004000
                                                               <<01647>>05006000
   INTEGER ARRAY                                                        05008000
         LFNAME(0:4),   <<LOCAL VERSION OF FNAME(*)>>                   05010000
         LCLASSNAME(0:4),                                               05012000
         JOBNUMBER (0:3),                                               05014000
      ASSOC(0:ASS'ENTRYSIZE),     <<LEAVE EXTRA FOR GENMSG TERMINATOR>> 05016000
         DTAB(*);                                                       05018000
   BYTE ARRAY                                                           05020000
      ASSOC'(*)=ASSOC,                                         <<00552>>05022000
         BLFNAME(*) = LFNAME,                                           05024000
         BLCLASSNAME(*) = LCLASSNAME,                                   05026000
         BJOBNUMBER (*) = JOBNUMBER;                                    05028000
   INTEGER ARRAY                                                        05030000
         LDENTRY(*) = LDT0,                                             05032000
         PDENTRY(*) = LPDT0;                                            05034000
   INTEGER POINTER                                             <<SD.00>>05036000
         TBUF, <<WILL POINT TO OPERATOR REPLY>>                <<SD.00>>05038000
         IOUTBUF; <<WILL POINT TO RESPONSE BUFFER>>            <<SD.00>>05040000
   BYTE ARRAY                                                  <<SD.00>>05042000
         BTBUF(0:26), <<MAX OP REPLY LENGTH IS 27 CHAR>>       <<SD.00>>05044000
         BLANKBUF(0:1); <<DEFAULT INPUT STRING>>               <<SD.00>>05046000
   BYTE POINTER                                                <<SD.00>>05048000
         INBUF:=@BLANKBUF,  <<INPUT STRING HOLDER>>            <<SD.00>>05050000
         OUTBUF:=@BTBUF; <<OUTPUT STRING HOLDER>>              <<SD.00>>05052000
    <<*** WARNING: THE FOLLOWING MUST BE THE LAST DECLARATIONS IN       05054000
                                 ----        ----   THIS PROCEDURE ***>>05056000
   INTEGER ARRAY                                                        05058000
         ICLASS(0:3) ;                                                  05060000
   BYTE ARRAY                                                           05062000
         BCLASS(*) = ICLASS;                                            05064000
$PAGE                                                          <<00552>>05066000
SUBROUTINE PARSEPARM;                                          <<SD.00>>05068000
COMMENT: PARSE OPERATOR RESPONSE.  MUST BE IN THE FORM         <<SD.00>>05070000
         LDEV# (OR) YES/NO   ,   PARAMETER                     <<SD.00>>05072000
         PARAMETER MAY BE 1)A NUMBER<=32759                    <<SD.00>>05074000
                          2)"YES" OR "NO"                      <<SD.00>>05076000
                          3)A STRING OF UP TO 20 CHARACTERS    <<SD.00>>05078000
         PARAMETER IS OPTIONAL WITH DEFAULTS BEING             <<SD.00>>05080000
                          1)ZERO                               <<SD.00>>05082000
                          2)"NO"                               <<SD.00>>05084000
                          3)ZERO LENGTH STRING                 <<SD.00>>05086000
         ANY DEVIATION WILL RESULT IN THE OPERATOR BEING       <<SD.00>>05088000
         REASKED.  ((RESP:=INVALID))                           <<SD.00>>05090000
END OF COMMENT;                                                <<SD.00>>05092000
BEGIN <<PARSEPARM>>                                            <<SD.00>>05094000
I:=TBUF; <<LENGTH OF RESPONSE>>                                <<SD.00>>05096000
RESP:=OKAY;                                                    <<SD.00>>05098000
BTBUF(I+2):=%54; <<APPEND COMMA TO INSURE END OF SCAN>>        <<SD.00>>05100000
IF CLASSREQ THEN                                               <<SD.00>>05102000
   BEGIN <<NUMERIC RESPONSE REQUESTED>>                        <<SD.00>>05104000
   I:=1; <<RESPONSE BEGINS IN SECOND WORD>>                    <<SD.00>>05106000
   WHILE BTBUF(I:=I+1)<>%54 <<COMMA>> DO                       <<SD.00>>05108000
     IF %60<=INTEGER(BTBUF(I))<=%71 THEN ELSE RESP:=INVALID;   <<SD.00>>05110000
   END   <<NUMERIC RESPONSE REQUESTED>>                        <<SD.00>>05112000
ELSE                                                           <<SD.00>>05114000
   BEGIN <<YES/NO RESPONSE REQUESTED>>                         <<SD.00>>05116000
   RESP:=INVALID;                                              <<SD.00>>05118000
   IF BTBUF(2)="Y," OR BTBUF(2)="YES," THEN RESP:=OKAY;        <<SD.00>>05120000
   IF BTBUF(2)="N," OR BTBUF(2)="NO,"  OR                      <<04538>>05122000
      BTBUF(2)="0," THEN RESP := OKAY;                         <<04538>>05124000
   END;  <<YES/NO RESPONSE REQUESTED>>                         <<SD.00>>05126000
IF RESP=OKAY THEN                                              <<SD.00>>05128000
   BEGIN <<OPERATOR RESPONSE HAS VALID SYNTAX>>                <<SD.00>>05130000
   IF CLASSREQ THEN                                            <<SD.00>>05132000
      BEGIN <<CONVERT # TO BINARY>>                            <<SD.00>>05134000
      I:=1; <<# BEGINS IN SECOND WORD>>                        <<SD.00>>05136000
      ANSWER:=0; <<ACCUMULATOR>>                               <<SD.00>>05138000
      WHILE BTBUF(I:=I+1)<>%54 AND ANSWER<3276 DO              <<SD.00>>05140000
         ANSWER:=ANSWER*10+INTEGER(BTBUF(I))-%60;              <<SD.00>>05142000
      END   <<CONVERT # TO BINARY>>                            <<SD.00>>05144000
   ELSE                                                        <<SD.00>>05146000
      BEGIN <<SET YES/NO>>                                     <<SD.00>>05148000
      ANSWER:=IF BTBUF(2)="Y" THEN -1<<TRUE>> ELSE 0<<FALSE>>; <<SD.00>>05150000
      I:=2; <<FOR SCAN TO FIND COMMA>>                         <<SD.00>>05152000
      END;  <<SET YES/NO>>                                     <<SD.00>>05154000
   WHILE BTBUF(I)<>%54 DO I:=I+1; <<FIND FIRST COMMA>>         <<SD.00>>05156000
   IF I-1<TBUF THEN                                            <<SD.00>>05158000
      BEGIN <<PARAMETER ENTERED BY OPERATOR>>                  <<SD.00>>05160000
      CASE PTYPE OF                                            <<SD.00>>05162000
         BEGIN <<CASE STATEMENT>>                              <<SD.00>>05164000
            IOUTBUF:=0; <<NO PARAMETER SOUGHT>>                <<SD.00>>05166000
            BEGIN <<NUMERIC PARM SOUGHT>>                      <<SD.00>>05168000
            IOUTBUF:=0; <<ACCUMULATOR>>                        <<SD.00>>05170000
            WHILE BTBUF(I:=I+1)<>%54 DO                        <<SD.00>>05172000
               BEGIN <<CONVERT # TO BINARY>>                   <<SD.00>>05174000
               IF BTBUF(I)<%60 OR BTBUF(I)>%71 THEN RESP:=INVALID;      05176000
               IF IOUTBUF<3276 THEN                            <<SD.00>>05178000
                  IOUTBUF:=IOUTBUF*10+INTEGER(BTBUF(I))-%60    <<SD.00>>05180000
               ELSE                                            <<SD.00>>05182000
                  RESP:=INVALID;                               <<SD.00>>05184000
               END;  <<CONVERT # TO BINARY>>                   <<SD.00>>05186000
            END;  <<NUMERIC PARM SOUGHT>>                      <<SD.00>>05188000
            BEGIN <<YES/NO>>                                   <<SD.00>>05190000
            IF RESP=OKAY THEN                                  <<SD.00>>05192000
               BEGIN <<SET RETURN VALUE FOR YES/NO>>           <<SD.00>>05194000
               RESP:=INVALID;                                  <<SD.00>>05196000
               IF BTBUF(I+1)="Y," OR BTBUF(I+1)="YES," THEN    <<SD.00>>05198000
                  BEGIN <<VALID YES PARM>>                     <<SD.00>>05200000
                  RESP:=OKAY;                                  <<SD.00>>05202000
                  IOUTBUF:=-1; <<TRUE>>                        <<SD.00>>05204000
                  END;  <<VALID YES PARM>>                     <<SD.00>>05206000
               IF BTBUF(I+1)="N," OR BTBUF(I+1)="NO," THEN     <<SD.00>>05208000
                  BEGIN <<VALID NO PARM>>                      <<SD.00>>05210000
                  RESP:=OKAY;                                  <<SD.00>>05212000
                  IOUTBUF:=0; <<FALSE>>                        <<SD.00>>05214000
                  END;  <<VALID NO PARM>>                      <<SD.00>>05216000
               END;  <<SET RETURN VALUE FOR YES/NO>>           <<SD.00>>05218000
            END;  <<YES/NO>>                                   <<SD.00>>05220000
            BEGIN <<STRING RESPONSE SOUGHT>>                   <<SD.00>>05222000
            IOUTBUF:=TBUF-I+1; <<LENGTH OF STRING>>            <<SD.00>>05224000
            MOVE OUTBUF(2):=BTBUF(I+1),(TBUF-I+1);             <<SD.00>>05226000
            END;  <<STRING PARM SOUGHT>>                       <<SD.00>>05228000
         END;  <<CASE STATEMENT>>                              <<SD.00>>05230000
      END   <<PARAMETER ENTERED BY OPERATOR>>                  <<SD.00>>05232000
   ELSE                                                        <<SD.00>>05234000
      BEGIN <<NO PARM ENTERED BY OP>>                          <<SD.00>>05236000
      IF PTYPE>0 THEN IOUTBUF:=0; <<DEFAULTS ARE:>>            <<SD.00>>05238000
                                  <<NUMERIC- 0   >>            <<SD.00>>05240000
                                  <<YES/NO-  NO  >>            <<SD.00>>05242000
                                  <<STRING-  NONE>>            <<SD.00>>05244000
      END;  <<NO PARM ENTERED BY OP>>                          <<SD.00>>05246000
   END;  <<OPERATOR RESPONSE HAS VALID SYNTAX>>                <<SD.00>>05248000
END;  <<PARSEPARM>>                                            <<SD.00>>05250000
$PAGE                                                          <<00552>>05252000
LOGICAL SUBROUTINE CHKASS(LDEV);                               <<00552>>05254000
VALUE LDEV;                                                    <<00552>>05256000
INTEGER LDEV;                                                  <<00552>>05258000
BEGIN                                                          <<00552>>05260000
   LOCK'ASS'TABLE;                                             <<01647>>05262000
   TOS:=LDEV*ASS'ENTRYSIZE;                                    <<00552>>05264000
   TOS:=@ASSOC;  <<GET ASSOCIATION TABLE ENTRY>>               <<00552>>05266000
   TOS:=ASS'DST;                                               <<00552>>05268000
   ASSEMBLE(CAB);                                              <<00552>>05270000
   TOS:=ASS'ENTRYSIZE;                                         <<00552>>05272000
   ASSEMBLE(MFDS 4);                                           <<00552>>05274000
   FREE'ASS'TABLE;                                             <<01647>>05276000
   MOVE BLCLASSNAME:=BLCLASSNAME WHILE AN,1;                   <<00552>>05278000
   CLASSLEN:=TOS-@BLCLASSNAME;                                 <<00552>>05280000
   IF ASSOC(ASS'JIT)<>0 AND                                    <<00552>>05282000
      ASSOC'(ASS'CLASS*2)<>BLCLASSNAME,(CLASSLEN) THEN         <<00552>>05284000
      CHKASS:=TRUE                                             <<00552>>05286000
   ELSE CHKASS:=FALSE;                                         <<00552>>05288000
END;                                                           <<00552>>05290000
$PAGE                                                          <<00552>>05292000
   <<********* SET OPTIONAL PARM VALUES ***************>>      <<SD.00>>05294000
   MOVE BLANKBUF:=%40,%0; <<DEFAULT INPUT BUFFER>>             <<SD.00>>05296000
   IF Q4.PTYPEBIT=0 THEN PTYPE:=0;                             <<SD.00>>05298000
   IF PTYPE>0 THEN                                             <<SD.00>>05300000
      IF Q4.STRINBIT=1 THEN @INBUF:=@STRIN;                    <<SD.00>>05302000
   IF Q4.RESPONSEBIT=1 THEN @OUTBUF:=@RESPONSE;                <<SD.00>>05304000
   @IOUTBUF:=@OUTBUF&LSR(1);                                   <<SD.00>>05306000
   @TBUF:=@BTBUF&LSR(1);                                       <<SD.00>>05308000
   IF (CLASSREQ_REQDEV<0) THEN                                          05310000
      BEGIN   <<GET CLASS ENTRY>>                                       05312000
      GETCLASS(ICLASS,FALSE,,-REQDEV);                                  05314000
      I _ BCLASS(6);                                                    05316000
      TOS _ I & LSR(1);                                                 05318000
      ASMB(ADDS 0);   <<INCREASE SIZE OF ICLASS(*)>>                    05320000
      GETCLASS(ICLASS,TRUE,ICLASS(0));                                  05322000
      TOS _ @LCLASSNAME;                                                05324000
      PUSH(DL);                                                         05326000
      ASMB(SUB);   <<DL TARGET>>                                        05328000
      TOS _ ICLASS;   <<DB SOURCE>>                                     05330000
      TOS _ 4;   <<COUNT>>                                              05332000
      EXCHANGEDB(LDTDSTN);                                              05334000
      ASMB(MVBL 3);   <<MOVE CLASS NAME TO LOCAL>>                      05336000
      EXCHANGEDB(0);                                                    05338000
      BLCLASSNAME (8) := " ";                                           05340000
      TOS _ @BLCLASSNAME;                                               05342000
      ASMB(DUP);                                                        05344000
      TOS _ "  ";                                                       05346000
      ASMB(SCU 1);                                                      05348000
      ASMB(XCH,SUB;STAX);                                               05350000
      BLCLASSNAME(X) _ 0;   <<TERMINATION CHAR.FOR PUTMSG>>             05352000
      END;   <<CLASSREQ>>                                               05354000
   SPOOLDEV:=Q4.SPOOLERBITS > 0;   <<SPOOLER PARMS PASSED>>    <<SD.00>>05356000
   MOVE LFNAME := FNAME, (4);                                           05358000
   BLFNAME (8) := " ";                                                  05360000
   TOS _ @BLFNAME;                                                      05362000
   ASMB(DUP);                                                           05364000
   TOS _ "  ";                                                          05366000
   ASMB(SCU 1);                                                         05368000
   ASMB(XCH,SUB;STAX);                                                  05370000
   BLFNAME(X) _ 0;   <<TERMINATION CHAR.FOR PUTMSG>>                    05372000
   IF SPOOLDEV THEN                                                     05374000
      BEGIN    << FORMAT JOB NUMBER >>                                  05376000
      BJOBNUMBER :=                                                     05378000
            IF JOBNUM.(0:2) = 1 THEN "S" ELSE "J";                      05380000
      BJOBNUMBER (ASCII (JOBNUM.(2:14), 10, BJOBNUMBER (1)) +1)         05382000
            := 0;                                                       05384000
      END;                                                              05386000
                                                               <<02566>>05388000
<< When a magtape has been configured for automatic >>         <<02566>>05390000
<< allocation, it means that operator intervention is not >>   <<02566>>05392000
<< required for FOPENs which specifically request that >>      <<02566>>05394000
<< device.  The caller will automatically be given that >>     <<02566>>05396000
<< device providing the following conditions are met:  >>      <<02566>>05398000
                                                               <<02566>>05400000
<< 1)  the LDEV is configured as a magtape (type 24) and >>    <<02566>>05402000
<<     the subtype is greater than or equal to %10.      >>    <<02566>>05404000
<< 2)  the LDEV is neither job nor data accepting.       >>    <<02566>>05406000
<< 3)  the FOPEN is for an unlabelled tape.              >>    <<02566>>05408000
<< 4)  the tape drive is not already allocated to        >>    <<02566>>05410000
<<     another user.                                     >>    <<02566>>05412000
<< 5)  for class requests, there can only be one LDEV    >>    <<02566>>05414000
<<     in the class, and if the device is associated, it >>    <<02566>>05416000
<<     must be associated under the same class name.     >>    <<02566>>05418000
                                                               <<02566>>05420000
AUTOALLOC := FALSE;  << Initialize flag >>                     <<02566>>05422000
                                                               <<02566>>05424000
IF CLASSREQ AND I=1 AND NOT CHKASS(ICLASS(3).(8:8)) THEN       <<00552>>05426000
  BEGIN  <<ONLY ONE DEVICE IN THIS CLASS>>                     <<TL.03>>05428000
  DEVTOCONSIDER:=ICLASS(3).(8:8);                              <<TL.03>>05430000
  GO TO AUTO;                                                  <<TL.03>>05432000
  END;                                                         <<TL.03>>05434000
IF NOT CLASSREQ THEN                                           <<TL.03>>05436000
  BEGIN                                                        <<TL.03>>05438000
  DEVTOCONSIDER:=REQDEV;                                       <<TL.03>>05440000
AUTO:  <<POSSIBLE AUTOMATICALLY ALLOCATED DEVICE>>             <<TL.03>>05442000
    B:=GETSIR(LDTSIR);                                         <<TL.03>>05444000
    C:=GETSIR(LPDSIR);                                         <<TL.03>>05446000
    IF LABELED = 1 AND ABSOLUTE(AVR) = 1 THEN                  <<02566>>05448000
       GO NORMAL;       << Labelled tape request >>            <<02566>>05450000
    IF NOT GETDEV(DEVTOCONSIDER,LDTDSTN,LDENTRY)               <<TL.03>>05452000
       THEN GO NORMAL;  << Can't get LDT entry >>              <<02566>>05454000
    IF LDENTRY(LD'DEVTYPE) <> MAGTAPE THEN GO NORMAL;          <<02566>>05456000
    GETDEV(DEVTOCONSIDER,LPDDSTN,PDENTRY);                     <<TL.03>>05458000
    IF PDENTRY(LP'AUTOALLOC) <> 1 THEN GO NORMAL;              <<02566>>05460000
    IF PDENTRY(LP'JA) <> 0 THEN GO NORMAL;  << Job/Data acc >> <<02566>>05462000
    AUTOALLOC:=TRUE; <<UNIQUELY DEFINED MAG TAPE>>             <<TL.03>>05464000
    RESP:=OKAY;                                                <<TL.03>>05466000
NORMAL: <<CONTINUE WITH NORMAL PROCESSING>>                    <<TL.03>>05468000
    RELSIR(LPDSIR,C);                                          <<TL.03>>05470000
    RELSIR(LDTSIR,B);                                          <<TL.03>>05472000
    END;                                                       <<TL.03>>05474000
   DO                                                                   05476000
      BEGIN                                                             05478000
      RESP:=OKAY;                                              <<01115>>05480000
     IF AUTOALLOC THEN GO TO CHECKDEV;<<SKIP OP QUESTIONS>>    <<TL.03>>05482000
      IF CLASSREQ THEN                                                  05484000
         BEGIN                                                          05486000
         IF SPOOLDEV THEN                                               05488000
            GENMSG(1,211,%10000,SPOOLERNUM,@BJOBNUMBER,        <<0U.EB>>05490000
                @BLFNAME,@BLCLASSNAME,,ASSOC'CLASS(LCLASSNAME),<<00552>>05492000
                0,@ANSWER)                                     <<00552>>05494000
         ELSE                                                           05496000
BEGIN                                                          <<TL.02>>05498000
  IF LABELED =1 AND ABSOLUTE(AVR)=1 THEN GO LABTAPE;           <<TL.02>>05500000
            IF PTYPE=0 THEN                                    <<SD.00>>05502000
               GENMSG(1,6,%0,@BLFNAME,@BLCLASSNAME,,,,         <<SD.00>>05504000
                ASSOC'CLASS(LCLASSNAME),0,@ANSWER) <<NO PARM RE<<00552>>05506000
            ELSE                                               <<SD.00>>05508000
               BEGIN <<PARM TYPE REQUEST>>                     <<SD.00>>05510000
               GENMSG(1,276,0,@BLFNAME,@BLCLASSNAME,@INBUF,,,  <<SD.00>>05512000
                ASSOC'CLASS(LCLASSNAME),%15402,@TBUF);<<PARM RE<<00552>>05514000
               PARSEPARM;                                      <<SD.00>>05516000
               END;  <<PARM TYPE REQUEST>>                     <<SD.00>>05518000
END;                                                           <<TL.02>>05520000
     IF RESP=OKAY THEN                                         <<01115>>05522000
       BEGIN                                                   <<01115>>05524000
         IF ANSWER = 0 THEN                                             05526000
            RESP _ REJECTED                                             05528000
         ELSE                                                           05530000
            BEGIN   <<SEE IF ANSWER IS IN CLASS>>                       05532000
            I _ 6;                                                      05534000
            J _ BCLASS(6)+7;   <<UPPER LIMIT>>                          05536000
            WHILE (I_I+1) < J DO                                        05538000
               IF ANSWER = INTEGER(BCLASS(I)) THEN                      05540000
               IF CHKASS(INTEGER(BCLASS(I))) THEN              <<00552>>05542000
               BEGIN                                           <<00552>>05544000
                  ASSOC(ASS'CLASS+4):=0; <<FOR GENMSG>>        <<00552>>05546000
                  GENMSG(1,301,[1/0,3/1,3/0,9/0],ANSWER,       <<00552>>05548000
                         @ASSOC'(ASS'CLASS*2),,,,              <<00552>>05550000
                  ASSOC'CLASS(LCLASSNAME),,,,1);               <<00552>>05552000
               END                                             <<00552>>05554000
               ELSE                                            <<00552>>05556000
                  I _ %77770;   <<STOP LOOP>>                           05558000
            RESP _ IF I = J THEN INVALID ELSE OKAY;                     05560000
            END;                                                        05562000
       END;                                                    <<01115>>05564000
         DEVTOCONSIDER _ ANSWER;                                        05566000
         END   <<CLASSREQ>>                                             05568000
      ELSE                                                              05570000
         BEGIN   <<PARTICULAR DEVICE REQUEST>>                          05572000
         IF SPOOLDEV THEN                                               05574000
            GENMSG(1,212,%10010,SPOOLERNUM,@BJOBNUMBER,        <<0U.EB>>05576000
               @BLFNAME,REQDEV,,0,1,@ANSWER)                   <<0U.EB>>05578000
         ELSE                                                           05580000
 BEGIN                                                         <<TL.02>>05582000
  IF LABELED =1 AND ABSOLUTE(AVR)=1 THEN <<LABELLED TAPE>>     <<TL.02>>05584000
  BEGIN                                                        <<TL.02>>05586000
LABTAPE:                                                       <<TL.02>>05588000
    << If user made a specific LDEV request, tell LINKLABEL >> <<02566>>05590000
    IF CLASSREQ THEN  LDEVN := 0                               <<02566>>05592000
                ELSE  LDEVN := DEVTOCONSIDER;                  <<02566>>05594000
    RESP:=LINKLABEL(LDEVN,ACCESS);                             <<TL.02>>05596000
    DEVTOCONSIDER:=LDEVN;                                      <<TL.02>>05598000
    GO GOTDEV;                                                 <<TL.02>>05600000
  END                                                          <<TL.02>>05602000
  ELSE                                                         <<TL.02>>05604000
  BEGIN  <<NO LABEL>>                                          <<TL.02>>05606000
            IF PTYPE=0 THEN                                    <<SD.00>>05608000
            GENMSG(1,5,%01000,@BLFNAME,REQDEV,,,,0,1,          <<0U.EB>>05610000
               @ANSWER) <<NO PARM REQUESTED>>                  <<SD.00>>05612000
            ELSE                                               <<SD.00>>05614000
              BEGIN <<PARM TYPE REQUEST>>                      <<SD.00>>05616000
              GENMSG(1,275,%1000,@BLFNAME,REQDEV,              <<SD.00>>05618000
              @INBUF,,,0,%14002,@TBUF);                        <<SD.00>>05620000
              PARSEPARM;                                       <<SD.00>>05622000
              END;  <<PARM TYPE REQUEST>>                      <<SD.00>>05624000
  END;                                                         <<TL.02>>05626000
 END;                                                          <<TL.02>>05628000
         IF RESP=OKAY THEN                                     <<01115>>05630000
            RESP := IF LOGICAL(ANSWER) THEN OKAY ELSE REJECTED;<<01115>>05632000
         DEVTOCONSIDER _ REQDEV;                                        05634000
         END;   <<DEVICE REQ>>                                          05636000
CHECKDEV: <<CHECK FOR VALID DEV>>                              <<TL.03>>05638000
GOTDEV:                                                        <<TL.02>>05640000
      B_ GETSIR(LDTSIR);                                                05642000
      C _ GETSIR(LPDSIR);                                               05644000
      IF RESP = OKAY THEN                                               05646000
         IF NOT GETDEV(DEVTOCONSIDER,LDTDSTN,LDENTRY) THEN              05648000
            RESP _ INVALID;                                             05650000
      IF RESP = OKAY THEN                                               05652000
         BEGIN                                                          05654000
         GETDEV(DEVTOCONSIDER,LPDDSTN,PDENTRY);                         05656000
         IF LOGF = 0 OR LOGR = 1 THEN                                   05658000
            RESP _ INVALID;   <<DOWN OR DOWN PENDING>>                  05660000
         IF PDENTRY(0) < 0 THEN                                         05662000
            RESP _ INVALID;   <<VDEV OR NON-EXISTENT>>                  05664000
                                                               <<03770>>05666000
         IF RESP=OKAY AND CLASSREQ AND                         <<01115>>05668000
            (LOGICAL(ICLASS(2)) LAND %77) = FDISC AND          <<01115>>05670000
            ( SYS'LPDTP(ANSWER &LSL(1) +1).FORS<>1 OR          <<01115>>05672000
              SYS'LPDTP(ANSWER &LSL(1) +1).SDLF<>1  )          <<01115>>05674000
            THEN  <<NOT FOREIGN>>                              <<01115>>05676000
              BEGIN                                            <<01115>>05678000
              GENMSG(1,272,%10000,DEVTOCONSIDER,,,,,0);        <<01115>>05680000
              RESP:=INVALID;                                   <<01115>>05682000
              END;                                             <<01115>>05684000
<< We will check for a "labeled" serial disc or tape here   >> <<03788>>05688000
<< Since the indentation is screwed up already, we will     >> <<03788>>05690000
<< persist with the tradition (after all we need tradition!)>> <<03788>>05692000
<< Additionally, we will not accept a reply in which the ldev>><<03788>>05694000
<< has a PV at this time (for both class and ldev requests). >><<03788>>05696000
                                                               <<03788>>05698000
CHECK'FOR'AVR := FALSE;      << Default no check >>            <<03788>>05700000
                                                               <<03788>>05702000
IF RESP=OKAY THEN                                              <<03788>>05704000
BEGIN                                                          <<03788>>05706000
    IF LDENTRY(2).(10:6)=MAGTAPE                               <<03788>>05708000
      THEN CHECK'FOR'AVR := TRUE                               <<03788>>05710000
                                                               <<03788>>05712000
      ELSE        << not a tape >>                             <<03788>>05714000
      BEGIN                                                    <<03788>>05716000
        DSTAT'RET := REQSTATUS(DEVTOCONSIDER);                 <<03788>>05718000
        IF =  THEN   << = means disc device >>                 <<03788>>05720000
          IF NOT ON'LINE THEN                                  <<03788>>05722000
           BEGIN                                               <<03788>>05724000
              RESP := INVALID;                                 <<03788>>05726000
              GENMSG(1,292,%10000,DEVTOCONSIDER,,,,,0);        <<03788>>05728000
              << LDEV# \ must be on-line before REPLYing>>     <<03788>>05730000
           END                                                 <<03788>>05732000
          ELSE                                                 <<03788>>05734000
            IF SYS'LPDTP(DEVTOCONSIDER*LPDTSIZE+1).SDLF=1 THEN <<03788>>05736000
                 IF SYS'LPDTP(DEVTOCONSIDER*LPDTSIZE+1).FORS=0 <<03788>>05738000
                    THEN CHECK'FOR'AVR := TRUE                 <<03788>>05740000
                 ELSE    << Foreign disc case - do nothing >>  <<03788>>05742000
            ELSE RESP := INVALID;  << We will not allow a PV >><<03788>>05744000
     END; << Not a tape >>                                     <<03788>>05746000
 END;  << Check for tape/serial disc >>                        <<03788>>05748000
           IF RESP=OKAY AND CHECK'FOR'AVR                      <<03788>>05750000
            AND LABELED <> 1 AND ABSOLUTE(AVR)=1 THEN          <<TL.03>>05752000
            BEGIN                                              <<TL.03>>05754000
             RELSIR(LPDSIR,C);                                 <<TL.03>>05756000
             RELSIR(LDTSIR,B);                                 <<TL.03>>05758000
             IF CKFORLABEL(DEVTOCONSIDER,ACCESS,0)             <<TL.03>>05760000
             THEN RESP:=INVALID;                               <<TL.03>>05762000
             B:=GETSIR(LDTSIR);                                <<TL.03>>05764000
             C:=GETSIR(LPDSIR);                                <<TL.03>>05766000
            END;                                               <<TL.03>>05768000
         END;                                                           05770000
                                                               <<03698>>05772000
      IF RESP = OKAY AND (NOT SPOOLDEV) THEN                            05774000
         BEGIN                                                          05776000
         IF OLDFLAG AND PDENTRY(1).(3:1) = 1 THEN                       05778000
            RESP _ OLDDATA                                              05780000
         ELSE                                                           05782000
            BEGIN                                                       05784000
            EXCHANGEDB(LPDDSTN);                                        05786000
            @DTAB _ DEVTOCONSIDER&LSL(1);                               05788000
            DISABLE;                                                    05790000
          IF LABELED =1 AND ABSOLUTE(AVR)=1 THEN GO LABOK;     <<TL.02>>05792000
            IF DTAB(1).(0:2)<>0 THEN                                    05794000
               BEGIN   <<OWNED>>                                        05796000
               ENABLE;                                                  05798000
               IF CLASSREQ THEN                                         05800000
                  RESP _ INVALID                                        05802000
               ELSE                                                     05804000
                  BEGIN                                                 05806000
                  EXCHANGEDB(LDTDSTN);                                  05808000
                  @DTAB _ DEVTOCONSIDER*5;                              05810000
                  IF JMPIN = DTAB(1).(0:8) THEN                         05812000
                     RESP _ REALLOC   <<OWNED BY CALLER>>               05814000
                  ELSE                                                  05816000
                     RESP _ INVALID;                                    05818000
                  END;                                                  05820000
               END                                                      05822000
            ELSE                                                        05824000
               BEGIN   <<UNOWNED>>                                      05826000
LABOK:                                                         <<TL.02>>05828000
               DTAB(1).(0:2) _ 3;   <<RESERVE DEVICE>>                  05830000
               ENABLE;                                                  05832000
               END;                                                     05834000
            EXCHANGEDB(0);                                              05836000
            END;                                                        05838000
         END;                                                           05840000
      RELSIR(LPDSIR,C);                                                 05842000
      RELSIR(LDTSIR,B);                                                 05844000
     AUTOALLOC:=FALSE; <<IF FAILED AUTOALLOC ASK OP>>          <<TL.03>>05846000
      END UNTIL RESP<>INVALID;                                          05848000
   IF RESP <> REJECTED THEN                                             05850000
      BEGIN                                                             05852000
      ASKOP _ TRUE;                                                     05854000
      ALLOCDEV _ DEVTOCONSIDER;                                         05856000
      TYPE _ RESP;                                                      05858000
      END;                                                              05860000
   END;   <<ASKOP>>                                                     05862000
$PAGE "   ***   ALLOCATE   ***"                                         05864000
<<>>                                                                    05866000
<<>>                                                                    05868000
INTEGER PROCEDURE ALLOCATE(INDX,OLD,OUTPRI,ID,JMPIN,FORMSG,JNUM,COPIES, 05870000
                  DEVINFO,XDDADR,FLAGS);                       <<TL.02>>05872000
    VALUE INDX,OLD,OUTPRI,JMPIN,JNUM,COPIES;                   <<TL.02>>05874000
    INTEGER INDX,OUTPRI,JMPIN,FLAGS,JNUM,COPIES;               <<TL.02>>05876000
    LOGICAL OLD;                                                        05878000
    INTEGER ARRAY ID,DEVINFO;                                           05880000
    INTEGER POINTER XDDADR;                                             05882000
    BYTE ARRAY FORMSG;                                                  05884000
    OPTION PRIVILEGED,UNCALLABLE;                                       05886000
         <<REAL AND VIRTUAL DEVICE ALLOCATION FOR ALL NON-DISK DEVICES>>05888000
         <<INPUT:                                                     >>05890000
         <<      INDX > 0           - LOGICAL DEVICE #                >>05892000
         <<           < 0           - DEVICE CLASS INDEX              >>05894000
         <<      OLD = TRUE         - OLD DEVICE                      >>05896000
         <<          = FALSE        - NEW DEVICE                      >>05898000
         <<      OUTPRI             - OUTPUT SPOOL PRIORITY           >>05900000
         <<      ID                 - USER NAME,ACCT.NAME,JOB NAME,   >>05902000
         <<                            FILE NAME (4 WORDS APIECE) >>    05904000
         <<      JMPIN              - JOB MAIN PROCESS #              >>05906000
         <<      FLAGS            - (0:8)= FLAGS            >> <<TL.02>>05908000
         <<      LABELED          - FLAGS.(7:1)             >> <<TL.02>>05910000
         <<      ACCESS           - FLAGS.(14:2)            >> <<TL.02>>05912000
         <<      JNUM               - JOB #                           >>05914000
         <<      FORMSG             - FORMS MSG. STRING TERMINATED BY >>05916000
         <<                            A PERIOD. (SUPPLIED BY USER)   >>05918000
         <<      ACCESS = 0         - INPUT ONLY                      >>05920000
         <<             = 1         - OUTPUT ONLY                     >>05922000
         <<             = 2         - INPUT/OUTPUT                    >>05924000
         <<                                                           >>05926000
         <<OUTPUT:                                                    >>05928000
         <<      ALLOCATE = 0       - OK, IT'S YOURS                  >>05930000
         <<               = -1      - OK, BUT THERE'RE FORMS ON DEV   >>05932000
         <<                           (ONLY FOR INITIAL $STDLIST)     >>05934000
         <<               = -2      - NEW OR REALLOC :DATA            >>05936000
         <<               = -3      - OK, SPOOLED CLASS REQUEST<<00635>>05938000
         <<               = 1       - DEV.(OR VDEV) NOT AVAILABLE     >>05940000
         <<               = 3       - ND CAPABILITY REQUIRED          >>05942000
         <<               = 4       - VDEV REQUESTED NOT OWNED        >>05944000
         <<               = 5       - FAILURE IN SOPEN                >>05946000
         <<               = 6       - ACCESS VIOLATION                >>05948000
         <<               = 7       - NO ROOM IN XDD                  >>05950000
         <<               = 8       - SPOOLING FAILURE                >>05952000
         <<      ACCESSPARM         - MAY BE CHANGED FROM 2 TO 0 OR 1 >>05954000
         <<      DEVINFO(0)         - LDEV OR VDEV ALLOCATED          >>05956000
         <<             (1)-(2)     - LPDT ENTRY                      >>05958000
         <<             (3)-(7)     - LDT ENTRY                       >>05960000
         <<      XDDADR             - ADR. OF XDD ENTRY               >>05962000
         <<     NOTE: DB MUST BE AT STACK - SAME ON EXIT.             >>05964000
   BEGIN                                                                05966000
   DEFINE                                                      <<SD.00>>05968000
         SUBTYP=(12:4)#;                                       <<SD.00>>05970000
   EQUATE YES'NO=2; <<FOR YES/NO PARM FROM OPERATOR>>          <<SD.00>>05972000
   EQUATE PAGE'PRINTER = 8,                                    <<02540>>05974000
          UNSPOOLED    = 0;                                    <<02540>>05976000
                                                               <<02540>>05978000
   INTEGER                                                              05980000
         I,J,K,                                                         05982000
         LDT0,   <<NOTE: THESE 7 VARIABLES MUST BE CORRECTLY ORDERED>>  05984000
         LDT1,                                                          05986000
         LDT2,                                                          05988000
         LDT3,                                                          05990000
         LDT4,                                                          05992000
         LPDT0,                                                         05994000
         LPDT1,                                                         05996000
         XDDDSTN,                                                       05998000
         XDDSIR,                                                        06000000
         BESTSOFAR,   <<USED WHEN SCANNING XDD (INTERNAL TO SCANXDD)>>  06002000
         ALLOCDEV,   <<LDEV OR VDEV ALLOCATED>>                         06004000
         DEVTYPE,   <<DEVICE TYPE (OR CLASS TYPE)>>                     06006000
         CLOSEIDDSUBP,   <<USED DURING XDD SCAN FOR CLASS REQ>>         06008000
         NEXTDEV,   <<USED AS LDEV WHEN HUMPING THROUGH DEVS.IN CLASS>> 06010000
         DSTX,   <<TEMP.FOR OLD DB VALUE>>                              06012000
         XDDSUBP := 0,    <<XDD SUBENTRY PNTR>>                         06014000
         DLXDDX,   <<DL.REL.ADR.OF XDDX(*)>>                            06016000
         DLXDDX2,   <<DL REL.ADR.OF XDDX2(*)>>                          06018000
         CURRCLASSEL,   <<INDEX INTO BCLASS(*) FOR CURRENT ELEMENT>>    06020000
         MAXCURRCLASSEL,   << LARGEST POSSIBLE INDEX INTO BCLASS(*)>>   06022000
         TRYFLAG,   <<BEATS ME>>                                        06024000
         REPLYTYPE,   <<TYPE RETURNED BY ASKOP>>                        06026000
         FMSGLGTH  := 0,                                                06028000
         TRYDEV,                                                        06030000
         NUMCOPIES  := 0,    <<#COPIES CALLER WILL GET>>                06032000
         HEADX;   <<HEAD INDEX>>                                        06034000
    DEFINE ACCESS  = FLAGS.(14:2)#;                            <<TL.02>>06036000
   DEFINE LABELED=LOGICAL(FLAGS.(7:1))#;                       <<00677>>06038000
   LOGICAL SORFDISC:=FALSE; <<ALLOCATING SER/FORN DISC>>       <<01115>>06040000
   EQUATE INITARRAYSIZE=5;                                     <<03512>>06042000
          <<**WARNING** CHANGING INITARRAYSIZE WILL REQUIRE>>  <<SD.00>>06044000
          <<SAME CHANGE IN SDISCIO>>                           <<SD.00>>06046000
   EQUATE JUSTALLOCATED'ADR=7; <<CHANGNG THIS>>                <<00076>>06048000
          <<WILL REQUIRE SAME CHANGE IN SDISC>>                <<00076>>06050000
   EQUATE JUSTALLOCCELL=0, <<CELLS IN THE INIT>>               <<00239>>06052000
          WRITERINGCELL=1, <<ARRAY FOR SDISC>>                 <<00239>>06054000
          FATALERRCELL =2, <<Extra data seg>>                  <<03512>>06056000
          ERRORLOGCELL =3,                                     <<03512>>06058000
          MEMSIZECELL  =4;                                     <<03512>>06060000
   INTEGER ARRAY TEMPDESC(0:INITARRAYSIZE-1); <<SDISC DESCRIP>><<SD.00>>06062000
   INTEGER LDTX0,  <<MUST BE IN THIS ORDER>>                   <<SD.00>>06064000
           LDTX1,  <<MUST BE IN THIS ORDER>>                   <<SD.00>>06066000
           LDTX2,  <<MUST BE IN THIS ORDER>>                   <<SD.00>>06068000
           LDTX3,  <<MUST BE IN THIS ORDER>>                   <<SD.00>>06070000
           LDTX4,  <<MUST BE IN THIS ORDER>>                   <<SD.00>>06072000
           SEGNUM,                                             <<SD.00>>06074000
DISCTYPE,                                                      <<00076>>06076000
           DTYPE;                                              <<SD.00>>06078000
   BYTE ARRAY MESS(0:18); <<MESSAGE FOR SERIAL DISC>>          <<SD.00>>06080000
   LOGICAL SPOOLFLAG;                                          <<00635>>06082000
   INTEGER                                                     <<00.DL>>06084000
         QLOGICAL:=%140000; <<BITMAP OF LOGICAL VARIABLES>>    <<00.DL>>06086000
         <<INITIAL:=TRUE>>                                     <<00.DL>>06088000
         <<REALD:=TRUE>>                                       <<00.DL>>06090000
         <<ALL ELSE:=FALSE>>                                   <<00.DL>>06092000
   DEFINE                                                      <<00.DL>>06094000
         INITIAL=QLOGICAL.(0:1)#, <<INITIAL ALLOCATION>>       <<00.DL>>06096000
         REALD=QLOGICAL.(1:1)#, <<REAL DEVICE>>                <<00.DL>>06098000
         NDCAP=QLOGICAL.(2:1)#, <<USER HAS ND CAPABILITY>>     <<00.DL>>06100000
         <<** UNUSED **>>                                      <<00.DL>>06102000
         <<** UNUSED **>>                                      <<00.DL>>06104000
         <<** UNUSED **>>                                      <<00.DL>>06106000
         CLASSREQ=QLOGICAL.(6:1)#, <<REQUEST IS BY CLASS>>     <<00.DL>>06108000
         OLDREQ=QLOGICAL.(7:1)#, <<OLD DEVICE REQUEST>>        <<00.DL>>06110000
         RESTART=QLOGICAL.(8:1)#,                              <<00.DL>>06112000
         FORMSFLAG=QLOGICAL.(9:1)#,                            <<00.DL>>06114000
         OPFLAG=QLOGICAL.(10:1)#, <<OPERATOR INTERVENTION>>    <<00.DL>>06116000
         ASKFORMS=QLOGICAL.(11:1)#,                            <<00.DL>>06118000
         OPREQD=QLOGICAL.(12:1)#, <<OP INTERVENTION REQ'D>>    <<00.DL>>06120000
         UPDATEXDD=QLOGICAL.(13:1)#, <<XDD MUST BE OR HAS>>    <<00.DL>>06122000
                                     <<BEEN UPDATED>>          <<00.DL>>06124000
         GOTSEXT=QLOGICAL.(14:1)#, <<GOT SPOOL EXTENT>>        <<00.DL>>06126000
         FRESERVED=QLOGICAL.(15:1)#; <<SS HAS BEEN SET TO 3>>  <<00.DL>>06128000
   EQUATE                                                      <<00.DL>>06130000
         TRUE'=1, <<TRUE FOR TESTING BITMAP LOGICALS>>         <<00.DL>>06132000
         FALSE'=0; <<FALSE FOR BITMAP LOGICALS>>               <<00.DL>>06134000
   LOGICAL B,C,D; <<THESE MUST BE 16-BIT QUANTITIES>>          <<00.DL>>06136000
   LOGICAL LOCKED := FALSE;  << LOCK DRIVE FLAG >>             <<03546>>06138000
   INTEGER POINTER                                                      06140000
                                                                        06142000
         XDDSUBPP = XDDSUBP,                                            06144000
         PXPNTR;                                                        06146000
   INTEGER ARRAY                                                        06148000
         LDENTRY(*) = LDT0,                                             06150000
         PDENTRY(*) = LPDT0,                                            06152000
         LDT'ENTRY(*)  = LDT0,                                 <<04429>>06154000
         LDTX'ENTRY(*) = LDTX0,                                <<04429>>06156000
         LPDT'ENTRY(*) = LPDT0,                                <<04429>>06158000
         QID(0:15) = Q,   <<LOCAL VERSION OF ID>>                       06160000
         XDDX(0:XDDSIZE-1) = Q,   <<XDD ENTRY-LOCAL VERSION>>           06162000
         XDDX2(0:XDDSIZE-1) = Q,   <<BACKUP-ORIGINAL XDD ENTRY>>        06164000
         DTAB(*) = DB+0;   <<USED FOR LOOKING AT EXTRA DATA SEGS.>>     06166000
    <<NOTE: THE FOLLOWING MUST BE THE LAST DECLARATIONS IN PROCEDURE>>  06168000
   INTEGER ARRAY                                                        06170000
         ICLASS(0:3) = Q;                                               06172000
   BYTE ARRAY                                                           06174000
         BCLASS(*) = ICLASS;                                            06176000
                                                                        06178000
                                                                        06180000
SUBROUTINE CREATESUBENTRY;                                              06182000
   BEGIN                                                                06184000
   UPDATEXDD := TRUE';                                         <<00.DL>>06186000
   XDDX := 0;                                                  <<00.DL>>06188000
   XDDX.(1:2) := (IF OLDREQ=TRUE' THEN DFREADY ELSE DFOPENED); <<00.DL>>06190000
   <<STATE>>                                                   <<00.DL>>06192000
   IF OLDREQ=FALSE' THEN XDDX.(3:4) := OUTPRI;                 <<00.DL>>06194000
   XDDX.(7:1) := (IF REALD=TRUE' THEN 0 ELSE                   <<00.DL>>06196000
   IF INDX<0 THEN 1 ELSE 0); <<FLAG, LDEV OR CLINX>>           <<00.DL>>06198000
   XDDX.(8:8) := (IF REALD=TRUE' THEN ALLOCDEV ELSE            <<00.DL>>06200000
   IF INDX<0 THEN -INDX ELSE INDX); <<DEVICE,LDEV/CLINX>>      <<00.DL>>06202000
   XDDX(XD'JOBNUM) _ JNUM;   <<JOB #>>                                  06204000
   TOS _ @XDDX(X+1);   <<TARGET>>                                       06206000
   TOS _ @ID;   <<SOURCE>>                                              06208000
   TOS _ 16;   <<COUNT>>                                                06210000
   ASMB(MOVE 3);   <<U,A,J,F>>                                          06212000
   XDDX(XD'DEVFILEID) _ 0;   <<DEVICE FILEID>><<*>>                     06214000
   XDDX(X:=X+1) := 0;                                                   06216000
   IF FMSGLGTH <> 0 THEN XDDX(XD'TEF) := 1;                             06218000
   << XDDX (XD'DATA) := FALSE >>                                        06220000
   XDDX(XD'SPOOLFILE) := 0;                                             06222000
   MOVE XDDX(XD'LOWADDR) := XDDX(XD'SPOOLFILE), (XDDSIZE-21);           06224000
   IF REALD=FALSE' THEN                                        <<00.DL>>06226000
      BEGIN                                                             06228000
      XDDX(XD'VDEV) := ALLOCDEV;                                        06230000
      IF OLDREQ=FALSE' THEN                                    <<00.DL>>06232000
         XDDX(XD'NUMCOPIES) := NUMCOPIES;                               06234000
      END;                                                              06236000
   END;   <<CREATESUBENTRY>>                                            06238000
                                                                        06240000
                                                                        06242000
INTEGER SUBROUTINE GETVDEV;                                             06244000
   BEGIN                                                                06246000
   GETVDEV := 0;                                                        06248000
   J := (SYS'LPDTP(0).(0:8)+1)*LPDTSIZE;                                06250000
   I := 0;                                                              06252000
   WHILE (I := I+LPDTSIZE) < J DO                                       06254000
      IF SYS'LPDTP(I).(LP'VIRTUALF) <> 0 THEN                           06256000
         BEGIN  <<VDEV>>                                                06258000
         DISABLE;                                                       06260000
         IF SYS'LPDTP(I+LP'SS) = DEVAVAIL THEN                          06262000
            BEGIN                                                       06264000
            SYS'LPDTP(I+LP'SS) := DEVRESERVED;                          06266000
            ENABLE;                                                     06268000
            GETVDEV := I/LPDTSIZE;                                      06270000
            FRESERVED := TRUE';                                <<00.DL>>06272000
            I := J;                                                     06274000
            END;                                                        06276000
         ENABLE;                                                        06278000
         END;                                                           06280000
   END;  <<GETVDEV>>                                                    06282000
                                                                        06284000
                                                                        06286000
LOGICAL SUBROUTINE GETLDT'LPDT(LDEV);                                   06288000
    VALUE LDEV;                                                         06290000
    INTEGER LDEV;                                                       06292000
         <<PUT LDT ENTRY IN LDENTRY(*) & LPDTENTRY IN PDENTRY(*).     >>06294000
         <<RETURN TRUE IF OK, FALSE IF GETDEV FAILS.                >>  06296000
         <<DB MAY BE ANYWHERE - SAME ON RETURN.                       >>06298000
   BEGIN                                                                06300000
   IF GETDEV(LDEV,LDTDSTN,LDENTRY) THEN                                 06302000
      IF GETDEV(LDEV,LPDDSTN,PDENTRY) THEN                              06304000
         BEGIN                                                 <<SD.00>>06306000
         GETLDT'LPDT:=TRUE;                                    <<SD.00>>06308000
            TOS:=@LDTX0;                                       <<DL003>>06310000
            TOS:=LDTDSTN;                                      <<DL003>>06312000
            TOS:=0;                                            <<DL003>>06314000
            TOS:=LDTSIZE;                                      <<DL003>>06316000
            ASSEMBLE(MFDS 4); <<RECORD#0 OF LDT>>              <<DL003>>06318000
            LDTX0:=LDEV; <<SAVE IN A Q-REL LOC>>               <<00096>>06320000
            <<BEFORE TOS IS MODIFIED AS LDEV IS S-REL>>        <<00096>>06322000
            TOS:=@LDTX0;                                       <<DL003>>06324000
            TOS:=LDTDSTN;                                      <<DL003>>06326000
            TOS:=LDTX1+LDTX3+LDTX0*LDTXSIZE;                   <<00096>>06328000
            TOS:=LDTXSIZE;                                     <<DL003>>06330000
            ASSEMBLE(MFDS 4); <<GOT LDTX ENTRY>>               <<DL003>>06332000
         IF (LDT2.(10:3) = DEVDISC) AND                        <<03512>>06334000
         LPDT1.(4:3)=NOT'PV'OR'SYS THEN                        <<SD.00>>06336000
BEGIN                                                          <<00076>>06338000
DISCTYPE:=LDT2.(10:6);                                         <<00076>>06340000
            LDT2.(10:6):=IF LPDT1.FORS=0 THEN SDISC ELSE FDISC;<<<<FDF>>06342000
END;                                                           <<00076>>06344000
         END;                                                  <<SD.00>>06346000
   END;   <<GETLDT'LPDT>>                                               06348000
                                                                        06350000
                                                                        06352000
SUBROUTINE ASK;                                                         06354000
   BEGIN                                                                06356000
   RELSIR(XDDSIR,C);                                                    06358000
   RELSIR(LPDSIR,D);                                                    06360000
   RELSIR(LDTSIR,B);                                                    06362000
   IF LDT2.(10:6)=SDISC OR LDT2.(10:6)=FDISC THEN              <<<<FDF>>06364000
      BEGIN <<ASKOP FOR SDISC AND WRITERING>>                  <<SD.00>>06366000
      MOVE MESS:=",WRITE RING? (Y/N)";                         <<SD.00>>06368000
      MESS(18):=BYTE(0);                                       <<SD.00>>06370000
      IF NOT ASKOP(INDX,ID(12),(OLDREQ=TRUE'),ALLOCDEV,        <<SD.00>>06372000
      REPLYTYPE,JMPIN,,,FLAGS,YES'NO,MESS,                     <<SD.00>>06374000
      TEMPDESC(WRITERINGCELL)) THEN                            <<00239>>06376000
         BEGIN <<REJECTED SDISC>>                              <<SD.00>>06378000
         ALLOCATE:=1;                                          <<SD.00>>06380000
         GO BAD3;                                              <<SD.00>>06382000
         END;                                                  <<SD.00>>06384000
         IF TEMPDESC(WRITERINGCELL)=0 AND                      <<01737>>06386000
            LDT2.(10:6)=FDISC THEN ACCESS:=INPUTONLY;          <<01737>>06388000
      END   <<ASKOP FOR SDISC AND WRITERING>>                  <<SD.00>>06390000
   ELSE                                                        <<SD.00>>06392000
   IF NOT ASKOP (INDX,ID(12),(OLDREQ=TRUE'),ALLOCDEV,          <<00531>>06394000
   REPLYTYPE,JMPIN,,,FLAGS)  THEN                              <<00531>>06396000
      BEGIN                                                             06398000
      ALLOCATE := 1;                                                    06400000
      GO BAD3;   <<REJECTED>>                                           06402000
      END;                                                              06404000
   IF REPLYTYPE = OPASSIGNED THEN                                       06406000
      FRESERVED := TRUE';   <<FOR FAILURE UNWIND>>             <<00.DL>>06408000
   IF REPLYTYPE = REALLOC THEN                                          06410000
      INITIAL := FALSE';                                       <<00.DL>>06412000
   B _ GETSIR(LDTSIR);                                                  06414000
   D _ GETSIR(LPDSIR);                                                  06416000
   GETLDT'LPDT (ALLOCDEV);                                              06418000
   C _ GETSIR(XDDSIR);                                                  06420000
   END;   <<ASK>>                                                       06422000
                                                                        06424000
LOGICAL SUBROUTINE REJECTLDEV(TRYDEV);                         <<02540>>06426000
   VALUE TRYDEV;                                               <<02540>>06428000
   INTEGER TRYDEV;                                             <<02540>>06430000
                                                               <<02540>>06432000
<< REJECT SPECIAL CASES OF DEVICES>>                           <<02540>>06434000
<< EG:  AN UNSPOOLED 2680A (EPOC) >>                           <<02540>>06436000
<<      PAGE PRINTER CANNOT BE ALLOCATED>>                     <<02540>>06438000
<<      AS A HOT PRINTER         >>                            <<02540>>06440000
BEGIN                                                          <<02540>>06442000
                                                               <<02540>>06444000
<<>>                                                           <<02540>>06446000
   REJECTLDEV := FALSE;                                        <<02540>>06448000
   IF LDT2.(10:6) = PRINTER AND                                <<02540>>06450000
      LPDT1.(12:4) = PAGE'PRINTER AND                          <<02540>>06452000
      LDT3.(0:2) = UNSPOOLED THEN                              <<02540>>06454000
      REJECTLDEV := TRUE;                                      <<02540>>06456000
END; <<REJECTLDEV>>                                            <<02540>>06458000
                                                               <<02540>>06460000
                                                               <<02540>>06462000
INTEGER SUBROUTINE TRYNEWREALDEV(TRYDEV);                               06464000
    VALUE TRYDEV;                                                       06466000
    INTEGER TRYDEV;                                                     06468000
         <<CHECK SPECIFIC DEVICE FOR UP & UNOWNED.                    >>06470000
         <<INPUT:                                                     >>06472000
         <<      TRYDEV             - LOG.DEV.#                       >>06474000
         <<OUTPUT:                                                    >>06476000
         <<      TRYNEWREALDEV = 0  - UNAVAILABLE                     >>06478000
         <<                    = 1  - FORMS REQD.OR FORMS MOUNTED     >>06480000
         <<                    = 2  - MAG.TAPE                        >>06482000
         <<                    = 3  - OK,SS SET TO 3,(RESERVED)       >>06484000
   BEGIN                                                                06486000
   TRYNEWREALDEV _ 0;                                                   06488000
   IF LOGF=1 THEN                                                       06490000
      BEGIN   <<UP>>                                                    06492000
      IF REJECTLDEV(TRYDEV) THEN RETURN; <<UNAVAIL>>           <<02540>>06494000
      TOS := ID (12);  <<1ST 2 BYTES OF FNAME>>                         06496000
      EXCHANGEDB(LPDDSTN);                                              06498000
      FORMSFLAG := IF ((FMSGLGTH>0) LOR (LDT2.(9:1)=1)) THEN   <<00.DL>>06500000
      TRUE' ELSE FALSE'; <<FORMS REQ'D OR FORMS MOUNTED>>      <<00.DL>>06502000
      IF TOS <> "$S" THEN                                               06504000
         << NEVER ASK OP FOR $STDLIST, FROM ALLOCATE >>                 06506000
         IF    (FORMSFLAG=TRUE')                               <<01115>>06508000
            OR (LDT2.(10:6)=MAGTAPE)                           <<01115>>06510000
            OR (LDT2.(10:6)=SDISC)                             <<01115>>06512000
            OR (LDT2.(10:6)=FDISC)                             <<01115>>06514000
            OR (                                               <<01115>>06516000
                     (CLASSREQ=TRUE')                          <<01115>>06518000
                LAND (    (ICLASS(2).(10:6)=SDISC)             <<01115>>06520000
                      LOR (ICLASS(2).(10:6)=FDISC)             <<01115>>06522000
                     )                                         <<01115>>06524000
               )                                               <<01115>>06526000
            THEN OPFLAG:=TRUE'                                 <<01115>>06528000
            ELSE OPFLAG:=FALSE';                               <<01115>>06530000
      X := TRYDEV &LSL(1) +1;                                           06532000
      DISABLE;                                                          06534000
      IF DTAB(X).(0:2) = 0 THEN                                         06536000
         BEGIN   <<UP&UNOWNED>>                                         06538000
BYPAS:                                                         <<00677>>06540000
         IF OPFLAG=FALSE' THEN                                 <<00.DL>>06542000
            BEGIN                                                       06544000
            DTAB(X).(0:2) := 3;    <<RESERVE>>                          06546000
            SS _ 3;                                                     06548000
            ENABLE;                                                     06550000
            TRYNEWREALDEV _ 3;   <<RESERVED>>                           06552000
            FRESERVED := TRUE';   <<FOR ERROR UNWINDING>>      <<00.DL>>06554000
            IF FORMSFLAG=TRUE' THEN <<TOOK DEV W/ FORMS ON IT>><<00.DL>>06556000
               ALLOCATE := -1;                                          06558000
            END                                                         06560000
         ELSE                                                           06562000
            BEGIN   <<CAN'T RESERVE IT>>                                06564000
            ENABLE;                                                     06566000
            TRYNEWREALDEV:=IF FORMSFLAG=TRUE' THEN 1 ELSE 2;   <<00.DL>>06568000
            END;                                                        06570000
         END                                                   <<04289>>06572000
         ELSE                                                  <<04289>>06574000
         IF LDT2.(10:6) = MAGTAPE AND DTAB(X).(0:2) = 1        <<04289>>06576000
         THEN TRYNEWREALDEV := 2;  << MAG.TAPE IN USE >>       <<04289>>06578000
      ENABLE;                                                           06580000
      EXCHANGEDB(0);                                                    06582000
      END;                                                              06584000
   END;   <<TRYNEWREALDEV>>                                             06586000
INTEGER SUBROUTINE SCANXDD(HEADX,OPENREQ);                              06588000
    VALUE HEADX,OPENREQ;                                                06590000
    INTEGER HEADX;                                                      06592000
    LOGICAL OPENREQ;                                                    06594000
         <<FIND SUBENTRY IN XDD. IF FOUND, MOVE INTO XDDX(*).         >>06596000
         <<INPUT:                                                     >>06598000
         <<      HEADX              - HEAD INDEX                      >>06600000
         <<      OPENREQ = FALSE    - FILE MUST BE "READY"            >>06602000
         <<              = TRUE     - FILE MUST BE "OPENED"           >>06604000
         << NOTE: LDT & LPDT ENTRIES MUST BE IN LOCALS.               >>06606000
         <<OUTPUT:                                                    >>06608000
         <<      SCANIDD = 0        - NOT FOUND                       >>06610000
         <<              = 1        - CLOSE MATCH                     >>06612000
         <<              = 2        - EXACT MATCH                     >>06614000
   BEGIN                                                                06616000
   EXCHANGEDB (XDDDSTN);                                                06618000
   J := DTAB (HEADX*XDDHSIZE+1);      <<PNTR 2 1ST SUBENTRY>>           06620000
   BESTSOFAR _ 0;                                                       06622000
NXTSUB:                                                                 06624000
   IF J = 0 THEN                                                        06626000
      BEGIN   <<NO MORE SUBENTRIES>>                                    06628000
      IF BESTSOFAR = 0 THEN                                             06630000
         BEGIN   <<NO MATCH>>                                           06632000
         SCANXDD _ NOMATCH;                                             06634000
         J := 0;                                                        06636000
         GOTO LEAVESCAN;                                                06638000
         END;                                                           06640000
      << CLOSE MATCH>>                                                  06642000
      SCANXDD _ CLOSEMATCH;                                             06644000
      J := BESTSOFAR;                                                   06646000
      END                                                               06648000
   ELSE                                                                 06650000
      BEGIN                                                             06652000
      X := DTAB(J+XD'STATE);   <<STATE OF FILE>>                        06654000
      IF OPENREQ THEN                                                   06656000
         BEGIN   <<MUST BE OPENED FILE>>                                06658000
         IF (X <> DFOPENED) OR (DTAB (J +XD'JOBNUM) <> JNUM) THEN       06660000
            BEGIN   <<POINT J TO NEXT SUBENTRY>>                        06662000
PRESSON:    J := DTAB (J+XD'LINKP);                                     06664000
            GO NXTSUB;                                                  06666000
            END;                                                        06668000
   <<IF REAL DEV. REQUEST AND THIS XDD ENTRY IS FOR>>          <<00868>>06670000
   <<A SPOOLFILE;  OR IF VIRTUAL DEV. REQUEST AND THIS>>       <<00868>>06672000
   <<XDD ENTRY IS FOR A REAL DEVICEFILE...>>                   <<00868>>06674000
   <<THEN GO ON TO NEXT ENTRY--(IE., NO MATCH). >>             <<00868>>06676000
         IF (LPDT0.(LP'VIRTUALF) <> 0)  AND   <<IF VIRT. DEV>> <<00868>>06678000
            ((DTAB(J+XD'VDEV) <> ALLOCDEV)  OR  <<WRONG VDEV>> <<00868>>06680000
             (DTAB(J+XD'SPOOLFILE) = 0))     <<REAL DEV XDD>>  <<00868>>06682000
           THEN  GO PRESSON;  <<GO LOOK AT NEXT ENTRY>>        <<00868>>06684000
         IF (LPDT0.(LP'VIRTUALF) = 0)  AND  <<IF REAL DEV>>    <<00868>>06686000
            (DTAB(J+XD'SPOOLFILE) <> 0)     <<AND VDEV XDD>>   <<00868>>06688000
           THEN  GO PRESSON;  <<GO CHECK NEXT ENTRY>>          <<00868>>06690000
         END                                                            06692000
      ELSE                                                              06694000
         BEGIN   <<FILE MUST BE READY>>                                 06696000
         IF X <> DFREADY THEN                                           06698000
            GO PRESSON;   <<THIS ENTRY NO GOOD>>                        06700000
         TOS := DTAB (J +XD'JOBNUM);                                    06702000
         IF = THEN                                                      06704000
            BEGIN   <<JOB# = 0>>                                        06706000
            DEL;                                                        06708000
            I _ -1;                                                     06710000
            WHILE (I_I+1) < 12 DO                                       06712000
               IF DTAB(I+J+XD'UNAME) <> QID(I) THEN                     06714000
                  BEGIN                                                 06716000
                  GO PRESSON;                                           06718000
                  END;                                                  06720000
            END                                                         06722000
         ELSE                                                           06724000
            IF TOS <> JNUM THEN GOTO PRESSON;                           06726000
         IF BESTSOFAR=0 THEN                                            06728000
            BEGIN   <<THIS WILL BE THE 1ST MATCH OF ANY KIND>>          06730000
            IF DTAB (J+XD'FNAME) = "  "  OR  QID(12) = "  " THEN        06732000
               BESTSOFAR := J;                                          06734000
            END;                                                        06736000
         I _ -1;                                                        06738000
         WHILE (I_I+1) < 4 DO                                           06740000
            IF DTAB(I+J+XD'FNAME) <> QID(I+12) THEN                     06742000
               GOTO PRESSON;    <<FILE NAME MISMATCH>>                  06744000
         END;                                                           06746000
      SCANXDD _ EXACTMATCH;                                             06748000
      END;                                                              06750000
   TOS _ DLXDDX;   <<DL-TARGET>>                                        06752000
   TOS := J;    <<DB- SOURCE>>                                          06754000
   TOS _ XDDSIZE;   <<COUNT>>                                           06756000
   ASMB(MVBL 3);                                                        06758000
LEAVESCAN:                                                              06760000
   EXCHANGEDB (0);                                                      06762000
   XDDSUBP := J;                                                        06764000
   END;   <<SCANXDD>>                                                   06766000
LOGICAL SUBROUTINE FINDNEWREALEE;                              <<00.DL>>06768000
         <<SCAN CLASS(INDX) FOR UP,UNOWNED,REALEE.                    >>06770000
         <<OUTPUT:                                                    >>06772000
         <<      FINDNEWREALEE = FALSE - NO DEVICE AVAILABLE         >> 06774000
         <<                  = TRUE  - DEVICE AVAILABLE               >>06776000
         <<    * IF DEV.AVAIL THEN:                                   >>06778000
         <<      OPREQD = FALSE      - NO OP.INTERVENTION REQD.       >>06780000
         <<                            ALLOCDEV SET. LPDT ENTRY       >>06782000
         <<                            RESERVED. (I.E. SS_3)          >>06784000
         <<             = TRUE       - OP.INTERVENTION REQD.          >>06786000
         <<    * IF DEV.AVAIL.AND OP.INTERVENTION REQD.THEN:          >>06788000
         <<      ASKFORMS = TRUE     - FORMS REQUEST REQD.            >>06790000
         <<               = FALSE    - MAG.TAPE                       >>06792000
   BEGIN                                                                06794000
   ASKFORMS _ TRUE;                                                     06796000
   I _ 6;                                                               06798000
   J := BCLASS(6) +7;                                                   06800000
   WHILE(I_I+1)<J DO                                                    06802000
      BEGIN                                                             06804000
      TRYDEV _ BCLASS(I);                                               06806000
      GETLDT'LPDT (TRYDEV);                                             06808000
      IF (CS=0) AND ((K _ TRYNEWREALDEV(TRYDEV)) <> 0) THEN             06810000
         BEGIN   <<TRYDEV IS SOME KIND OF AVAILABLE>>                   06812000
         FINDNEWREALEE _ TRUE;   <<AVAILABLE>>                          06814000
         IF K=3 THEN                                                    06816000
            BEGIN   <<GOT IT. NO FORMS OR MAGTAPE PROBLEMS>>            06818000
            ALLOCDEV _ TRYDEV;                                          06820000
            OPREQD _ FALSE;                                             06822000
            RETURN;                                                     06824000
            END;                                                        06826000
         OPREQD _ TRUE;                                                 06828000
         IF K=2 THEN                                                    06830000
            ASKFORMS _ FALSE;                                           06832000
          <<TRY AGAIN>>                                                 06834000
         END;                                                           06836000
      END;                                                              06838000
   END;   <<FINDNEWREALEE>>                                             06840000
   ALLOCATE _ 0;   <<OK>>                                               06842000
   MOVE QID := ID, (16);                                                06844000
   PUSH(DL);                                                            06846000
   ASMB(DUP,DUP);                                                       06848000
   TOS _ @XDDX;                                                         06850000
   ASMB(XCH,SUB);                                                       06852000
   DLXDDX _ TOS;   <<DL-REL.ADR.OF XDDX(*)>>                            06854000
   TOS _ @XDDX2;                                                        06856000
   ASMB(XCH,SUB);                                                       06858000
   DLXDDX2 _ TOS;   <<DL-REL.ADR.OF XDDX2(*)>>                          06860000
   @PXPNTR _ TOS-PS0(-1);                                               06862000
   NDCAP:=PXPNTR(2).(14:1);                                    <<00.DL>>06864000
   RESTART := PXPNTR (PX'RESTART);                             <<00.DL>>06866000
   B _ GETSIR(LDTSIR);                                                  06868000
   D _ GETSIR(LPDSIR);                                                  06870000
   CLASSREQ:=INDX.(0:1);                                       <<00.DL>>06872000
   IF CLASSREQ=TRUE' THEN                                      <<00.DL>>06874000
      BEGIN   <<CLASS REQUEST SETUP>>                                   06876000
      IF NDCAP=FALSE' THEN                                     <<00.DL>>06878000
         BEGIN   <<NO ND CAPABILITY>>                                   06880000
         ALLOCATE _ 3;                                                  06882000
         GO BAD2;                                                       06884000
         END;                                                           06886000
      IF NOT GETCLASS(ICLASS,FALSE,,-INDX) THEN   <<GET MINIMAL INFO>>  06888000
         BEGIN   <<INDX INVALID>>                                       06890000
         SUDDENDEATH(361);                                              06892000
         END;                                                           06894000
      I _ BCLASS(6);                                                    06896000
      TOS _ I & LSR(1);                                                 06898000
      ASMB(ADDS 0);   <<GET ICLASS(*) TO PROPER SIZE>>                  06900000
      TOS := 0;                                                         06902000
      GETCLASS(ICLASS,TRUE,ICLASS(0));   <<GET WHOLE BAGFULL>>          06904000
      MAXCURRCLASSEL _ BCLASS(6) + 6;                                   06906000
      CURRCLASSEL _ 7;                                                  06908000
      ALLOCDEV _ BCLASS(CURRCLASSEL);                                   06910000
      DEVTYPE _ BCLASS(5).(10:3);   <<CLASS DEVTYPE>>                   06912000
      IF NOT GETLDT'LPDT(ALLOCDEV) THEN                                 06914000
         SUDDENDEATH(362);   <<BAD DEVICE# IN CLASS TABLE>>             06916000
      END                                                               06918000
   ELSE                                                                 06920000
      BEGIN   <<DEVICE REQUEST SETUP>>                                  06922000
      IF NDCAP=FALSE' THEN                                     <<04537>>06924000
         BEGIN   <<NO ND CAPABILITY>>                          <<04537>>06926000
         ALLOCATE := 3;                                        <<04537>>06928000
         GO BAD2;                                              <<04537>>06930000
         END;                                                  <<04537>>06932000
      ALLOCDEV _ INDX;                                                  06934000
      IF NOT GETLDT'LPDT(ALLOCDEV) THEN                                 06936000
         BEGIN   <<INVALID INDX>>                                       06938000
         SUDDENDEATH(363);                                              06940000
         END;                                                           06942000
      DEVTYPE _ LDT2.(10:3);   <<HIGH 3BITS OF DEV.TYPE-DEV.TYPE GROUP>>06944000
      END;                                                              06946000
    <<CHECK ACCESS COMPATABILITY WITH DEVTYPE>>                         06948000
   IF DEVTYPE = DEVIN THEN                                              06950000
      BEGIN                                                             06952000
      IF ACCESS = OUTPUTONLY THEN                                       06954000
         BEGIN   <<BAD ACCESS>>                                         06956000
BADACC:                                                                 06958000
         ALLOCATE _ 6;                                                  06960000
         GO BAD2;                                                       06962000
         END;                                                           06964000
      ACCESS _ INPUTONLY;                                               06966000
      OLDREQ:=TRUE';                                           <<00.DL>>06968000
      END                                                               06970000
   ELSE                                                                 06972000
      IF DEVTYPE = DEVOUT THEN                                          06974000
         BEGIN                                                          06976000
         IF ACCESS = INPUTONLY THEN                                     06978000
            GO BADACC;                                                  06980000
         ACCESS := OUTPUTONLY;                                          06982000
         OLDREQ:=FALSE';                                       <<00.DL>>06984000
         END                                                            06986000
      ELSE                                                              06988000
         BEGIN   <<I/O DEVICE>>                                         06990000
          IF ACCESS = INPUTONLY AND LPDT0.(0:2) = 3 THEN       <<00846>>06992000
             <<CONTRADICTORY ACCESS AND VIRTUAL DEVICE TYPE>>  <<00846>>06994000
             GO TO BADACC;                                     <<00846>>06996000
          IF ACCESS = OUTPUTONLY AND LPDT0.(0:2) = 2 THEN      <<00846>>06998000
             GO TO BADACC; <<INPUT VIRT DEV AND OUT ACCESS>>   <<00846>>07000000
         IF ACCESS = INPUTONLY THEN OLDREQ:=TRUE'              <<00.DL>>07002000
         ELSE                                                           07004000
            IF ACCESS = OUTPUTONLY THEN OLDREQ:=FALSE'         <<00.DL>>07006000
            ELSE                                                        07008000
            IF LOGICAL(LPDT0.(0:1)) THEN <<VIRTUAL DEVICE>>    <<SP.01>>07010000
               IF LOGICAL(LPDT0.(1:1)) THEN <<OUTPUT>>         <<SP.01>>07012000
                  BEGIN                                        <<SP.01>>07014000
                  ACCESS := OUTPUTONLY;                        <<SP.01>>07016000
                  OLDREQ := FALSE';                            <<SP.01>>07018000
                  END                                          <<SP.01>>07020000
               ELSE                 <<VIRTUAL INPUT DEVICE>>   <<SP.01>>07022000
                  BEGIN                                        <<SP.01>>07024000
                  ACCESS := INPUTONLY;                         <<SP.01>>07026000
                  OLDREQ := TRUE';                             <<SP.01>>07028000
                  END                                          <<SP.01>>07030000
            ELSE                                               <<SP.01>>07032000
               OLDREQ:=OLD.(15:1);                             <<00.DL>>07034000
         END;                                                           07036000
$PAGE "   ***   ALLOCATE- OLD   ***"                                    07038000
   IF OLDREQ=TRUE' THEN                                        <<00.DL>>07040000
      BEGIN   <<* * * * * * * * *   O L D   R E Q U E S T   * * * * * >>07042000
      XDDSIR _ IDDSIR;                                                  07044000
      C _ GETSIR(XDDSIR);                                               07046000
      XDDDSTN _ IDDDST;                                                 07048000
      IF CLASSREQ=TRUE' THEN                                   <<00.DL>>07050000
         BEGIN   <<OLD,CLASS REQ.>>                                     07052000
         CLOSEIDDSUBP _ 0;                                              07054000
         NEXTDEV _ ALLOCDEV;                                            07056000
         DO                                                             07058000
            BEGIN   <<LOOP THROUGH CLASS>>                              07060000
            EXCHANGEDB(LDTDSTN);                                        07062000
            HEADX := DTAB (NEXTDEV *5 +4).(8:8);                        07064000
            K _ SCANXDD(HEADX,FALSE);                                   07066000
            IF K=EXACTMATCH THEN                                        07068000
               ALLOCDEV _ NEXTDEV   <<GOT IT>>                          07070000
            ELSE                                                        07072000
               IF (K=CLOSEMATCH) AND (CLOSEIDDSUBP=0) THEN              07074000
                  BEGIN   <<FIRST CLOSE MATCH - SAVE IT>>               07076000
                  CLOSEIDDSUBP _ XDDSUBP;   <<SAVE CLOSE ONE>>          07078000
                  TOS _ @XDDX2;                                         07080000
                  TOS _ @XDDX;                                          07082000
                  TOS _ XDDSIZE;                                        07084000
                  ASMB(MOVE 3);   <<SAVE IN CASE OF FAILURE>>           07086000
                  END;                                                  07088000
            NEXTDEV _ BCLASS(CURRCLASSEL_CURRCLASSEL+1);                07090000
            END                                                         07092000
         UNTIL (K=EXACTMATCH) OR (CURRCLASSEL>MAXCURRCLASSEL);          07094000
         IF K = EXACTMATCH THEN                                         07096000
            GETLDT'LPDT (ALLOCDEV)                                      07098000
         ELSE                                                           07100000
            IF CLOSEIDDSUBP<>0 THEN                                     07102000
               BEGIN   <<CLOSE MATCH WAS FOUND>>                        07104000
               TOS _ @XDDX;   <<TARGET>>                                07106000
               TOS _ @XDDX2;   <<SOURCE>>                               07108000
               TOS _ XDDSIZE;   <<COUNT>>                               07110000
               ASMB(MOVE 3);   <<USE 1ST CLOSE ENTRY>>                  07112000
               ALLOCDEV _ XDDX(XD'DEVICE);                              07114000
               XDDSUBP _ CLOSEIDDSUBP;                                  07116000
               GETLDT'LPDT (ALLOCDEV);                                  07118000
               END                                                      07120000
            ELSE                                                        07122000
               BEGIN                                                    07124000
               DO ASK                                                   07126000
               UNTIL (REPLYTYPE = OPASSIGNED)                           07128000
                     OR (SCANXDD (LDHEADX, FALSE)                       07130000
                     <> NOMATCH);                                       07132000
               END;                                                     07134000
         END                                                            07136000
      ELSE                                                              07138000
         BEGIN   <<OLD REQ.BY LDEV>>                                    07140000
         IF OWNEDBYCALLER THEN                                          07142000
            BEGIN   <<MUST SUCCEED>>                                    07144000
            SCANXDD (LDHEADX, TRUE);                                    07146000
            END                                                         07148000
         ELSE                                                           07150000
            BEGIN   <<NOT A SIMPLE REALLOCATION>>                       07152000
            IF LPDT0.(LP'VIRTUALF) <> 0 THEN                            07154000
               BEGIN                                                    07156000
               ALLOCATE := 4;                                           07158000
               GO BADEXIT;                                              07160000
               END;                                                     07162000
             <<AT THIS POINT, MUST BE INITIAL ALLOC,SPOOFLE REALLOC BY>>07164000
             <<LDEV OR A SUDDEN REALLOC DURING ASKOP.                 >>07166000
            DO                                                          07168000
               BEGIN   <<TRY TO FIND READY FILE>>                       07170000
               TRYFLAG _ GOTREADY;   <<INIT.FOR LOOP>>                  07172000
               IF SCANXDD (LDHEADX,FALSE) = NOMATCH THEN                07174000
                  DO                                                    07176000
                     BEGIN   <<TRY TO FIND OPENED FILE>>                07178000
                     TRYFLAG _ GOTOPENED;                               07180000
                     IF SCANXDD(LDHEADX,TRUE)=NOMATCH                   07182000
                      THEN                                              07184000
                        BEGIN   <<ASK OPERATOR>>                        07186000
                        IF NDCAP=FALSE' THEN                   <<00.DL>>07188000
                           BEGIN   <<NO ND CAPABILITY>>                 07190000
                           ALLOCATE _ 3;                                07192000
                           GO BADEXIT;                                  07194000
                           END;                                         07196000
                        ASK;                                            07198000
                        IF REPLYTYPE = REALLOC THEN                     07200000
                           TRYFLAG _ TRYOPENED                          07202000
                        ELSE                                            07204000
                           IF REPLYTYPE = OLDDATA THEN                  07206000
                              TRYFLAG _ TRYREADY;                       07208000
                        << ELSE OPASSIGNED:                             07210000
                              LEAVE TRYFLAG = GOTOPENED,                07212000
                              TO DROP OUT OF LOOP >>                    07214000
                        END;   <<OPERATOR>>                             07216000
                     END                                                07218000
                  UNTIL TRYFLAG<>TRYOPENED                              07220000
               ELSE                                                     07222000
                  IF NDCAP=FALSE' THEN                         <<00.DL>>07224000
                     BEGIN   <<NO ND CAPABILITY-READY,INITIAL ALLOC>>   07226000
                     ALLOCATE _ 3;                                      07228000
                     GO BADEXIT;                                        07230000
                     END;                                               07232000
               END                                                      07234000
            UNTIL TRYFLAG<>TRYREADY;                                    07236000
            END;                                                        07238000
         END;   <<OLD LDEV REQ.>>                                       07240000
      IF XDDSUBP=0 THEN                                                 07242000
         CREATESUBENTRY                                                 07244000
      ELSE                                                              07246000
         BEGIN                                                          07248000
         IF XDDX (XD'SPOOLFILE) <> 0 THEN                               07250000
            REALD := FALSE';                                   <<00.DL>>07252000
         IF XDDX (XD'STATE) = DFOPENED THEN                             07254000
            INITIAL := FALSE';                                 <<00.DL>>07256000
         END;                                                           07258000
      MOVE XDDX2 := XDDX, (XDDSIZE);                                    07260000
      IF REALD=FALSE' THEN                                     <<00.DL>>07262000
         BEGIN   <<SPOOFLE>>                                            07264000
         IF INITIAL=TRUE' THEN                                 <<00.DL>>07266000
            BEGIN                                                       07268000
            IF ( ALLOCDEV := GETVDEV ) = 0 THEN                         07270000
               BEGIN                                                    07272000
               ALLOCATE := 1;                                           07274000
               GO BADEXIT;                                              07276000
               END;                                                     07278000
            XDDX(XD'VDEV) := ALLOCDEV;                                  07280000
            IF RESTART=TRUE' THEN XDDX (XD'RESTART) := TRUE;   <<00.DL>>07282000
            UPDATEXDD := TRUE';                                <<00.DL>>07284000
            END                                                         07286000
         ELSE                                                           07288000
            ALLOCDEV := XDDX(XD'VDEV);  <<RE-ALLOCATION>>               07290000
         END;                                                           07292000
      IF INITIAL=TRUE' THEN                                    <<00.DL>>07294000
         BEGIN                                                          07296000
         UPDATEXDD:=TRUE';                                     <<00.DL>>07298000
         XDDX(XD'STATE) _ DFOPENED;                                     07300000
         XDDX (XD'JOBNUM) := JNUM;                                      07302000
         END;                                                           07304000
      IF LOGICAL (XDDX (XD'DATA)) THEN                                  07306000
         ALLOCATE := -2;    <<:DATA RETURN>>                            07308000
      END    <<OLD REQUEST>>                                            07310000
$PAGE "   ***   ALLOCATE- NEW   ***"                                    07312000
   ELSE                                                                 07314000
      BEGIN   <<* * * * * * * * *   N E W   R E Q U E S T   * * * * * >>07316000
      TOS := FORMSG(49);  <<SAVE>>                                      07318000
      TOS _ @FORMSG;                                                    07320000
      ASMB(DUP);                                                        07322000
      FORMSG(49) _ ".";   <<TO ENSURE TERMINATION>>                     07324000
      SCAN * UNTIL "..",1;                                              07326000
      ASMB(XCH,SUB);                                                    07328000
      FMSGLGTH _ TOS;   <<FORMS MSG.LENGTH>>                            07330000
      FORMSG(49) _ TOS; <<RESTORE>>                                     07332000
      NUMCOPIES := IF COPIES = 0 THEN 1 ELSE COPIES;    <<COPIES>>      07334000
      IF OUTPRI = 0 THEN   <<DEFAULT OUTPRI>>                           07336000
         OUTPRI := IF (ABSYS'SPOOLLOGM LAND %401) = %401       <<00.05>>07338000
                      THEN 8 ELSE 13;                                   07340000
      XDDDSTN := ODDDST;                                                07342000
      XDDSIR _ ODDSIR;                                                  07344000
      C _ GETSIR(XDDSIR);                                               07346000
      IF CLASSREQ=TRUE' THEN                                   <<00.DL>>07348000
         BEGIN   <<CLASS REQUEST>>                                      07350000
         SPOOLFLAG := SPOOLEDDEV(INDX);                                 07352000
         IF SPOOLFLAG = 1 THEN                                          07354000
         BEGIN <<SPOOLED CLASS>>                                        07356000
            ALLOCATE := -3;                                             07358000
            REALD := FALSE';                                            07360000
         END    <<SPOOLED CLASS>>                                       07362000
         ELSE                                                           07364000
         BEGIN     <<NOT SPOOLED CLASS>>                                07366000
         IF NUMCOPIES <= 1 THEN                                         07368000
            BEGIN   <<NORMAL INITIAL ALLOCATION>>                       07370000
            IF NOT FINDNEWREALEE THEN                          <<00.DL>>07372000
               BEGIN                                                    07374000
                  IF SPOOLFLAG THEN                            <<00635>>07376000
                  REALD:=FALSE'                                <<00.DL>>07378000
               ELSE                                                     07380000
                  BEGIN   <<DEVICE UNAVAILABLE>>                        07382000
                  ALLOCATE _ 1;                                         07384000
                  GO BADEXIT;                                           07386000
                  END;                                                  07388000
               END                                                      07390000
            ELSE   <<OP.INTERVENTION REQD.OR RESERVED>>                 07392000
            END                                                         07394000
         ELSE                                                           07396000
            BEGIN   <<#COPIES>1, TRY FOR SPOOLEE>>                      07398000
                  IF SPOOLFLAG THEN                            <<00635>>07400000
               REALD:=FALSE'                                   <<00.DL>>07402000
            ELSE                                                        07404000
               BEGIN   <<TRY FOR REAL DEV.& OVERRIDE COPIES>>           07406000
               IF NOT FINDNEWREALEE THEN                       <<00.DL>>07408000
                  BEGIN   <<DEVICE UNAVAILABLE>>                        07410000
                  ALLOCATE _ 1;                                         07412000
                  GO BADEXIT;                                           07414000
                  END;                                                  07416000
               NUMCOPIES _ 1;                                           07418000
               END;                                                     07420000
            END;   <<SPOOL TRY>>                                        07422000
         END;      <<NOT SPOOLED CLASS>>                                07424000
         END   <<NEW,CLASS STUFF>>                                      07426000
      ELSE                                                              07428000
         BEGIN   <<NEW,LDEV REQUEST>>                                   07430000
         IF OWNEDBYCALLER THEN                                          07432000
            BEGIN   <<OWNED BY CALLER. LDEV OR VDEV REALLOC>>           07434000
            INITIAL:=FALSE';                                   <<00.DL>>07436000
            IF LPDT0.(LP'VIRTUALF) <> 0 THEN                            07438000
               REALD := FALSE'  <<VDEV REALLOC>>               <<00.DL>>07440000
            ELSE                                                        07442000
               BEGIN   <<LDEV REALLOC>>                                 07444000
               NUMCOPIES _ 1;                                           07446000
               IF FMSGLGTH>0 OR LDT2.(9:1)=1 THEN                       07448000
                  BEGIN <<FORMS REQ'D OR FORMS UP>>            <<00.DL>>07450000
                  OPREQD:=TRUE';                               <<00.DL>>07452000
                  ASKFORMS:=TRUE';                             <<00.DL>>07454000
                  END;  <<FORMS REQ'D OR FORMS UP>>            <<00.DL>>07456000
               END;                                                     07458000
            END   <<REALLOC>>                                           07460000
         ELSE                                                           07462000
            BEGIN                                                       07464000
            IF LPDT0.(LP'VIRTUALF) <> 0 THEN                            07466000
               BEGIN                                                    07468000
               ALLOCATE := 4;                                           07470000
               GO BADEXIT;                                              07472000
               END;                                                     07474000
             <<MUST BE INITIAL ALLOC OR SPOOFLE REALLOC BY LDEV>>       07476000
            I := SCANXDD (LDHEADX, TRUE);                               07478000
            IF I<>0 THEN                                                07480000
               BEGIN   <<GOT OPENED, MUST BE REALLOC SPOOFLE>>          07482000
               INITIAL:=FALSE';                                <<00.DL>>07484000
               REALD:=FALSE';                                  <<00.DL>>07486000
               ALLOCDEV := XDDX(XD'VDEV);                               07488000
               END                                                      07490000
            ELSE                                                        07492000
               BEGIN   <<INITIAL ALLOC>>                                07494000
               IF CS = 1 THEN                                           07496000
                  REALD:=FALSE'  <<SPOOLEE>>                   <<00.DL>>07498000
               ELSE                                                     07500000
                  BEGIN   <<REALEE>>                                    07502000
                  IF (K_TRYNEWREALDEV(ALLOCDEV)) = 0 THEN               07504000
                     BEGIN   <<DEV.NOT AVAILABLE>>                      07506000
                     ALLOCATE _ 1;                                      07508000
                     GO BADEXIT;                                        07510000
                     END;                                               07512000
                  IF K <> 3 THEN                                        07514000
                     BEGIN   <<MAGTAPE OR FORMS>>                       07516000
                     OPREQD:=TRUE';                            <<00.DL>>07518000
                     IF K=1 THEN                                        07520000
                        ASKFORMS:=TRUE';   <<FORMS>>           <<00.DL>>07522000
                     END;                                               07524000
                  END;   <<REALEE>>                                     07526000
               END;   <<INITIAL ALLOC>>                                 07528000
            END;                                                        07530000
         END;   <<NEW,LDEV REQ.>>                                       07532000
       <<STUFF COMMON TO ALL NEW>>                                      07534000
       <<REAL INITIAL                                                   07536000
       << T      T     IF OPREQD THEN ASK FOR FORMS,MAG.TAPE          >>07538000
       <<               ELSE ALLOCDEV SET & RESERVED.                 >>07540000
       << T      F     IF OPREQD THEN ASK FOR FORMS ELSE SIMPLE       >>07542000
       <<               REALLOC OF ALLOCDEV                           >>07544000
       << F      T     GET A NEW VDEV.                                >>07546000
       << F      F     SPOOFLE REALLOC. ALLOCDEV SET TO VDEV.         >>07548000
       <<                                                             >>07550000
       <<XDDSUBP=0, EXCEPT FOR SPOOFLE REALLOC BY LDEV.               >>07552000
       <<FOR REAL ALLOC, OPREQD SET IF OP.INTERVENTION REQUIRED.      >>07554000
      IF OPREQD=TRUE' THEN                                     <<00.DL>>07556000
         BEGIN   <<OP.INTERVENTION REQUIRED>>                           07558000
         IF ASKFORMS=TRUE' THEN                                <<00.DL>>07560000
            IF FMSGLGTH > 0 THEN                                        07562000
               BEGIN   <<SEND FORMS MESSAGE>>                           07564000
               I _ FORMSG(FMSGLGTH);   <<SAVE>>                         07566000
               FORMSG(X) _ 0;   <<TERMINATION CHAR.FOR PUTMSG>>         07568000
               CLEAN'MESSAGE(FORMSG,FMSGLGTH);                          07570000
               GENMSG(1,213,%10000,ALLOCDEV,@FORMSG,,,,0);     <<00741>>07572000
               FORMSG (FMSGLGTH) := I;                                  07574000
               END                                                      07576000
            ELSE                                                        07578000
               GENMSG(1,214,%10000,ALLOCDEV);                  <<00552>>07580000
         ASK;                                                           07582000
         END;   <<OP.INTERVENTION. GOT INITIAL OR REALLOC REALEE>>      07584000
      IF INITIAL=TRUE' THEN                                    <<00.DL>>07586000
         BEGIN   <<CREATE LOCAL ODD SUBENTRY>>                          07588000
         IF REALD=FALSE' THEN                                  <<00.DL>>07590000
            IF ( ALLOCDEV := GETVDEV ) = 0 THEN                         07592000
               BEGIN                                                    07594000
               ALLOCATE := 1;                                           07596000
               GO BADEXIT;                                              07598000
               END;                                                     07600000
         CREATESUBENTRY;                                                07602000
         IF REALD=FALSE' THEN                                  <<00.DL>>07604000
            BEGIN    << INITIAL, NEW, SPOOLFILE: GET 1ST EXT >>         07606000
            IF DISKALLOC (0,1,XDDX (OD'SPOOLFILE),0) <> 0 THEN <<RH.PV>>07608000
               BEGIN    << ERR GETTING 1ST EXT FOR SPOOLFILE >>         07610000
               ALLOCATE := 5;                                           07612000
               GOTO BADEXIT;                                            07614000
               END;                                                     07616000
            GOTSEXT := TRUE';                                  <<00.DL>>07618000
            END;                                                        07620000
         END                                                            07622000
      ELSE                                                              07624000
         BEGIN   <<REALLOC>>                                            07626000
         IF XDDSUBP = 0 THEN                                            07628000
            IF SCANXDD (LDHEADX, TRUE) = 0 THEN                         07630000
               CREATESUBENTRY;                                          07632000
         END;                                                           07634000
      MOVE XDDX2 := XDDX, (XDDSIZE);                                    07636000
      IF REALD=TRUE' THEN                                      <<00.DL>>07638000
         BEGIN   <<NOTE: LDT&LPDT ENTRIES MUST BE IN LOCALS>>           07640000
         GETLDT'LPDT (ALLOCDEV);                                        07642000
         IF FO=0 AND FMSGLGTH>0 OR FO=1 AND FMSGLGTH=0 THEN             07644000
            BEGIN   <<FORMS BIT DON'T JIVE>>                            07646000
            FO := NOT (LOGICAL (FO));   <<REVERSE BIT IN TABLE LATER>>  07648000
            END;                                                        07650000
         END                                                            07652000
      ELSE                                                              07654000
         BEGIN                                                          07656000
         IF INITIAL=FALSE' THEN                                <<00.DL>>07658000
            BEGIN                                                       07660000
            GETLDT'LPDT (ALLOCDEV);                                     07662000
            IF XDDX(XD'NUMCOPIES) < NUMCOPIES THEN                      07664000
               BEGIN                                                    07666000
               UPDATEXDD:=TRUE';                               <<00.DL>>07668000
               XDDX(XD'NUMCOPIES) _ NUMCOPIES;                          07670000
               END;                                                     07672000
            END;                                                        07674000
         END;                                                           07676000
      IF FMSGLGTH>0 AND XDDX(XD'TEF) =0 THEN                            07678000
         BEGIN                                                          07680000
         XDDX(XD'TEF) _ 1;                                              07682000
         UPDATEXDD:=TRUE';                                     <<00.DL>>07684000
         END;                                                           07686000
      END;   <<NEW REQUEST>>                                            07688000
$PAGE "   ***   COMPLETE ALLOCATE (OLD AND NEW)   ***"                  07690000
   IF INITIAL=TRUE' AND REALD=TRUE' AND                        <<SD.00>>07692000
     (LDT2.(10:6)=SDISC OR LDT2.(10:6)=FDISC) THEN             <<01115>>07694000
      BEGIN   << Get and initialize dataseg if serial disc. >> <<03607>>07696000
      IF LDT2.(10:6) = SDISC THEN                              <<01115>>07700000
         BEGIN                                                 <<01115>>07702000
         <<************* GET **************************>>      <<SD.00>>07704000
         SEGNUM := GETDATASEG (MEMSIZE, VDSIZE);               <<SD.00>>07706000
         IF <> THEN                                            <<SD.00>>07708000
            BEGIN <<CAN'T GET DATASEG>>                        <<SD.00>>07710000
            SEGNUM := -1;                                      <<SD.00>>07712000
            END;  <<CAN'T GET DATASEG>>                        <<SD.00>>07714000
         <<************* SAVE IN LDTX *****************>>      <<SD.00>>07716000
         END                                                   <<01115>>07718000
      ELSE                                                     <<01115>>07720000
         SEGNUM := 1;   << Foreign disc.                    >> <<01115>>07722000
      TOS := @LDTX0;                                           <<SD.00>>07724000
      TOS := LDTDSTN;                                          <<SD.00>>07726000
      TOS := 0;                                                <<SD.00>>07728000
      TOS := LDTSIZE;                                          <<SD.00>>07730000
      ASSEMBLE(MFDS 4); <<RECORD#0 OF LDT>>                    <<SD.00>>07732000
      TOS := @LDTX0;                                           <<SD.00>>07734000
      TOS := LDTDSTN;                                          <<SD.00>>07736000
      TOS := LDTX1 + LDTX3 + ALLOCDEV * LDTXSIZE;              <<SD.00>>07738000
      I := S0;                                                 <<SD.00>>07740000
      TOS := LDTXSIZE;                                         <<SD.00>>07742000
      ASSEMBLE(MFDS 4); <<GOT LDTX ENTRY>>                     <<SD.00>>07744000
         IF NOT LOGICAL( LDTX'ENTRY(LDTX'SERIAL'DISC) ) THEN   <<04429>>07746000
         BEGIN <<FIRST ALLOCATION>>                            <<SD.01>>07748000
                                                               <<03607>>07750000
<< Lock any CS80 device to prevent the  operator  from  un- >> <<03607>>07752000
<< loading it while it is allocated.  Although this must be >> <<03607>>07754000
<< a physical I/O request (that is, not to the serial  disc >> <<03607>>07756000
<< code),  FLAGS.(10:1)  (the  last  parameter to ATTACHIO) >> <<03607>>07758000
<< must still be 0.  The reason is that the device  is  not >> <<03607>>07760000
<< yet  owned,  according to the DRSTATE field in the LPDT. >> <<03607>>07762000
<< (This field is set just before we  exit  ALLOCATE).  AT- >> <<03607>>07764000
<< TACHIO  will not call the serial disc for an unowned de- >> <<03607>>07766000
<< vice.  FLAGS.(10:1) = 1 is then treated as a MAM request >> <<03607>>07768000
<< with disastrous (SF613)  consequences.  The  same  holds >> <<03607>>07770000
<< at the ATTACHIO call at BADEXIT.                         >> <<03607>>07772000
                                                               <<03607>>07774000
         IF LDEVTOTYPE(ALLOCDEV) = CS80'DEVICE THEN            <<03607>>07776000
            BEGIN                                              <<03607>>07778000
            LOCKED := TRUE;    <<set in case of an error>>     <<03607>>07780000
            ATTACHIO (ALLOCDEV,0,0,0,LOCK,0,0,0,1);            <<03607>>07782000
            END;                                               <<03607>>07784000
         LDTX'ENTRY(LDTX'SERIAL'DISC) := TRUE;                 <<04429>>07786000
         LDTX'ENTRY(LDTX'SDISC'XDS) := SEGNUM;                 <<04429>>07788000
         TOS := LDTDSTN;                                       <<SD.00>>07790000
         TOS := I;                                             <<SD.00>>07792000
         TOS := @LDTX0;                                        <<SD.00>>07794000
         TOS := LDTXSIZE;                                      <<SD.00>>07796000
         ASSEMBLE(MTDS 4); <<PUT ALTERED LDTX BACK>>           <<SD.00>>07798000
         <<************* INITIALIZE FOR THIS SUBTYPE **>>      <<SD.00>>07800000
         IF SEGNUM > 0 AND LDT2.(10:6) = SDISC THEN            <<01115>>07802000
            BEGIN <<VALID DATASEG NUMBER>>                     <<SD.00>>07804000
            TEMPDESC(JUSTALLOCCELL) := -1;                     <<00239>>07806000
            TEMPDESC(FATALERRCELL) := 0;                       <<00239>>07808000
            TEMPDESC(ERRORLOGCELL) := 0;                       <<03512>>07810000
            TEMPDESC(MEMSIZECELL) := MEMSIZE;                  <<03512>>07812000
            TOS := SEGNUM;                                     <<SD.00>>07814000
            TOS := JUSTALLOCATED'ADR;                          <<00076>>07816000
            TOS := @TEMPDESC;                                  <<SD.00>>07818000
            TOS := INITARRAYSIZE;                              <<SD.00>>07820000
            ASSEMBLE(MTDS 4);                                  <<SD.00>>07822000
            END;  <<VALID DATASEG NUMBER>>                     <<SD.00>>07824000
         END   <<FIRST ALLOCATION>>                            <<SD.01>>07826000
      ELSE                                                     <<SD.01>>07828000
         IF SEGNUM > 0 AND LDT2.(10:6) = SDISC THEN            <<01115>>07830000
            RELDATASEG (SEGNUM);                               <<01115>>07832000
      END;  <<GET AND INITIALIZE DATASEG>>                     <<SD.00>>07834000
   IF UPDATEXDD=TRUE' THEN                                     <<00.DL>>07836000
      BEGIN   <<NEW OR ALTERED ENTRY>>                                  07838000
      IF XDDSUBP=0 THEN                                                 07840000
         BEGIN   <<ADD NEW ENTRY>>                                      07842000
         IF SPUTXDD((OLDREQ=FALSE'),IF XDDX(XD'C)=0 THEN       <<00.DL>>07844000
                    XDDX(XD'DEVICE) ELSE                                07846000
                  -XDDX(XD'DEVICE),XDDX,XDDSUBPP)<>0 THEN               07848000
            BEGIN   <<NO ROOM IN TABLE>>                                07850000
            ALLOCATE _ 7;                                               07852000
            GO BADEXIT;                                                 07854000
            END;                                                        07856000
         XDDSUBP := @XDDSUBPP.(1:15);                                   07858000
         END                                                            07860000
      ELSE                                                              07862000
         BEGIN   <<MODIFIED ENTRY IN XDDX(*),ORIGINAL IN XDDX2(*)>>     07864000
         EXCHANGEDB(XDDDSTN);                                           07866000
         TOS _ XDDSUBP;   <<DB TARGET>>                                 07868000
         TOS _ DLXDDX;   <<DL SOURCE>>                                  07870000
         TOS _ XDDSIZE;   <<COUNT>>                                     07872000
         ASMB(MVLB 3);   <<MOVE SUBENTRY INTO TALBE>>                   07874000
         EXCHANGEDB(0);                                                 07876000
         END;                                                           07878000
      END;   <<NEW OR ALTERED ENTRY>>                                   07880000
   IF INITIAL=TRUE' THEN                                       <<00.DL>>07882000
      IF REALD=FALSE' THEN                                     <<00.DL>>07884000
         BEGIN  <<SET UP VIRTUAL DEVICE>>                               07886000
         TOS := 0;                                                      07888000
         TOS := XDDX(XD'DEVICE);  <<GET REAL DEV>>                      07890000
         IF LOGICAL(XDDX(XD'C)) THEN                                    07892000
            BEGIN  <<ON CLASS CHAIN>>                                   07894000
            DEL;                                                        07896000
            IF NOT GETCLASS(ICLASS,0,,XDDX(XD'DEVICE))                  07898000
                  THEN SUDDENDEATH(364);                                07900000
            TOS := ICLASS(3).(8:8);                                     07902000
            END;                                                        07904000
         GETLDT'LPDT(*);  <<GET REAL DEV ENTRIES>>                      07906000
         <<MERGE LPDT ENTRIES>>                                         07908000
         LPDT0 := @XDDSUBPP;                                            07910000
         LPDT0.(0:2) := IF OLDREQ=FALSE' THEN 3 ELSE 2;        <<00.DL>>07912000
         LPDT1 := LOGICAL(LPDT1) LAND %33017;                           07914000
         <<MERGE LDT ENTRIES>>                                          07916000
         LDT0 := 0;                                                     07918000
         LDT2 := LOGICAL(LDT2) LAND %177677;                            07920000
         LDT3.(0:2) := IF OLDREQ=FALSE'                        <<00.DL>>07922000
                             THEN OUTPUTSPOOFLE                         07924000
                             ELSE INPUTSPOOFLE;                         07926000
         LDENTRY (LD'SQ) := 0;                                          07928000
         IF LOGICAL (XDDX (XD'C)) THEN    <<ON CLASS CHAIN>>            07930000
            LDENTRY (LD'XDDHEADX) := ODDCLASSHEADX;                     07932000
         END;                                                           07934000
      TJMPIN := JMPIN;                                                  07936000
      SS := 1;                                                          07938000
   USECOUNT _ USECOUNT + 1;                                             07940000
   SORFDISC:=LDT2.(10:6);                                      <<01115>>07942000
   IF SORFDISC=SDISC OR SORFDISC=FDISC                         <<01115>>07944000
      THEN LDT2.(10:6):=DISCTYPE;                              <<01115>>07946000
   PUTDEV(ALLOCDEV,LDTDSTN,LDENTRY);                                    07948000
   PUTDEV(ALLOCDEV,LPDDSTN,PDENTRY);                                    07950000
   WRITEDSEG(XDDDSTN);                                                  07952000
   RELSIR(XDDSIR,C);                                                    07954000
   RELSIR(LPDSIR,D);                                                    07956000
   RELSIR(LDTSIR,B);                                                    07958000
   LDT2.(10:6):=SORFDISC;                                      <<01115>>07960000
    <<SET UP RETURNS>>                                                  07962000
   DEVINFO _ ALLOCDEV;                                                  07964000
   TOS _ @DEVINFO(1);                                                   07966000
   TOS _ @LPDT0;                                                        07968000
   TOS _ 2;                                                             07970000
   ASMB(MOVE 2);   <<LPDT ENTRY>>                                       07972000
   TOS _ @LDT0;                                                         07974000
   TOS _ 5;                                                             07976000
   ASMB(MOVE 3);   <<LDT ENTRY>>                                        07978000
   @XDDADR:=@XDDSUBPP;                                         <<00.DL>>07980000
   IF OLDREQ=FALSE' THEN @XDDADR.(0:1):=1;                     <<00.DL>>07982000
   RETURN;                                                              07984000
BADEXIT:                                                                07986000
   IF LOCKED THEN ATTACHIO(ALLOCDEV,0,0,0,UNLOCK,0,0,0,1);     <<03546>>07988000
   IF FRESERVED=TRUE' THEN                                     <<00.DL>>07990000
      BEGIN                                                             07992000
      EXCHANGEDB(LPDDSTN);                                              07994000
      DTAB(ALLOCDEV&LSL(1)+1).(0:2) _ 0;   <<RESET SS>>                 07996000
      END;                                                              07998000
   EXCHANGEDB(0);                                                       08000000
   IF GOTSEXT=TRUE' THEN                                       <<00.DL>>08002000
      << GOT 1ST SPOOLFILE EXTENT: RELEASE IT >>                        08004000
      DISKDEALLOC (0, 0, %201, XDDX (OD'SPOOLFILE));                    08006000
   RELSIR(XDDSIR,C);                                                    08008000
BAD2:                                                                   08010000
   RELSIR(LPDSIR,D);                                                    08012000
   RELSIR(LDTSIR,B);                                                    08014000
BAD3:                                                                   08016000
   END;   <<ALLOCATE>>                                                  08018000
$PAGE "   ***   PRIMEDEVICE   ***"                                      08020000
LOGICAL PROCEDURE PRIMEDEVICE (LDEV, XDDEP, FORMS);            <<01027>>08022000
   VALUE LDEV, XDDEP, FORMS;                                            08024000
   INTEGER LDEV;          <<LOG. DEV NO.>>                              08026000
   INTEGER POINTER XDDEP; <<XDD ENTRY PNTR (W/SIGN FLAG)>>              08028000
   LOGICAL FORMS;         <<SPECIAL FORMS WERE MOUNTED>>                08030000
   OPTION PRIVILEGED, UNCALLABLE;                                       08032000
                                                                        08034000
<< DOES NECESSARY ATTACHIO SETUP FOR ALLOCATE'D DEVICE <LDEV>:          08036000
   ALWAYS ISSUES ATTACHIO (OPENFILE);                                   08038000
   PRINTS HEADER IF 1ST ALLOC (OF L.P., CD. PUN., OR P/R/P);            08040000
   PERFORMS FORMS ALIGNMENT, IF <FORMS>.                                08042000
   >>                                                                   08044000
                                                                        08046000
BEGIN                                                                   08048000
   INTEGER ARRAY    LDT (0:LDTSIZE-1)  = Q;    <<LOCAL OF LDT ENTRY>>   08050000
LOGICAL ARRAY                                                  <<04426>>08052000
              LDTX( 0 : LDTXSIZE - 1 )  = Q                    <<04426>>08054000
             ,LDT0(*) = LDTX << never simultaneously used >>   <<04426>>08056000
;                                                              <<04426>>08058000
                                                               <<04426>>08060000
INTEGER                                                        <<04426>>08062000
        LDT'SIR'SAVE                                           <<04426>>08064000
;                                                              <<04426>>08066000
                                                               <<04426>>08068000
                                                                        08070000
<< >>                                                                   08072000
   PRIMEDEVICE := FALSE;   <<INITIALIZE>>                      <<01027>>08074000
   ATTACHIO (LDEV, 0, 0, 0, 2, 0, 0, 0, %17);                           08076000
  << If this is the first allocation of this device and      >><<04426>>08078000
  << if it is CIPER protocol then send a Job Start function. >><<04426>>08080000
                                                               <<04426>>08082000
  << Get local copies of the ldt and ldtx entries of >>        <<04426>>08084000
  << this device. >>                                           <<04426>>08086000
  LDT'SIR'SAVE := GETSIR(LDT'SIR);                             <<04426>>08088000
  TOS := @LDT;                                                 <<04426>>08090000
  TOS := LDT'DST;                                              <<04426>>08092000
  TOS := LDEV * LDTSIZE;                                       <<04426>>08094000
  TOS := LDTSIZE;                                              <<04426>>08096000
  ASSEMBLE (MFDS 4);                                           <<04426>>08098000
                                                               <<04426>>08100000
  << Get the header entry of the ldt to calculate the >>       <<04426>>08102000
  << ldtx'base. >>                                             <<04426>>08104000
  TOS := @LDT0;                                                <<04426>>08106000
  TOS := LDT'DST;                                              <<04426>>08108000
  TOS := 0; << Zero (header) Entry >>                          <<04426>>08110000
  TOS := LDTSIZE;                                              <<04426>>08112000
  ASSEMBLE (MFDS 4);                                           <<04426>>08114000
                                                               <<04426>>08116000
  TOS := @LDTX;                                                <<04426>>08118000
  TOS := LDTX'DST;                                             <<04426>>08120000
  TOS := LDTX'BASE + LDEV * LDTXSIZE;                          <<04426>>08122000
  TOS := LDTXSIZE;                                             <<04426>>08124000
  ASSEMBLE (MFDS 4);                                           <<04426>>08126000
                                                               <<04426>>08128000
  RELSIR(LDT'SIR, LDT'SIR'SAVE);                               <<04426>>08130000
                                                               <<04426>>08132000
  IF (LDT(LDT'FILE'USE'CNT) = 1) AND LDTX(LDTX'CIPER'PROTOCOL) <<04426>>08134000
       THEN                                                    <<04426>>08136000
    BEGIN                                                      <<04426>>08138000
                                                               <<04426>>08140000
    TOS := ATTACHIO(LDEV, 0 << QMISC := NA >>,                 <<04426>>08142000
              0 << DSTX := stack >>, 0 << ADDR := DB+0 >>,     <<04426>>08144000
         142 << FUNC := Start of Job >>, 0 << CNT := none >>,  <<04426>>08146000
         1 << P1 := reset programable features >>,             <<04426>>08148000
         0 << P2 := NA >>,                                     <<04426>>08150000
         1 << FLAGS := no premption; not special request; >>   <<04426>>08152000
         << not diagnostic; not system buffer; blocked,   >>   <<04426>>08154000
         << wake on completion, impede if no IOQ element    >> <<04426>>08156000
         << is available. >> );                                <<04426>>08158000
                                                               <<04426>>08160000
    DEL;  << get rid of transmission log/control returns >>    <<04426>>08162000
                                                               <<04426>>08164000
    IF TOS.(8:8) << qualifying & general status >> <> 1 THEN   <<04426>>08166000
         RETURN; << exit, an error occured >>                  <<04426>>08168000
                                                               <<04426>>08170000
    END;                                                       <<04426>>08172000
                                                               <<04426>>08174000
   IF @XDDEP < 0 THEN                                                   08176000
      BEGIN    << OUTPUT DEVICE: [,HEADER] [,FORMSALIGN] >>    <<04426>>08178000
      IF LDT (LD'USECOUNT) = 1 THEN                                     08182000
         BEGIN    << 1ST ALLOC: TRY HEADER >>                           08184000
         TOS := 0;    <<STACK PARMS FOR HEADER CALL>>                   08186000
         TOS := @XDDEP.(1:15);    <<MASK OFF ODD BIT>>                  08188000
         IF NOT HEADER (*,LDEV,LDT(LD'DEVTYPE),LDT(LD'RWIDTH)) <<01027>>08190000
         THEN RETURN;                                          <<01027>>08192000
         END;                                                           08194000
      IF FORMS THEN FORMSALIGN (LDEV);    <<ALIGN IF <FORMS>.>>         08196000
      END;    << OUTPUT DEV >>                                          08198000
   PRIMEDEVICE := TRUE;                                        <<01027>>08200000
   END;    << PRIMEDEVICE >>                                            08202000
$PAGE "   ***   DEALLOCATE   ***"                                       08204000
$CONTROL SEGMENT= ALLOCUTIL                                             08206000
                                                                        08208000
PROCEDURE FREEDEVICE(LDEV,WAIT,NOREW);                         <<TL.02>>08210000
   VALUE WAIT,LDEV,NOREW;                                      <<TL.02>>08212000
   INTEGER LDEV;    <<NON-SHARABLE, REAL DEVICE 2 B FREED>>             08214000
   LOGICAL WAIT;    <<WAIT ON CLOSEDEVICE?>>                            08216000
  LOGICAL NOREW;                                               <<TL.02>>08218000
  OPTION VARIABLE;                                             <<TL.02>>08220000
   OPTION PRIVILEGED, UNCALLABLE;                                       08222000
BEGIN                                                                   08224000
   INTEGER           SAVESIR1,         <<GETSIR RETURNS>>               08226000
                     SAVESIR2,                                          08228000
                     DEVTYPE,          << Device type >>       <<02566>>08230000
                     DUMMY,            << for procedure call >><<02566>>08232000
                     Q4=Q-4,                                   <<TL.02>>08234000
                     DEVX;                                              08236000
   INTEGER POINTER   DEVP;             <<LDT PNTR>>                     08238000
   LOGICAL POINTER   DEVPL  = DEVP;                                     08240000
   LOGICAL           COMM  := FALSE,        <<CS DEVICE?>>              08242000
                     NOWOFFLINE  := FALSE,  <<IF DOWN PENDING>>         08244000
                     FLUSH  := FALSE;  <<COM PEND OR NON-I AND ACCEPT>> 08246000
                                                                        08248000
   LOGICAL LFLAG:=FALSE; <<TAPE LABEL FLAG>>                   <<TL.02>>08250000
<< >>                                                                   08252000
   DEVX := LDEV*LPDTSIZE;                                               08254000
   @DEVP := LDEV *LDTSIZE;                                              08256000
   IF Q4.(15:1)=1 THEN LFLAG:=NOREW;                           <<TL.02>>08258000
   EXCHANGEDB (LDTDST);                                                 08260000
   SAVESIR1 := GETSIR (LDTSIR);                                         08262000
   DEVP (LD'USECOUNT) := 0;                                             08264000
   DEVP (LD'MAINPIN) := 0;                                              08266000
   DEVTYPE := DEVP(LD'DEVTYPE);                                <<02566>>08268000
   IF DEVPL (LD'R) THEN                                                 08270000
      BEGIN                                                             08272000
      NOWOFFLINE := TRUE;                                               08274000
      DEVPL (LD'F) := FALSE;                                            08276000
      DEVPL (LD'R) := FALSE;                                            08278000
      END                                                               08280000
   ELSE                                                                 08282000
      BEGIN                                                             08284000
      SAVESIR2 := GETSIR (LPDTSIR);                                     08286000
      IF NOT (SYS'LPDTP (DEVX +LP'EOF)) AND                             08288000
         SYS'LPDTP (DEVX +LP'EOF) <> 0                                  08290000
      OR NOT (SYS'LPDTP(DEVX+LP'I)) AND                                 08292000
         SYS'LPDTP(DEVX+LP'JA) <> 0 THEN                                08294000
            FLUSH := TRUE;                                              08296000
      RELSIR (LPDTSIR, SAVESIR2);                                       08298000
      END;                                                              08300000
   IF DEVPL (LD'CS) THEN COMM := TRUE;                                  08302000
   RELSIR (LDTSIR, SAVESIR1);                                           08304000
   EXCHANGEDB (0);                                                      08306000
                                                                        08308000
   IF NOWOFFLINE THEN                                                   08310000
      GENMSG(1,250,%10000,LDEV,,,,,0);                         <<0U.EB>>08312000
   IF FLUSH THEN                                                        08314000
      BEGIN                                                             08316000
      DISABLE;                                                          08318000
      SYS'LPDTP(DEVX+LP'SS) := DEVSERVICE;                              08320000
      SYS'LPDTP(LPDT'SERVREQ) := SYS'LPDTP(LPDT'SERVREQ)+1;             08322000
      ENABLE;                                                           08324000
      AWAKE (SYSPROC(DRECLPIN), JUNKWAIT, 0);                           08326000
      END                                                               08328000
   ELSE                                                                 08330000
      BEGIN                                                             08332000
      IF NOT (COMM) THEN                                                08334000
         IF NOT LFLAG THEN                                     <<02566>>08336000
            BEGIN                                              <<02566>>08338000
            << Clean up density data structure for tapes. >>   <<02566>>08340000
            IF DEVTYPE=MAGTAPE THEN                            <<02566>>08342000
               BEGIN                                           <<02566>>08344000
               STORE'DENSITY(LDEV,DUMMY,2);  << Clear fields >><<02566>>08346000
               SET'LPDT'BOT(LDEV,1);   << Set BOT >>           <<02566>>08348000
               END;                                            <<02566>>08350000
                                                               <<02566>>08352000
            << Close device >>                                 <<02566>>08354000
            ATTACHIO(LDEV,0,0,0,4,0,0,0,IF WAIT THEN 1         <<02566>>08356000
                                                ELSE %17);     <<02566>>08358000
            END;                                               <<02566>>08360000
      SYS'LPDTP(DEVX+LP'SS) := DEVAVAIL;                                08362000
      IF NOT (NOWOFFLINE) THEN                                          08364000
         BEGIN                                                          08366000
         DISABLE;                                                       08368000
         TOS := ABSYS'JOBSYNC;                                          08370000
         ASSEMBLE (                                                     08372000
            TSBC 15;    <<INDICATE DEV AVAIL>>                          08374000
            TRBC 14);   <<IS JOB WAITING 4 DEV?>>                       08376000
         ABSOLUTE (XREG) := TOS;                                        08378000
         ENABLE;                                                        08380000
         IF <> THEN                                                     08382000
            AWAKE(SYSPROC(UCOPLPIN), JUNKWAIT, 0);                      08384000
         END;                                                           08386000
      END;                                                              08388000
   END;    <<FREEDEVICE>>                                               08390000
DOUBLE PROCEDURE DOUBLETIME;                                            08392000
   OPTION PRIVILEGED, UNCALLABLE;                                       08394000
                                                                        08396000
<< RETURNS CURRENT TIME IN FOLLOWING (POSITIVE) DOUBLE-WORD FORMAT:     08398000
   [1/0, 7/YEAR, 9/DAY, 5/HOUR, 6/MIN, 4/QUADSECOND] D.  >>             08400000
                                                                        08402000
BEGIN                                                                   08404000
   TOS := CALENDAR;                                                     08406000
   TOS := CLOCK;                                                        08408000
   << "TASK" NOW IS TO "ELIMINATE" (1).(0:3), (1).(8:2), (2).(0:2),     08410000
      (2).(6:10); COMPRESSING REMAINING FIELDS, RT-JUSTIFIED. >>        08412000
   TOS := TOS &LSL(2);    <<MAKE MIN & SEC ADJACENT>>                   08414000
   TOS := TOS &DLSR(8);    <<SETUP TO MAKE HR & MIN ADJACENT>>          08416000
   TOS := TOS &LSL(2);    <<MAKE HR & MIN ADJACENT>>                    08418000
   TOS := TOS &DLSR(5);    <<MAKE YR & HR ADJACENT>>                    08420000
   DELB;                  <<ALL INFO SHIFTED OUT OF S-1>>               08422000
   TOS := TOS &DLSR(1);    <<RT. JUSTIFY>>                              08424000
                                                                        08426000
   DOUBLETIME := TOS;                                                   08428000
   END;    <<DOUBLETIME>>                                               08430000
PROCEDURE FORS'XDS'DEALLOC(LDEV);                              <<03633>>08432000
  VALUE LDEV;                                                  <<03633>>08434000
  INTEGER LDEV;                                                <<03633>>08436000
  OPTION PRIVILEGED,UNCALLABLE;                                <<03633>>08438000
COMMENT                                                        <<03633>>08440000
                                                               <<03633>>08442000
   This procedure is used to deallocate the extra data         <<03633>>08444000
segment used in SDISC.  It is called from DEALLOCATE and       <<03633>>08446000
CLEANTAPE (in LABSEG).  To be called the device (LDEV)         <<03633>>08448000
must be a non system and non Private Volume Disc.              <<03633>>08450000
DB at stack on entry/exit.                                     <<03633>>08452000
                                                               <<03633>>08454000
;                                                              <<03633>>08456000
BEGIN  << Unlock CS80 dev, deallocate SD XDS >>                <<03633>>08458000
  INTEGER DEVX;                                                <<03633>>08460000
  INTEGER SEGNUM;                                              <<03633>>08462000
  INTEGER SAVELDT;                                             <<03633>>08464000
  POINTER LDTXENT;                                             <<03633>>08466000
                                                               <<03633>>08470000
DEVX := LDEV*LPDTSIZE;                                         <<03633>>08472000
EXCHANGEDB (LDTDST);                                           <<03633>>08474000
SAVELDT := GETSIR (LDTSIR);                                    <<03633>>08476000
                                                               <<03633>>08478000
<< Unlock any CS80 serial or foreign disc.  FREEDEVICE made >> <<03633>>08480000
<< the device unowned again, so serial  disc  will  not  be >> <<03633>>08482000
<< called.  FLAGS.(10:1)  (last parameter of ATTACHIO) must >> <<03633>>08484000
<< be 0 to avoid treating the call as a MAM request.        >> <<03633>>08486000
                                                               <<03633>>08488000
IF LDEVTOTYPE(LDEV) = CS80'DEVICE                              <<03633>>08490000
  THEN ATTACHIO (LDEV,0,0,0,UNLOCK,0,0,0,1);                   <<03633>>08492000
                                                               <<03633>>08494000
<< Get serial disc XDS number from LDT extension.           >> <<03633>>08496000
                                                               <<03633>>08498000
@LDTXENT := LDT'DCT+LDT'DCTSIZE+LDEV*LDTXSIZE;                 <<03633>>08500000
SEGNUM := LDTXENT(LDTX'SDISC'XDS);                             <<04429>>08502000
                                                               <<03633>>08504000
<< Segment exists only if the device is a serial disc,  but >> <<03633>>08506000
<< the  Foreign  Disc Facility uses the LDTX entry as well. >> <<03633>>08508000
<< Thus the LDTX entry must be cleared in any case.         >> <<03633>>08510000
                                                               <<03633>>08512000
LDTXENT(LDTX'SERIAL'DISC) := FALSE;                            <<04429>>08514000
LDTXENT(LDTX'SDISC'XDS) := 0; <<clear the data seg linkage>>   <<04429>>08516000
IF SYS'LPDTP(DEVX+1).FORS = 0 THEN                             <<03633>>08518000
   RELDATASEG (SEGNUM);                                        <<03633>>08520000
RELSIR (LDTSIR, SAVELDT);                                      <<03633>>08522000
EXCHANGEDB (0);                                                <<03633>>08524000
END;   << Unlock CS80 dev, deallocate SD XDS >>                <<03633>>08526000
                                                                        08528000
                                                                        08530000
                                                                        08532000
                                                                        08534000
PROCEDURE DEALLOCATE (DEVPARM);                                         08536000
   VALUE DEVPARM;                                                       08538000
   INTEGER DEVPARM;                                                     08540000
   OPTION PRIVILEGED, UNCALLABLE;                                       08542000
BEGIN                                                                   08544000
                                                               <<04201>>08546000
   << The STDLISTFAIL bit will be set by MORGUE when the     >><<04201>>08548000
   << FJOPEN of $STDLIST (from :JOB, i.e. virtual) fails. In >><<04201>>08550000
   << this case, we want make sure the file usecount (LDT(0))>><<04201>>08552000
   << gets set to zero, the LPDT shows as unowned, and that  >><<04201>>08554000
   << the ODD entry gets removed. However we DO NOT want to  >><<04201>>08556000
   << perform any disc deallocation. Before UCOP launches a  >><<04201>>08558000
   << job/session it will pre-allocate the devices for $STDx.>><<04201>>08560000
   << UCOP will NEVER allocate the disc space for the spooled>><<04201>>08562000
   << devices. FJOPEN will not perform any deallocation - it >><<04201>>08564000
   << knows that $STDLIST is a new file so upon a failure has>><<04201>>08566000
   << nothing to deallocate. So it now becomes MORGUE's      >><<04201>>08568000
   << resposibility to clean up after the FJOPEN failures.   >><<04201>>08570000
   << Therefore we will do everything EXCEPT deallocate disc >><<04201>>08572000
   << space.                                                 >><<04201>>08574000
                                                               <<04201>>08576000
   DEFINE            << INPUT PARAMETER BREAKDOWN: >>                   08578000
                     LDEV  = DEVPARM.(8:8)  #,                          08580000
                     PRIMED  = NOT (LOGICAL (DEVPARM.(7:1)))  #,        08582000
                     UNPRIMED = (LOGICAL (DEVPARM.(7:1))) #,   <<00.05>>08584000
                     WAIT  = NOT (LOGICAL (DEVPARM.(6:1)))  #,          08586000
                     ALLOCED = NOT (LOGICAL (DEVPARM.(5:1)))#,          08588000
                       LABELLED=(LOGICAL(DEVPARM.(3:1)))#,     <<TL.02>>08590000
                       STDLISTFAIL=(LOGICAL(DEVPARM.(2:1)))#,  <<04201>>08592000
                     IOABORT = (LOGICAL (DEVPARM.(4:1)))#;              08594000
   INTEGER           SAVELDT,     <<GETSIR RETURNS>>                    08598000
                     SAVEXDD;                                           08602000
   INTEGER POINTER   HEADP,       <<XDD HEAD PNTR>>                     08604000
                     ENTRYP,      <<XDD ENTRY PNTR>>                    08608000
                     ODDSUBP,     <<SUBENTRY PNTR>>                     08610000
                     DEVP;        <<LDT ENTRY PNTR>>                    08612000
   DOUBLE POINTER    ENTRYPD  = ENTRYP;                                 08614000
   DOUBLE ARRAY      DISKADDR(0:1) = Q;                                 08616000
   INTEGER           DEVX;                                              08618000
   LOGICAL           VIRTDEV;                                           08620000
   LOGICAL POINTER   DEVPL  = DEVP;                                     08622000
   INTEGER           DEVTYPE;     <<DEVICE TYPE>>                       08624000
   DEFINE            DEVACCCL = DEVTYPE.(10:3)#;               <<03512>>08626000
                              << Device access class >>        <<03512>>08628000
   INTEGER           DEVRSIZE;    <<DEVICE REC SIZE>>                   08630000
   LOGICAL           FORMSDONE  := FALSE,                               08632000
                     TRAILERPRINTED  := FALSE,                          08634000
                     RELSIR'STACK  := TRUE;                             08636000
   LOGICAL POINTER                                             <<04428>>08638000
                   LDT             = DEVP                      <<04428>>08640000
                  ,LDT0                                        <<04428>>08642000
                  ,LDTX                                        <<04428>>08644000
;                                                              <<04428>>08646000
   LOGICAL                                                     <<04428>>08648000
           CIPER'PROTOCOL                                      <<04428>>08650000
;                                                              <<04428>>08652000
                                                                        08654000
                                                                        08656000
INTEGER SUBROUTINE FINDENTRY (DST, SIR, REMOVE);                        08658000
   VALUE DST, SIR, REMOVE;                                              08660000
   INTEGER DST, SIR;                                                    08662000
   LOGICAL REMOVE;                                                      08664000
BEGIN                                                                   08666000
   EXCHANGEDB (DST);                                                    08668000
   SAVEXDD := GETSIR (SIR);                                             08670000
   @ENTRYP := HEADP (XD'HHEADP);                                        08672000
   WHILE <> AND ((ENTRYP (XD'STATE) <> (IF ALLOCED THEN                 08674000
      DFOPENED ELSE DFREADY)) LOR (ENTRYP(XD'SPOOLFILE)<>0)) DO         08676000
      @ENTRYP := ENTRYP (XD'LINKP);                                     08678000
   IF ((FINDENTRY := @ENTRYP) <> 0) AND REMOVE THEN                     08680000
      BEGIN                                                             08682000
      TOS := @HEADP (XD'HHEADP);                                        08684000
      DELINKENTRY (*, ENTRYP);                                          08686000
      DEALLOCENTRY (ENTRYP);                                            08688000
      END;                                                              08690000
   RELSIR (SIR, SAVEXDD);                                               08692000
   EXCHANGEDB (0);                                                      08694000
   END;    <<FINDENTRY>>                                                08696000
                                                                        08698000
                                                                        08700000
    DEVX := LDEV*LPDTSIZE;                                     <<SD.00>>08702000
   @DEVP := LDEV *LDTSIZE;                                              08704000
   EXCHANGEDB (LDTDST);                                        <<04428>>08706000
   @LDT0 := 0; <<set to base of ldt>>                          <<04428>>08708000
     <<compute ldtx entry position>>                           <<04428>>08710000
   @LDTX := LDTX'BASE + LDEV * INTEGER(LDT0(LDT0'ENT'SIZE));   <<04428>>08712000
   CIPER'PROTOCOL := LDTX(LDTX'CIPER'PROTOCOL) ;               <<04428>>08714000
   SAVELDT := GETSIR (LDTSIR);                                          08716000
   IF DEVP(LD'BASICTYPE)=DISC AND                              <<00076>>08718000
   SYS'LPDTP(DEVX+1).(4:3)<>NOT'PV'OR'SYS THEN                 <<SD.00>>08720000
      BEGIN                                                             08722000
      DEVP (LD'USECOUNT) := DEVP (LD'USECOUNT) -1;                      08724000
      IF = AND DEVPL (LD'R) THEN                                        08726000
         BEGIN    <<DOWN WAS PENDING: TAKE DOWN>>                       08728000
         DEVPL (LD'F) := FALSE;                                         08730000
         DEVPL (LD'R) := FALSE;                                         08732000
         RELSIR (LDTSIR, SAVELDT);                                      08734000
         EXCHANGEDB (0);                                                08736000
                                                               <<03507>>08738000
         << Deallocate and delete disc free space data >>      <<03507>>08740000
         << segment, ignore errors.                    >>      <<03507>>08742000
                                                               <<03507>>08744000
         Deallocate'Dfs'Data'Seg (ldev);                       <<03507>>08746000
                                                               <<03507>>08748000
         Delete'Dfs'Data'Seg (Ldev);                           <<03507>>08750000
                                                               <<03507>>08752000
         RELSIR'STACK := FALSE;                                         08754000
         GENMSG(1,250,%10000,LDEV,,,,,0);                      <<0U.EB>>08756000
         END;                                                           08758000
      END    <<DISC DEALLOC>>                                           08760000
   ELSE                                                                 08762000
      BEGIN    <<NON-SHARABLE DEVICE>>                                  08764000
      VIRTDEV := SYS'LPDTP(DEVX).(LP'VIRTUALF);                         08766000
      IF NOT ALLOCED THEN GOTO ELIM;                                    08768000
                                                                        08770000
      IF NOT (DEVPL(LD'CS)) AND NOT (VIRTDEV) THEN                      08772000
        IF PRIMED OR (UNPRIMED LAND (DEVP(LD'DEVTYPE)                   08774000
             = TERMINAL)) THEN                                          08776000
          IF LDT(LDT'FILE'USE'CNT) > 1 THEN                             08778000
            ATTACHIO(LDEV,0,0,0,3,0,0,0,%17)                            08780000
          ELSE << file'use'cnt = 1 >>                                   08782000
            IF Get'DSDEVICE(Ldev) = DSPseudoterm then                   08784000
              Begin                                                     08786000
              RELSIR(LDTSIR,SAVELDT);                                   08788000
              ATTACHIO(LDEV,0,0,0,3,0,1,0,%11);                         08790000
              SAVELDT:=GETSIR(LDTSIR);                                  08792000
              End                                                       08794000
            ELSE << file'use'cnt = 1, not pseudo-terminal >>            08796000
              IF NOT CIPER'PROTOCOL THEN                                08798000
                BEGIN                                          <<04843>>08800000
                RELSIR(LDTSIR,SAVELDT);                        <<04843>>08802000
                ATTACHIO(LDEV,0,0,0,3,0,0,0,%17);                       08804000
                SAVELDT := GETSIR(LDTSIR);                     <<04843>>08806000
                END;                                           <<04843>>08808000
                                                               <<04843>>08810000
      DEVP (LD'USECOUNT) := DEVP (LD'USECOUNT) -1;                      08812000
      IF < THEN SUDDENDEATH (366);                                      08814000
      IF = THEN                                                         08816000
         BEGIN    <<FINAL DEALLOC>>                                     08818000
  ELIM:                                                                 08820000
         DEVP (LD'MAINPIN) := 0;                                        08822000
         IF NOT VIRTDEV THEN                                            08824000
            BEGIN  <<REAL DEVICE>>                                      08826000
            IF DEVPL (LD'FO) THEN FORMSDONE := TRUE;                    08828000
            DEVTYPE := DEVP (LD'DEVTYPE);                               08830000
                                                               <<04274>>08834000
            << If forms on a terminal, turn forms off.      >> <<04274>>08836000
                                                               <<04274>>08838000
            IF DEVTYPE = TERMINAL AND FORMSDONE                <<04274>>08840000
               THEN DEVPL (LD'FO) := 0;                        <<04274>>08842000
                                                               <<04274>>08844000
            DEVRSIZE := DEVP (LD'RWIDTH);                               08846000
            @HEADP := DEVP (LD'XDDHEADX) *XDDHSIZE;                     08848000
            RELSIR (LDTSIR, SAVELDT);                                   08850000
            EXCHANGEDB (0);                                             08852000
            IF IOABORT AND (DEVTYPE.(LD'BASICTYPE'F)<>DEVCONIO)<<01899>>08854000
               AND (DEVTYPE.(LD'BASICTYPE'F)<>DEVDISC)         <<01899>>08856000
               THEN ABORTIO(-LDEV);                                     08858000
            RELSIR'STACK := FALSE;                                      08860000
            IF (DEVTYPE.(LD'BASICTYPE'F) <> DEVIN)                      08862000
                  AND ((@ODDSUBP := FINDENTRY (ODDDST, ODDSIR,          08864000
                     FALSE))) <> 0 THEN                                 08866000
               BEGIN    <<ODD ENTRY EXISTS: [TRAILER &] REMOVE>>        08868000
               IF PRIMED THEN                                           08870000
        BEGIN                                                  <<04428>>08872000
        IF CIPER'PROTOCOL THEN                                 <<04428>>08874000
          BEGIN                                                <<04428>>08876000
                                                               <<04428>>08878000
          ATTACHIO(LDEV, 0 << QMISC := NA >>,                  <<04428>>08880000
               0 << DSTX := stack >>, 0 << ADDR := DB+0 >>,    <<04428>>08882000
          186 << FUNC := Return Job Report >>,                 <<04428>>08884000
          0 << CNT := none >>,                                 <<04428>>08886000
          0 << P1 :=force ALL buffers to be output & printed>>,<<04428>>08888000
          0 << P2 := NA >>,                                    <<04428>>08890000
          1 << FLAGS := no premption; not special request;   >><<04428>>08892000
          << not diagnostic; not system buffer; blocked,     >><<04428>>08894000
          << wake on completion, impede if no IOQ element    >><<04428>>08896000
          << is available. >> );                               <<04428>>08898000
                                                               <<04428>>08900000
          << The return from Attachio should be checked here,>><<04428>>08902000
          << but there is no way to pass error conditions    >><<04428>>08904000
          << back to the operating system except Suddendeath.>><<04428>>08906000
          << For the ciper protocol this is unacceptable.    >><<04428>>08908000
          << We will have to tolerate this lack of error     >><<04428>>08910000
          << checking and ignore it.                         >><<04428>>08912000
          END; <<ciper'protocol, step 1>>                      <<04428>>08914000
                                                               <<04428>>08916000
        IF DEVTYPE <> MAGTAPE THEN                                      08918000
            << Trailer will print a trailer for those device >>         08920000
            << types for which trailers are appropriate.     >>         08922000
          TRAILERPRINTED := TRAILER( ODDSUBP, LDEV,                     08924000
               DEVTYPE, DEVRSIZE );                                     08926000
                                                               <<04428>>08928000
        IF CIPER'PROTOCOL THEN                                 <<04428>>08930000
          BEGIN                                                <<04428>>08932000
                                                               <<04428>>08934000
          << Send End of Job function code to device.        >><<04428>>08936000
          ATTACHIO(LDEV, 0 << QMISC := NA >>,                  <<04428>>08938000
               0 << DSTX := stack >>, 0 << ADDR := DB+0 >>,    <<04428>>08940000
          145 << FUNC := End of Job >>, 0 << CNT := none >>,   <<04428>>08942000
          0 << P1 := NA >>, 0 << P2 := NA >>,                  <<04428>>08944000
          1 << FLAGS := no premption; not special request;   >><<04428>>08946000
          << not diagnostic; not system buffer; blocked,     >><<04428>>08948000
          << wake on completion, impede if no IOQ element    >><<04428>>08950000
          << is available. >> );                               <<04428>>08952000
                                                               <<04428>>08954000
          << Send FClose function code to match the FOpen    >><<04428>>08956000
          << sent during device allocation by Primedevice.   >><<04428>>08958000
          ATTACHIO(LDEV, 0 << QMISC := NA >>,                  <<04428>>08960000
               0 << DSTX := stack >>, 0 << ADDR := DB+0 >>,    <<04428>>08962000
          3 << FUNC := File close >>, 0 << CNT := none >>,     <<04428>>08964000
          0 << P1 := NA >>, 0 << P2 := NA >>,                  <<04428>>08966000
          1 << FLAGS := no premption; not special request;   >><<04428>>08968000
          << not diagnostic; not system buffer; unblocked,   >><<04428>>08970000
          << no wake on completion, impede if no IOQ element >><<04428>>08972000
          << is available. >> );                               <<04428>>08974000
                                                               <<04428>>08976000
          END; <<ciper'protocol, step 2>>                      <<04428>>08978000
                                                               <<04428>>08980000
        END; <<device was primed>>                             <<04428>>08982000
                                                               <<04428>>08984000
               TOS := @ODDSUBP;                                         08988000
               TOS.(0:1) := 1;                                          08990000
               SREMOVEXDD (*);                                          08992000
               END;                                                     08994000
            IF DEVTYPE.(LD'BASICTYPE'F) <> DEVOUT THEN                  08996000
               << FIND ENTRY AND REMOVE, IF THERE IS 1 >>               08998000
               FINDENTRY (IDDDST, IDDSIR, TRUE);                        09000000
                                                               <<03607>>09002000
<< The call to FREEDEVICE must precede the release  of  any >> <<03607>>09004000
<< serial disc extra data segment.  FREEDEVICE makes an AT- >> <<03607>>09006000
<< TACHIO Device Close call which is ignored by the  serial >> <<03607>>09008000
<< disc code if the data segment has been released. But the >> <<03607>>09010000
<< Device Close call is sometimes needed to insure that the >> <<03607>>09012000
<< serial disc is logically (and for LINUS physically) dis- >> <<03607>>09014000
<< mounted.                                                 >> <<03607>>09016000
<<   Releasing the XDS here instead of at its original code >> <<03607>>09018000
<< location requires an extra EXCHANGEDB pair and acquiring >> <<03607>>09020000
<< and releasing the LDT SIR once more.  Maybe this can  be >> <<03607>>09022000
<< streamlined some day...???                               >> <<03607>>09024000
                                                               <<03607>>09026000
            FREEDEVICE (LDEV, WAIT LAND TRAILERPRINTED,        <<TL.02>>09028000
                        LABELLED);                             <<TL.02>>09030000
            IF DEVACCCL = DEVDISC AND                          <<03607>>09032000
              SYS'LPDTP(DEVX+1).(4:3) = NOT'PV'OR'SYS AND      <<03633>>09034000
                 NOT LABELLED THEN FORS'XDS'DEALLOC(LDEV);     <<03633>>09036000
            END    << Real device.                          >>          09040000
         ELSE                                                           09042000
            BEGIN  <<VIRTUAL DEVICE>>                                   09044000
            @ENTRYP := SYS'LPDTP(DEVX).(LP'XDDPF);                      09046000
            IF SYS'LPDTP(X).(LP'IDD'ODDF)=0 THEN                        09048000
               BEGIN                                                    09050000
               SREMOVEXDD(ENTRYP);                                      09052000
               END                                                      09054000
            ELSE                                                        09056000
               BEGIN    << NEW SPOOLFILE >>                             09058000
               EXCHANGEDB (ODDDST);                                     09060000
               SAVEXDD := GETSIR (ODDSIR);                              09062000
               TOS := ENTRYP (OD'XDDHEADX) *ODD'HEADSIZE +OD'HHEADP;    09064000
               DELINKENTRY (*, ENTRYP);                                 09066000
               IF PRIMED THEN                                           09068000
                  BEGIN                                                 09070000
                  SLINKXDD (ENTRYP (OD'XDDHEADX), ENTRYP);              09072000
                  ENTRYP (OD'STATE) := DFREADY;    << MAKE READY >>     09074000
                  ENTRYPD (OD'TIMEREADY'D) := DOUBLETIME;               09076000
                  TOS := ENTRYP (OD'DEVICE);                            09078000
                  IF LOGICAL (ENTRYP (OD'C)) THEN TOS := -TOS;          09080000
                  END                                                   09082000
               ELSE                                                     09084000
                  BEGIN                                                 09086000
                  DISKADDR := ENTRYPD(XD'SPOOLFILE'D);                  09088000
                  DEALLOCENTRY(ENTRYP);                                 09090000
                  END;                                                  09092000
               RELSIR (ODDSIR, SAVEXDD);                                09094000
               IF PRIMED THEN                                           09096000
                  BEGIN                                                 09098000
                  EXCHANGEDB (LDTDST);                                  09100000
                  SROOSTER (*);                                         09102000
                  END                                                   09104000
               ELSE                                                     09106000
                  BEGIN                                                 09108000
                  EXCHANGEDB(0);                                        09110000
                  IF NOT STDLISTFAIL  THEN                     <<04201>>09112000
                      DISKDEALLOC(0,0,%201,DISKADDR);          <<04201>>09114000
                  END;                                                  09116000
               END;                                                     09118000
            SYS'LPDTP (DEVX +LP'SS) := DEVAVAIL;                        09120000
            DISABLE;                                                    09122000
            TOS := ABSYS'JOBSYNC;                                       09124000
            ASSEMBLE(TSBC 15;    <<INDICATE DEV AVAIL>>                 09126000
                     TRBC 14);   <<IS JOB WAITING FOR DEV>>             09128000
            ABSYS'JOBSYNC := TOS;                                       09130000
            ENABLE;                                                     09132000
            IF <> THEN AWAKE(SYSPROC(UCOPLPIN), JUNKWAIT,0);            09134000
            END;                                                        09136000
         END;                                                           09138000
      END;    <<NON-SHARABLE DEVICE TREATMENT>>                         09140000
   IF RELSIR'STACK THEN                                                 09142000
      BEGIN                                                             09144000
      RELSIR (LDTSIR, SAVELDT);                                         09146000
      EXCHANGEDB (0);                                                   09148000
      END;                                                              09150000
   END;    <<DEALLOCATE>>                                               09152000
                                                                        09156000
$CONTROL SEGMENT=MAIN                                                   09158000
END.                                                                    09160000
