$CONTROL USLINIT,CODE,MAP                                               00010000
<< FILEACC - File System Access Control - Module 50 >>                  00012000
<< HP32002C source C.00.00 >>                                           00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00018000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00020000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00022000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00024000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00026000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00028000
$SET X9=ON  <<ALLOW RIO FILES>>                                <<01011>>00036000
$SET X0=OFF,X1=ON, X2=ON, X3=OFF                                        00038000
$ TITLE " MPE-IV FILE SYSTEM - BASELINE OPEN-CLOSE "                    00040000
$ THIRTY                                                                00042000
$ CONTROL MAIN = FILEACCESS                                             00044000
BEGIN                                                                   00046000
                                                                        00048000
<<----------------------------------------------------------------------00050000
*                                                                      *00052000
*              MPE-IV Baseline File System                            * 00054000
*                                                                      *00056000
*  TOGGLES:                                                            *00058000
*     X0   ENABLES CODE THAT PRINTS THE PROCEDURE NAME AND CALLS       *00060000
*          DEBUG UPON ENTRY TO MOST FILE SYSTEM INTRINSICS.            *00062000
*                                                                      *00064000
*     X1   ENABLES CODE THAT CALLS SUDDENDEATH(50) WHEN IRRECOVERABLE  *00066000
*          ERRORS ARE DETECTED.  THESE ERRORS SHOULD NEVER OCCUR AND   *00068000
*          WOULD OTHERWISE GO UNDETECTED.                              *00070000
*                                                                      *00072000
*     X2   ENABLES CODE THAT CALLS SUDDENDEATH(50) WHEN DATA FAILS     *00074000
*          CREDIBLITY CHECKS.                                          *00076000
*                                                             *  +0.04  00078000
*     X3   ENABLES CODE THAT CALLS THE MMSTAT MEASUREMENT     *  +0.04  00080000
*          FACILITY FOR EACH INTRINSIC CALLED WHEN ACCESSING  *  +0.04  00082000
*          A DISC FILE.                                       *  +0.04  00084000
*                                                             *((00630))00086000
*     X9   ENABLES RELATIVE-I/O FEATURE (FOPEN/FOPENDA)       *((00630))00088000
*                                                                      *00090000
---------------------------------------------------------------------->>00092000
                                                                        00094000
$PAGE                                                          <<04516>>00096000
<<**********************************************************>> <<04516>>00098000
<<                                                          >> <<04516>>00100000
<<            LOCKING  COVENTIONS IN MODULE 50              >> <<04516>>00102000
<<                                                          >> <<04516>>00104000
<<      Module 50 locking conventions are as follows.  Sys- >> <<04516>>00106000
<< tem resources, SIR's and Control Blocks, are locked in a >> <<04516>>00108000
<< definite order and the locking conventions described be- >> <<04516>>00110000
<< low MUST BE FOLLOWED.  ATTENTION:  From now on, FGETCB   >> <<04516>>00112000
<< should not be used to lock the control blocks.  The      >> <<04516>>00114000
<< locking procedures described in module 97 are now the    >> <<04516>>00116000
<< accepted locking conventions and should be used if       >> <<04516>>00118000
<< at all possible.  See module 97 for details.             >> <<04516>>00120000
<<                                                          >> <<04516>>00122000
<< A. FMAVT SIR is always the first resource to lock.       >> <<04516>>00124000
<<                                                          >> <<04516>>00126000
<< B. ACB always comes next.  There are two ways at present >> <<04516>>00128000
<<    that the ACB is locked in this module.                >> <<04516>>00130000
<<                                                          >> <<04516>>00132000
<<    1. LOC'ACB is passes the file number and it places a  >> <<04516>>00134000
<<       copy of the ACB in the Q-relative location that is >> <<04516>>00136000
<<       specified.  It automatically locks the ACB if the  >> <<04516>>00138000
<<       file has been opened multi-access.  If there exists>> <<04516>>00140000
<<       an LACB for the file, then this signifies mulit-   >> <<04516>>00142000
<<       access, for example $STDIN and $STDLIST to the same>> <<04516>>00144000
<<       terminal or a disc file explicity open multi-access>> <<04516>>00146000
<<       UNLOC'ACB is used to copy the changed ACB back to  >> <<04516>>00148000
<<       the data segment containing the ACB and to unlock  >> <<04516>>00150000
<<       the ACB if it has been locked.                     >> <<04516>>00152000
<<                                                          >> <<04516>>00154000
<<    2. FGETCB is passed the PACBV as input.  It sets DB to>> <<04516>>00156000
<<       the data segment containing the control block and  >> <<04516>>00158000
<<       passes back a variety of usefull informaion, the   >> <<04516>>00160000
<<       control block's DB relative offset, callers DST    >> <<04516>>00162000
<<       number and the new vector if it has been moved.    >> <<04516>>00164000
<<       The PACBV is obtained for the call if two ways:    >> <<04516>>00166000
<<                                                          >> <<04516>>00168000
<<       a. When used by FOPEN and FOPENDA and the proce-   >> <<04516>>00170000
<<          dures that it calls (SETACB, DELACB), the PACBV >> <<04516>>00172000
<<          is being initialized and is added to and ac-    >> <<04516>>00174000
<<          cessed from the FMAVT via SCANFMAVT if the file >> <<04516>>00176000
<<          is open multi-access.  In this case, the ACB is >> <<04516>>00178000
<<          explicitly locked when FGETCB is called for the >> <<04516>>00180000
<<          for the first time by specifying LOCK in the    >> <<04516>>00182000
<<          FLAGS parameter to FGETCB.  When FGETCB is cal- >> <<04516>>00184000
<<          led any time later to access the ACB, it is not >> <<04516>>00186000
<<          locked (LOCK bit in FLAGS is off).              >> <<04516>>00188000
<<                                                          >> <<04516>>00190000
<<       b. Procedures that lock the ACB via LOC'ACB some-  >> <<04516>>00192000
<<          times use FGETCB to set DB to the ACB data seg- >> <<04516>>00194000
<<          ment.  However, from now on, FGETCB should not  >> <<04516>>00196000
<<          be used since LOC'ACB places a complete copy of >> <<04516>>00198000
<<          the ACB on the stack.  When it is used at pres- >> <<04516>>00200000
<<          ent, however, the LOCK bit in FLAGS is off since>> <<04516>>00202000
<<          LOC'ACB previously locked the ACB.              >> <<04516>>00204000
<<                                                          >> <<04516>>00206000
$PAGE                                                          <<04516>>00208000
<<                                                          >> <<04516>>00210000
<<       In both cases described, any SIR's obtained must be>> <<04516>>00212000
<<       released before impeding on the ACB.  This is done >> <<04516>>00214000
<<       so that the SIR's are not held while the process is>> <<04516>>00216000
<<       impeded since it the process can impede for a "long>> <<04516>>00218000
<<       time".  Releasing the SIR's is accomplished as     >> <<04516>>00220000
<<       follows.  If the FMAVT SIR is being held when the  >> <<04516>>00222000
<<       ACB is requested, either via LOC'ACB or FGETCB, the>> <<04516>>00224000
<<       FMAVT SIR and the return value from GETSIR must be >> <<04516>>00226000
<<       sent as parameters to these procedures.  In the    >> <<04516>>00228000
<<       case of FOPEN, both the FMAVT and FI SIR's are     >> <<04516>>00230000
<<       locked before calling FGETCB to lock the ACB and   >> <<04516>>00232000
<<       are sent as parameters to FGETCB. LOC'ACB and      >> <<04516>>00234000
<<       FGETCB both release the SIR(s) before impeding if  >> <<04516>>00236000
<<       the ACB has been previously locked and the process >> <<04516>>00238000
<<       must be impeded on the ACB.                        >> <<04516>>00240000
<<                                                          >> <<04516>>00242000
<<       FRELCB is used to set DB back to the original user >> <<04516>>00244000
<<       DST number and to unlock the CB if so specified    >> <<04516>>00246000
<<       in the FLAGS parameter UNLOCK bit.                 >> <<04516>>00248000
<<                                                          >> <<04516>>00250000
<< C. FI SIR is locked next.  FOPEN violated this rule by   >> <<04516>>00252000
<<    getting the FI SIR before locking the ACB via FGETCB. >> <<04516>>00254000
<<    However,  FGETCB avoids deadlocks by releasing        >> <<04516>>00256000
<<    the SIR's before impeding the process.  However, from >> <<04516>>00258000
<<    now on, the ACB should be locked before the FI SIR is >> <<04516>>00260000
<<    obtained to maintain the locking conventions correctly>> <<04516>>00262000
<<                                                          >> <<04516>>00264000
<< D. The FCB is locked last.  This is locked in module 50  >> <<04516>>00266000
<<    in two ways:                                          >> <<04516>>00268000
<<                                                          >> <<04516>>00270000
<<       (1)  FGETCB - FGETCB is sent the FCBV and it re-   >> <<04516>>00272000
<<            turns with DB set to the data segment contain->> <<04516>>00274000
<<            ing the FCB.  It is not necessary to send any >> <<04516>>00276000
<<            SIR's since the ACB has already been locked   >> <<04516>>00278000
<<            and no other process could have the FCB at    >> <<04516>>00280000
<<            this point.  THIS PROCEDURE SHOULD NOT BE     >> <<04516>>00282000
<<            USED ANYMORE!  The 2nd. method should be used.>> <<04516>>00284000
<<            FRELCB is used to set DB back to the user's   >> <<04516>>00286000
<<            original data segment and to unlock the con-  >> <<04516>>00288000
<<            trol block if specified in the FLAGS parm.    >> <<04516>>00290000
<<            unlock bit.                                   >> <<04516>>00292000
<<                                                          >> <<04516>>00294000
<<       (2)  LOCK'CB should be used in the future to lock  >> <<04516>>00296000
<<            the FCB.  See the discussion in Module 97 for >> <<04516>>00298000
<<            more details about this procedure and its     >> <<04516>>00300000
<<            counter part, UNLOCK'CB.                      >> <<04516>>00302000
<<                                                          >> <<04516>>00304000
<<**********************************************************>> <<04516>>00306000
$PAGE                                                          <<04516>>00308000
<< Correct problem in attempted write beyond FLIM >>           <<00532>>00310000
<< Add Relative I/O features >>                                <<00630>>00312000
<< Allow tape FOPEN without write ring. >>                     <<00685>>00314000
<< Fix EOT on unbuffered labeled tapes. >>                     <<00722>>00316000
<< Partially remove System Buffer code >>                      <<00822>>00318000
<< Add Tape Label info to FFILEINFO, etc. >>                   <<00828>>00320000
<< Change for 3270. >>                                         <<00838>>00322000
<< Labeled tape record and block size override FOPEN, FEQ. >>  <<00841>>00324000
<< FGETINFO can return "$NULL". >>                             <<00899>>00326000
<< FCONTROL write EOF to read-only tape rejected. >>           <<00900>>00328000
<< Correct FSPACE to labeled tape. >>                          <<00901>>00330000
<< Put all FCB's in system shared DST's. Fix SIR bug >>        <<01084>>00332000
<< Change test on initial extent alloc to <=0 >>               <<01084>>00334000
<< Initialize DX in FCONVBLK in case of error in LABELIOSQ. >> <<01085>>00336000
<< TEMPORARY fix for FCONTROL (2) and (6).                  >> <<01083>>00338000
<< Fix FGETINFO; chg FCLOSE to write EOF on mult.vol unlbl tp>><<01086>>00340000
<< NOSYSBUF, initial PXFILE, and FLOCK fixes  >>               <<*****>>00342000
<< Fix FMAVT SIR/LOCK PACB deadlock                          >><<HM.00>>00344000
<< Changes for Process Level Redirection of $STDIN/$STDLIST >> <<01425>>00346000
<< Reverse order of sirs passed to FOPEN (re:1393)           >><<01480>>00348000
<< Correct call to FGETCB in FOPENDA                         >><<01480>>00350000
<< Change to FFILEINFO for $NULL                             >><<01480>>00352000
<< FCB strategy to use stack FCB's >>                          <<01863>>00354000
<< Fix open of bad environment file >>                         <<01863>>00356000
<< Add global multiaccess for message files >>                 <<01863>>00358000
<< change FINDAFTENT for redirection of $STDIN >>              <<01863>>00360000
<< message file fix >>                                         <<01863>>00362000
<< Add FGETLOCKWORD for CI   >>                                <<04867>>00364000
<< change FCLOSE for SPOOK >>                                  <<01863>>00366000
<< Change FCLOSE for spooling >>                               <<01863>>00368000
<< FRENAME: Allow FRENAME A,A,TEMP, SF check for perm files >> <<01863>>00370000
<< Fix excess page ejects; spoofle u-labels >>                 <<01863>>00372000
<< fix remote Environment file Open >>                         <<01882>>00374000
<<>>                                                           <<01901>>00376000
<< FLABIO: checks that 1st extent addr of FLAB equals SECTOR >><<01901>>00378000
<< FOPEN: remove direct call to FLABIO; go thru LABELIO      >><<01901>>00380000
<< Turn X2 on to restore error checking for CBT, VT addresses>><<01901>>00382000
<< FCLOSE logging fix >>                                       <<01937>>00384000
<< Add 1 to INITALLOC in JDT (:FILE) in FILECOMVALS (SR14822)>><<01968>>00386000
<< FCLEAR: allow initialization > 33023 sectors     (SR15613)>><<01968>>00388000
<< Correct bf calc for 1B/rec case (RBSIZE in FOPEN)(SR11529)>><<01968>>00390000
<< Correct file size calculations in FCREATE                 >><<01968>>00392000
<< Fix FCREATECB SIR problem >>                                <<01992>>00394000
<< Fix spoolfile overflow >>                                   <<02055>>00396000
<< Changes for new disc free space management, also fix >>     <<03509>>00398000
<< Eliminate redirect of $STDIN to $STDINX and vice versa.  >> <<02309>>00400000
<< returned before updating the file label.             >>     <<03509>>00402000
<< New Tape Labels code >>                                     <<02549>>00404000
<< If ACC=OUT, write EOF to tape even if no FWRITE (SR15066) >><<02356>>00406000
<< Define NOTLOCKED for consistency with module 97 (FUNLOCK) >><<02355>>00408000
<< FCLOSE: Preserve release space bits in DISP parm          >><<02351>>00410000
<< FCLOSE: check for SF cap in JIT ucap; return 111 if no SF >><<02349>>00412000
<< New error number 12: record out of range                  >><<02307>>00414000
<< New error no.: 74: no room left in stk seg for another file <<02357>>00416000
<< Enhancement to suppress prompt of lockword                >><<02350>>00418000
<< a problem in fclose - crunch where the space was     >>     <<03509>>00420000
<< Add FSERR 6 and 7 for LINUS, chng NAVLSTAT for reel swt  >> <<03561>>00422000
<< Add SF 404 and recomment a SF 0 that is commented out    >> <<04138>>00424000
<< SR24941:  forms msg now allowed on spooled card punch.   >> <<04189>>00426000
<< Allow ENV files for 2608A/2608S unspooled printers.      >> <<04383>>00428000
<< Don't post ENV info to non-existing UL's on hot printers.>> <<04481>>00430000
<< FCLOSE now properly handles crunch w/mulit-acc.>>           <<04513>>00432000
<< FCLOSE now crunches variable length files.               >> <<04549>>00434000
                                                               <<01084>>00436000
<< FOPEN no longer fail if open remote KSAM file.            >><<04311>>00438000
DEFINE INT = INTEGER#,                                                  00440000
       DBL = DOUBLE#,                                          <<HM.00>>00442000
       LOG = LOGICAL#,                                                  00444000
       ABS = ABSOLUTE#,                                                 00446000
       ASMB = ASSEMBLE#;                                                00448000
INTEGER DB0 = DB+0;                                                     00450000
INTEGER DB1 = DB+1;                                                     00452000
INTEGER POINTER PDB0 = DB+0;                                            00454000
INTEGER ARRAY ADB0 (*) = DB+0;                                          00456000
INTEGER ARRAY DUM (*) = DB+0;  <<DUMMY REFERENCE PARAM>>       <<01.02>>00458000
DOUBLE ARRAY DADB0 (*) = DB+0;                                          00460000
INTEGER ARRAY AQM1 (*) = Q-1;                                           00462000
INTEGER ARRAY AQ0 (*) = Q-0;                                            00464000
BYTE BS0 = S-0;                                                         00466000
BYTE BS1 = S-1;                                                         00468000
BYTE BS2 = S-2;                                                         00470000
BYTE BS3 = S-3;                                                         00472000
INTEGER Q0 = Q-0;                                              <<00630>>00474000
INTEGER S0 = S-0;                                                       00476000
INTEGER S1 = S-1;                                                       00478000
INTEGER S2 = S-2;                                                       00480000
INTEGER S3 = S-3;                                                       00482000
INTEGER S4 = S-4;                                                       00484000
INTEGER S5 = S-5;                                                       00486000
INTEGER S6 = S-6;                                                       00488000
INTEGER S7 = S-7;                                                       00490000
LOGICAL LS0 = S-0;                                                      00492000
LOGICAL LS1 = S-1;                                                      00494000
LOGICAL LS2 = S-2;                                                      00496000
DOUBLE DS1 = S-1;                                                       00498000
DOUBLE DS2 = S-2;                                                       00500000
DOUBLE DS3 = S-3;                                                       00502000
DOUBLE DS4 = S-4;                                                       00504000
DOUBLE DS5 = S-5;                                                       00506000
DOUBLE DS6 = S-6;                                                       00508000
BYTE POINTER BPS0 = S-0;                                                00510000
BYTE POINTER BPS1 = S-1;                                                00512000
BYTE POINTER BPS2 = S-2;                                                00514000
BYTE POINTER BPS3 = S-3;                                       <<RV.PV>>00516000
INTEGER POINTER PS0 = S-0;                                              00518000
INTEGER POINTER PS1 = S-1;                                              00520000
INTEGER POINTER PS2 = S-2;                                              00522000
LOGICAL POINTER LPS0 = S-0;                                             00524000
LOGICAL POINTER LPS1 = S-1;                                             00526000
DOUBLE POINTER DPS0 = S-0;                                              00528000
DOUBLE POINTER DPS1 = S-1;                                              00530000
DOUBLE POINTER DPS2 = S-2;                                              00532000
DOUBLE POINTER DPS3 = S-3;                                              00534000
DOUBLE POINTER DPS4 = S-4;                                              00536000
<<  On FCLOSE of a unlabeled serial disc the TLT is cleaned >> <<03671>>00538000
DOUBLE POINTER DPS5 = S-5;                                              00540000
DOUBLE POINTER DPS6 = S-6;                                              00542000
DOUBLE POINTER DPS7 = S-7;                                              00544000
INTEGER ARRAY AS0 (*) = S-0;                                            00546000
INTEGER ARRAY AS1 (*) = S-1;                                            00548000
INTEGER ARRAY AS2 (*) = S-2;                                            00550000
INTEGER ARRAY AS3 (*) = S-3;                                            00552000
INTEGER ARRAY AS4 (*) = S-4;                                            00554000
                                                               <<04624>>00556000
DEFINE                                                         <<04624>>00558000
   MOVE'DS'1  =  ASSEMBLE(MDS 1)#,                             <<04624>>00560000
   MOVE'DS'2  =  ASSEMBLE(MDS 2)#,                             <<04624>>00562000
   MOVE'DS'3  =  ASSEMBLE(MDS 3)#,                             <<04624>>00564000
   MOVE'DS'4  =  ASSEMBLE(MDS 4)#,                             <<04624>>00566000
   MOVE'DS'5  =  ASSEMBLE(MDS 5)#;                             <<04624>>00568000
                                                               <<04624>>00570000
INTEGER ARRAY AS5 (*) = S-5;                                   <<43.PV>>00572000
INTEGER DELTAQ =Q-0;                                                    00574000
LOGICAL STATUS =Q-1;                                                    00576000
INTEGER X = X;                                                          00578000
EQUATE CCE=2,CCG=0,CCL=1;                                               00580000
                                                                        00582000
DEFINE PRIVMODE = STATUS.(0:1)#,                                        00584000
       CARRYCODE = STATUS.(5:1)#,                                       00586000
       CONDCODE = STATUS.(6:2)#;                                        00588000
DEFINE SETCARRY=CARRYCODE:=1#,                                 <<01393>>00590000
       SETNOCARRY=CARRYCODE:=0#;                               <<01393>>00592000
                                                               <<01393>>00594000
DEFINE MIN2 = ASSEMBLE(DDUP,CMP); IF > THEN ASSEMBLE(XCH); DEL#;        00596000
DEFINE MIN3 = MIN2; MIN2#;                                              00598000
DEFINE MAX2 = ASSEMBLE(DDUP,CMP); IF < THEN ASSEMBLE(XCH); DEL#;        00600000
DEFINE ENABLE = ASSEMBLE(SED 1)#;                                       00602000
DEFINE DISABLE = ASSEMBLE(SED 0)#;                                      00604000
DEFINE PSEUDODISABLE = ASSEMBLE(PSDB)#;                                 00606000
DEFINE PSEUDOENABLE = ASSEMBLE(PSEB)#;                                  00608000
                                                               <<00822>>00610000
comment CHECKDB: If DB is at the stack, then DBBANK=SBANK.       00822  00612000
STACKDB and SBANK for the current process are obtained           00822  00614000
from the two words preceding the dispatcher marker on            00822  00616000
the interrupt control stack.  ;                                <<00822>>00618000
DEFINE CHECKDB =                                                        00620000
   DISABLE;                                                             00622000
   PUSH(DB);                                                            00624000
   X := ABSOLUTE(QI)-5;                                                 00626000
   TOS := ABSOLUTE(X);                                                  00628000
   X := X+1;                                                            00630000
   TOS := ABSOLUTE(X);                                                  00632000
   ENABLE;                                                              00634000
   ASSEMBLE(DCMP)#;                                                     00636000
DEFINE CURRENTDB = CHECKDB; TOS := IF = THEN 0 ELSE FSDSTX#;            00638000
DEFINE MPYD = ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD)#,              00640000
       DIVD = ASSEMBLE(ZERO,CAB;LDXA,LDIV;CAB,LDXA;LDIV)#,              00642000
       DIVD'DEL = ASSEMBLE(ZERO,CAB;LDXA,LDIV;CAB,LDXA;LDIV,DEL)#;      00644000
                                                                        00646000
<<----------------------------------------------------------------------00648000
*                                                                      *00650000
*  FILE SYSTEM PARAMETERS                                              *00652000
*                                                                      *00654000
---------------------------------------------------------------------->>00656000
                                                                        00658000
EQUATE                                                                  00660000
MAXEXTENTS  =   32,   << MAXIMUM NUMBER OF EXTENTS >>                   00662000
DEFEXTSIZE  =  256,   << DEFAULT EXTENT SIZE >>                         00664000
DEFFSIZE    = 1024,   << DEFAULT FILE SIZE - IN RECORDS >>              00666000
DEFNUMEXTS  =    8,   << DEFAULT NUMBER OF EXTENTS >>                   00668000
DEFBUFFERS  =    2,   << DEFAULT NUMBER OF BUFFERS >>          <<00.05>>00670000
MAXBUFFERS  =14000,   << Max. words of buffer data >>          <<02549>>00672000
SPOOLRSIZE  =  506,   << DEFAULT SPOOLFILE REC SIZE >>                  00674000
SPOOLRSECT  =    4,   << #SECTORS/SPOOLFILE REC >>                      00676000
FISIR       =   37,   << FILE INTEGRITY SIR NUMBER >>                   00678000
DSSIR       =    8;   << DIRECTORY SIR >>                               00680000
                                                                        00682000
<<----------------------------------------------------------------------00684000
*                                                                      *00686000
*  FILE ERROR CODES                                                    *00688000
*                                                                      *00690000
---------------------------------------------------------------------->>00692000
                                                                        00694000
EQUATE                                                                  00696000
SUCCESSFUL  =  0,   << NO ERRORS >>                            <<HM.00>>00698000
EOF         =  0,   << End Of File >>                                   00700000
ILLDB       =  1,   << illegal DB register >>                           00702000
ILLCAP      =  2,   << illegal capability >>                            00704000
OMITTEDPARM =  3,   << NEEDED PARAMETER IS MISSING >>          <<HM.00>>00706000
disc'space'allocation'disabled = 4,                            <<03509>>00708000
TOOBIGDRT   =  5,   << DRT number > 255 >>                     <<03091>>00710000
NO'SPARES   =  6,   << No available spare blocks on device. >> <<03561>>00712000
BLANK'MEDIA =  7,   << Unformatted or uninitialized media.  >> <<03561>>00714000
ILLPARM     =  8,   << illegal parameter value >>                       00716000
FILETYPEVIOL=  9,   << undefined file type >>                  <<01815>>00718000
INVDRECSIZE = 10,   << invalid record size specification >>    <<RV.RV>>00720000
INVDBLKSIZE = 11,   << invalid resultant block size >>         <<RV.RV>>00722000
BADRECNO    = 12,   << record number out of range   >>         <<02307>>00724000
OUTFMAVT    = 13,   << Out of FMAVT entries.                >> <<04519>>00726000
TOOMANYOPEN = 16,   << # FOPENs for a file > %377 >>           <<01882>>00728000
RUNAWAY     = 17,   << mag tape runaway >>                              00730000
DEVPWRUP    = 18,   << device powered up - reset >>                     00732000
VFCRESET    = 19,   << LP VF control reset >>                           00734000
INVOP       = 20,   << invalid operation >>                             00738000
DATAPAR     = 21,   << data parity error >>                             00740000
SOFTIMEOUT  = 22,   << software timeout >>                              00742000
EOT         = 23,   << End Of Tape >>                                   00744000
NOTREADY    = 24,   << unit not ready >>                                00746000
NORING      = 25,   << no write ring >>                     <<NOT USED>>00748000
TRANSERR    = 26,   << transmission error >>                            00750000
IOTIMEOUT   = 27,   << I/O timeout >>                                   00752000
TIMERR      = 28,   << timing error or data overrun >>                  00754000
SIOFAIL     = 29,   << SIO failure >>                                   00756000
UNITFAIL    = 30,   << unit failure >>                                  00758000
EOL         = 31,   << End Of Line on special char >>                   00760000
SOFTABORT   = 32,   << software abort I/O >>                            00762000
DATALOST    = 33,   << data lost >>                                     00764000
UNITOFF     = 34,   << unit not on-line >>                              00766000
DATASET     = 35,   << data set not ready >>                            00768000
INVDISKADR  = 36,   << invalid disk address >>                          00770000
INVMEMADR   = 37,   << invalid memory address >>                        00772000
TAPERR      = 38,   << tape parity error >>                             00774000
TAPERREC    = 39,   << recovered tape I/O error >>                      00776000
ACCVIOL     = 40,   << access-type violation >>                         00778000
RECVIOL     = 41,   << record-type violation >>                         00780000
DEVVIOL     = 42,   << device-type violation >>                         00782000
BADTCOUNT   = 43,   << transfer count overrun on non-MR write >>        00784000
FUPDSEQERR  = 44,   << FUPDATE at record 0 >>                           00786000
PRIVVIOL    = 45,   << privileged-file violation >>                     00788000
NOSPACE     = 46,   << insufficient disk >>                             00790000
LBLIOERR    = 47,   << I/O error accessing file label >>                00792000
MLTIACCERR  = 48,   << invalid option due to multiple file access >>    00794000
UNIMPL      = 49,   << unimplemented function >>                        00796000
UNDEFACCT   = 50,   << undefined account >>                             00798000
UNDEFGRP    = 51,   << undefined group >>                               00800000
UNDEFFILESD = 52,   << file not found in system directory >>            00802000
UNDEFFILEJD = 53,   << file not found in job directory >>               00804000
INVFREF     = 54,   << invalid file reference >>                        00806000
NAVAILDEV   = 55,   << non-available device >>                          00808000
UNDEFDEV    = 56,   << undefined device >>                              00810000
MEMPROB     = 57,   << insufficient virtual memory >>                   00812000
NOPASSD     = 58,   << no passed file >>                                00814000
MTINTVIOL   = 59,   << standard label violation >>                      00816000
NORIN       = 60,   << no RIN available >>                              00818000
GPSPEX      = 61,   << group space exceeded >>                          00820000
ACSPEX      = 62,   << account space exceeded >>                        00822000
NONSHAR     = 63,   << user doesn't have Non-sharable Device cap. >>    00824000
MRIN        = 64,   << user doesn't have Multi-RIN cap. >>              00826000
PLIMIT      = 66,   << plotter limit switch reached >>                  00828000
PTAPERR     = 67,   << paper tape error >>                              00830000
SYSTEM      = 68,   << internal error >>                                00832000
UNUSED      = 69,   << unassigned ATTACHIO error >>                     00834000
IOERRHDR    = 70,   << header/trailer I/O error >>             <<01027>>00836000
                                                                        00838000
<< FS/CS common errors >>                                               00840000
                                                                        00842000
TMFP        = 71,   << too many files for process >>                    00844000
INVFN       = 72,   << invalid file number >>                           00846000
BNDVIOL     = 73,   << bounds violation >>                              00848000
NOROOMLEFT  = 74,   << no room for PXFILE expansion (for AFT)>><<02357>>00850000
BUFABSENT   = 76,   << input buffer absent (IOWAIT) >>         <<+1.01>>00852000
IOPENDING   = 77,   << No-wait I/O pending >>                           00854000
NOIOPENDING1= 78,   << no No-wait I/O pending for any file >>           00856000
NOIOPENDING2= 79,   << no No-wait I/O pending for spec. file >>         00858000
                                                                        00860000
<< Spooling error codes >>                                              00862000
                                                                        00864000
SPOOLMIN     = 80,  << smallest spooling error nr. >>                   00866000
SPOOLMAXSSECT= 80,  << max kilosectors used for spoolfiles >>           00868000
SPOOLNOCLASS = 81,  << spool class not defined >>                       00870000
SPOOLNOSPACE = 82,  << no space avail in spool class >>                 00872000
SPOOLBADEXT  = 83,  << extent size > 65K >>                             00874000
SPOOLDEVDOWN = 84,  << device in spool class down >>                    00876000
SPOOLILLOP   = 85,  << requ function inconsist with spooling >>         00878000
SPOOLERROR   = 86,  << spooling internal operational error >>           00880000
SPOOLBADOFF  = 87,  << offset to data > 255 >>                          00882000
SPOOFLEINVL  = 88,  << NONEXISTANT SPOOLFILE >>                <<04272>>00884000
SPOOLMAX     = 88,  << largest spooling error nr. >>                    00886000
                                                                        00888000
POWERFAILED = 89,   << power failed >>                                  00890000
EXSHERR1    = 90,   << exclusive violation - caller's req'ts >>         00892000
EXSHERR2    = 91,   << exclusive violation - other's req'ts >>          00894000
LWVIOL      = 92,   << lockword violation >>                            00896000
SEXVIOL     = 93,   << security violation >>                            00898000
USERIDVIOL  = 94,   << creator conflict >>                              00900000
BROKENREAD  = 95,   << "Broken" terminal Read >>                        00902000
DISCIOERR   = 96,   << misc. disc I/O error >>                          00904000
BADESCAPE   = 97,   << no CONTROL-Y PIN >>                              00906000
TIMEROVERFLOW=98,   << Read time overflow >>                            00908000
BOT         = 99,   << BOT and BSR or BSF request >>                    00910000
DUPNSD      =100,   << duplicate file name - system directory >>        00912000
DUPNJD      =101,   << duplicate file name - job directory >>           00914000
DIRIOERR    =102,   << directory I/O error >>                           00916000
DIROVFLO    =103,   << directory overflow - system directory >>         00918000
JTFDIROFL   =104,   << directory overflow - job directory >>            00920000
BADVARBLK   =105,   << bad variable block structure >>                  00922000
BADEXTENT   =106,   << extent size > 65K >>                             00924000
BADOFFSET   =107,   << Offset to data > 255 >>                          00926000
BADFILE     =108,   << inaccessable file - bad label >>                 00928000
BADCONTROL  =109,   << illegal carriage control >>                      00930000
INVSAVE     =110,   << attempt to save System file in Job directory >>  00932000
SFERR       =111,   << user lacks "Save File" capability >>    <<RV.PV>>00934000
UVCAP       =112,   << user lacks "Private Volume" capability ><<RV.PV>>00936000
MOUNTPROB   =113,   << volume set mount failure >>             <<RV.PV>>00938000
DISMOUNTPROB=114,   << volume set dismount failure >>          <<RV.PV>>00940000
HVSVIOL     =115,   << RENAME across HVS's violation >>        <<RV.PV>>00942000
LBTSYNTAX   =116,   << Syntax err in formsmsg >>                        00944000
LBTUNEXP    =117,   << Tried write to unexpired tape >>                 00946000
LBTFMTERR   =118,   << Format of "labeled" tape wrong >>                00948000
LBTPOSERR   =119,   << Error positioning labeled tape >>                00950000
<<>>                                                                    00952000
LBTLWERR    =121,   << Labeled tape lockword violation >>               00954000
LBTOFLOW    =122,   << Tape label table overflow >>                     00956000
LBTEOVSET   =123,   << End of volset encountered >>                     00958000
LBTAPPEND   =124,   << Tried Append to labeled tape >>                  00960000
DLTDREC     =139,   << deleted record on IBM floppy disc >>    <<01115>>00962000
INACT       =148,   << inactive RIO record (CCE) >>            <<00630>>00964000
NONPAIR     =149,   << unmatched FFILEINFO ITEMNUM/VAL >>      <<00630>>00966000
NONITEM     =150,   << undefined FFILEINFO ITEMNUM >>         <<SP.ENV>>00968000
<< The following errors are produced by the device >>         <<SP.ENV>>00970000
<< parameters, currently ENV= and OUTQ= : >>                  <<SP.ENV>>00972000
DP'UNDEFINED'KEYWORD=152, << parser does not recognize >>     <<SP.ENV>>00974000
DP'EXPECT'SEMI'CR = 153,  << parser expects ";" or CR >>      <<SP.ENV>>00976000
DP'ENV'OPEN'FAIL = 154,   << environment file open err >>     <<SP.ENV>>00978000
 DP'ENV'BADFILE  = 155,    <<Bad file code or recsize>>        <<02524>>00980000
DP'ENV'HDR'FAIL = 156,    << hdr record incorrect >>          <<SP.ENV>>00982000
DP'ENV'NOT'COMPILE = 157, << uncompiled environment file >>   <<SP.ENV>>00984000
DP'ENV'READ'ERR = 158,    << error reading environment file >><<SP.ENV>>00986000
DP'ENV'FCLOSE = 159,      << error closing environment file >><<SP.ENV>>00988000
DP'ENV'FDEVICECONTROL = 160,  <<FDEVICECONTROL failure>>      <<SP.ENV>>00990000
DP'OVERFLOW  = 161,       << DEVPARMS array overflow >>       <<SP.ENV>>00992000
DP'EXPECT'EQUAL=162,      << parser expects "=" >>            <<SP.ENV>>00994000
DP'ENV'FEQ'ERR    = 163,  << possible loop in back ref >>      <<01882>>00996000
DP'MISSING'CR = 164,      << In 1st 129 chars of DEV, no CR >> <<02524>>00998000
DP'DEN'INVALID = 165,     << Invalid density specification  >> <<02524>>01000000
                                                               <<02555>>01002000
<< Error in FFILEINFO to determine if remote file is spooled>> <<02555>>01004000
DP'REMOTE'ACCESS = 166,                                        <<02555>>01006000
<< Error in FREADLABEL/FWRITELABEL in spool user label 0 >>    <<02555>>01008000
DP'ENV'SPULAB'ERR = 167,                                       <<02555>>01010000
DP'END       = 1;                                             <<SP.ENV>>01012000
                                                                        01014000
EQUATE DUPKEY       =171;<<DUPLICATE KEY>>                     <<KS.00>>01016000
EQUATE ERRNOKEY     =172;<<NO SUCH KEY>>                       <<KS.00>>01018000
EQUATE ERRTCOUNTL   =173;<<TCOUNT LONGER THAN RECSIZE>>        <<KS.00>>01020000
EQUATE ERRNOEXTRADS =174;<<CANNOT GET EXTRA DATA SEGMENT>>     <<KS.00>>01022000
EQUATE KSAMERROR    =175;<<KSAM INTERNAL ERROR>>               <<KS.00>>01024000
EQUATE ILLENGTH     =176;<<ILLEGAL EXTRA DATA SEG LENGTH>>     <<KS.00>>01026000
EQUATE TOOMANYDS    =177;<<TOO MANY EXTRA DATA SEG >>          <<KS.00>>01028000
EQUATE NODSSTORAGE  =178;<<NO STORAGE FOR EXTRA DATA SEG>>     <<KS.00>>01030000
EQUATE NOTLOCKED    =179;<<file not locked: must FLOCK first>> <<02355>>01032000
EQUATE ILLKEYLOC    =181;<<ILLEGAL KEYLOC PARAMETER>>          <<KS.00>>01034000
EQUATE EMPFIL       =182;<<FILE IS EMPTY>>                     <<KS.00>>01036000
EQUATE RECTOOSHORT  =183;<<RECORD DOES NOT CONTAIN ALL KEYS>>  <<KS.00>>01038000
EQUATE NEGNUMBER    =184;<<NEGATIVE NUMBER IN FFINDN>>         <<KS.00>>01040000
EQUATE SEQERROR     =185;<<SEQUENCE ERROR ON PRIMARY KEY>>     <<KS.00>>01042000
EQUATE KEYTOOSHORT  =186;<<GENERIC KEY NOT ALLOW FOR NUMERIC>> <<KS.00>>01044000
                         <<DISPLAY OR PACKED DECIMAL>>         <<KS.00>>01046000
EQUATE INVKSPEC     =187;<<INVALID KEY SPECIFICATION>>         <<KS.00>>01048000
EQUATE INVDEV       =188;<<INVALID DEVICE SPECIFICATION>>      <<KS.00>>01050000
EQUATE INVRECFMT    =189;<<INVALID RECORDD FORMAT>>            <<KS.00>>01052000
EQUATE INVKBF       =190;<<INVALID KEYBLOCK FACTOR>>           <<KS.00>>01054000
EQUATE KSAMSTD      =193;<<KSAM NOT ALLOWED FOR $STDIN/LIST >> <<04765>>01056000
DEFINE SPOOLERRCODE = #;                                      <<SP.ENV>>01060000
                                                                        01062000
<<----------------------------------------------------------------------01064000
*                                                                      *01066000
*  FILE SYSTEM MONITORING DEFINITIONS                                  *01068000
*                                                                      *01070000
---------------------------------------------------------------------->>01072000
                                                                        01074000
DEFINE                                                                  01076000
MYPIN         = (ABS(MONITOR).(0:8) = 0 OR                              01078000
                 ABS(MONITOR).(0:8) = GETPROCNUM)#,                     01080000
                                                                        01082000
MONOTHER      = INTEGER(ABSOLUTE(MONITOR)) <> 0 AND            <<+1.C3>>01084000
                ABS(MONITOR).(13:1) AND MYPIN#,<<OTHER>>       <<+1.C3>>01086000
MONUNCALLABLE = INTEGER(ABSOLUTE(MONITOR)) <> 0 AND            <<+1.C3>>01088000
                ABS(MONITOR).(14:1) AND MYPIN#,<<UNCALLABLE>>  <<+1.C3>>01090000
MONCALLABLE   = INTEGER(ABSOLUTE(MONITOR)) <>0 AND             <<+1.C3>>01092000
                ABS(MONITOR).(15:1) AND MYPIN#;<<CALLABLE>>    <<+1.C3>>01094000
                                                               <<+0.04>>01096000
<<-------------------------------------------------------------  +0.04  01098000
*                                                             *  +0.04  01100000
*  MMSTAT MEASUREMENT DEFINITIONS                             *  +0.04  01102000
*                                                             *  +0.04  01104000
---------------------------------------------------------------  +0.04>>01106000
                                                               <<+0.04>>01108000
DEFINE MEAS'TAPE'ON =LOGICAL(ABSOLUTE(MEASMSK1))#;             <<+1.C3>>01110000
EQUATE                                                         <<+0.04>>01112000
EFOPEN          = -60,  << FOPEN/FOPENDA INITIAL >>            <<+0.04>>01114000
EFOPEN'         = -61,  << FOPEN/FOPENDA CONTINUATION >>       <<+0.04>>01116000
EFREAD          = -62,  << FREAD >>                            <<+0.04>>01118000
EFWRITE         = -63,  << FWRITE >>                           <<+0.04>>01120000
EFREADDIR       = -64,  << FREADDIR INITIAL >>                 <<+0.04>>01122000
EFREADDIR'      = -64,  << FREADDIR CONTINUATION >>            <<+0.04>>01124000
EFWRITEDIR      = -65,  << FWRITEDIR INITIAL >>                <<+0.04>>01126000
EFWRITEDIR'     = -65,  << FWRITEDIR CONTINUATION >>           <<+0.04>>01128000
EFUPDATE        = -66,  << FUPDATE >>                          <<+0.04>>01130000
EIOWAIT         = -67,  << IOWAIT >>                           <<+0.04>>01132000
EFREADSEEK      = -68,  << FREADSEEK >>                        <<+0.04>>01134000
EFSPACE         = -69,  << FSPACE >>                           <<+0.04>>01136000
EFPOINT         = -70,  << FPOINT >>                           <<+0.04>>01138000
EFCONTROL       = -71,  << FCONTROL >>                         <<+0.04>>01140000
EFSETMODE       = -72,  << FSETMODE >>                         <<+0.04>>01142000
EFRELATE        = -73,  << FRELATE >>                          <<+0.04>>01144000
EFCHECK         = -74,  << FCHECK >>                           <<+0.04>>01146000
EFGETINFO       = -75,  << FGETINFO >>                         <<+0.04>>01148000
EFREADLABEL     = -76,  << FREADLABEL >>                       <<+0.04>>01150000
EFWRITELABEL    = -77,  << FWRITELABEL >>                      <<+0.04>>01152000
EFLOCK          = -78,  << FLOCK >>                            <<+0.04>>01154000
EFUNLOCK        = -79,  << FUNLOCK >>                          <<+0.04>>01156000
EFRENAME        = -80,  << FRENAME >>                          <<+0.04>>01158000
EFCLOSE         = -81,  << FCLOSE >>                           <<+0.04>>01160000
EFALTSEC        = -82;  << FALTSEC >>                          <<01175>>01162000
                                                                        01164000
<<----------------------------------------------------------------------01166000
*                                                                      *01168000
*  SYSGLOB DEFINITIONS                                                 *01170000
*                                                                      *01172000
---------------------------------------------------------------------->>01174000
                                                                        01176000
EQUATE                                                                  01178000
DSTP         =   2,         << DST base >>                              01180000
QI           =   5,                                                     01182000
SYSDB        = 512,         << System DB base >>                        01184000
CLOADID      = SYSDB+%75,   << Cold Load count >>                       01186000
SHFCBDST     = SYSDB+%76,   << Shared FCB DST nr. >>                    01188000
MONITOR      = SYSDB+%77,   << monitoring flag word >>                  01190000
MAXSSECT     = SYSDB+%100,  << max # spoolfile sectors >>               01192000
NUMSSECT     = SYSDB+%102,  << current # ...........   >>               01194000
EXTSSECT     = SYSDB+%104,  << # sectors/spoolfile extent >>            01196000
SPOOLINDEX   = SYSDB+%132,  << class spool index >>                     01198000
CSIOWAIT     = SYSDB+%135,  << CSIOWAIT P-label >>                      01200000
CCLOSEPLABL  = SYSDB+%140,  << CS CCLOSE Plabel - FPROCTERM >>          01202000
MEASMSK1     = SYSDB+%267,                                     <<+1.C3>>01204000
DSCHKPLABL   = SYSDB+%335,  << DSCHECK Plabel >>               <<DS.00>>01206000
DSOPENPLABL  = SYSDB+%336,  << DSOPEN Plabel >>                <<DS.00>>01208000
DSCLOSEPLABL = SYSDB+%337,  << DSCLOSE Plabel >>               <<DS.00>>01210000
SDSLDEVLABEL = SYSDB+%323,  << Plabel for SDSLDEV >>           <<DS.04>>01212000
EXTLAB3270   = %73,         << SYSGLOBEXT index >>             <<01165>>01214000
SYSEXTPTR    = %377,  << PTR TO SYSEXT OF SYSGLOB >>           <<01165>>01216000
MANWCPLABL   = SYSDB+%340,  << MANAGEWRITECONV PLABEL >>       <<DS.00>>01218000
AVR          = SYSDB+%346;  << auto volume recognition, labeled tape >> 01220000
POINTER SYSGLOBEXT = SYSEXTPTR;                                <<01165>>01222000
DEFINE                                                         <<01165>>01224000
  PLABEL3270 = SYSGLOBEXT(EXTLAB3270)#;                        <<01165>>01226000
                                                                        01228000
<<----------------------------------------------------------------------01230000
*                                                                      *01232000
*  JOB INFO TABLE (JIT) DEFINITIONS                                    *01234000
*                                                                      *01236000
---------------------------------------------------------------------->>01238000
                                                                        01240000
EQUATE                                                                  01242000
JCELLS      =  2,   << JMAT offset to JCELLS ptr >>                     01244000
JITJNUM     =  9,   << Job number >>                                    01246000
JITMPN      = 10,   << Main program PIN in (8:8) >>                     01248000
JITEOF      = 11,   << EOF flush flags >>                               01250000
JITASEC     = 13,   << Acct security >>                                 01252000
JITHAN      = 16,   << word index in JIT for Home Account  >>           01254000
JITAIP      = 32,   << word index in JIT for Acct Directory index >>    01256000
JITGIP      = 33,   << word index in JIT for Grp Directory index >>     01258000
JITPFP      = 18,   << passed file double pointer >>                    01260000
JITJN       = 44,   << Job name >>                                      01262000
JPASS       = 14,   << JCELLS double offset to Pass cells >>   <<02349>>01264000
JITUCAP     = 38;   << User capability >>                      <<02349>>01266000
                                                                        01268000
<<----------------------------------------------------------------------01270000
*                                                                      *01272000
*  I/O SYSTEM DEFINITIONS                                              *01274000
*                                                                      *01276000
---------------------------------------------------------------------->>01278000
                                                                        01280000
EQUATE   << Device type (subtype) & subclass >>                <<02568>>01282000
MHDISK       =  0,    DIRACC     =  0,                                  01284000
FHDISK       =  1,                                                      01286000
FDISC        =  7,                                             <<01115>>01288000
CARDR        =  8,    SERIALIN   =  1,                                  01290000
PTREAD       =  9,                                                      01292000
TERMINAL     = 16,    PARALELL   =  2,                                  01294000
READERPUNCH  = 20,                                                      01296000
SSLC         = 22,                                                      01298000
PROGCONT     = 23,                                                      01300000
MTAPE        = 24,    SERIALIO   =  3,                                  01302000
   HP7970    =  0,    << subtype.(13:3) = 0 >>                 <<02568>>01304000
   HP7976    =  1,    << subtype.(13:3) = 1 >>                 <<02568>>01306000
SDISC        = 31,                                             <<00.SD>>01308000
LPTR         = 32,    SERIALOUT  =  4,                                  01310000
CPNCH        = 33,                                                      01312000
PTPNCH       = 34,                                                      01314000
CALCOMP500   = 35,                                                      01316000
CALCOMP600   = 36,                                                      01318000
CALCOMP700   = 37,                                                      01320000
CALCOMP836   = 38,                                                      01322000
NULL         = 63;                                                      01324000
                                                                        01326000
DEFINE S1STAT =S1.(8:8)#;                                      <<*****>>01328000
EQUATE   << IOCODE VALUES >>                                            01330000
EOFSTAT     = %12,                                             <<*****>>01332000
EOTSTAT     = %31,                                             <<*****>>01334000
BREAKSTAT   =%173,   << BREAK hit on terminal >>               <<*****>>01336000
NAVLSTAT    =%204,   << Labeled dev unavail after reelswtch >> <<03561>>01338000
EOFCODE     =  2;                                                       01340000
                                                               <<+0.05>>01342000
DEFINE  << ATTACHIO FLAGS >>                                   <<+0.05>>01344000
UFLAGS    = %010000#,  << UNBLOCKED >>                         <<+0.05>>01346000
BFLAGS    = %010001#,  << BLOCKED >>                           <<+0.05>>01348000
BBFLAGS   = %010011#,  << BLOCKED W/SBUF'S >>                  <<+0.05>>01350000
UBPFLAGS  = %010013#,  << UNBLOCKED W/SBUF'S NO PCB >>         <<+0.05>>01352000
USFLAGS   = ((SPOOLF.(14:2)+1)&LSL(12))#,                      <<+0.05>>01354000
BSFLAGS   = ((SPOOLF.(14:2)+1)&LSL(12)+1)#;                    <<00822>>01356000
                                                                        01358000
<<----------------------------------------------------------------------01360000
*                                                                      *01362000
*  IOQ TABLE DEFINITIONS                                               *01364000
*                                                                      *01366000
---------------------------------------------------------------------->>01368000
                                                                        01370000
INTEGER POINTER IOQ = 5;  <<IOQ SYSTEM TABLE NR.>>                      01372000
                                                                        01374000
<<----------------------------------------------------------------------01376000
*                                                                      *01378000
*  LOGICAL PHYSICAL DEVICE TABLE (LPDT) DEFINITIONS                    *01380000
*                                                                      *01382000
---------------------------------------------------------------------->>01384000
                                                                        01386000
EQUATE                                                                  01388000
LPDTDST     = %15,  << LOG PHYS DEV TABLE DST >>                        01390000
LPDTENTRY   =   2;  <<ENTRY SIZE>>                                      01392000
                                                                        01394000
DEFINE                                                         <<02568>>01396000
   T'SUBTYPE        = (13:3)#,  << Subtype for mag tapes >>    <<02568>>01398000
   VARIABLE'DENSITY =                                          <<02568>>01400000
      LPDT(DADDR*LPDTENTRY + 1).T'SUBTYPE = HP7976#;           <<02568>>01402000
                                                               <<02568>>01404000
INTEGER POINTER LPDT = 8;  <<LPDT SYSTEM TABLE>>                        01406000
                                                                        01408000
<<----------------------------------------------------------------------01410000
*                                                                      *01412000
*  VOLUME TABLE DEFINITIONS                                            *01414000
*                                                                      *01416000
---------------------------------------------------------------------->>01418000
                                                                        01420000
EQUATE                                                                  01422000
VTAB        = %35,  << VOLUME TABLE DST >>                              01424000
VTABSIR     =  22,  << VOLUME TABLE SIR >>                              01426000
VTABENTRY   =  14;  << ENTRY SIZE >>                                    01428000
                                                                        01430000
<<----------------------------------------------------------------------01432000
*                                                                      *01434000
*  LOGICAL DEVICE TABLE (LDT) DEFINITIONS                              *01436000
*                                                                      *01438000
---------------------------------------------------------------------->>01440000
                                                                        01442000
EQUATE                                                                  01444000
LDT         = %16,  << LOGICAL DEVICE TABLE DST >>                      01446000
LDTENTRY    =   5,  << ENTRY SIZE >>                                    01448000
LDTNO       =   3;                                                      01450000
DEFINE  CS = (8:1)#;  <<CS DEVICE>>                            <<00161>>01452000
                                                                        01454000
<<----------------------------------------------------------------------01456000
*                                                                      *01458000
*  INPUT/OUTPUT DEVICE DIRECTORY (XDD) DEFINITIONS                     *01460000
*                                                                      *01462000
---------------------------------------------------------------------->>01464000
                                                                        01466000
EQUATE                                                                  01468000
ODDSIR      =  4,    << ODD SIR >>                             <<04679>>01470000
XDDSIZE     = 30,                                                       01472000
IDDDST      = 45,   << INPUT XDD >>                                     01474000
ODDDST      = 46;   << OUTPUT XDD >>                                    01476000
                                                                        01478000
<<----------------------------------------------------------------------01480000
*                                                                      *01482000
*  FILE SYSTEM MULTI-ACCESS TABLE (FMAVT) DEFINITIONS                  *01484000
*                                                                      *01486000
---------------------------------------------------------------------->>01488000
                                                                        01490000
EQUATE                                                                  01492000
FMAVT       = 44,                                                       01494000
FMAVTSIR    = 16;                                                       01496000
                                                                        01498000
<<-------------------------------------------------------------  +0.06  01500000
*                                                                +0.06  01502000
*  SIR TABLE (SIR) DEFINITIONS                                   +0.06  01504000
*                                                                +0.06  01506000
---------------------------------------------------------------  +0.06  01508000
                                                               <<+0.06>>01510000
EQUATE                                                         <<+0.06>>01512000
SIRDST      = %53,  << SIR TABLE DST NR. >>                    <<+0.06>>01514000
SIRENTRY    = 2;    << ENTRY SIZE >>                           <<+0.06>>01516000
                                                               <<+0.06>>01518000
INTEGER POINTER SIR = 12;  << SIR TABLE SYSTEM TABLE NR. >>    <<+0.06>>01520000
                                                                        01522000
<<----------------------------------------------------------------------01524000
*                                                                      *01526000
*  PROCESS CONTROL BLOCK (PCB) DEFINITIONS                             *01528000
*                                                                      *01530000
---------------------------------------------------------------------->>01532000
                                                                        01534000
EQUATE                                                                  01536000
USER'MAIN      =  2,  << CI PCB TYPE >>                        <<DS.06>>01538000
PCBB        =   3,  << PCB BASE >>                                      01540000
CPCB        =   4,  << CURRENT PCB >>                                   01542000
PCBSIZE     =  16;  << PCB SIZE - WORDS >>                              01544000
                                                                        01546000
DEFINE                                                                  01548000
GETPROCNUM  = (ABSOLUTE(CPCB)-ABSOLUTE(PCBB))&LSR(4)#;                  01550000
                                                                        01552000
INTEGER POINTER PCB = 3;  <<PCB SYSTEM TABLE>>                          01554000
                                                                        01556000
DEFINE                                                                  01558000
PCBXDS      = PCB(PIN*PCBSIZE+2).(1:10)#,  <<EXTRA DATA SEG. NR.>>      01560000
PCBSTK      = PCB(PIN*PCBSIZE+3).(1:10)#,  <<STACK DST NR.>>            01562000
PCBIQPTR    = PCB(PIN*PCBSIZE+8).(8:8)#,   <<IMPEDED QUEUE POINTER>>    01564000
PCBPTYPE    = PCB(PIN*PCBSIZE+9).(6:2)#,   <<PROCESS TYPE>>             01566000
PCBFATHER   = PCB(PIN*PCBSIZE+5).(0:8)#,                       <<DS.06>>01568000
PCBTYPE     = PCB(PIN*PCBSIZE+9).(6:3)#,                       <<DS.06>>01570000
                                                                        01572000
PCB'XDS     = ABS(ABS(CPCB)+2).(1:10)#,    <<EXTRA DATA SEG. NR.>>      01574000
PCB'STK     = ABS(ABS(CPCB)+3).(1:10)#,    <<STACK DST NR.>>            01576000
PCB'PTYPE   = ABS(ABS(CPCB)+9).(6:2)#;     <<PROCESS TYPE>>             01578000
                                                                        01580000
<<-------------------------------------------------------------  RV.PV  01582000
*                                                             *  RV.PV  01584000
*  MOUNTED VOLUME TABLE DEFINITIONS                           *  RV.PV  01586000
*                                                             *  RV.PV  01588000
---------------------------------------------------------------  RV.PV  01590000
                                                                 RV.PV>>01592000
EQUATE                                                         <<RV.PV>>01594000
MVTABDST    = 53,   << MOUNTED VOLUME TABLE DST NR. >>         <<RV.PV>>01596000
MVTABENTRY  = 21;   << MVTAB ENTRY SIZE >>                     <<RV.PV>>01598000
INTEGER ARRAY MVTAB (*) = ADB0;                                <<RV.PV>>01600000
DEFINE                                                         <<RV.PV>>01602000
MVTABSZ     = MVTAB.(0:8) #;  << ENTRY SIZE >>                 <<RV.PV>>01604000
                                                               <<RV.PV>>01606000
<<----------------------------------------------------------------------01608000
*                                                                      *01610000
*  PXGLOB DEFINITIONS                                                  *01612000
*                                                                      *01614000
---------------------------------------------------------------------->>01616000
                                                                        01618000
DEFINE                                                                  01620000
FINDPCBX    = PUSH(DL); TOS := TOS-PS0(-1)#,                            01622000
SETPCBX     = FINDPCBX; @PCBX := TOS#,                                  01624000
DBOFFSET    = FINDPCBX; TOS := PS0(1); DELB#;                           01626000
                                                                        01628000
DEFINE                                                                  01630000
PXGDLOFFSET = PCBX#,           << DL OFFSET >>                          01632000
PXGDBOFFSET = PCBX(1)#,        << DB OFFSET >>                          01634000
PXGSTDIN    = PCBX(3).(8:8)#,  << $STDIN LOGICAL DEVICE NR. >>          01636000
PXGSTDLIST  = PCBX(4).(8:8)#,  << $STDLIST LOGICAL DEVICE NR. >>        01638000
PXGJOBTYPE  = PCBX(6).(2:2)#,  << JOB TYPE >>                           01640000
PXGDUP      = PCBX(6).(4:1)#,  << JOB IN/LIST DUPLICATIVE >>            01642000
PXGINT      = PCBX(6).(5:1)#,  << JOB IN/LIST INTERACTIVE >>            01644000
PXGJITDST   = PCBX(6).(6:10)#; << JIT DST NR. >>                        01646000
                                                                        01648000
<<----------------------------------------------------------------------01650000
*                                                                      *01652000
*  AOPTIONS DEFINITIONS                                                *01654000
*                                                                      *01656000
---------------------------------------------------------------------->>01658000
                                                               <<04189>>01660000
EQUATE                                                         <<04189>>01662000
   WRITE'NEW    = 1,                                           <<04189>>01664000
   WRITE'SAVE   = 2,                                           <<04189>>01666000
   WRITE'APPEND = 3;                                           <<04189>>01668000
                                                                        01670000
DEFINE  <<AOPTION FIELDS>>                                              01672000
AOPCOPYF        = (3:1)#,                << COPY MODE >>       <<HM.00>>01674000
AOPNOWAITF      = (4:1)#,                << NO-WAIT I/O MODE >>         01676000
AOPMULTACF      = (5:2)#,                << MULTI ACCESS MODE >>        01678000
AOPINHIBITBUFF  = (7:1)#,                << INHIBIT BUFFERING >>        01680000
AOPACMODEF      = (8:2)#,                << ACCESS MODE >>              01682000
AOPLOCKINGF     = (10:1)#,               << DYNAMIC LOCKING >>          01684000
AOPMULTIRECF    = (11:1)#,               << MULTI-RECORD >>             01686000
AOPACTYPEF      = (12:4)#;               << ACCESS TYPE >>              01688000
                                                                        01690000
DEFINE                                                                  01692000
AOPCOPY         = AOPTIONS.(3:1)#,       << FILE TO BE COPIED>><<HM.00>>01694000
AOPNOWAIT       = AOPTIONS.(4:1)#,       << NO-WAIT I/O MODE >>         01696000
AOPMULTAC       = AOPTIONS.(5:2)#,       << MULTI ACCESS MODE >>        01698000
AOPGLOBALMULTAC = AOPTIONS.(5:1)#,       << INTER JOB MULTI>>  <<HM.00>>01700000
AOPINHIBITBUF   = AOPTIONS.(7:1)#,       << INHIBIT BUFFERING >>        01702000
AOPACMODE       = AOPTIONS.(8:2)#,       << ACCESS MODE >>              01704000
AOPDEFAULT      = (INT(AOPACMODE) = 0)#, << DEFAULT >>                  01706000
AOPEXCLUSIVE    = (INT(AOPACMODE) = 1)#, << EXCLUSIVE >>                01708000
AOPSEMI         = (INT(AOPACMODE) = 2)#, << SEMI-EXCLUSIVE >>           01710000
AOPSHARE        = (INT(AOPACMODE) = 3)#, << SHARE >>                    01712000
AOPLOCKING      = AOPTIONS.(10:1)#,      << DYNAMIC LOCKING >>          01714000
AOPMULTIREC     = AOPTIONS.(11:1)#,      << MULTI-RECORD >>             01716000
AOPACTYPE       = AOPTIONS.(12:4)#,      << ACCESS TYPE >>              01718000
AOPREAD         = (INT(AOPACTYPE) = 0)#, << READ ONLY >>                01720000
AOPWRITE        = (INT(AOPACTYPE) = 1)#, << WRITE ONLY - DELETE >>      01722000
AOPWRITESAVE    = (INT(AOPACTYPE) = 2)#, << WRITE ONLY - SAVE >>        01724000
AOPAPPEND       = (INT(AOPACTYPE) = 3)#, << APPEND ONLY >>              01726000
AOPREADWRITE    = (INT(AOPACTYPE) = 4)#, << READ OR WRITE >>            01728000
AOPUPDATE       = (INT(AOPACTYPE) = 5)#, << UPDATE ONLY >>              01730000
AOPEXECUTE      = (INT(AOPACTYPE) = 6)#, << EXECUTE ONLY >>             01732000
AOPWRITEONLY    = (1 <= INT(AOPACTYPE) <= 3)#;  << FORM OF WRITE >>     01734000
                                                                        01736000
<<----------------------------------------------------------------------01738000
*                                                                      *01740000
*  FOPTIONS DEFINITIONS                                                *01742000
*                                                                      *01744000
---------------------------------------------------------------------->>01746000
                                                               <<04189>>01748000
EQUATE                                                         <<04189>>01750000
   NEW'FILE      = 0,                                          <<04189>>01752000
   OLD'PERM'FILE = 1,                                          <<04189>>01754000
   OLD'TEMP'FILE = 2,                                          <<04189>>01756000
   OLD'FILE      = 3;                    << Perm or temp.   >> <<04189>>01758000
                                                                        01760000
DEFINE  <<FOPTIONS FIELDS>>                                             01762000
FILETYPE        = (2:3)#,                << TYPE OF FILE >>    <<HM.00>>01764000
FOPNOEQUATEF    = (5:1)#,                << NO FILE EQUATION >>         01766000
FOPLABELLEDF    = (6:1)#,                << LABELLED TAPE >>  <<TL.02>> 01768000
FOPCONTROLF     = (7:1)#,                << CARRIAGE CONTROL >>         01770000
FOPFORMATF      = (8:2)#,                << RECORD FORMAT >>            01772000
FOPDESIGNATORF  = (10:3)#,               << DESIGNATOR TYPE >>          01774000
FOPASCIIF       = (13:1)#,               << ASCII/BINARY FORMAT >>      01776000
FOPDOMAINF      = (14:2)#;               << FILE DOMAIN >>              01778000
                                                                        01780000
DEFINE                                                                  01782000
FOPFILETYPE     = FOPTIONS.(2:3)#,       << TYPE OF FILE >>    <<HM.00>>01784000
FOPKSAM         = (FOPFILETYPE=1)#,      << RESERVED FOR KSAM    HM.00>>01786000
FOPRIO          = (FOPFILETYPE=2)#,      << RIO FILE >>        <<HM.00>>01788000
FOPCIRFILE      = (FOPFILETYPE=4)#,      << CIRCULAR FILE >>   <<HM.00>>01790000
FOPMSGFILE      = (FOPFILETYPE=6)#,      << IPC FILE >>        <<HM.00>>01792000
FOPNOEQUATE     = FOPTIONS.(5:1)#,       << NO FILE EQUATION >>         01794000
FOPLABELLED     = LOG(FOPTIONS.(6:1))#,                        <<TL.02>>01796000
FOPCONTROL      = FOPTIONS.(7:1)#,       << CARRIAGE CONTROL >>         01798000
FOPFORMAT       = FOPTIONS.(8:2)#,       << RECORD FORMAT >>            01800000
FOPVARFLD       = FOPTIONS.(9:1)#,       << VARIABLE BIT >>             01802000
FOPFIXED        = (INT(FOPFORMAT) = 0)#, << FIXED >>                    01804000
FOPVARIABLE     = (INT(FOPVARFLD) = 1)#, << VARIABLE >>                 01806000
FOPNORMVAR      = (INT(FOPFORMAT) = 1)#, << NORMAL VARIABLE >>          01808000
FOPSPECVAR      = (INT(FOPFORMAT) = 3)#, << SPECIAL VARIABLE >>         01810000
FOPUNDEFINED    = (INT(FOPFORMAT) = 2)#, << UNDEFINED >>                01812000
FOPFIXEDFMT     = 0  #,                                        <<01115>>01814000
FOPDESIGNATOR   = FOPTIONS.(10:3)#,      << DESIGNATOR TYPE >>          01816000
FOPACTUAL       = (INT(FOPDESIGNATOR) = 0)#,<< ACTUAL >>                01818000
FOPSTDLIST      = (INT(FOPDESIGNATOR) = 1)#,<< $STDLIST >>              01820000
FOPNEWPASS      = (INT(FOPDESIGNATOR) = 2)#,<< $NEWPASS >>              01822000
FOPOLDPASS      = (INT(FOPDESIGNATOR) = 3)#,<< $OLDPASS >>              01824000
FOPSTDIN        = (INT(FOPDESIGNATOR) = 4)#,<< $STDIN >>                01826000
FOPSTDINX       = (INT(FOPDESIGNATOR) = 5)#,<< $STDINX >>               01828000
FOPNULL         = (INT(FOPDESIGNATOR) = 6)#,<< $NULL >>                 01830000
FOPASCII        = FOPTIONS.(13:1)#,      << ASCII/BINARY FORMAT >>      01832000
FOPDOMAIN       = FOPTIONS.(14:2)#,      << FILE DOMAIN >>              01834000
FOPNEW          = (INT(FOPDOMAIN) = 0)#, << NEW >>                      01836000
FOPPERMANENT    = (INT(FOPDOMAIN) = 1)#, << OLD - PERMANENT >>          01838000
FOPTEMPORARY    = (INT(FOPDOMAIN) = 2)#, << OLD - TEMPORARY >>          01840000
FOPOLD          = (INT(FOPDOMAIN) = 3)#; << OLD - EITHER >>             01842000
                                                                        01844000
DEFINE                                                                  01846000
NOLABEL         = FALSE#;                << FUTURE HOOK >>              01848000
                                                                        01850000
COMMENT                                                        <<02524>>01852000
<<-------------------------------------------------------------<<02524>>01854000
*                                                             *<<02524>>01856000
*  DEVICE parameter/DEVPARMS array definitions                *<<02524>>01858000
*                                                             *<<02524>>01860000
------------------------------------------------------------->><<02524>>01862000
;  << end of header >>                                         <<02524>>01864000
                                                               <<02524>>01866000
EQUATE                                                         <<02524>>01868000
   DEVPARM'SIZE = %101,    << size of formatted area >>        <<02524>>01870000
   DEVPARM'END  = DEVPARM'SIZE-1,                              <<02524>>01872000
         << index for end of formatted area >>                 <<02524>>01874000
   BDEVPARM'END = DEVPARM'END*2 + 1,                           <<02524>>01876000
         << byte index for end of formatted area >>            <<02524>>01878000
   NUM'EXTRA'VARS = 5,     << overhead at end of DEVPARMS >>   <<02524>>01880000
   DEV'ARRAY'END  = DEVPARM'END + NUM'EXTRA'VARS,              <<02524>>01882000
         << DEVPARMS array bounds >>                           <<02524>>01884000
   MAXDEVLEN = 17,           <<max. size of DEVL array>>       <<02524>>01886000
                                                               <<02524>>01888000
   << index definitions for overhead region >>                 <<02524>>01890000
                                                               <<02524>>01892000
   DP'INDEX'IND = DEVPARM'END+1,                               <<02524>>01894000
   DP'FLAG'IND  = DP'INDEX'IND+1,                              <<02524>>01896000
   DP'ENV'FNUM'IND = DP'FLAG'IND+1,                            <<02524>>01898000
   DEVPARMFLAG'IND = DP'ENV'FNUM'IND+1,                        <<02524>>01900000
   DP'DEN'IND   = DEVPARMFLAG'IND+1,                           <<02524>>01902000
                                                               <<02524>>01904000
   NUM'DP'TOKENS   = 3,                                        <<02524>>01906000
   AVAIL'PTR'IND   = NUM'DP'TOKENS*2 + 1;                      <<02524>>01908000
         << index of free ptr in formatted region >>           <<02524>>01910000
                                                               <<02524>>01912000
DEFINE                                                         <<02524>>01914000
   BUILD'DEVPARMS =                                            <<02524>>01916000
      ARRAY DEVPARMS(0:DEV'ARRAY'END);                         <<02524>>01918000
      BYTE ARRAY BDEVPARMS(*) = DEVPARMS#,                     <<02524>>01920000
   NEXT'AVAIL'PTR =                                            <<02524>>01922000
      DEVPARMS(AVAIL'PTR'IND)#,                                <<02524>>01924000
                                                               <<02524>>01926000
   << overhead area defines >>                                 <<02524>>01928000
                                                               <<02524>>01930000
   DP'INDEX = DEVPARMS(DP'INDEX'IND)#,                         <<02524>>01932000
   DP'FLAG  = DEVPARMS(DP'FLAG'IND)#,                          <<02524>>01934000
   DP'ENV'FNUM = DEVPARMS(DP'ENV'FNUM'IND)#,                   <<02524>>01936000
   DEVPARMFLAG = DEVPARMS(DEVPARMFLAG'IND)#,                   <<02524>>01938000
   DP'DEN   = DEVPARMS(DP'DEN'IND)#,                           <<02524>>01940000
                                                               <<02524>>01942000
   << token defines >>                                         <<02524>>01944000
                                                               <<02524>>01946000
   OUTQ'DEFN     = "OQ"#,                                      <<02524>>01948000
   ENV'DEFN      = "EN"#,                                      <<02524>>01950000
   DEN'DEFN      = "DN"#;                                      <<02524>>01952000
                                                               <<02524>>01954000
EQUATE                                                         <<02524>>01956000
   << density equates >>                                       <<02524>>01958000
                                                               <<02524>>01960000
   DEN'1600      = 1,                                          <<02524>>01962000
   DEN'6250      = 2,                                          <<02524>>01964000
   DEN'DEFAULT   = 0,                                          <<02568>>01966000
                                                               <<02524>>01968000
   << token equates >>                                         <<02524>>01970000
                                                               <<02524>>01972000
   OUTQ'TOKEN    = OUTQ'DEFN,                                  <<02524>>01974000
   ENV'TOKEN     = ENV'DEFN,                                   <<02524>>01976000
   DEN'TOKEN     = DEN'DEFN;                                   <<02524>>01978000
                                                               <<02524>>01980000
<<----------------------------------------------------------------------01982000
*                                                                      *01984000
*  FOPEN STATE WORD (STATE) DEFINITIONS                                *01986000
*                                                                      *01988000
---------------------------------------------------------------------->>01990000
                                                                        01992000
DEFINE                                                                  01994000
CARRIAGEF   = (9:1)#,         << CARRIAGE CONTROL FLAG >>               01996000
DEFAULTBF   = (10:1)#,        << DEFAULT BLOCKING FLAG >>               01998000
READCODE    = (11:4)#,        << INPUT EOF CHECK >>                     02000000
READTYPE    = (11:2)#,        << 00 DATA,01 JOB,10 SESS >>              02002000
READMODE    = (13:2)#;        << SEE BELOW >>                           02004000
                                                                        02006000
EQUATE                                                                  02008000
STDINRD     = 0,    << TYPE=JOB/SESSION >>                              02010000
STDINXRD    = 1,                                                        02012000
STDINCIRD   = 2,                                                        02014000
MAGTRD      = 0,    << TYPE=DATA >>                                     02016000
OTHERRD     = 1,                                                        02018000
COLONRD     = 2;                                                        02020000
                                                                        02022000
<<----------------------------------------------------------------------02024000
*                                                                      *02026000
*  PCBX FILE SECTION (PXFILE) DEFINITIONS                              *02028000
*                                                                      *02030000
---------------------------------------------------------------------->>02032000
                                                                        02034000
DEFINE                                                                  02036000
FINDPXFILE      = PUSH(DL); TOS := TOS-PS0(-3)#,                        02038000
SETPXFILE       = FINDPXFILE; @PXFILE := TOS#,                          02040000
FINDOTHERPXFILE = TOS := DB0; TOS := TOS-PS0(-3)#,                      02042000
SETOTHERPXFILE  = FINDOTHERPXFILE; @PXFILE := TOS#;                     02044000
DEFINE DL'IN'MY'STACK = PUSH(DL)#;                             <<+1.C3>>02046000
DEFINE DL'IN'HIS'STACK = TOS := DB0#;                          <<+1.C3>>02048000
DEFINE CONV'DLTOPXFILE = TOS := TOS-PS0(-3)#;                  <<+1.C3>>02050000
DEFINE CONV'PXFILETOCBTAB =TOS := TOS + PXFOVERHEAD#;          <<+1.C3>>02052000
DEFINE CONV'DLTOCBTAB = CONV'DLTOPXFILE;CONV'PXFILETOCBTAB#;   <<+1.C3>>02054000
                                                                        02056000
EQUATE                                                                  02058000
PXFCBTMAX   = 8,            << MAX. NR. USER (NOBUF) CBT'S >>           02060000
PXFOVERHEAD = 8+PXFCBTMAX,  << PXFILE OVERHEAD SIZE IN WORDS >>         02062000
PXFCBTSIZEMAX=1000;         << MAX. PXFILE SIZE >>                      02064000
                                                                        02066000
DEFINE                                                                  02068000
PXFSIZE     = PXFILE#,         << PXFILE SIZE >>                        02070000
PXFDOPEN    = PXFILE(1).(0:8)#,<< LAST DOPEN ERROR CODE >>              02072000
PXFCOPEN    = PXFILE(1).(8:8)#,<< LAST COPEN ERROR CODE >>              02074000
PXFNOCB     = LOG(PXFILE(2).(0:1))#,  << NO CB'S IN PCBX? >>            02076000
PXFDSINFO   = PXFILE(3)#,      << RESERVED FOR DS >>                    02078000
PXFKOPEN    = PXFILE(4).(0:8)#,<< RESERVED FOR KSAM >>                  02080000
PXFFOPEN    = PXFILE(4).(8:8)#,<< LAST FOPEN ERROR CODE >>              02082000
PXFAFTSIZE  = PXFILE(5)#,      << AFT SIZE IN WORDS >>                  02084000
PXFCTRINFO  = PXFILE(6)#,      << CS TRACE FILE INFO >>                 02086000
PXFLEFTOFF  = PXFILE(7)#,      << LAST RESPONDING FILE/LINE >>          02088000
PXFCBT1     = PXFILE(8)#,      << 1ST USER (NOBUF) CBT DST NR. >>       02090000
PXFCBT2     = PXFILE(9)#,      << 2ND USER (NOBUF) CBT DST NR. >>       02092000
PXFCBT3     = PXFILE(10)#,     << 3RD USER (NOBUF) CBT DST NR. >>       02094000
PXFCBT4     = PXFILE(11)#,     << 4TH USER (NOBUF) CBT DST NR. >>       02096000
PXFCBT5     = PXFILE(12)#,     << 5TH USER (NOBUF) CBT DST NR. >>       02098000
PXFCBT6     = PXFILE(13)#,     << 6TH USER (NOBUF) CBT DST NR. >>       02100000
PXFCBT7     = PXFILE(14)#,     << 7TH USER (NOBUF) CBT DST NR. >>       02102000
PXFCBT8     = PXFILE(15)#,     << 8TH USER (NOBUF) CBT DST NR. >>       02104000
PXFCBTAB    = PXFILE(16)#,     << CONTROL BLOCK TABLE >>                02106000
PXFCBTSIZE  = PXFILE(16)#,     << C.B. TABLE SIZE IN WORDS >>           02108000
PXFDSTX     = PXFILE(17)#,     << C.B. TABLE DST NUMBER >>              02110000
PXFVTSIZE   = PXFILE(18)#,     << VECTOR TABLE SIZE IN WORDS >>         02112000
PXFLOCK     = PXFILE(19)#,     << C.B. TABLE LOCK WORD >>               02114000
PXFQUEUE    = PXFILE(20)#,     << C.B. TABLE IMPEDE WORD >>             02116000
PXFVT       = PXFILE(21)#;     << VECTOR TABLE >>                       02118000
                                                                        02120000
<<----------------------------------------------------------------------02122000
*                                                                      *02124000
*  DATA SEGMENT CBT DEFINITIONS                                        *02126000
*                                                                      *02128000
---------------------------------------------------------------------->>02130000
                                                                        02132000
EQUATE                                                                  02134000
FSEGINIT    = 720,  << DST CBT INITIAL SIZE - NO BUFFERS >>             02136000
FSEGMAX     = 5120, << DST CBT MAXIMUM SIZE - NO BUFFERS >>    <<00.06>>02138000
FSEGBUFMAX  = 8192, << DST CBT MAXIMUM SIZE - BUFFERS >>                02140000
FSOVERHEAD  = 5,    << DST CBT OVERHEAD SIZE IN WORDS >>                02142000
FSVTENTRY   = 4;    << CBT VECTOR TABLE ENTRY SIZE >>                   02144000
DEFINE MAKE'AN'OFFSET = &LSR(8) LAND %374#;<<.(0:6)*VTENTRY>>  <<+1.C3>>02146000
                                                                        02148000
INTEGER ARRAY FSCBTAB (*) = DB+0;  << F.S. CONTROL BLOCK TABLE >>       02150000
EQUATE AD'FSCBTAB = 0;                                         <<+1.C3>>02152000
DEFINE AD'FSCBTAB'AND'ZERO = 0D#;                              <<+1.C3>>02154000
INTEGER FSSIZE = DB+0;         << F.S. TABLE SIZE IN WORDS >>           02156000
INTEGER FSDSTX = DB+1;         << F.S. TABLE DST NUMBER >>              02158000
INTEGER FSVTSIZE = DB+2;       << VECTOR TABLE SIZE IN WORDS >>         02160000
INTEGER FSLOCK = DB+3;         << F.S. TABLE LOCK WORD >>               02162000
INTEGER FSQUEUE = DB+4;        << F.S. TABLE IMPEDED QUEUE >>           02164000
ARRAY FSVT(*) = DB+FSOVERHEAD; << VECTOR TABLE >>              <<+1.03>>02166000
EQUATE AD'FSVT = 5;                                            <<+1.C3>>02168000
                                                                        02170000
DEFINE                                                                  02172000
FSDSTSIZE = (ABSOLUTE(ABSOLUTE(DSTP)+FSDSTX&LSL(2)).(3:13)-1)&LSL(2)#;  02174000
DEFINE                                                         <<04624>>02176000
   VTA = &LSR(10)&LSL(2)+FSOVERHEAD#,                          <<04624>>02178000
   DSTN=(6:10)#;                                               <<04624>>02180000
                                                                        02182000
<<----------------------------------------------------------------------02184000
*                                                                      *02186000
*  CONTROL BLOCK TABLE (CBTAB) DEFINITIONS                             *02188000
*                                                                      *02190000
---------------------------------------------------------------------->>02192000
                                                                        02194000
EQUATE                                                                  02196000
CBTOVERHEAD = FSOVERHEAD,  << CB TABLE OVERHEAD SIZE IN WORDS >>        02198000
CBTVT1      = 16,          << NR. INIT. VT ENTRIES - PXFILE >>          02200000
CBTVT2      = 64,          << NR. INIT. VT ENTRIES - USER >>            02202000
CBTVT3      = 64,          << NR. INIT. VT ENTRIES - SYSTEM >>          02204000
CBTVT4      = 1;           << NR. INIT. VT ENTRIES - BUF. ACB >>        02206000
                                                                        02208000
DEFINE                                                                  02210000
CBTSIZE     = CBTAB#,            << C.B. TABLE SIZE IN WORDS >>         02212000
CBTDSTX     = CBTAB(1)#,         << C.B. TABLE DST NUMBER >>            02214000
CBTVTSIZE   = CBTAB(2).(2:14)#,  << VECTOR TABLE SIZE IN WORDS <<00300>>02216000
CBTTYPEF    = CBTAB(2).(0:2)#,   << CTRL BLOCK TABLE TYPE >>   <<00300>>02218000
CBTLOCK     = CBTAB(3)#,         << C.B. TABLE LOCK WORD >>             02220000
CBTQUEUE    = CBTAB(4)#,         << C.B. TABLE IMPEDED QUEUE >>         02222000
CBTVT       = CBTAB(5)#;         << VECTOR TABLE >>                     02224000
                                                                        02226000
EQUATE                                                                  02228000
CBGARBAGE   = 0,  <<GARBAGE TYPE NR.>>                                  02230000
CBFCB       = 1,  <<FCB TYPE NR.>>                                      02232000
CBPACB      = 2,  <<PACB TYPE NR.>>                                     02234000
CBLACB      = 3;  <<LACB TYPE NR.>>                                     02236000
                                                                        02238000
DEFINE                                                                  02240000
CBDESCRIP   = CB#,            << DESCRIPTOR WORD >>                     02242000
CBTYPE      = CB.(0:2)#,      << CONTROL BLOCK TYPE NR.>>               02244000
CBSIZE      = CB.(2:14)#;     << CONTROL BLOCK SIZE >>                  02246000
                                                                        02248000
<<----------------------------------------------------------------------02250000
*                                                                      *02252000
*  VECTOR TABLE (VT) DEFINITIONS                                       *02254000
*                                                                      *02256000
---------------------------------------------------------------------->>02258000
                                                                        02260000
EQUATE                                                                  02262000
VTENTRY     = FSVTENTRY;  << VECTOR TABLE ENTRY SIZE>>                  02264000
                                                                        02266000
DEFINE                                                                  02268000
VTADR       = VT#,            << CONTROL BLOCK ADDRESS >>               02270000
VTCONTROL   = VT(1)#,         << CONTROL WORD >>                        02272000
VTQUEUE     = VT(2)#,         << HIGH PRIORITY IMPEDED QUEUE >>         02274000
VTSAVEDQUEUE= VT(3)#;         << LOW PRIORITY IMPEDED QUEUE >>          02276000
                                                                        02278000
<<----------------------------------------------------------------------02280000
*                                                                      *02282000
*  CONTROL BLOCK LOCK (CBL) DEFINITIONS                                *02284000
*                                                                      *02286000
---------------------------------------------------------------------->>02288000
                                                                        02290000
DEFINE                                                                  02292000
CBLCONTROL  = CBL#,           << CONTROL WORD >>                        02294000
CBLLOCK     = CBL.(0:1)#,     << LOCK BIT >>                            02296000
CBLBREAK    = CBL.(1:1)#,     << BREAK QUEUE ESTABLISHED >>             02298000
CBLCOUNT    = CBL.(2:6)#,     << LOCK COUNT >>                          02300000
CBLPIN      = CBL.(8:8)#,     << PROCESS PIN HOLDING LOCK >>            02302000
CBLQUEUE    = CBL(1)#,        << HIGH PRIORITY IMPEDED QUEUE >>         02304000
CBLTAIL     = CBL(1).(0:8)#,  << TAIL PROCESS PIN >>                    02306000
CBLHEAD     = CBL(1).(8:8)#,  << HEAD PROCESS PIN >>                    02308000
CBLSAVEDQUEUE= CBL(2)#,       << LOW PRIORITY IMPEDED QUEUE >>          02310000
CBLSAVEDTAIL= CBL(2).(0:8)#,  << TAIL PROCESS PIN >>                    02312000
CBLSAVEDHEAD= CBL(2).(8:8)#;  << HEAD PROCESS PIN >>                    02314000
                                                                        02316000
<<----------------------------------------------------------------------02318000
*                                                                      *02320000
*  Available File Table (AFT) entry definitions                  KS.00 *02322000
*                                                                      *02324000
---------------------------------------------------------------------->>02326000
                                                                        02328000
EQUATE                                                                  02330000
AFTENTRY    = 4;    << AFT entry size >>                                02332000
DEFINE DIV'BY'AFTENTRY = &LSR(2)#;                                      02334000
                                                                        02336000
DEFINE                                                                  02338000
AFTTYPE     = AFT.(0:4)#,     << entry type >>                 <<DS.00>>02340000
AFTFSTYPE   = (AFTTYPE = 0)#, << FS entry type >>              <<DS.00>>02342000
AFTRFTYPE   = (AFTTYPE = 1)#, << RF entry type >>              <<DS.00>>02344000
AFTDSTYPE   = (AFTTYPE&LSR(1) = 1)#, << DS entry type >>       <<DS.00>>02346000
AFTCSTYPE   = (AFTTYPE&LSR(1) = 2)#, << CS entry type >>       <<DS.00>>02348000
AFTKSTYPE   = (AFTTYPE=6)#,          << KS entry type >>       <<KS.00>>02350000
AFT3270TYPE  = (AFTTYPE = 7)#,                                 <<00183>>02352000
AFTMSGTYPE   = (AFTTYPE = 8)#,                                 <<HM.00>>02354000
AFTNULL     = LOG(AFT.(4:1))#,      << $NULL file >>           <<DS.00>>02356000
AFTDSKLUDGE = (AFTTYPE <> 2)#,<< no I/O Wait line - DS only >> <<DS.00>>02358000
AFTLDEV     = AFT.(8:8)#,     << logical device nr. - CS only >>        02360000
AFTFLAG     = AFT.(5:2)#,            << KS error flag>>        <<KS.00>>02362000
AFTERRNUM   = AFT.(8:8)#,            <<KSAM special error #>>  <<KS.00>>02364000
AFTPACBV    = AFT(1)#,        << physical ACB vector >>                 02366000
AFTCSIOQCBV = AFT(1)#,        << CS IOQ index CB vector >>     <<00613>>02368000
AFTRFNUM    = AFT(1).(0:8)#,  << remote file number >>         <<DS.00>>02370000
AFTLINENUM  = AFT(1).(8:8)#,  << local line # of remote file >><<DS.00>>02372000
AFTKEYFN    = AFT(1).(0:8)#,         <<KSAM key file number>>  <<KS.00>>02374000
AFTDATAFN   = AFT(1).(8:8)#,         <<KSAM data file number>> <<KS.00>>02376000
AFTLACBV    = AFT(2)#,        << logical ACB vector >>                  02378000
                                     <<0 = no error>>          <<KS.00>>02380000
                                     <<1 = data file error>>   <<KS.00>>02382000
                                     <<2 = key file error>>    <<KS.00>>02384000
                                     <<3 = KSAM special err>>  <<KS.00>>02386000
AFTEDSNUM   = AFT(2)#,               <<KSAM extra data seg #>> <<KS.00>>02388000
AFTCS'MDST  = AFT(2).(6:10)#, << CS info data segment for AFT>><<00613>>02390000
AFTIOQX     = AFT(3)#;        << No-Wait I/O IOQX >>                    02392000
                                                                        02394000
DEFINE                                                                  02396000
FINDAFT     = PUSH(DL); TOS := TOS-4-FILENUM*AFTENTRY#,                 02398000
SETAFT      = FINDAFT; @AFT := TOS#;                                    02400000
DEFINE FAST'FINDAFT = TOS := TOS - 4 - X&LSL(2)#;              <<+1.C3>>02402000
                                                                        02404000
<<-------------------------------------------------------------  DS.00  02406000
*                                                             *  DS.00  02408000
*  AFT FILE ENTRY TYPES                                       *  KS.00  02410000
*                                                             *  DS.00  02412000
---------------------------------------------------------------  DS.00>>02414000
                                                               <<DS.00>>02416000
DEFINE                                                         <<DS.00>>02418000
FSTYPE      = (FTYPE = 0)#,         << LOCAL FILE >>           <<DS.00>>02420000
RFTYPE      = (FTYPE = 1)#,         << REMOTE FILE >>          <<DS.00>>02422000
DSTYPE      = (FTYPE&LSR(1) = 1)#,  << DS FILE TYPE >>         <<DS.00>>02424000
CSTYPE      = (FTYPE&LSR(1) = 2)#;  << CS FILE TYPE >>         <<DS.00>>02426000
DEFINE                                                         <<KS.00>>02428000
KSTYPE      = (FTYPE = 6)#;          <<KSAM FILE   TYPE>>      <<KS.00>>02430000
DEFINE                                                         <<00183>>02432000
  TTSTYPE     = ( FTYPE = 7)#;                                 <<00183>>02434000
DEFINE                                                         <<HM.00>>02436000
MSGTYPE     = (FTYPE = 8)#;         << MSG FILE TYPE >>        <<HM.00>>02438000
EQUATE FS'TYPE = 0;                                            <<+1.C3>>02440000
EQUATE RF'TYPE = 1;                                            <<+1.C3>>02442000
EQUATE KS'TYPE = 6;                                            <<+1.C3>>02444000
EQUATE MSG'TYPE= 8;                                            <<HM.00>>02446000
EQUATE MAXFILETYPE = 7;                                        <<HM.00>>02448000
                                                               <<DS.00>>02450000
<<----------------------------------------------------------------------02452000
*                                                                      *02454000
*  LOGICAL ACCESS CONTROL BLOCK (LACB) DEFINITIONS                     *02456000
*                                                                      *02458000
---------------------------------------------------------------------->>02460000
                                                                        02462000
EQUATE                                                                  02464000
SIZELACB      = 16, << LACB SIZE IN WORDS >>                   <<HM.00>>02466000
MSGLACBEXTEND = 9;  << # EXTRA WORDS IN MSG FILE LACB >>       <<03035>>02468000
                                                                        02470000
DEFINE                                                                  02472000
LACBSIZE    = LACB.(2:14)#,   << LACB SIZE >>                           02474000
LACBFNUM    = LACB(01)#,      << File number >>                         02476000
LACBNAME1   = LACB(02)#,      << File name >>                           02478000
LACBNAME2   = LACB(03)#,                                                02480000
LACBNAME3   = LACB(04)#,                                                02482000
LACBNAME4   = LACB(05)#,                                                02484000
LACBFOPTIONS= LACB(06)#,      << FOPTIONS >>                            02486000
LACBAOPTIONS= LACB(07)#,      << AOPTIONS >>                            02488000
LACBRSIZE   = LACB(08)#,      << record size - bytes >>                 02490000
LACBBSIZE   = LACB(09)#,      << block size - words >>                  02492000
LACBPACB    = LACB(10)#,      << PACB vector >>                         02494000
LACBCTL     = LACB(11)#,      << control word >>                        02496000
LACBSTATE   = LACB(12)#,      << local state flags >>                   02498000
LACBMODE    = LACB(13).(0:8)#,<< mode flags >>                          02500000
LACBSTOPCHAR= LACB(13).(8:8)#,<< terminal stop char >>                  02502000
LACBERROR   = LACB(14)#,      << error code >>                          02504000
LACBTLOG    = LACB(15)#;      << last I/O trans log >>                  02506000
                                                                        02508000
<<----------------------------------------------------------------------02510000
*                                                                      *02512000
*  Access Control Block (ACB) definitions                              *02514000
*                                                                      *02516000
---------------------------------------------------------------------->>02518000
                                                                        02520000
EQUATE                                                                  02522000
   ACBNAME'DISP = 2,  << Offset to file name in ACB.        >> <<04624>>02524000
SIZEACB     =48,     << Basic ACB size >>                               02526000
SIZEXACB    =%70,    << Sixe of extra ACB used by LOC'ACB   >> <<04516>>02528000
IPCBLKOVERHEAD=3,                                              <<HM.00>>02530000
MSGACBEXTEND= 43,                                              <<03035>>02532000
MSGSIZEACB  = SIZEACB+MSGACBEXTEND,                            <<HM.00>>02534000
BLKBUFDISP  = 08,    << Buffering extension size >>            <<04866>>02536000
BLKBUFBDISP = BLKBUFDISP*2;  << SAME IN BYTES >>                        02538000
                                                                        02540000
DEFINE                                                                  02542000
ACBSIZE     =ACB.(2:14)#,     << size of ACB (incl. buffs) >>           02544000
ACBFNUM     =ACB(1).(8:8)#,   << file number >>                         02546000
ACBNAME     =ACB(2)#,         << file name >>                           02548000
ACBNAME1    =ACBDBL(1)#,      << file name - first half >>              02550000
ACBNAME2    =ACBDBL(2)#,      << file name - second half >>             02552000
ACBFOPTIONS =ACB(6)#,         << FOPTIONS >>                            02554000
ACBAOPTIONS =ACB(7)#,         << AOPTIONS >>                            02556000
ACBRSIZE    =ACB(8)#,         << record size (bytes) >>                 02558000
ACBBSIZE    =ACB(9)#,         << block size (words) >>                  02560000
ACBDUM      =ACB(10)#,        << for LACBPACB >>                        02562000
ACBCTL      =ACB(11)#,        << carriage control word >>               02564000
ACBLSTATE   =ACB(12)#,        << local state flags >>                   02566000
ACBMODW     =ACB(13)#,        << mode word >>                           02568000
ACBMODE     =ACBMODW.(0:8)#,  << mode setting >>                        02570000
ACBTAPEERROR=ACBMODW.(4:1)#,  << report recovered tape error >>         02572000
ACBINHIBCRLF=ACBMODW.(5:1)#,  << inhibit terminal CR/LF >>              02574000
ACBQUIESCE  =ACBMODW.(6:1)#,  << critical output verify >>              02576000
ACBSTOPCHAR =ACBMODW.(8:8)#,  << terminal stop character >>             02578000
ACBERROR    =ACB(14)#,        << error code >>                          02580000
ACBTLOG     =ACB(15)#,        << last I/O transmission log >>           02582000
ACBFPTR     =ACBDBL(08)#,     << current record number >>               02584000
ACBBLK      =ACBDBL(09)#,     << current variable block >>              02586000
ACBRTFRCT   =ACBDBL(10)#,     << logical record tfr count >>            02588000
ACBBTFRCT   =ACBDBL(11)#,     << block transfer count >>                02590000
ACBHIBLK    =ACBDBL(12)#,     << highest block started >>               02592000
ACBFCB      =ACB(26)#,        << FCB vector >>                          02594000
ACBTEMP1    =ACB(27)#,        << temp cell >>                           02596000
ACBSHCNTS   =ACB(28)#,        << LACB counts >>                         02598000
ACBSHCNTIN  =ACBSHCNTS.(0:8)#,<< # of Read LACB'S >>                    02600000
ACBSHCNT    =ACBSHCNTS.(8:8)#,<< # of LACB'S >>                         02602000
ACBSTATW    =ACB(29)#,        << access class, status, etc. >>          02604000
ACBBREAK    =ACBSTATW.(1:1)#, << break ($STDIN/LIST only) >>            02606000
ACBDTYPE    =ACBSTATW.(2:6)#, << device type >>                         02608000
ACBACCCL    =ACBSTATW.(2:3)#, << device access class >>                 02610000
ACBSUBCL    =ACBSTATW.(5:3)#, << device sub-class >>                    02612000
ACBSTATUS   =ACBSTATW.(8:8)#, << last logical I/O status >>             02614000
ACBQSTATUS  =ACBSTATW.(8:5)#, << qualifying status part >>              02616000
ACBGSTATUS  =ACBSTATW.(13:3)#,<< general status part >>                 02618000
ACBGSTW     =ACB(30)#,        << global status flags >>                 02620000
ACBNOWAITEOF=ACBGSTW.(0:1)#,  << EOF advanced? >>                       02622000
ACBNOWAITMODE=ACBGSTW.(1:1)#, << last I/O: 0=read, 1=write >>           02624000
ACBABORTREAD=ACBGSTW.(2:1)#,  << abort broken re-read? >>               02626000
ACBNEWEOF   =ACBGSTW.(3:1)#,  << EOF advanced - tape only >>            02628000
ACBSAVEEOFS =ACBGSTW.(4:2)#,  << for saving ACBEOFS >>                  02630000
ACBEOFS     =ACBGSTW.(6:2)#,  << EOF flags - :EOD/: >>                  02632000
ACBBLKFACT  =ACBGSTW.(8:8)#,  << records/block >>                       02634000
ACBBUFX     =ACB(31)#,        << buffer data & misc. flags >>           02636000
ACBPRIV     =ACBBUFX.(0:1)#,  << privileged access only >>              02638000
ACBHIT      =ACBBUFX.(1:1)#,  << buffer hit flag >>                     02640000
ACBCURRBUF  =ACBBUFX.(4:4)#,  << current buffer nr. >>                  02642000
ACBTAPEDISP =ACBBUFX.(8:4)#,  << Number tape pre-reads.     >> <<04814>>02644000
ACBNUMBUFS  =ACBBUFX.(12:4)#, << number of buffers less 1>>             02646000
ACBBUFUSED  =ACB(32)#,        << used block word count >>               02648000
ACBBUFSIZE  =ACB(33)#,        << buffer size (words) >>                 02650000
ACBXXXX     =ACB(34)#,        << Spooler Reserved >>                    02652000
ACBFMAVTX   =ACB(35)#,        << FMAVT index >>                         02654000
ACBVDADDR   =ACB(36)#,        << volume table index >>                  02656000
ACBDNTD     =ACB(37)#,        << type & disposition >>                  02658000
ACBDNTYPE   =ACBDNTD.(0:8)#,  << name type for dir. search >>           02660000
ACBDISP     =ACBDNTD.(8:8)#,  << file disposition >>                    02662000
ACBAMLD     =ACB(38)#,        << access mask & LDEV >>                  02664000
ACBACCESS   =ACBAMLD.(0:8)#,  << access mask >>                         02666000
ACBDADDR    =ACBAMLD.(8:8)#,  << logical device number >>               02668000
                                                                        02670000
ACBSPFL     =ACB(39)#,        << spool control flags >>                 02672000
ACBSPOOL    =ACBSPFL.(0:1)#,  << spooled device flag >>                 02674000
ACBSPOOLIO  =ACBSPFL.(0:2)#,  << spooled IN/OUT >>                      02676000
ACBSPSQ     =ACBSPFL.(2:2)#,  << squeeze flags >>                       02678000
ACBSPSQZ    =ACBSPFL.(2:1)#,  << file squeezed >>                       02680000
ACBSPRSQ    =ACBSPFL.(3:1)#,  << request to sqz >>                      02682000
ACBSPDSQ    =ACBSPFL.(4:1)#,  << squeeze just done>>                    02684000
ACBSPVDEV   =ACBSPFL.(8:8)#,  << spooled virtual device >>              02686000
ACBSPTYRC   =ACB(40)#,        << spooled dev type/recsize>>             02688000
ACBSPTYPE   =ACBSPTYRC.(0:6)#,<< spooled dev type >>                    02690000
ACBSPREC    =ACBSPTYRC.(6:10)#, << spooled dev rec size >>              02692000
ACBSPFOPT   =ACB(41)#,        << spooled dev FOPTIONS >>                02694000
ACBSPAOPT   =ACB(42)#,        << spooled dev AOPTIONS >>                02696000
ACBSPXDDX   =ACB(43)#,        << IDD/ODD index >>                       02698000
ACBNOWAITDA =ACBDBL(23)#,     << No-wait disk address >>       <<*****>>02700000
<< 44-47 are spares. >>                                                 02702000
                                                                        02704000
ACBNOWAITLDEV=ACB(47)#,       << for current extent >>         <<*****>>02706000
ACBBUFPOOL  =ACB(SIZEACB)#,   << buffer pool origin >>                  02708000
                                                                        02710000
BLKIOQX     =BLK#,            << IOQ entry nr. >>                       02712000
BLKFLAGS    =BLK(1).(13:3)#,  << I/O flags >>                           02714000
BLKIOOUT    =BLK(1).(13:1)#,  << last I/O was write? >>                 02716000
BLKDIRTY    =BLK(1).(14:1)#,  << buffer modified? >>                    02718000
BLKIOPEND   =LOG(BLK(1).(15:1))#,  << I/O in progress? >>               02720000
BLKIOCOMP   =BLK(1).(14:2)#,  << I/O complete - not dirty >>            02722000
BLKIOCB     =BLKDBL(1)#,      << IOCB >>                                02724000
BLKLSTAT    =BLK(2)#,         << IOCB - STATUS >>                       02726000
BLKTLOG     =BLK(3)#,         << IOCB - transmission log >>             02728000
BLKBLOCK    =BLKDBL(2)#,      << block number >>                        02730000
BLKDADDR    =BLKDBL(3)#,      << block sector number >>                 02732000
BLKLDEV     =BLK(6).(0:8)#,   << block logical device nr. >>            02734000
BLKEXTBASE   =BLKDBL(4)#,      << extent base of block >>      <<04652>>02736000
BLKEXTSIZE   =BLK(10)#,        << extent size of block >>      <<04652>>02738000
BLKDUMMY     =BLK(11)#,        << * * U N U S E D * *  >>      <<04652>>02740000
BLKBUFFER   =BLK(BLKBUFDISP)#;<< buffer >>                              02742000
DEFINE  <<ACBLSTATE DEFINITIONS>>                                       02744000
ACBEOF      =ACBLSTATE.(1:1)#, << END OF FILE SENSED >>                 02746000
ACBLPCTL    =ACBLSTATE.(2:2)#, << PAGE AND LINE CONTROL >>              02748000
ACBPAGECTL  =ACBLSTATE.(2:1)#, << PAGE CONTROL 0=60 LPP 1=66 LPP >>     02750000
ACBLINECTL  =ACBLSTATE.(3:1)#, << LINE CONTROL 0=POST 1=PRE >>          02752000
ACBSTREAM   =ACBLSTATE.(4:1)#, << STREAM I/O >>                         02754000
ACBFKEYS    =ACBLSTATE.(5:1)#, << RESTORE FUNCTION KEYS >>              02756000
ACBXMITCRLF =ACBLSTATE.(6:1)#, << TRANSMIT CR,LF TO USER BUFFER >>      02758000
ACBTBLOCK   =ACBLSTATE.(7:1)#, << DISABLE TERMINAL BLOCK MODE >>        02760000
ACBBINARYIO =ACBLSTATE.(8:1)#, << EIGHT BIT TERMINAL TRANSFERS >>       02762000
ACBCARRIAGE =ACBLSTATE.(9:1)#, << CARRIAGE CONTROL FLAG >>              02764000
ACBDEFBLOCK =ACBLSTATE.(10:1)#,<< DEFAULT BLOCKING >>                   02766000
ACBREADCODE =ACBLSTATE.(11:4)#,<< INPUT EOF CHECK >>                    02768000
ACBREADTYPE =ACBLSTATE.(11:2)#,<< INPUT EOF TYPE >>                     02770000
ACBREADMODE =ACBLSTATE.(13:2)#;<< INPUT EOF MODE >>                     02772000
                                                                        02774000
DEFINE  <<AOPTIONS DEFINITIONS>>                                        02776000
ACBCOPY         = LOG(ACBAOPTIONS.(3:1))#,<< COPY/REPLICATE >> <<HM.00>>02778000
ACBNOWAIT       = LOG(ACBAOPTIONS.(4:1))#,<< NO-WAIT I/O MODE >>        02780000
ACBMULTAC       = ACBAOPTIONS.(5:2)#,     << MULTI ACCESS MODE>>        02782000
ACBGLOBALMULTAC = ACBAOPTIONS.(6:1)#,     << GLOBAL MULTI >>   <<HM.00>>02784000
ACBINHIBITBUF   = LOG(ACBAOPTIONS.(7:1))#,<< INHIBIT BUFFERING >>       02786000
ACBACMODE       = ACBAOPTIONS.(8:2)#,     << ACCESS MODE >>             02788000
ACBDEFAULT      = (ACBACMODE = 0)#,       << DEFAULT >>                 02790000
ACBEXCLUSIVE    = (ACBACMODE = 1)#,       << EXCLUSIVE >>               02792000
ACBSEMI         = (ACBACMODE = 2)#,       << SEMI-EXCLUSIVE >>          02794000
ACBSHARE        = (ACBACMODE = 3)#,       << SHARE >>                   02796000
ACBLOCKING      = LOG(ACBAOPTIONS.(10:1))#,<< DYNAMIC LOCKING >>        02798000
ACBMULTIREC     = LOG(ACBAOPTIONS.(11:1))#,<< MULTI-RECORD >>           02800000
ACBACTYPE       = ACBAOPTIONS.(12:4)#,    << ACCESS TYPE >>             02802000
ACBREAD         = (ACBACTYPE = 0)#,       << READ ONLY >>               02804000
ACBWRITE        = (ACBACTYPE = 1)#,       << WRITE ONLY - DELETE >>     02806000
ACBWRITESAVE    = (ACBACTYPE = 2)#,       << WRITE ONLY - SAVE >>       02808000
ACBAPPEND       = (ACBACTYPE = 3)#,       << APPEND ONLY >>             02810000
ACBREADWRITE    = (ACBACTYPE = 4)#,       << READ/WRITE >>              02812000
ACBUPDATE       = (ACBACTYPE = 5)#,       << UPDATE ONLY >>             02814000
ACBEXECUTE      = (ACBACTYPE = 6)#;       << EXECUTE ONLY >>            02816000
                                                                        02818000
DEFINE  <<FOPTIONS DEFINITIONS>>                                        02820000
ACBFILETYPE     = ACBFOPTIONS.(2:3)#,     << FILE TYPE >>      <<HM.00>>02822000
ACBFKSAM        = (ACBFFILETYPE=1)#,      << RESERVED FOR KSAM   HM.00>>02824000
ACBRIO          = (ACBFILETYPE=2)#,       << RIO FILE >>       <<HM.00>>02826000
ACBCIRFILE      = (ACBFILETYPE=4)#,       << CIRCULAR FILE >>  <<HM.00>>02828000
ACBMSGFILE      = (ACBFILETYPE=6)#,       << IPC FILE >>       <<HM.00>>02830000
ACBNOEQUATE     = LOG(ACBFOPTIONS.(5:1))#,<< NO FILE EQUATION >>        02832000
ACBUNLABELLED   = NOT LOG(ACBFOPTIONS.(6:1))#,                 <<TL.02>>02834000
ACBLABELLED     = LOG(ACBFOPTIONS.(6:1))#,                     <<TL.02>>02836000
ACBCONTROL      = LOG(ACBFOPTIONS.(7:1))#,<< CARRIAGE CONTROL >>        02838000
ACBFORMAT       = ACBFOPTIONS.(8:2)#,     << RECORD FORMAT >>           02840000
ACBVARFLD       = ACBFOPTIONS.(9:1)#,     << VARIABLE BIT >>            02842000
ACBFIXED        = (ACBFORMAT = 0)#,       << FIXED >>                   02844000
ACBVARIABLE     = (ACBVARFLD = 1)#,       << VARIABLE >>                02846000
ACBNORMVAR      = (ACBFORMAT = 1)#,       << NORMAL VAR >>              02848000
ACBSPECVAR      = (ACBFORMAT = 3)#,       << SPECIAL VAR >>             02850000
ACBUNDEFINED    = (ACBFORMAT = 2)#,       << UNDEFINED >>               02852000
ACBDESIGNATOR   = ACBFOPTIONS.(10:3)#,    << DESIGNATOR TYPE >>         02854000
ACBACTUAL       = (ACBDESIGNATOR = 0)#,   << ACTUAL >>                  02856000
ACBSTDLIST      = (ACBDESIGNATOR = 1)#,   << $STDLIST >>                02858000
ACBNEWPASS      = (ACBDESIGNATOR = 2)#,   << $NEWPASS >>                02860000
ACBOLDPASS      = (ACBDESIGNATOR = 3)#,   << $OLDPASS >>                02862000
ACBSTDIN        = (ACBDESIGNATOR = 4)#,   << $STDIN >>                  02864000
ACBSTDINX       = (ACBDESIGNATOR = 5)#,   << $STDINX >>                 02866000
ACBNULL         = (ACBDESIGNATOR = 6)#,   << $NULL >>                   02868000
ACBASCII        = LOG(ACBFOPTIONS.(13:1))#,<< ASCII/BINARY FORMAT >>    02870000
ACBDOMAIN       = ACBFOPTIONS.(14:2)#,    << FILE DOMAIN >>             02872000
ACBNEW          = (ACBDOMAIN = 0)#,       << NEW >>                     02874000
ACBPERMANENT    = (ACBDOMAIN = 1)#,       << OLD - PERMANENT >>         02876000
ACBTEMPORARY    = (ACBDOMAIN = 2)#,       << OLD - TEMPORARY >>         02878000
ACBOLD          = (ACBDOMAIN = 3)#;       << OLD - EITHER >>            02880000
                                                                        02882000
DEFINE  <<SPOOL DEFINITIONS>>                                           02884000
ACBSPOOLED      = LOG(ACBSPOOL)#;         << SPOOLED DEVICE>>           02886000
                                                                        02888000
DEFINE  <<MISC. DEFINITIONS>>                                           02890000
ACBSTATUSCODE   = [2/CCL,2/CCL,2/CCG,2/CCE,2/CCL]                       02892000
                  &LSR(ACBGSTATUS*2)#;                                  02894000
                                                                        02896000
                                                               <<04517>>02898000
<<**********************************************************>> <<04517>>02900000
<< Used to calculate Q relative location of ACB and FCB     >> <<04517>>02902000
<< ACBMQ is used in calls to LOC'ACB and UNLOC'ACB and FCBMQ>> <<04517>>02904000
<< is used in calls to LOCK'CB.  We must P-Disable our-     >> <<04517>>02906000
<< selves since  the LRA instruction does not work in split >> <<04517>>02908000
<< stack mode if DB moves between instructions.             >> <<04517>>02910000
<<**********************************************************>> <<04517>>02912000
                                                               <<04517>>02914000
DEFINE GET'ACB'Q'LOC =                                         <<04517>>02916000
          PSEUDODISABLE;                                       <<04517>>02918000
          ACBMQ := @ACB - @Q0;                                 <<04517>>02920000
          PSEUDOENABLE#;                                       <<04517>>02922000
                                                               <<04517>>02924000
DEFINE GET'FCB'Q'LOC =                                         <<04517>>02926000
          PSEUDODISABLE;                                       <<04517>>02928000
          FCBMQ := @FCB - @Q0;                                 <<04517>>02930000
          PSEUDOENABLE#;                                       <<04517>>02932000
                                                               <<04517>>02934000
DEFINE GET'FCB'PRIME'Q'LOC =   << Using FCB' instead of FCB >> <<04517>>02936000
          PSEUDODISABLE;                                       <<04517>>02938000
          FCBMQ := @FCB' - @Q0;                                <<04517>>02940000
          PSEUDOENABLE#;                                       <<04517>>02942000
                                                               <<04517>>02944000
<<----------------------------------------------------------------------02946000
*                                                                      *02948000
*  File Control Block (FCB) definitions                                *02950000
*                                                                      *02952000
---------------------------------------------------------------------->>02954000
                                                                        02956000
EQUATE                                                                  02958000
SIZEBFCB    = 36,   << SIZE OF FCB LESS EXTENT MAP >>          <<HM.00>>02960000
SIZEDFCB    = 2*MAXEXTENTS+SIZEBFCB;   << MAXIMUM DISC FCB >>           02962000
                                                                        02964000
DEFINE                                                                  02966000
ALLOCFCB    = PUSH(S); @FCB := TOS+1; ASSEMBLE(ADDS SIZEDFCB)#;         02968000
                                                                        02970000
DEFINE                                                                  02972000
FCBSIZE     =FCB.(2:14)#,     << size of FCB >>                         02974000
SIZEF       =(2:14)#,         << Size field of FCB(0).      >> <<04624>>02976000
FCBNEWFCBV  =FCB(1)#,         << new FCB vector >>                      02978000
FCBFOPTIONS =FCB(2)#,         << FOPTIONS >>                            02980000
FCBDEVICE   =FCB(3)#,         << pos. LDEV or neg. device class index >>02982000
FCBLKST     =FCB(4).(0:2)#,   << previous lock state >>                 02984000
FCBDTYPE    =FCB(4).(2:6)#,   << device type - first extent >>          02986000
FCBCRUNCH   =FCB(4).(8:1)#,   << Pending crunch disposition >> <<04513>>02988000
FCBSUBTYPE  =FCB(4).(12:4)#,  << device sub-type - first extent >>      02990000
FCBOCNTOUT  =FCB(5).(0:8)#,   << # processes accessing - output mode >> 02992000
FCBOCNT     =FCB(5).(8:8)#,   << # processes accessing - any mode >>    02994000
FCBACB      =FCB(6)#,         << creator ACB vector >>                  02996000
FCBRIN      =FCB(7)#,         << RIN # >>                               02998000
FCBEXCLSTAT =FCB(8)#,         << exclusive status >>                    03000000
FCBPVINFO   =FCB (9) #,       <<CLASSFLG,VMASK & MVTABX if PV>><<RV.PV>>03002000
FCBCLASSFLG =FCBPVINFO.(0:1)#,<< CLASSFLG >>                   <<RV.PV>>03004000
FCBMVTABX   =FCBPVINFO.(4:4)#,<< MVTABX >>                     <<RV.PV>>03006000
FCBVMASK    =FCVPVINFO.(8:8)#,<< VMASK >>                      <<RV.PV>>03008000
FCBFLIM     =FCBDBL(5)#,      << maximum # blocks >>                    03010000
FCBIMAGE    =FCBDBL(6)#,      << reserved for IMAGE >>                  03012000
FCBEOF      =FCBDBL(7)#,      << end of data pointer >>                 03014000
FCBUSERLBL  =FCB(16)#,        << user labels >>                         03016000
FCBLBLEOF   =FCB(16).(0:8)#,  << # labels written >>                    03018000
FCBLBL      =FCB(16).(8:8)#,  << # of user labels >>                    03020000
FCBEXTSIZE  =FCB(17)#,        << extent size >>                         03022000
FCBBLKFACT  =FCB(18).(0:8)#,  << blocking factor >>                     03024000
FCBSECTPBLK =FCB(18).(8:8)#,  << sectors per block >>                   03026000
FCBSECTOFF  =FCB(19).(0:8)#,  << sector offset to data >>               03028000
FCBDISP     =FCB (19).(8:3)#, << pending file disposition >>   <<RV.PV>>03030000
FCBNUMEXTS  =FCB(19).(11:5)#, << number of extents - 1>>                03032000
FCBLASTEXTSIZE=FCB(20)#,      << last extent size >>                    03034000
FCBOCNTIN   =FCB(21).(8:8)#,  << # processes accessing - input mode >>  03036000
FCBGN       =FCB(22)#,        << group name >>                          03038000
FCBGN1      =FCBDBL(11)#,     << group name - first half >>             03040000
FCBGN2      =FCBDBL(12)#,     << group name - second half >>            03042000
FCBAN       =FCB(26)#,        << account name >>                        03044000
FCBAN1      =FCBDBL(13)#,     << account name - first half >>           03046000
FCBAN2      =FCBDBL(14)#,     << account name - second half >>          03048000
FCBSTART    =FCBDBL(15)#,     << ABSOLUTE START BLOCK >>       <<HM.00>>03050000
FCBEND      =FCBDBL(16)#,     << VARIABLE LENGTH RECORDS - >>  <<HM.00>>03052000
                              << END BLOCK #, REL TO START BLK   HM.00>>03054000
FCBHDRECS   =FCBDBL(17)#,     << NUMBER OF NONDATA HEADER REC ><<HM.00>>03056000
FCBLABEL    =FCBDBL(18)#,     << FILE LABEL LDEV AND SECTOR NUM<<HM.00>>03058000
FCBLDEV     =FCB(36).(0:8)#,  << FILE LABEL LDEV >>            <<HM.00>>03060000
FCBEXTMAP   =FCB(36)#;        << EXTENT MAP >>                 <<HM.00>>03062000
                                                                        03064000
EQUATE  << FCBSTATE BITS >>                                             03066000
FMOD        =  0;  << FILE MAP MODIFIED >>                              03068000
                                                                        03070000
DEFINE  <<FOPTIONS DEFINITIONS>>                                        03072000
FCBFILETYPE     = FCBFOPTIONS.(2:3)#,     << FILE TYPE >>      <<HM.00>>03074000
FCBKSAM         = (FCBFILETYPE=1)#,       << RESERVED FOR KSAM   HM.00>>03076000
FCBRIO          = (FCBFILETYPE=2)#,           <<RIO FILE>>     <<HM.00>>03078000
FCBCIRFILE      = (FCBFILETYPE=4)#,       << CIRCULAR FILE >>  <<HM.00>>03080000
FCBMSGFILE      = (FCBFILETYPE=6)#,       << IPC FILE >>       <<HM.00>>03082000
FCBNOEQUATE     = LOG(FCBFOPTIONS.(5:1))#,<< NO FILE EQUATION >>        03084000
FCBUNLABELLED   = LOG(FCBFOPTIONS.(6:1))#,<< UNLABELLED TAPE >>         03086000
FCBCONTROL      = LOG(FCBFOPTIONS.(7:1))#,<< CARRIAGE CONTROL >>        03088000
FCBFORMAT       = FCBFOPTIONS.(8:2)#,     << RECORD FORMAT >>           03090000
FCBVARFLD       = FCBFOPTIONS.(9:1)#,     << VARIABLE BIT >>            03092000
FCBFIXED        = (FCBFORMAT = 0)#,       << FIXED >>                   03094000
FCBVARIABLE     = (FCBVARFLD = 1)#,       << VARIABLE >>                03096000
FCBNORMVAR      = (FCBFORMAT = 1)#,       << NORMAL VAR >>              03098000
FCBSPECVAR      = (FCBFORMAT = 3)#,       << SPECIAL VAR >>             03100000
FCBUNDEFINED    = (FCBFORMAT = 2)#,       << UNDEFINED >>               03102000
FCBDESIGNATOR   = FCBFOPTIONS.(10:3)#,    << DESIGNATOR TYPE >>         03104000
FCBACTUAL       = (FCBDESIGNATOR = 0)#,   << ACTUAL >>                  03106000
FCBSTDLIST      = (FCBDESIGNATOR = 1)#,   << $STDLIST >>                03108000
FCBNEWPASS      = (FCBDESIGNATOR = 2)#,   << $NEWPASS >>                03110000
FCBOLDPASS      = (FCBDESIGNATOR = 3)#,   << $OLDPASS >>                03112000
FCBSTDIN        = (FCBDESIGNATOR = 4)#,   << $STDIN >>                  03114000
FCBSTDINX       = (FCBDESIGNATOR = 5)#,   << $STDINX >>                 03116000
FCBNULL         = (FCBDESIGNATOR = 6)#,   << $NULL >>                   03118000
FCBASCII        = LOG(FCBFOPTIONS.(13:1))#,<< ASCII/BINARY FORMAT >>    03120000
FCBDOMAIN       = FCBFOPTIONS.(14:2)#,    << FILE DOMAIN >>             03122000
FCBNEW          = (FCBDOMAIN = 0)#,       << NEW >>                     03124000
FCBPERMANENT    = (FCBDOMAIN = 1)#,       << OLD - PERMANENT >>         03126000
FCBTEMPORARY    = (FCBDOMAIN = 2)#,       << OLD - TEMPORARY >>         03128000
FCBOLD          = (FCBDOMAIN = 3)#;       << OLD - EITHER >>            03130000
                                                                        03132000
<<----------------------------------------------------------------------03134000
*                                                                      *03136000
*  FILE LABEL DEFINITIONS                                              *03138000
*                                                                      *03140000
---------------------------------------------------------------------->>03142000
                                                                        03144000
EQUATE                                                                  03146000
FLSKIP1     =  28,  << LOCK BITS INDEX >>                               03148000
FLSKIP2     =  34,  << CHECKSUM INDEX >>                                03150000
FLSKIP3     =  35,  << COLD LOAD ID INDEX >>                            03152000
HARDFLABERR =   7,  << IRRECOVERABLE LABEL ERROR >>                     03154000
FLABERRNO   = 247;  << MESSAGE CATALOG ENTRY NUMBER >>                  03156000
                                                                        03158000
DEFINE                                                                  03160000
ALLOCFLAB   = PUSH(S); @FLAB := TOS+1; ASSEMBLE(ADDS 128)#,             03162000
LABELDEVICE                                                    <<03578>>03164000
  =ACBLABELLED = 1 AND ACBACCCL = SERIALIO#,                   <<03578>>03166000
CHECKSUM    = TOS := -1;                                                03168000
              X := 127;                                                 03170000
              DO BEGIN                                                  03172000
                 IF X <> FLSKIP1 AND X <> FLSKIP2 AND X <> FLSKIP3 THEN 03174000
                    TOS := TOS XOR LOGICAL(FLAB(X));                    03176000
                 X := X-1                                               03178000
                 END UNTIL <#;                                          03180000
                                                                        03182000
DEFINE                                                                  03184000
FLLOCNAME   =FLAB#,           << local file name >>                     03186000
FLGRPNAME   =FLAB(4)#,        << group name >>                          03188000
FLACCTNAME  =FLAB(8)#,        << account name >>                        03190000
FLUSERID    =FLAB(12)#,       << creating user ID >>                    03192000
FLLOCKWORD  =FLAB(16)#,       << lockword >>                            03194000
FLSECMX     =FLABDBL(10)#,    << security matrix >>                     03196000
FLSECURE    =FLAB(22).(15:1)#,<< file Secure bit >>                     03198000
FLCREATE    =FLAB(23)#,       << create date >>                         03200000
FLLASTACC   =FLAB(24)#,       << last access date >>                    03202000
FLLASTMOD   =FLAB(25)#,       << last modification date >>              03204000
FLFILECODE  =FLAB(26)#,       << file code >>                           03206000
FLFCBVECT   =FLAB(27)#,       << FCB vector >>                          03208000
FLLOCK      =FLAB(28)#,       << lock bits, etc. >>                     03210000
FLSTORE     =FLAB(28).(0:1)#, << file being Stored >>                   03212000
FLRESTORE   =FLAB(28).(1:1)#, << file being Restored >>                 03214000
FLLOAD      =FLAB(28).(2:1)#, << file Loaded >>                         03216000
FLEXCL      =FLAB(28).(3:1)#, << exclusive FOPEN >>                     03218000
FLSR        =FLAB(28).(0:2)#, << Store & Restore bits >>                03220000
FLSRL       =FLAB(28).(0:3)#, << Store, Restore & Load bits >>          03222000
FLSRLX      =FLAB(28).(0:4)#, << Store, Restore, Load & Excl bits >>    03224000
FLSUBTYPE   =FLAB(28).(4:4)#, << sub type >>                            03226000
FLDTYPE     =FLAB(28).(8:6)#, << device type >>                         03228000
FLSTATUS    =FLAB(28).(14:2)#,<< Write/Read status >>                   03230000
FLUSERLBL   =FLAB(29)#,       << user label >>                          03232000
FLLBLEOF    =FLAB(29).(0:8)#, << # lbls written >>                      03234000
FLLBL       =FLAB(29).(8:8)#, << # of user labels >>                    03236000
FLFLIM      =FLABDBL(15)#,    << file limit >>                          03238000
FLPVINFO    =FLAB (33) #,     << PVINFO from mount >>          <<00188>>03240000
FLMVTABX    =FLPVINFO.(4:4) #,<< Mounted Vol Table index >>    <<00188>>03242000
FLCHECKSUM  =FLAB(34)#,       << file label checksum >>                 03244000
FLCLID      =FLAB(35)#,       << Cold Load ID >>                        03246000
FLFOPTIONS  =FLAB(36)#,       << FOPTIONS >>                            03248000
FLRECSIZE   =FLAB(37)#,       << record size, -bytes >>                 03250000
FLBLKSIZE   =FLAB(38)#,       << block size, words >>                   03252000
FLSECTOFF   =FLAB(39).(0:8)#, << sector offset to data >>               03254000
FLNUMEXTS   =FLAB(39).(11:5)#,<< number of extents - 1 >>               03256000
FLLASTEXTSIZE=FLAB(40)#,      << last extent size, sectors >>           03258000
FLEXTSIZE   =FLAB(41)#,       << extent size, sectors >>                03260000
FLEOF       =FLABDBL(21)#,    << end-of-data pointer, records >>        03262000
FLLABEL     =FLABDBL(22)#,    << file label VTAB and sector number >>   03264000
FLVTAB      =FLAB(44).(0:8)#, << file label VTAB index >>               03266000
FLEXTMAP    =FLAB(44)#,       << origin of Extent map >>                03268000
FLALLOCTIME =FLABDBL(54)#,    << Restore time >>               <<00630>>03270000
FLALLOCDATE =FLAB(110)#,      << Restore date >>               <<00630>>03272000
FLSTART     =FLABDBL(56)#,    << ABSOLUTE FIRST DATA BLOCK       HM.00>>03274000
FLEND       =FLABDBL(57)#,    << VAR LENGTH RECORDS ONLY - END   HM.00>>03276000
                              << NUMBER RELATIVE TO START BLOCK  HM.00>>03278000
FLHDRECS    =FLABDBL(58)#,    << NUMBER OF HEADER RECS >>      <<HM.00>>03280000
FLDEVNAME   =FLAB(124)#;      << device specification name >>           03282000
                                                                        03284000
DEFINE  <<FOPTIONS DEFINITIONS>>                                        03286000
FLFILETYPE      = FLFOPTIONS.(2:3)#,      << FILE TYPE >>      <<HM.00>>03288000
FLKSAM          = (FLFILETYPE=1)#,        << RESERVED FOR KSAM   HM.00>>03290000
FLRIO           = (FLFILETYPE=2)#,           <<RIO FILE>>      <<HM.00>>03292000
FLCIRFILE       = (FLFILETYPE=4)#,        << CIRCULAR FILE >>  <<HM.00>>03294000
FLMSGFILE       = (FLFILETYPE=6)#,        << IPC FILE >>       <<HM.00>>03296000
FLNOEQUATE      = LOG(FLFOPTIONS.(5:1))#, << NO FILE EQUATION >>        03298000
FLUNLABELLED    = LOG(FLFOPTIONS.(6:1))#, << UNLABELLED TAPE >>         03300000
FLCONTROL       = LOG(FLFOPTIONS.(7:1))#, << CARRIAGE CONTROL >>        03302000
FLFORMAT        = FLFOPTIONS.(8:2)#,      << RECORD FORMAT >>           03304000
FLVARFLD        = FLFOPTIONS.(9:1)#,      << VARIABLE BIT >>            03306000
FLFIXED         = (FLFORMAT = 0)#,        << FIXED >>                   03308000
FLVARIABLE      = (FLVARFLD = 1)#,        << VARIABLE >>                03310000
FLNORMVAR       = (FLFORMAT = 1)#,        << NORMAL VAR >>              03312000
FLSPECVAR       = (FLFORMAT = 3)#,        << SPECIAL VAR >>             03314000
FLUNDEFINED     = (FLFORMAT = 2)#,        << UNDEFINED >>               03316000
FLDESIGNATOR    = FLFOPTIONS.(10:3)#,     << DESIGNATOR TYPE >>         03318000
FLACTUAL        = (FLDESIGNATOR = 0)#,    << ACTUAL >>                  03320000
FLSTDLIST       = (FLDESIGNATOR = 1)#,    << $STDLIST >>                03322000
FLNEWPASS       = (FLDESIGNATOR = 2)#,    << $NEWPASS >>                03324000
FLOLDPASS       = (FLDESIGNATOR = 3)#,    << $OLDPASS >>                03326000
FLSTDIN         = (FLDESIGNATOR = 4)#,    << $STDIN >>                  03328000
FLSTDINX        = (FLDESIGNATOR = 5)#,    << $STDINX >>                 03330000
FLNULL          = (FLDESIGNATOR = 6)#,    << $NULL >>                   03332000
FLASCII         = LOG(FLFOPTIONS.(13:1))#,<< ASCII/BINARY FORMAT >>     03334000
FLDOMAIN        = FLFOPTIONS.(14:2)#,     << FILE DOMAIN >>             03336000
FLNEW           = (FLDOMAIN = 0)#,        << NEW >>                     03338000
FLPERMANENT     = (FLDOMAIN = 1)#,        << OLD - PERMANENT >>         03340000
FLTEMPORARY     = (FLDOMAIN = 2)#,        << OLD - TEMPORARY >>         03342000
FLOLD           = (FLDOMAIN = 3)#;        << OLD - EITHER >>            03344000
                                                                        03346000
<<-------------------------------------------------------------  DS.00  03348000
*                                                             *  DS.00  03350000
*   REMOTE FILE ACCESS DEFINITIONS                            *  DS.00  03352000
*                                                             *  DS.00  03354000
---------------------------------------------------------------  DS.00>>03356000
                                                                        03358000
EQUATE                                                         <<DS.00>>03360000
DSDUMMYDEV     = 41, << DEVICE TYPE OF DS DUMMY >>             <<DS.00>>03362000
RFAMSG         = 7,  << MESSAGE TYPE >>                        <<DS.00>>03364000
RFASTREAM      = %20,<< STREAM TYPE >>                         <<DS.00>>03366000
RFASUBSTR      = 0;  << SUBSTREAM TYPE >>                      <<DS.00>>03368000
                                                               <<DS.00>>03370000
DEFINE                                                         <<DS.00>>03372000
ALLOCBUF       = PUSH(S); X := (TOS+1)&LSL(1)#,                <<DS.00>>03374000
ALLOCRFABUF    = PUSH(S); @RFAPTR := TOS+1#,                   <<DS.00>>03376000
CC             = (6:2)#, << COND. CODE BITS OF STATUS >>       <<DS.00>>03378000
CHECKXFER      = IF <> THEN                                    <<DS.00>>03380000
                 BEGIN                                         <<DS.00>>03382000
                    TOS := 0;                                  <<DS.00>>03384000
                    TOS := RFALINE;                            <<DS.00>>03386000
                    TOS := DSCHKPLABEL;                        <<DS.00>>03388000
                    ASMB(PCAL 0);                              <<DS.00>>03390000
$                   IF X1 = ON                                 <<DS.00>>03392000
                    IF <> THEN FTROUBLE(486);                  <<KJ.03>>03394000
$                   IF                                         <<DS.00>>03396000
                    TOS := CCL;                                <<DS.00>>03398000
                    GO EXIT;                                   <<DS.00>>03400000
                 END#,                                         <<DS.00>>03402000
DELAPPENDAGE   = TOS := RFALEN-1; ASSEMBLE(SUBS 0)#,           <<DS.00>>03404000
FTYPE          = AFTE.(0:4)#, << FILE TYPE FROM AFT >>         <<DS.03>>03406000
FTYPE'OF'TOS = TOS.(0:4)#,                                     <<+1.C3>>03408000
GETMWCPARMS    = TOS := 0;  TOS := RFALINE;  TOS := RFAMSG;    <<DS.00>>03410000
                 TOS := RFASTREAM;  TOS := RFASUBSTR;          <<DS.00>>03412000
                 TOS := @RFAPTR;  TOS := RFALEN#,              <<DS.00>>03414000
LOAD'ERROR    = TOS := TOS LOR LOCAL'FAILURE&LSL(8)#,          <<DS.04>>03416000
MWCNOBUF       = GETMWCPARMS;  TOS := 0D;  TOS := 0D;          <<DS.00>>03418000
                 TOS := MWCPLABEL;  ASMB(PCAL 0); DEL#,        <<DS.00>>03420000
DSCHKPLABEL    = ABS(DSCHKPLABL)#,                             <<DS.00>>03422000
DSOPENPLABEL   = ABS(DSOPENPLABL)#,                            <<DS.00>>03424000
DSCLOSEPLABEL  = ABS(DSCLOSEPLABL)#,                           <<DS.00>>03426000
MWCPLABEL      = ABS(MANWCPLABL)#,                             <<DS.00>>03428000
SDSLDEVPLABEL = ABS(SDSLDEVLABEL)#,                            <<DS.04>>03430000
PREPRETURN     = TOS := TOS.CC; ASSEMBLE(ZERO,XCH)#,           <<DS.00>>03432000
RFAFILE        = PACBV.(0:8)#,                                 <<DS.00>>03434000
RFALINE        = PACBV.(8:8)#,                                 <<DS.00>>03436000
RFAMREC        = LOGICAL(AFTE)#, << RFA MULTI-REC FILE >>      <<DS.03>>03438000
SETRFAPTR      = DSTX := EXCHANGEDB(0);                        <<DS.00>>03440000
                 ALLOCRFABUF;                                  <<DS.00>>03442000
                 DSTX := EXCHANGEDB(DSTX)#;                    <<DS.00>>03444000
                                                               <<DS.00>>03446000
<<-------------------------------------------------------------  RV.PV  03448000
*                                                             *  RV.PV  03450000
*  DIRECTORY ENTRY DEFINITIONS                                *  RV.PV  03452000
*                                                             *  RV.PV  03454000
---------------------------------------------------------------  RV.PV>>03456000
                                                               <<RV.PV>>03458000
EQUATE                                                         <<RV.PV>>03460000
                                                               <<RV.PV>>03462000
   NAMESIZE        = 4,                                        <<RV.PV>>03464000
                                                               <<RV.PV>>03466000
<<GROUP ENTRY>>                                                <<RV.PV>>03468000
   GNAME           = 0,                  <<NAME>>              <<RV.PV>>03470000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX>>        <<RV.PV>>03472000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>          <<RV.PV>>03474000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>   <<RV.PV>>03476000
   GDFSLIMIT       = GDFSCOUNT+2,                              <<RV.PV>>03478000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>          <<RV.PV>>03480000
   GCPULIMIT       = GCPUCOUNT+2,                              <<RV.PV>>03482000
   GCONTIMECOUNT   = GCPULIMIT+2,                              <<RV.PV>>03484000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                          <<RV.PV>>03486000
   GSEC            = GCONTIMELIMIT+2,                          <<RV.PV>>03488000
   GPURGEFLAGW     = GSEC,                                     <<RV.PV>>03490000
   GCAP            = GSEC +2,                                  <<RV.PV>>03492000
   GLINKAGE        = GCAP+1,                                   <<RV.PV>>03494000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<RV.PV>>03496000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<RV.PV>>03498000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<RV.PV>>03500000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<RV.PV>>03502000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<RV.PV>>03504000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,<<SAVES GFIPNTR>>     <<RV.PV>>03506000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,      <<MOUNT USE COUNTER>> <<RV.PV>>03508000
   GSPARE          = GMOUNTREFCNTR+1,                          <<RV.PV>>03510000
   GSIZE           = GSPARE+1;                                 <<RV.PV>>03512000
<<GLINKAGE DEFINITIONS>>                                       <<RV.PV>>03514000
DEFINE                                                         <<RV.PV>>03516000
   PVF             = 0:1 #,                                    <<RV.PV>>03518000
   MVTABXF         = 8:8 #;                                    <<RV.PV>>03520000
EQUATE                                                         <<RV.PV>>03522000
   PV              = 1;                                        <<RV.PV>>03524000
<<----------------------------------------------------------------------03526000
*                                                                      *03528000
*  FORWARD PROCEDURE DECLARATIONS                                      *03530000
*                                                                      *03532000
---------------------------------------------------------------------->>03534000
                                                                        03536000
PROCEDURE DELACB (PACBV,LACBV,ACCESS'TYPE);                    <<04796>>03540000
   VALUE PACBV,LACBV,ACCESS'TYPE;                              <<04796>>03542000
   INTEGER PACBV,LACBV,ACCESS'TYPE;                            <<04796>>03544000
   OPTION FORWARD,VARIABLE;                                    <<04796>>03546000
DOUBLE PROCEDURE DISCSIZE(LDEV);                               <<01115>>03548000
   VALUE LDEV;                                                 <<01115>>03550000
   INTEGER LDEV;                                               <<01115>>03552000
   OPTION FORWARD;                                             <<01115>>03554000
PROCEDURE FGETCB (NEWVECTOR,DST,CB,VECTOR,FLAGS,S1,O1,S2,O2);  <<01393>>03556000
   VALUE NEWVECTOR,DST,CB,VECTOR,FLAGS,S1,O1,S2,O2;            <<01393>>03558000
   INTEGER NEWVECTOR,DST,VECTOR,S1,O1,S2,O2;                   <<01393>>03560000
   INTEGER POINTER CB;                                         <<01175>>03562000
   LOGICAL FLAGS;                                              <<01175>>03564000
   OPTION FORWARD,VARIABLE;                                    <<01393>>03566000
INTEGER PROCEDURE FCLEAR (ASCII,DADDR,SECTADDR,NUM);                    03568000
   VALUE ASCII,DADDR,SECTADDR,NUM;                                      03570000
   LOGICAL ASCII,DADDR,NUM;                                             03572000
   DOUBLE SECTADDR;                                                     03574000
   OPTION FORWARD;                                                      03576000
PROCEDURE FCLOSE (FILENUM,DISP,SECCODE);                                03578000
   VALUE FILENUM,DISP,SECCODE;                                          03580000
   INTEGER FILENUM,DISP,SECCODE;                                        03582000
   OPTION FORWARD;                                                      03584000
PROCEDURE FDELETECB (VECTOR);                                           03586000
   VALUE VECTOR;                                                        03588000
   INTEGER VECTOR;                                                      03590000
   OPTION FORWARD;                                                      03592000
PROCEDURE FRELCB (DST,VECTOR,FLAGS);                                    03594000
   VALUE DST,VECTOR,FLAGS;                                              03596000
   INTEGER DST,VECTOR;                                                  03598000
   LOGICAL FLAGS;                                                       03600000
   OPTION FORWARD;                                                      03602000
LOGICAL PROCEDURE FREPLY (MESSAGE,LENGTH);                              03604000
   VALUE LENGTH;                                                        03606000
   BYTE ARRAY MESSAGE;                                                  03608000
   INTEGER LENGTH;                                                      03610000
   OPTION FORWARD;                                                      03612000
PROCEDURE FTITLE (T1,T2,T3,T4);                                         03614000
   VALUE T1,T2,T3,T4;                                                   03616000
   DOUBLE T1,T2,T3,T4;                                                  03618000
   OPTION FORWARD;                                                      03620000
PROCEDURE FTROUBLE (CODE);                                              03622000
   VALUE CODE;                                                          03624000
   INTEGER CODE;                                                        03626000
   OPTION FORWARD;                                                      03628000
PROCEDURE FUNLOCKCB (CBL,FLAGS);                                        03630000
   VALUE CBL,FLAGS;                                                     03632000
   INTEGER POINTER CBL;                                                 03634000
   LOGICAL FLAGS;                                                       03636000
   OPTION FORWARD;                                                      03638000
INTEGER PROCEDURE FLABIO(LDEV,SECT,FUNC,FLAB);                 <<00.06>>03640000
   VALUE   LDEV,SECT,FUNC;                                     <<00.06>>03642000
   INTEGER LDEV,FUNC;                                          <<00.06>>03644000
   DOUBLE  SECT;                                               <<00.06>>03646000
   INTEGER ARRAY FLAB;                                         <<00.06>>03648000
   OPTION  FORWARD;                                            <<00.06>>03650000
PROCEDURE FLABIOERR(FLAG,FN,FGA);                              <<00.06>>03652000
   VALUE   FLAG,FN,FGA;                                        <<00.06>>03654000
   LOGICAL FLAG;                                               <<00.06>>03656000
   INTEGER FN,FGA;                                             <<00.06>>03658000
   OPTION  FORWARD,VARIABLE;                                   <<00.06>>03660000
INTEGER PROCEDURE GETBLKSIZE(RECSIZE,BLKFACT,FOPS);            <<00630>>03662000
   VALUE RECSIZE,BLKFACT,FOPS;                                 <<00630>>03664000
   INTEGER RECSIZE,BLKFACT;                                    <<00630>>03666000
   LOGICAL FOPS; OPTION FORWARD;                               <<00630>>03668000
INTEGER PROCEDURE SCANFMAVT (FLAG,ONE,TWO,VECT);                        03670000
   VALUE FLAG,ONE,TWO,VECT;                                             03672000
   INTEGER FLAG,ONE,TWO,VECT;                                           03674000
   OPTION FORWARD;                                                      03676000
INTEGER PROCEDURE KOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,      <<KS.00>>03678000
   RECSIZE,DEVICE,FORMMSG,USERLABELS,BLOCKFACTOR,PRICOPBUFS,   <<KS.00>>03680000
   FILESIZE,NUMEXTENTS,INITALLOC,FILECODE);                    <<KS.00>>03682000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,USERLABELS,BLOCKFACTOR,     <<KS.00>>03684000
   PRICOPBUFS,FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;          <<KS.00>>03686000
   BYTE ARRAY FORMDESIGNATOR,DEVICE,FORMMSG;                   <<KS.00>>03688000
   LOGICAL FOPTIONS,AOPTIONS;                                  <<KS.00>>03690000
   INTEGER RECSIZE,USERLABELS,BLOCKFACTOR,PRICOPBUFS,          <<KS.00>>03692000
   NUMEXTENTS,INITALLOC,FILECODE;                              <<KS.00>>03694000
   DOUBLE FILESIZE;                                            <<KS.00>>03696000
   OPTION EXTERNAL;                                            <<KS.00>>03698000
PROCEDURE KCLOSE(FN,DISP,SEC);                                 <<KS.00>>03700000
   VALUE FN,DISP,SEC;                                          <<KS.00>>03702000
   INTEGER FN,DISP,SEC;                                        <<KS.00>>03704000
   OPTION EXTERNAL;                                            <<KS.00>>03706000
PROCEDURE KFCLOSE(FN,DISP,SEC);<<SECONDARY ENTRY TO FCLOSE>>   <<KS.00>>03708000
   VALUE FN,DISP,SEC;                                          <<KS.00>>03710000
   INTEGER FN,DISP,SEC;                                        <<KS.00>>03712000
   OPTION FORWARD;                                             <<KS.00>>03714000
PROCEDURE FFILEINFO (FILENUM, ITEMNUM1, ITEMVAL1,              <<01425>>03716000
                     ITEMNUM2, ITEMVAL2, ITEMNUM3, ITEMVAL3,   <<01425>>03718000
                     ITEMNUM4, ITEMVAL4, ITEMNUM5, ITEMVAL5);  <<01425>>03720000
   VALUE FILENUM, ITEMNUM1, ITEMNUM2, ITEMNUM3, ITEMNUM4,      <<01425>>03722000
         ITEMNUM5;                                             <<01425>>03724000
   INTEGER FILENUM, ITEMNUM1, ITEMNUM2, ITEMNUM3, ITEMNUM4,    <<01425>>03726000
           ITEMNUM5;                                           <<01425>>03728000
   BYTE ARRAY ITEMVAL1, ITEMVAL2, ITEMVAL3, ITEMVAL4,          <<01425>>03730000
              ITEMVAL5;                                        <<01425>>03732000
   OPTION VARIABLE, EXTERNAL;                                  <<01425>>03734000
PROCEDURE FGETINFO(FILENUM,FILENAME,FOPTIONS,AOPTIONS,         <<KS.00>>03736000
   RECSIZE,DEVTYPE,LDNUM,HDADDR,FILECODE,RECPTR,EOF,           <<KS.00>>03738000
   FLIMIT,LOGCOUNT,PHYSCOUNT,BLKSIZE,EXTSIZE,                  <<KS.00>>03740000
   NUMEXTENTS,USERLABELS,CREATORID,DISKADR);                   <<KS.00>>03742000
   VALUE FILENUM;                                              <<KS.00>>03744000
   INTEGER FILENUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,           <<KS.00>>03746000
   NUMEXTENTS,USERLABELS;                                      <<KS.00>>03748000
   BYTE ARRAY FILENAME,CREATORID;                              <<KS.00>>03750000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;             <<KS.00>>03752000
   DOUBLE RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,DISKADR;        <<KS.00>>03754000
   OPTION VARIABLE,EXTERNAL;           <<>>                             03756000
                                                               <<KS.00>>03758000
PROCEDURE FREADLABEL(FN,TARGET,TCOUNT,LBL);                    <<SP.11>>03760000
   VALUE FN,TCOUNT,LBL;                                        <<SP.11>>03762000
   INTEGER FN,TCOUNT,LBL;                                      <<SP.11>>03764000
   ARRAY TARGET;                                               <<SP.11>>03766000
   OPTION VARIABLE,EXTERNAL;           <<>>                             03768000
                                                               <<SP.11>>03770000
PROCEDURE FWRITELABEL(FN,TARGET,TCOUNT,LBL);                   <<SP.11>>03772000
   VALUE FN,TCOUNT,LBL;                                        <<SP.11>>03774000
   INTEGER FN,TCOUNT,LBL;                                      <<SP.11>>03776000
   ARRAY TARGET;                                               <<SP.11>>03778000
   OPTION VARIABLE,EXTERNAL;           <<>>                             03780000
                                                               <<04679>>03782000
PROCEDURE FSCLOSE(FILENUM,DISP,SEC);                           <<04679>>03784000
VALUE FILENUM,DISP,SEC;                                        <<04679>>03786000
INTEGER FILENUM,DISP,SEC;                                      <<04679>>03788000
OPTION FORWARD;                                                <<04679>>03790000
                                                               <<04679>>03792000
                                                               <<SP.11>>03794000
<<----------------------------------------------------------------------03796000
*                                                                      *03798000
*  EXTERNAL PROCEDURE DECLARATIONS                                     *03800000
*                                                                      *03802000
---------------------------------------------------------------------->>03804000
                                                                        03806000
PROCEDURE ABORTIOX (IOQX);                                     <<+0.05>>03808000
   VALUE IOQX;                                                 <<+0.05>>03810000
   INTEGER IOQX;                                               <<+0.05>>03812000
   OPTION EXTERNAL;                                            <<+0.05>>03814000
LOGICAL PROCEDURE ACCCHECK(LEVEL,AN,ASEC,GN,GSEC,CREATOR,FSEC,USERINFO);03816000
   VALUE LEVEL,ASEC,GSEC,FSEC;                                          03818000
   INTEGER LEVEL;                                                       03820000
   BYTE ARRAY AN,GN;                                                    03822000
   BYTE ARRAY CREATOR;                                                  03824000
   LOGICAL ASEC;                                                        03826000
   DOUBLE GSEC,FSEC;                                                    03828000
   BYTE ARRAY USERINFO;                                                 03830000
   OPTION VARIABLE,EXTERNAL;                                            03832000
INTEGER PROCEDURE ADDJTENTRY (N1,N2,N3,TNO,SIZE,INFO);                  03834000
   VALUE SIZE,TNO;                                                      03836000
   BYTE ARRAY N1,N2,N3;                                                 03838000
   INTEGER SIZE,TNO;                                                    03840000
   INTEGER ARRAY INFO;                                                  03842000
   OPTION EXTERNAL;                                                     03844000
INTEGER PROCEDURE ALLOCATE (INDEX,OLD,OUTPRI,ID,JMPIN,FORMMSG,          03846000
         JNUM,COPIES,DEVINFO,XDDADR,ACCESSTYPE);                        03848000
   VALUE   INDEX,OLD,OUTPRI,JMPIN,JNUM,COPIES;                          03850000
   INTEGER INDEX,OUTPRI,JMPIN,JNUM,COPIES,ACCESSTYPE;                   03852000
   LOGICAL OLD;                                                         03854000
   INTEGER ARRAY   ID,DEVINFO;                                          03856000
   INTEGER POINTER XDDADR;                                              03858000
   BYTE ARRAY      FORMMSG;                                             03860000
   OPTION EXTERNAL;                                                     03862000
INTEGER PROCEDURE ALLORIN (RCODE,USNAM,RPASS);                          03864000
   VALUE RCODE;                                                         03866000
   ARRAY USNAM,RPASS;                                                   03868000
   INTEGER RCODE;                                                       03870000
   OPTION VARIABLE,EXTERNAL;                                            03872000
LOGICAL PROCEDURE ALTDSEGSIZE (DSTX,SIZE);                              03874000
   VALUE DSTX,SIZE;                                                     03876000
   INTEGER DSTX,SIZE;                                                   03878000
   OPTION EXTERNAL;                                                     03880000
INTEGER PROCEDURE ALTPXFILESIZE (NEWSIZE);                              03882000
   VALUE NEWSIZE;                                                       03884000
   INTEGER NEWSIZE;                                                     03886000
   OPTION EXTERNAL;                                                     03888000
DOUBLE PROCEDURE ATTACHIO (LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);  03890000
   VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     03892000
   INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                   03894000
   OPTION EXTERNAL;                                                     03896000
INTEGER PROCEDURE CALENDAR;                                             03898000
   OPTION EXTERNAL;                                                     03900000
PROCEDURE CLEARWAKE (IOQX);                                             03902000
   VALUE IOQX;                                                          03904000
   INTEGER IOQX;                                                        03906000
   OPTION EXTERNAL;                                                     03908000
PROCEDURE CLEARWWS;                                                     03910000
   OPTION EXTERNAL;                                                     03912000
INTEGER PROCEDURE CREATETLTENT(FMSG,ID,FILNUM,ACCTYP,DENS);    <<02568>>03916000
   VALUE FILNUM,ACCTYP,DENS;                                   <<02568>>03918000
   INTEGER FILNUM,ACCTYP,DENS;                                 <<02568>>03920000
  BYTE ARRAY FMSG;                                             <<TL.02>>03922000
  ARRAY ID;                                                    <<TL.02>>03924000
  OPTION EXTERNAL;                                             <<TL.02>>03926000
                                                               <<TL.02>>03930000
PROCEDURE CLEANLDEV(DADDR);                                    <<TL.02>>03932000
  VALUE DADDR;                                                 <<02577>>03934000
  INTEGER DADDR;                                               <<TL.02>>03936000
  OPTION EXTERNAL;                                             <<TL.02>>03938000
                                                               <<TL.02>>03940000
INTEGER PROCEDURE CHECKUL(FN,CODE,FUNC);                       <<02688>>03942000
  VALUE FN,CODE,FUNC;                                          <<02549>>03944000
  INTEGER FN,CODE,FUNC;                                        <<02549>>03946000
  OPTION EXTERNAL;                                             <<TL.02>>03948000
                                                               <<TL.02>>03950000
INTEGER PROCEDURE POSITION(LDEV,FNUM,BLKFACT,RSIZ,FOPS,AOPS);  <<02549>>03954000
   VALUE LDEV,FNUM,AOPS;                                       <<02549>>03956000
   INTEGER LDEV,FNUM,BLKFACT,RSIZ;                             <<02549>>03958000
   LOGICAL FOPS,AOPS;                                          <<02549>>03960000
  OPTION EXTERNAL;                                             <<TL.02>>03962000
                                                               <<TL.02>>03964000
DOUBLE PROCEDURE WRITE'DENSITY(LDEV);                          <<02653>>03966000
   VALUE LDEV;                                                 <<02568>>03968000
   INTEGER LDEV;                                               <<02568>>03970000
   OPTION EXTERNAL;                                            <<02568>>03972000
                                                               <<02568>>03974000
PROCEDURE SET'LPDT'BOT(LDEV,VAL);                              <<02568>>03976000
   VALUE LDEV,VAL;                                             <<02568>>03978000
   INTEGER LDEV,VAL;                                           <<02568>>03980000
   OPTION EXTERNAL;                                            <<02568>>03982000
                                                               <<02568>>03984000
PROCEDURE STORE'DENSITY(LDEV,BUFFER,MODE);                     <<02568>>03986000
   VALUE LDEV,MODE;                                            <<02568>>03988000
   INTEGER LDEV,MODE;                                          <<02568>>03990000
   ARRAY BUFFER;                                               <<02568>>03992000
   OPTION EXTERNAL;                                            <<02568>>03994000
                                                               <<02568>>03996000
PROCEDURE DEALLOCATE (XDEV);                                            03998000
   VALUE   XDEV;                                                        04000000
   INTEGER XDEV;                                                        04002000
   OPTION EXTERNAL;                                                     04004000
PROCEDURE DEALLORIN (RINNUM,USNAM);                                     04006000
   VALUE RINNUM;                                                        04008000
   INTEGER RINNUM;                                                      04010000
   ARRAY USNAM;                                                         04012000
   OPTION VARIABLE,EXTERNAL;                                            04014000
PROCEDURE DEBUG;                                                        04016000
   OPTION EXTERNAL;                                                     04018000
LOGICAL PROCEDURE DEVICESTATUS (LDEV);                                  04020000
   VALUE LDEV;                                                          04022000
   INTEGER LDEV;                                                        04024000
   OPTION EXTERNAL;                                                     04026000
DOUBLE PROCEDURE DIRECADJUST (NUMSECTS,DUMMY,AN,GN,MVTABX);    <<39.PV>>04028000
   VALUE NUMSECTS,DUMMY,MVTABX;                                <<39.PV>>04030000
   DOUBLE NUMSECTS;                                                     04032000
   INTEGER DUMMY,MVTABX;                                       <<39.PV>>04034000
   ARRAY AN,GN;                                                         04036000
   OPTION EXTERNAL,VARIABLE;                                   <<39.PV>>04038000
DOUBLE PROCEDURE DIRECFINDFILE (TYPE,LINKAGE'INDEXP,AN,        <<38.PV>>04040000
                                GN,FN,PRETURN,MVTABX);         <<38.PV>>04042000
   VALUE TYPE,LINKAGE'INDEXP,MVTABX;                           <<38.PV>>04044000
   INTEGER TYPE,MVTABX;                                        <<38.PV>>04046000
   DOUBLE  LINKAGE'INDEXP;                                              04048000
   ARRAY AN,GN,FN,PRETURN;                                              04050000
   OPTION EXTERNAL,VARIABLE;                                   <<38.PV>>04052000
DOUBLE PROCEDURE DIRECINSERTFILE (NUMSECTS, DUMMY, AN, GN,     <<38.PV>>04054000
                                  FN, FADDR, MVTABX);          <<RV.PV>>04056000
   VALUE NUMSECTS, DUMMY, FADDR, MVTABX;                       <<38.PV>>04058000
   DOUBLE NUMSECTS,FADDR;                                               04060000
   INTEGER DUMMY, MVTABX;                                      <<38.PV>>04062000
   ARRAY AN,GN,FN;                                                      04064000
   OPTION EXTERNAL, VARIABLE;                                  <<RV.PV>>04066000
DOUBLE PROCEDURE DIRECPURGEFILE (NUMSECTS, DUMMY, AN,          <<38.PV>>04068000
                                 GN, FN, MVTABX);              <<38.PV>>04070000
   VALUE NUMSECTS, DUMMY, MVTABX;                              <<38.PV>>04072000
   DOUBLE NUMSECTS;                                                     04074000
   INTEGER DUMMY, MVTABX;                                      <<38.PV>>04076000
   ARRAY AN,GN,FN;                                                      04078000
   OPTION EXTERNAL, VARIABLE;                                  <<21.PV>>04080000
DOUBLE PROCEDURE DIRECRESETFILE (NUMSECTS, DUMMY, AN, GN,      <<00088>>04082000
                                 FN, FADDR, MVTABX);           <<00088>>04084000
   VALUE NUMSECTS, DUMMY, FADDR, MVTABX;                       <<00088>>04086000
   DOUBLE NUMSECTS,FADDR;                                      <<00088>>04088000
   INTEGER DUMMY, MVTABX;                                      <<00088>>04090000
   ARRAY AN,GN,FN;                                             <<00088>>04092000
   OPTION EXTERNAL, VARIABLE; <<'INSERTFILE SANS SECURITY CHK>><<00088>>04094000
PROCEDURE DIRECSETFLAG (TYPE,LINKAGE'INDEXP,AN,GN,FN,MVTABX);  <<38.PV>>04096000
   VALUE TYPE,LINKAGE'INDEXP,MVTABX;                           <<38.PV>>04098000
   INTEGER TYPE,MVTABX;                                        <<38.PV>>04100000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>04102000
   ARRAY AN,GN,FN;                                             <<32.PV>>04104000
   OPTION EXTERNAL,VARIABLE;                                   <<32.PV>>04106000
INTEGER PROCEDURE DISKALLOC (INDEX,NUMEXT,SPACEDATA,PVINFO);   <<RH.PV>>04108000
   VALUE INDEX,NUMEXT,PVINFO;                                  <<RH.PV>>04110000
   INTEGER INDEX,NUMEXT;                                       <<RH.PV>>04112000
   LOGICAL PVINFO;                                             <<RH.PV>>04114000
   DOUBLE ARRAY SPACEDATA;                                              04116000
   OPTION EXTERNAL;                                                     04118000
   COMMENT  RETURNS OPERATION STATUS AS RESULT:                         04120000
      0 - OK                                                            04122000
      1 - Space not available                                  ((DFS00))04124000
      2 - I/O or other error                                   ((DFS00))04126000
      3 - Free space allocation disabled on this ldev          ((DFS00))04128000
      4 - Device not available                                 ((DFS00))04130000
      5 - INVALID INDEX;                                                04132000
INTEGER PROCEDURE DISKDEALLOC (EXTSIZE,LASTEXTSIZE,NUMEXT,MAP);         04134000
   VALUE EXTSIZE,LASTEXTSIZE,NUMEXT;                                    04136000
   INTEGER EXTSIZE,LASTEXTSIZE,NUMEXT;                                  04138000
   DOUBLE ARRAY MAP;                                                    04140000
   OPTION EXTERNAL;                                                     04142000
   COMMENT  RETURNS OPERATION STATUS AS RESULT:                         04144000
      LEFT BYTE:                                                        04146000
         MAP ENTRY INDEX                                                04148000
      RIGHT BYTE:                                                       04150000
         0 - OK                                                         04152000
         1 - MISC. I/O ERROR                                            04154000
         2 - INVALID NUMBER OF SECTORS                                  04156000
         4 - INVALID SECTOR NUMBER                                      04158000
         5 - FREE SPACE TABLE FULL;                                     04160000
PROCEDURE ERROREXIT (WORDS,ERROR,ZERO);                                 04164000
   VALUE WORDS,ERROR,ZERO;                                              04166000
   INTEGER WORDS,ERROR,ZERO;                                            04168000
   OPTION EXTERNAL;                                                     04170000
PROCEDURE ERRORON;                                                      04172000
   OPTION EXTERNAL;                                                     04174000
LOGICAL PROCEDURE EXCHANGEDB (DSTX);                                    04176000
   VALUE DSTX;                                                          04178000
   LOGICAL DSTX;                                                        04180000
   OPTION EXTERNAL;                                                     04182000
PROCEDURE FCCLOSE(FILENUM,FCB,FLAB);                           <<HM.00>>04184000
   VALUE FILENUM,FCB,FLAB;                                     <<HM.00>>04186000
   INTEGER FILENUM;                                            <<HM.00>>04188000
   INTEGER POINTER FCB,FLAB;                                   <<HM.00>>04190000
   OPTION EXTERNAL;                                            <<HM.00>>04192000
INTEGER PROCEDURE FCINITACB(ACB,LIMIT,HEADREC,EPTR);           <<HM.00>>04194000
   VALUE ACB,LIMIT,HEADREC,EPTR;                               <<HM.00>>04196000
   INTEGER POINTER ACB;                                        <<HM.00>>04198000
   DOUBLE LIMIT,HEADREC,EPTR;                                  <<HM.00>>04200000
   OPTION EXTERNAL;                                            <<HM.00>>04202000
INTEGER PROCEDURE FCOPEN(ACB,LACBV);                           <<HM.00>>04204000
   VALUE ACB,LACBV;                                            <<HM.00>>04206000
   INTEGER POINTER ACB;                                        <<HM.00>>04208000
   INTEGER LACBV;                                              <<HM.00>>04210000
   OPTION EXTERNAL;                                            <<HM.00>>04212000
INTEGER PROCEDURE FCWRITEOF(DUMMY1,DUMMY2);                    <<HM.00>>04214000
   VALUE DUMMY1,DUMMY2;                                        <<HM.00>>04216000
   INTEGER DUMMY1,DUMMY2;                                      <<HM.00>>04218000
   OPTION EXTERNAL;                                            <<HM.00>>04220000
INTEGER PROCEDURE FORMSG(INBUFF,SETNO,MSGNO,MASK,P1,P2,P3,     <<09.EB>>04222000
      P4,P5,OUTBUFF,OUTBUFFSIZE,OUTLEN,DEST,CONTROL);          <<09.EB>>04224000
   VALUE SETNO,MSGNO,MASK,P1,P2,P3,P4,P5,OUTBUFFSIZE,          <<09.EB>>04226000
      DEST,CONTROL;                                            <<09.EB>>04228000
   BYTE ARRAY INBUFF,OUTBUFF;                                  <<09.EB>>04230000
   INTEGER SETNO,MSGNO,OUTBUFFSIZE,DEST,OUTLEN;                <<09.EB>>04232000
   LOGICAL MASK,P1,P2,P3,P4,P5,CONTROL;                        <<09.EB>>04234000
   OPTION EXTERNAL;                                            <<09.EB>>04236000
INTEGER PROCEDURE GETDATASEG (MEMSIZE,VDSIZE);                          04238000
   VALUE MEMSIZE,VDSIZE;                                                04240000
   INTEGER MEMSIZE,VDSIZE;                                              04242000
   OPTION EXTERNAL;                                                     04244000
INTEGER PROCEDURE GETDEVINFO (DEVICE,DEVINFO);                          04246000
   BYTE ARRAY DEVICE;                                                   04248000
   INTEGER ARRAY DEVINFO;                                               04250000
   OPTION EXTERNAL;                                                     04252000
   COMMENT  RETURNS IN THE 9 WORD ARRAY DEVINFO CERTAIN PARAMETERS      04254000
      OF THE SPECIFIED DEVICE:                                          04256000
      IF DEVICE = <CLASSNAME> THEN                                      04258000
         DEVINFO(0) - DEVICE CLASS TABLE (NEGATIVE) INDEX               04260000
                (1) - DEVICE TYPE AS PER LDT                            04262000
                (2) - FOURTH WORD OF DEVICE CLASS TABLE                 04264000
            (4)-(8) - LDT ENTRY OF FIRST DEVICE IN CLASS                04266000
      IF DEVICE = <LOGICAL DEVICE NUMBER> THEN                          04268000
         DEVINFO(0) - LOGICAL DEVICE NUMBER                             04270000
                (1) - DEVICE TYPE AS PER LDT                            04272000
            (2)-(3) - LPDT ENTRY                                        04274000
            (4)-(8) - LDT ENTRY;                                        04276000
LOGICAL PROCEDURE GETSIR (SIRNUM);                                      04278000
   VALUE SIRNUM;                                                        04280000
   INTEGER SIRNUM;                                                      04282000
   OPTION EXTERNAL;                                                     04284000
PROCEDURE IMPEDE (PCBPT);                                               04286000
   VALUE PCBPT;                                                         04288000
   INTEGER PCBPT;                                                       04290000
   OPTION EXTERNAL;                                                     04292000
INTEGER PROCEDURE LDEVTOSUBTYPE(LDEV);                         <<01115>>04294000
   VALUE LDEV;                                                 <<01115>>04296000
   INTEGER LDEV;                                               <<01115>>04298000
   OPTION EXTERNAL;                                            <<01115>>04300000
INTEGER PROCEDURE LDEVTOTYPE(LDEV);                            <<01115>>04302000
   VALUE LDEV;                                                 <<01115>>04304000
   INTEGER LDEV;                                               <<01115>>04306000
   OPTION EXTERNAL;                                            <<01115>>04308000
PROCEDURE LOG5 (FN,DISP,SECT,DEV,REC,BLOCK,RECTYPE);                    04310000
   VALUE DISP,SECT,DEV,REC,BLOCK,RECTYPE;                               04312000
   INTEGER DISP,DEV,RECTYPE;                                            04314000
   DOUBLE SECT,REC,BLOCK;                                               04316000
   BYTE ARRAY FN;                                                       04318000
   OPTION EXTERNAL;                                                     04320000
PROCEDURE MMSTAT (EVENT,P1,P2,P3);                             <<+0.04>>04322000
   VALUE EVENT,P1,P2,P3;                                       <<+0.04>>04324000
   INTEGER EVENT,P1,P2,P3;                                     <<+0.04>>04326000
   OPTION EXTERNAL;                                            <<+0.04>>04328000
LOGICAL PROCEDURE MRCAPOK (SB, RIN);                           <<00560>>04330000
  VALUE SB, RIN;                                               <<00560>>04332000
  LOGICAL SB;                                                  <<00560>>04334000
  INTEGER RIN;                                                 <<00560>>04336000
  OPTION VARIABLE, EXTERNAL;                                   <<00560>>04338000
                                                              <<SP.ENV>>04340000
PROCEDURE PLOADENV(OUTFILENUM,ENVFILENAME,STATUS,ERRNUM);     <<SP.ENV>>04342000
   VALUE OUTFILENUM;                                          <<SP.ENV>>04344000
   INTEGER OUTFILENUM,STATUS,ERRNUM;                          <<SP.ENV>>04346000
   BYTE ARRAY ENVFILENAME;                                    <<SP.ENV>>04348000
   OPTION EXTERNAL;                                           <<SP.ENV>>04350000
                                                              <<SP.ENV>>04352000
PROCEDURE PCHECKENV( ENVFILENAME,STATUS, ERRNUM);             <<SP.ENV>>04354000
  BYTE ARRAY ENVFILENAME;                                     <<SP.ENV>>04356000
  INTEGER STATUS,ERRNUM;                                      <<SP.ENV>>04358000
   OPTION EXTERNAL;                                           <<SP.ENV>>04360000
LOGICAL PROCEDURE PRIMEDEVICE (LDEV,XDDEP,FORMS);              <<01027>>04362000
   VALUE   LDEV,XDDEP,FORMS;                                            04364000
   LOGICAL LDEV,FORMS;                                                  04366000
   POINTER XDDEP;                                                       04368000
   OPTION EXTERNAL;                                                     04370000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>04372000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>04374000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>04376000
      DST,IOTYPE;                                              <<0U.EB>>04378000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>04380000
      DST,IOTYPE;                                              <<0U.EB>>04382000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>04384000
INTEGER PROCEDURE REELSWITCH(LDEV,RDWR);                       <<02549>>04386000
   VALUE LDEV,RDWR;                                            <<02549>>04388000
   LOGICAL LDEV;                                               <<02549>>04390000
   INTEGER RDWR;                                               <<02549>>04392000
  OPTION EXTERNAL;                                             <<TL.02>>04394000
PROCEDURE RELDATASEG (IX);                                              04396000
   VALUE IX;                                                            04398000
   LOGICAL IX;                                                          04400000
   OPTION EXTERNAL;                                                     04402000
PROCEDURE RELSIR (SIRNUM,A);                                            04404000
   VALUE SIRNUM,A;                                                      04406000
   INTEGER SIRNUM;                                                      04408000
   LOGICAL A;                                                           04410000
   OPTION EXTERNAL;                                                     04412000
INTEGER PROCEDURE REMJTENTRY (N1,N2,N3,TNO,ADR);                        04414000
   VALUE TNO,ADR;                                                       04416000
   BYTE ARRAY N1,N2,N3;                                                 04418000
   INTEGER TNO,ADR;                                                     04420000
   OPTION EXTERNAL;                                                     04422000
DOUBLE PROCEDURE REQSTATUS(LDN);                               <<01115>>04424000
   VALUE LDN; INTEGER LDN;                                     <<01115>>04426000
   OPTION EXTERNAL;                                            <<01115>>04428000
PROCEDURE RESETCRITICAL (OLDVAL);                                       04430000
   VALUE OLDVAL;                                                        04432000
   LOGICAL OLDVAL;                                                      04434000
   OPTION EXTERNAL;                                                     04436000
INTEGER PROCEDURE RETJTENTRY (N1,N2,N3,SIZE,TNO);                       04438000
   BYTE ARRAY N1,N2,N3;                                                 04440000
   INTEGER SIZE;                                                        04442000
   INTEGER ARRAY TNO;                                                   04444000
   OPTION EXTERNAL;                                                     04446000
PROCEDURE Return'Disc'Space (ldev, disc'address,               <<03509>>04448000
                             number'of'sectors);               <<03509>>04450000
   VALUE ldev, disc'address, number'of'sectors;                <<03509>>04452000
   INTEGER ldev;                                               <<03509>>04454000
   DOUBLE disc'address, number'of'sectors;                     <<03509>>04456000
   OPTION EXTERNAL;                                            <<03509>>04458000
PROCEDURE RLOCK (RIN,T);                                                04460000
   VALUE RIN,T;                                                         04462000
   INTEGER RIN;                                                         04464000
   LOGICAL T;                                                           04466000
   OPTION EXTERNAL;                                                     04468000
PROCEDURE RUNLOCK (RIN);                                                04470000
   VALUE RIN;                                                           04472000
   INTEGER RIN;                                                         04474000
   OPTION EXTERNAL;                                                     04476000
LOGICAL PROCEDURE SETCRITICAL;                                          04478000
   OPTION EXTERNAL;                                                     04480000
PROCEDURE SETWAKE (IOQX);                                               04482000
   VALUE IOQX;                                                          04484000
   INTEGER IOQX;                                                        04486000
   OPTION EXTERNAL;                                                     04488000
PROCEDURE SUDDENDEATH (EN);                                             04490000
   VALUE EN;                                                            04492000
   INTEGER EN;                                                          04494000
   OPTION EXTERNAL;                                                     04496000
PROCEDURE SYSTEMDEBUG;                                                  04498000
   OPTION EXTERNAL;                                                     04500000
INTEGER PROCEDURE THISCPU;                                     <<KJ.03>>04502000
    OPTION EXTERNAL;                                           <<KJ.03>>04504000
PROCEDURE UNIMPEDE (PCBPT);                                             04506000
   VALUE PCBPT;                                                         04508000
   INTEGER PCBPT;                                                       04510000
   OPTION EXTERNAL;                                                     04512000
PROCEDURE WAIT (WF,JPCNTX);                                             04514000
   VALUE WF,JPCNTX;                                                     04516000
   INTEGER WF,JPCNTX;                                                   04518000
   OPTION EXTERNAL;                                                     04520000
DOUBLE PROCEDURE WAITFORIO (IOQX);                                      04522000
   VALUE IOQX;                                                          04524000
   INTEGER IOQX;                                                        04526000
   OPTION EXTERNAL;                                                     04528000
DOUBLE PROCEDURE WAITFORIOX (IOQX);                                     04530000
   VALUE IOQX;                                                          04532000
   INTEGER IOQX;                                                        04534000
   OPTION EXTERNAL;                                                     04536000
                                                               <<TL.02>>04540000
INTEGER PROCEDURE XRETJTENTRY (N1,N2,N3,SIZE,INFO);                     04542000
   INTEGER SIZE;                                                        04544000
   INTEGER ARRAY INFO;                                                  04546000
   BYTE ARRAY N1,N2,N3;                                                 04548000
   OPTION EXTERNAL;                                                     04550000
PROCEDURE SREMOVEXDD (XDDSUBP);                                         04552000
   VALUE XDDSUBP;                                                       04554000
   INTEGER POINTER XDDSUBP;                                             04556000
   OPTION EXTERNAL;                                                     04558000
DOUBLE PROCEDURE XDDSPOOLINFO (DVAL,ITEM,XDDSUBP);                      04560000
   VALUE   DVAL,ITEM,XDDSUBP;                                           04562000
   LOGICAL ITEM;                                                        04564000
   DOUBLE  DVAL;                                                        04566000
   INTEGER POINTER XDDSUBP;                                             04568000
   OPTION EXTERNAL;                                                     04570000
PROCEDURE MOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN,           <<00211>>04572000
                 PVINFO,SOME'OTHER'PIN);                       <<00211>>04574000
    VALUE   GEN,SOME'OTHER'PIN;                                <<00211>>04576000
    INTEGER REQTYPE,GEN,PVINFO,SOME'OTHER'PIN;                 <<00211>>04578000
    BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                         <<23.PV>>04580000
    OPTION VARIABLE,EXTERNAL;                                  <<23.PV>>04582000
                                                               <<23.PV>>04584000
                                                               <<23.PV>>04586000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCT,REQTYPE,             <<00211>>04588000
                    PVINFO,SOME'OTHER'PIN);                    <<00211>>04590000
    VALUE   PVINFO,SOME'OTHER'PIN;                             <<00211>>04592000
    INTEGER REQTYPE,PVINFO,SOME'OTHER'PIN;                     <<00211>>04594000
    BYTE ARRAY VSNAME,VSGROUP,VSACCT;                          <<23.PV>>04596000
    OPTION EXTERNAL,VARIABLE;                                  <<23.PV>>04598000
                                                               <<23.PV>>04600000
                                                               <<23.PV>>04602000
DOUBLE PROCEDURE DIRECFIND (TYPE, LINKAGE'INDEXP, ANAME,       <<38.PV>>04604000
                            GUNAME, FNAME, PRETURN);           <<RV.PV>>04606000
    VALUE   TYPE, LINKAGE'INDEXP;                              <<38.PV>>04608000
    INTEGER TYPE;                                              <<RV.PV>>04610000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>04612000
    ARRAY   ANAME, GUNAME, FNAME, PRETURN;                     <<RV.PV>>04614000
    OPTION EXTERNAL;                                           <<RV.PV>>04616000
                                                               <<RV.PV>>04618000
INTRINSIC CLOCK,FREAD;                                         <<04134>>04620000
INTRINSIC SEARCH,MYCOMMAND;                                   <<SP.ENV>>04622000
 PROCEDURE HELP  <<FOR DUMMY CALL>>;                           <<00117>>04624000
    OPTION EXTERNAL;                                           <<00117>>04626000
PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);       <<KS.00>>04628000
   VALUE FILENUM;                                                       04630000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              04632000
   DOUBLE BLKNUM;                                                       04634000
   OPTION VARIABLE,EXTERNAL;                                            04636000
LOGICAL PROCEDURE FBNDCHK(PARM,SIZE,UBND);                              04638000
VALUE PARM,SIZE,UBND;                                                   04640000
INTEGER PARM,SIZE,UBND;                                                 04642000
OPTION EXTERNAL;                                                        04644000
LOGICAL PROCEDURE STACKCHECK(DSTNUMBER);                       <<JB.IV>>04646000
VALUE DSTNUMBER;                                               <<JB.IV>>04648000
INTEGER DSTNUMBER;                                             <<JB.IV>>04650000
OPTION EXTERNAL;                                               <<JB.IV>>04652000
                                                               <<JB.IV>>04654000
COMMENT STACKCHECK RETURNS A TRUE VALUE IF THE SPECIFIED       <<JB.IV>>04656000
DATA SEGMENT IS A STACK, OTHERWISE FALSE;                      <<JB.IV>>04658000
                                                               <<JB.IV>>04660000
PROCEDURE LOCK'CB(FLAGS,STACK'DST,STACK'TARGET,CB'DST,CB'FST); <<04624>>04662000
          VALUE   FLAGS,STACK'DST,STACK'TARGET,CB'DST,CB'FST ; <<04624>>04664000
          INTEGER FLAGS,STACK'DST,STACK'TARGET,CB'DST,CB'FST ; <<04624>>04666000
          OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;               <<04624>>04668000
                                                               <<04624>>04670000
PROCEDURE UNLOCK'CB( FLAGS, CB'DST, CB'FST);                   <<04624>>04672000
             VALUE   FLAGS, CB'DST, CB'FST ;                   <<04624>>04674000
             INTEGER FLAGS, CB'DST, CB'FST ;                   <<04624>>04676000
             OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;            <<04624>>04678000
                                                               <<04624>>04680000
DOUBLE PROCEDURE GETFCB'INFO(FCBV,ITEM);                       <<04624>>04682000
VALUE   FCBV,ITEM;                                             <<04624>>04684000
INTEGER FCBV,ITEM;                                             <<04624>>04686000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<04624>>04688000
                                                               <<04624>>04690000
PROCEDURE IOMOVE(MODE,TARGET,TCOUNT);                          <<04516>>04692000
   VALUE MODE,TCOUNT;                                          <<04516>>04694000
   INTEGER TCOUNT;                                             <<04516>>04696000
   LOGICAL ARRAY TARGET;                                       <<04516>>04698000
   LOGICAL MODE;                                               <<04516>>04700000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<04516>>04702000
                                                               <<04516>>04704000
PROCEDURE LOC'ACB(DSTX,DQ,FILENUM,FLAGS,SIR,A);                <<04516>>04706000
   VALUE DSTX,DQ,FILENUM,FLAGS,SIR,A;                          <<04516>>04708000
   LOGICAL FLAGS;                                              <<04516>>04710000
   INTEGER DSTX,DQ,FILENUM,SIR,A;                              <<04516>>04712000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL,VARIABLE;             <<04516>>04714000
                                                               <<04516>>04716000
PROCEDURE UNLOC'ACB(DQ,FLAGS);                                 <<04516>>04718000
   VALUE DQ,FLAGS;                                             <<04516>>04720000
   INTEGER DQ;LOGICAL FLAGS;                                   <<04516>>04722000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<04516>>04724000
                                                               <<04516>>04726000
INTEGER PROCEDURE FQUIESCE'IO(MODE);                           <<04516>>04728000
   VALUE MODE;LOGICAL MODE;                                    <<04516>>04730000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<04516>>04732000
                                                               <<04516>>04734000
<<----------------------------------------------------------------------04736000
*                                                                      *04738000
*  GENERAL UTILITY PROCEDURES                                          *04740000
*                                                                      *04742000
---------------------------------------------------------------------->>04744000
                                                                        04746000
$ CONTROL SEGMENT = FILESYS4                                            04748000
INTEGER PROCEDURE LUN (VTABINX, MVTABX);                       <<RV.PV>>04750000
   <<CONVERTS THE VOLUME TABLE INDEX TO THE LOGICAL DEVICE NUMBER.      04752000
                                                                        04754000
     INPUT VARIABLES:                                                   04756000
         VTABINX - VOLUME TABLE INDEX                                   04758000
         MVTABX  - MOUNTED VOLUME TABLE INDEX                    RV.PV  04760000
                                                                        04762000
     OUTPUT VARIABLES:                                                  04764000
         LUN - LOGICAL DEVICE NUMBER                                    04766000
                                                                        04768000
     NOTE THAT DB IS SET TO THE VOLUME TABLE BUT IS RESET UPON          04770000
     RETURNING>>                                                        04772000
   VALUE VTABINX, MVTABX;                                      <<RV.PV>>04774000
   INTEGER VTABINX, MVTABX;                                    <<RV.PV>>04776000
   OPTION UNCALLABLE,PRIVILEGED;                                        04778000
   BEGIN                                                                04780000
   INTEGER RESULT = LUN;                                                04782000
                                                                        04784000
$  IF X0 = ON                                                           04786000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               04788000
      BEGIN                                                             04790000
      TOS := "LU"; TOS := "N ";                                         04792000
      ASSEMBLE(DZRO,DZRO; DZRO);                                        04794000
      FTITLE(*,*,*,*);                                                  04796000
      DEBUG                                                             04798000
      END;                                                              04800000
$  IF                                                                   04802000
                                                                        04804000
   IF MVTABX <> 0 THEN                                         <<RV.PV>>04806000
   BEGIN  <<GET LDEV FROM MVTAB USING LOCAL VTABINX >>         <<RV.PV>>04808000
       TOS := EXCHANGEDB (MVTABDST);                           <<RV.PV>>04810000
       LUN := MVTAB ((MVTABX*MVTABSZ)+5+((VTABINX-1)*2)).(0:8);<<RV.PV>>04812000
   END ELSE                                                    <<RV.PV>>04814000
   BEGIN                                                       <<RV.PV>>04816000
   TOS := EXCHANGEDB(VTAB);  <<SET DB TO VOLUME TABLE>>                 04818000
   LUN := ADB0(VTABINX*VTABENTRY+12).(0:8);  <<LOGICAL DEV. NR.>>       04820000
   END;                                                        <<RV.PV>>04822000
   ASSEMBLE(ZERO,XCH);                                                  04824000
   EXCHANGEDB(*);  <<RESET DB TO ORIG. DST>>                            04826000
   END;                                                                 04828000
$ CONTROL SEGMENT = FILESYS4                                            04830000
INTEGER PROCEDURE VTABINX (LUN, LOCAL);                        <<RV.PV>>04832000
   <<CONVERTS THE LOGICAL UNIT NUMBER TO THE VOLUME TABLE INDEX.        04834000
                                                                        04836000
     INPUT VARIABLES:                                                   04838000
         LUN - LOGICAL UNIT NUMBER                                      04840000
         LOCAL - IF TRUE THEN LOCAL VTABX MUST BE RETRIEVED      RV.PV  04842000
                 FROM VTAB                                       RV.PV  04844000
                                                                        04846000
     OUTPUT VARIABLES:                                                  04848000
         VTABINX - VOLUME INFO                                          04850000
            VTABINX.(0:8) - VDD HEAD INDEX (VESTIGAL)                   04852000
            VTABINX.(8:8) - VOLUME TABLE INDEX                          04854000
                                                                        04856000
     NOTE THAT DB IS SET TO THE LDT BUT IS RESET UPON                   04858000
     RETURNING>>                                                        04860000
   VALUE LUN, LOCAL;                                           <<RV.PV>>04862000
   INTEGER LUN;                                                         04864000
   LOGICAL LOCAL;                                              <<RV.PV>>04866000
   OPTION UNCALLABLE,PRIVILEGED;                                        04868000
   BEGIN                                                                04870000
   INTEGER RESULT = VTABINX;                                            04872000
                                                                        04874000
$  IF X0 = ON                                                           04876000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               04878000
      BEGIN                                                             04880000
      TOS := "VT"; TOS := "AB"; TOS := "IN"; TOS := "X ";               04882000
      ASSEMBLE(DZRO,DZRO);                                              04884000
      FTITLE(*,*,*,*);                                                  04886000
      DEBUG                                                             04888000
      END;                                                              04890000
$  IF                                                                   04892000
                                                                        04894000
   TOS := EXCHANGEDB(LDT);  <<SET DB TO LDT>>                           04896000
   TOS := ADB0(LUN*LDTENTRY+1).(0:8);  <<VOLUME TABLE INDEX>>           04898000
   TOS.(0:8) := ADB0(X+3);  <<VDD HEAD INDEX>>                          04900000
   VTABINX := TOS;   << VTAB and VDD head indices >>           <<*****>>04902000
   IF LOCAL THEN                                               <<RV.PV>>04904000
   BEGIN                                                       <<RV.PV>>04906000
       EXCHANGEDB (VTAB);                                      <<RV.PV>>04908000
       RESULT.(8:8) := ADB0 (RESULT.(8:8)*VTABENTRY+13).(4:4); <<RV.PV>>04910000
   END;                                                        <<RV.PV>>04912000
   ASSEMBLE(ZERO,XCH);                                                  04914000
   EXCHANGEDB(*);  <<RESET DB TO ORIG. DST>>                            04916000
   END;                                                                 04918000
$ CONTROL SEGMENT = FILESYS4                                            04920000
PROCEDURE VTABTOLDEV (TARGET,SOURCE,COUNT,MVTABX);             <<RV.PV>>04922000
   <<MOVES AN EXTENT MAP FROM SOURCE TO TARGET AND CONVERTS THE         04924000
     THE VOLUME TABLE INDEX IN EACH EXTENT DESCRIPTOR INTO A            04926000
     LOGICAL DEVICE NUMBER.                                             04928000
                                                                        04930000
     INPUT VARIABLES:                                                   04932000
         SOURCE - SOURCE EXTENT MAP                                     04934000
         COUNT - NUMBER OF EXTENT ENTRIES                               04936000
         MVTABX- MOUNTED VOLUME TABLE INDEX                      RV.PV  04938000
                                                                        04940000
     OUTPUT VARIABLES:                                                  04942000
         TARGET - TARGET EXTENT MAP                                     04944000
                                                                        04946000
     NOTE THAT SOURCE AND TARGET MAY BE THE SAME MAPS.  ALSO, DB        04948000
     MUST BE SET TO THE STACK WHEN THIS PROCEDURE IS CALLED>>           04950000
   VALUE COUNT,MVTABX;                                         <<RV.PV>>04952000
   DOUBLE ARRAY TARGET,SOURCE;                                          04954000
   INTEGER COUNT,MVTABX;                                       <<RV.PV>>04956000
   OPTION PRIVILEGED,UNCALLABLE;                                        04958000
   BEGIN                                                                04960000
   INTEGER TEMP;                                                        04962000
   BYTE BTEMP = TEMP;                                                   04964000
$  IF X2 = ON                                                           04966000
   INTEGER TEMP1;                                                       04968000
$  IF                                                                   04970000
                                                                        04972000
$  IF X0 = ON                                                           04974000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               04976000
      BEGIN                                                             04978000
      TOS := "VT"; TOS := "AB"; TOS := "TO"; TOS := "LD";               04980000
      TOS := "EV";                                                      04982000
      ASSEMBLE(ZERO,DZRO);                                              04984000
      FTITLE(*,*,*,*);                                                  04986000
      DEBUG                                                             04988000
      END;                                                              04990000
$  IF                                                                   04992000
                                                                        04994000
   X := 0;  <<EXTENT INDEX>>                                            04996000
   TOS := COUNT;  <<NR. EXTENTS>>                                       04998000
   WHILE <> DO                                                          05000000
      BEGIN                                                             05002000
      TOS := SOURCE(X);  <<EXTENT DESCRIPTOR>>                          05004000
      IF <> THEN  <<EXTENT ALLOCATED?>>                                 05006000
         BEGIN                                                          05008000
         TOS := @TEMP;                                                  05010000
         IF MVTABX <> 0 THEN                                   <<RV.PV>>05012000
         BEGIN <<GET LDEV FROM MVTAB USING LOCAL VTABINX>>     <<RV.PV>>05014000
             TOS := MVTABDST;                                  <<RV.PV>>05016000
             TOS := INTEGER ((BS3-1)*2)+5+(MVTABX*MVTABENTRY); <<RV.PV>>05018000
         END ELSE                                              <<RV.PV>>05020000
         BEGIN                                                 <<RV.PV>>05022000
         TOS := VTAB; TOS := BS3*VTABENTRY+12;                          05024000
         END;                                                  <<RV.PV>>05026000
         TOS := 1;                                                      05028000
         ASSEMBLE(MFDS 4);  <<FETCH LDEV>>                              05030000
         BS1 := BTEMP  <<INSERT LDEV>>                                  05032000
         END;                                                           05034000
      TARGET(X) := TOS;  <<FIXED EXTENT DESCRIPTOR>>                    05036000
      ASSEMBLE(INCX,DECA)                                               05038000
      END                                                               05040000
   END;                                                                 05042000
$ CONTROL SEGMENT = FILESYS4                                            05044000
PROCEDURE LDEVTOVTAB (TARGET,SOURCE,COUNT,LOCAL);              <<RV.PV>>05046000
   <<MOVES AN EXTENT MAP FROM SOURCE TO TARGET AND CONVERTS THE         05048000
     LOGICAL DEVICE NUMBER IN EACH EXTENT DESCRIPTOR INTO A VOLUME      05050000
     TABLE INDEX.                                                       05052000
                                                                        05054000
     INPUT VARIABLES:                                                   05056000
         SOURCE - SOURCE EXTENT MAP                                     05058000
         COUNT - NUMBER OF EXTENT ENTRIES                               05060000
         LOCAL - IF TRUE THEN LOCAL VTABX MUST BE RETRIEVED      RV.PV  05062000
                 FROM VTAB                                       RV.PV  05064000
                                                                        05066000
     OUTPUT VARIABLES:                                                  05068000
         TARGET - TARGET EXTENT MAP                                     05070000
                                                                        05072000
     NOTE THAT SOURCE AND TARGET MAY BE THE SAME MAPS.  ALSO, DB        05074000
     MUST BE SET TO THE STACK WHEN THIS PROCEDURE IS CALLED>>           05076000
   VALUE COUNT,LOCAL;                                          <<RV.PV>>05078000
   DOUBLE ARRAY TARGET,SOURCE;                                          05080000
   INTEGER COUNT;                                                       05082000
   LOGICAL LOCAL;                                              <<RV.PV>>05084000
   OPTION PRIVILEGED,UNCALLABLE;                                        05086000
   BEGIN                                                                05088000
   INTEGER TEMP;                                                        05090000
   BYTE BTEMP = TEMP;                                                   05092000
$  IF X2 = ON                                                           05094000
   INTEGER TEMP1;                                                       05096000
$  IF                                                                   05098000
                                                                        05100000
$  IF X0 = ON                                                           05102000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               05104000
      BEGIN                                                             05106000
      TOS := "LD"; TOS := "EV"; TOS := "TO"; TOS := "VT";               05108000
      TOS := "AB";                                                      05110000
      ASSEMBLE(ZERO,DZRO);                                              05112000
      FTITLE(*,*,*,*);                                                  05114000
      DEBUG                                                             05116000
      END;                                                              05118000
$  IF                                                                   05120000
                                                                        05122000
   X := 0;  <<EXTENT INDEX>>                                            05124000
   TOS := COUNT;  <<NR. EXTENTS>>                                       05126000
   WHILE <> DO                                                          05128000
      BEGIN                                                             05130000
      TOS := SOURCE(X);  <<EXTENT DESCRIPTOR>>                          05132000
      IF <> THEN  <<EXTENT ALLOCATED?>>                                 05134000
         BEGIN                                                          05136000
         TOS := @TEMP;                                                  05138000
         TOS := LDT; TOS := BS3*LDTENTRY+1;                             05140000
         TOS := 1;                                                      05142000
         ASSEMBLE(MFDS 4);  <<FETCH VTAB INDEX>>                        05144000
         IF LOCAL THEN                                         <<RV.PV>>05146000
         BEGIN                                                 <<RV.PV>>05148000
             TOS := 0;                                         <<RV.PV>>05150000
             TOS := @S0;                                       <<RV.PV>>05152000
             TOS := VTAB;                                      <<RV.PV>>05154000
             TOS := BTEMP*VTABENTRY+13;                        <<RV.PV>>05156000
             TOS := 1;                                         <<RV.PV>>05158000
             ASSEMBLE (MFDS 4);                                <<RV.PV>>05160000
             TEMP.(0:8) := S0.(4:4);                           <<RV.PV>>05162000
             DEL; <<VTAB WORD 13>>                             <<RV.PV>>05164000
         END;                                                  <<RV.PV>>05166000
         IF INTEGER (BTEMP) = 0 THEN FTROUBLE(54);             <<04798>>05168000
         BS1 := BTEMP  <<INSERT VTAB INDEX>>                            05170000
         END;                                                           05172000
      TARGET(X) := TOS;  <<FIXED EXTENT DESCRIPTOR>>                    05174000
      ASSEMBLE(INCX,DECA)                                               05176000
      END                                                               05178000
   END;                                                                 05180000
$ CONTROL SEGMENT = FILESYS5                                            05182000
INTEGER PROCEDURE FALTPXFILE (SIZE);                                    05184000
                                                               <<04512>>05186000
<<**********************************************************>> <<04512>>05188000
<< FALTPXFILE expands or contracts the PXFILE area and cor- >> <<04512>>05190000
<< rects all table pointers.                                >> <<04512>>05192000
<<                                                          >> <<04512>>05194000
<< INPUT VARIABLES:                                         >> <<04512>>05196000
<<    SIZE - Size in which to change PXFILE. Negative sig-  >> <<04512>>05198000
<<           nifies contract, positive expand.              >> <<04512>>05200000
<< OUTPUT VARIABLES:                                           <<04512>>05202000
<<    FALTPXFILE- A term in which to correct pointers into  >> <<04512>>05204000
<<                the PXFILE by calling procedures.         >> <<04512>>05206000
<< CONDITION CODE:                                          >> <<04512>>05208000
<<    CCE - OK!                                             >> <<04512>>05210000
<<    CCL - Error in expansion or contraction.              >> <<04512>>05212000
<<                                                          >> <<04512>>05214000
<< NOTE: DB MUST be set to the stack upon entrance!         >> <<04512>>05216000
<<**********************************************************>> <<04512>>05218000
                                                               <<04512>>05220000
   VALUE SIZE;                                                          05222000
   INTEGER SIZE;                                                        05224000
   OPTION PRIVILEGED,UNCALLABLE;                                        05226000
   BEGIN                                                                05228000
   INTEGER POINTER                                             <<04512>>05230000
      PXFILE,      << Current PXFILE DB-rel. pointer.       >> <<04512>>05232000
      NEWAFT,      << New AFT DB-rel pointer.               >> <<04512>>05234000
      OLDAFT;      << Starting address of old AFT           >> <<04512>>05236000
   LOGICAL                                                     <<04512>>05238000
      CONTRACTING; << Are we contracting or expanding?      >> <<04512>>05240000
   EQUATE                                                      <<04512>>05242000
      SUCCESSFUL=0;<< Successful call to ALTPXFILESIZE.     >> <<04512>>05244000
                                                                        05246000
$  IF X0 = ON                                                           05248000
   IF MONOTHER THEN  <<MONITORING?>>                                    05250000
      BEGIN                                                             05252000
      TOS := "FA"; TOS := "LT"; TOS := "PX"; TOS := "FI";               05254000
      TOS := "LE";                                                      05256000
      ASSEMBLE(ZERO,DZRO);                                              05258000
      FTITLE(*,*,*,*);                                                  05260000
      DEBUG                                                             05262000
      END;                                                              05264000
$  IF                                                                   05266000
                                                                        05268000
   SETPXFILE;      << Set PXFILE pointer.                   >> <<04512>>05270000
   CONTRACTING := FALSE;                                                05272000
   IF SIZE < 0 THEN                                            <<04512>>05274000
      BEGIN                                                    <<04512>>05276000
      CONTRACTING := TRUE;                                     <<04512>>05278000
      SIZE := -SIZE;        << SIZE becomes positive words. >> <<04512>>05280000
      SIZE := (SIZE /128)*128;         << Round down 128X   >> <<04512>>05282000
      END                                                      <<04512>>05284000
   ELSE SIZE := ((SIZE+127)/128)*128;  << Round up 128X     >> <<04512>>05286000
                                                               <<04512>>05288000
   CONDCODE := CCE;               << Assume successful      >> <<04512>>05290000
   IF CONTRACTING THEN                                         <<04512>>05292000
      BEGIN                       << Contraction.           >> <<04512>>05294000
      PUSH(DL);                                                <<04512>>05296000
      @OLDAFT := TOS - 4 - PXFAFTSIZE;                         <<04512>>05298000
      @NEWAFT := @OLDAFT - SIZE;                               <<04512>>05300000
      MOVE NEWAFT := OLDAFT,(PXFAFTSIZE);                      <<04512>>05302000
      IF ALTPXFILESIZE(-SIZE) <> SUCCESSFUL                    <<04512>>05304000
         THEN CONDCODE := CCL                                  <<04512>>05306000
         ELSE FALTPXFILE := SIZE ;<< Correction Term.       >> <<04512>>05308000
      END                                                      <<04512>>05310000
   ELSE                                                        <<04512>>05312000
      BEGIN                       << Expansion              >> <<04512>>05314000
      IF ALTPXFILESIZE(SIZE) <> SUCCESSFUL  THEN               <<04512>>05316000
         CONDCODE := CCL                                       <<04512>>05318000
      ELSE                                                     <<04512>>05320000
         BEGIN                                                 <<04512>>05322000
         SETPXFILE;         << Reset to new pointer.        >> <<04512>>05324000
         PUSH(DL);                                             <<04512>>05326000
         @NEWAFT := TOS - 4 - PXFAFTSIZE;                      <<04512>>05328000
         @OLDAFT := @NEWAFT - SIZE;                            <<04512>>05330000
         MOVE NEWAFT := OLDAFT,(PXFAFTSIZE);                   <<04512>>05332000
         FALTPXFILE := -SIZE;   << Correction Term.         >> <<04512>>05334000
         END;                                                  <<04512>>05336000
      END;                                                     <<04512>>05338000
   END;                                                                 05340000
$ CONTROL SEGMENT = FILESYS4                                            05342000
INTEGER PROCEDURE IOSTAT(STAT);                                         05344000
   << Converts an ATTACHIO error number into a file system error        05346000
     number.  Only the right eight bits of the error word are           05348000
     used.                                                              05350000
                                                                        05352000
     Input variable:                                                    05354000
         STAT - ATTACHIO error word                                     05356000
                                                                        05358000
     Output variable:                                                   05360000
         IOSTAT - File system error number                              05362000
                                                                        05364000
     This procedure may be called with DB anywhere.  >>                 05366000
                                                                        05368000
VALUE STAT;                                                             05370000
INTEGER STAT;                                                           05372000
OPTION UNCALLABLE;                                                      05374000
   BEGIN                                                                05376000
   INTEGER ARRAY MAP(*) =PB :=                                          05378000
                                                                        05380000
   << 0, %10, ... %370 -- Pending.  Not normally reported >>            05382000
                                                                        05384000
      UNUSED,INVOP,INVOP,INVOP,INVOP,INVOP,UNUSED,UNUSED,               05386000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05388000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05390000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05392000
                                                                        05394000
   << 1, %11, ... %371 -- Successful >>                                 05396000
                                                                        05398000
      UNUSED,EOL,TAPERREC,EOT,UNUSED,UNUSED,UNUSED,UNUSED,              05400000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05402000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05404000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05406000
                                                                        05408000
   << 2, %12, ... %372 -- End of File >>                                05410000
                                                                        05412000
      EOF,EOF,EOF,EOF,EOF,EOF,EOF,EOF,                                  05414000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05416000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05418000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05420000
                                                                        05422000
   << 3, %13, ... %373 -- Unusual Conditions >>                         05424000
                                                                        05426000
      UNUSED,DATAPAR,SOFTIMEOUT,SOFTABORT,DATALOST,NOTREADY,POWERFAILED,05428000
         BOT,                                                           05430000
      RUNAWAY,EOT,UNUSED,UNUSED,PLIMIT,BADESCAPE,TIMEROVERFLOW,         05432000
         BROKENREAD,                                                    05434000
      UNUSED,DEVPWRUP,BOT,UNUSED,UNUSED,UNUSED,UNUSED,VFCRESET,         05436000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          05438000
                                                                        05440000
   << 4, %14, ... %374 -- Irrecoverable error >>                        05442000
                                                                        05444000
      INVOP,TRANSERR,IOTIMEOUT,TIMERR,SIOFAIL,UNITFAIL,INVDISKADR,      05446000
         TAPERR,                                                        05448000
      SYSTEM,PTAPERR,SYSTEM,SYSTEM,SIOFAIL,BLANK'MEDIA,        <<03561>>05450000
        NO'SPARES, DLTDREC,                                    <<03561>>05452000
      NAVAILDEV, UNUSED, UNUSED, UNUSED, UNUSED, UNUSED,       <<03561>>05454000
        UNUSED, UNUSED,                                        <<03561>>05456000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED;          05458000
                                                                        05460000
$  IF X0 = ON                                                           05462000
   IF MONOTHER THEN                                                     05464000
      BEGIN                                                             05466000
      FTITLE("IOST","AT  ",0D,0D);                                      05468000
      DEBUG                                                             05470000
      END;                                                              05472000
$  IF                                                                   05474000
                                                                        05476000
   IF STAT.(13:3) > 4 THEN                                              05478000
      TOS := UNUSED      << number unassigned >>                        05480000
   ELSE              << valid error numbers >>                          05482000
      TOS := MAP(STAT.(13:3)*%40+STAT.(8:5));  << convert >>            05484000
   IOSTAT := TOS    << FS error nr. >>                                  05486000
   END;          << procedure IOSTAT >>                                 05488000
$ CONTROL SEGMENT = FILESYS4                                            05490000
PROCEDURE FTROUBLE (CODE);                                              05492000
   VALUE CODE;                                                          05494000
   INTEGER CODE;                                                        05496000
   OPTION PRIVILEGED,UNCALLABLE;                                        05498000
   BEGIN                                                                05500000
                                                                        05502000
$  IF X0 = ON                                                           05504000
   IF MONOTHER THEN  <<MONITORING?>>                                    05506000
      BEGIN                                                             05508000
      TOS := "FT"; TOS := "RO"; TOS := "UB"; TOS := "LE";               05510000
      ASSEMBLE(DZRO,DZRO);                                              05512000
      FTITLE(*,*,*,*);                                                  05514000
      DEBUG                                                             05516000
      END;                                                              05518000
$  IF                                                                   05520000
                                                                        05522000
  SUDDENDEATH(CODE);                                           <<KJ.03>>05524000
   END;                                                                 05526000
$ CONTROL SEGMENT = FILESYS4                                            05528000
PROCEDURE FTITLE (T1,T2,T3,T4);                                         05530000
   <<PRINTS THE SPECIFIED FILE SYSTEM PROCEDURE NAME ON $STDLIST.  THE  05532000
     NAME (AT MOST 15 CHARACTERS LONG) MUST BE TERMINATED BY 0 OR A     05534000
     BLANK.                                                             05536000
                                                                        05538000
     INPUT VARIABLES:                                                   05540000
         T1 - PROCEDURE NAME (FIRST 4 CHARACTERS)                       05542000
         T2 - PROCEDURE NAME (SECOND 4 CHARACTERS)                      05544000
         T3 - PROCEDURE NAME (THIRD 4 CHARACTERS)                       05546000
         T4 - PROCEDURE NAME (LAST 4 CHARACTERS)                        05548000
                                                                        05550000
     NOTE THAT DB MAY BE SET TO ANY DATA SEGMENT.  IT WILL BE SET TO THE05552000
     STACK AND THEN RESET BEFORE RETURNING TO THE CALLER>>              05554000
   VALUE T1,T2,T3,T4;                                                   05556000
   DOUBLE T1,T2,T3,T4;                                                  05558000
   OPTION PRIVILEGED,UNCALLABLE;                                        05560000
   BEGIN                                                                05562000
   INTEGER ARRAY TITLE (*) = T1;  <<PROCEDURE NAME>>                    05564000
   INTEGER DST = Q+1;  <<ORIG. DST NR.>>                                05566000
   INTEGER POINTER PCBX = Q+2;  <<PCBX POINTER>>                        05568000
   INTEGER CHARS = Q+3;  <<NEG. NR. CHAR'S IN NAME>>                    05570000
                                                                        05572000
   TOS := EXCHANGEDB(0);  <<SET DB TO STACK>>                           05574000
   FINDPCBX;  <<INIT. PCBX POINTER>>                                    05576000
   TOS := @TITLE&LSL(1);  <<NAME POINTER>>                              05578000
   SCAN BPS0 UNTIL " ",1;  <<STOP ON 0 OR BLANK>>                       05580000
   TOS := TOS-TOS;  <<NEG. NR. CHAR'S>>                                 05582000
   ATTACHIO(PXGSTDLIST,0,0,@TITLE,1,CHARS,0,0,BFLAGS);         <<+0.05>>05584000
   EXCHANGEDB(DST)  <<RESET DB>>                                        05586000
   END;                                                                 05588000
<<MMSTAT' DELETED - MMSTAT CALLED DIRECTLY>>                   <<+0.05>>05590000
$ PAGE "MPE-IV FILE SYSTEM - GENERAL CONTROL BLOCK MAINTENANCE"         05592000
<<----------------------------------------------------------------------05594000
*                                                                      *05596000
*  GENERAL CONTROL BLOCK MAINTENANCE PROCEDURES                         05598000
*                                                                      *05600000
---------------------------------------------------------------------->>05602000
                                                                        05604000
$ CONTROL SEGMENT = FILESYS1                                            05606000
PROCEDURE FLOCKCB (CBL,FLAGS,CBTL);                                     05608000
  <<LOCKS A CONTROL BLOCK TABLE OR SINGLE CONTROL BLOCK.  IF TWO        05610000
    PARAMETERS ARE PRESENT THEN THE REQUEST IS FOR A LOCK ON A CONTROL  05612000
    BLOCK TABLE.  IF THREE PARAMETERS ARE PRESENT THEN THE REQUEST      05614000
    IS FOR A LOCK ON A CONTROL BLOCK.  IN THE LATER CASE THE CONTROL    05616000
    BLOCK TABLE WILL BE UNLOCKED BEFORE RETURNING TO THE CALLER.        05618000
                                                                        05620000
    INPUT VARIABLES:                                                    05622000
       CBL - CONTROL BLOCK LOCK                                         05624000
       FLAGS - SPECIAL REQUEST MODES                                    05626000
         (1:1) - CONDITIONAL LOCK (QUEUE, DON'T IMPEDE, RETURN   01393  05628000
                                   WHILE PSEUDO-DISABLED)        01393  05630000
         (14:1) - CREATE BREAK QUEUE                                    05632000
       CBTL - CONTROL BLOCK TABLE LOCK (OPTIONAL)                       05634000
                                                                 01393  05636000
    OUTPUT:                                                      01393  05638000
       NOCARRY  -  SUCCESSFUL                                    01393  05640000
       CARRY    -  CONDTIONAL LOCK (QUEUED, NO IMPEDE)           01393  05642000
                                                                 01393  05644000
                                                                        05646000
     NOTE THAT DB MUST BE SET TO THE DATA SEGMENT CONTAINING THE        05648000
     CONTROL BLOCK TABLE>>                                              05650000
   VALUE CBL,FLAGS,CBTL;                                                05652000
   INTEGER POINTER CBL,CBTL;                                            05654000
   LOGICAL FLAGS;                                                       05656000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                               05658000
   BEGIN                                                                05660000
   LOGICAL PMAP = Q-4;  <<PARAMETER MAP>>                               05662000
   DEFINE CONDLOCK=FLAGS.(1:1)=1#,                             <<01393>>05664000
          UNLOCKTBL=PMAP.(15:1)=1#;                            <<01393>>05666000
   INTEGER PIN = Q+1;  <<CURRENT PROCESS NR.>>                          05668000
   INTEGER PINTYPE = Q+2;  <<PROCESS TYPE>>                             05670000
                                                                        05672000
   SETNOCARRY;                                                 <<01393>>05674000
   TOS := GETPROCNUM;  <<GET PIN>>                                      05676000
   TOS := PCBPTYPE;  <<PROCESS TYPE>>                                   05678000
                                                                        05680000
   PSEUDODISABLE;                                                       05682000
   TOS := CBLCONTROL;  <<CONTROL WORD>>                                 05684000
   IF < THEN  <<ALREADY LOCKED?>>                                       05686000
      IF S0.(8:8) = PIN THEN  <<SAME PROCESS?>>                         05688000
         BEGIN                                                          05690000
         CBLCOUNT := CBLCOUNT+1;  <<BUMP LOCK COUNT>>                   05692000
        IF CBLCOUNT = 0 THEN FTROUBLE(457); <<OVERFLOW?>>      <<KJ.03>>05694000
         IF UNLOCKTBL THEN FUNLOCKCB(CBTL,0); <<UNLOCK TABLE?> <<01393>>05696000
         PSEUDOENABLE                                                   05698000
         END                                                            05700000
      ELSE  <<DIFFERENT PROCESS>>                                       05702000
         BEGIN                                                          05704000
         IF FLAGS.(14:1) THEN  <<CREATE BREAK QUEUE?>>                  05706000
            BEGIN                                                       05708000
            CBLBREAK := 1;  <<SET BREAK MODE BIT>>                      05710000
            IF = THEN  <<WAS NOT IN BREAK MODE?>>                       05712000
               BEGIN                                                    05714000
               CBLSAVEDQUEUE := CBLQUEUE;  <<SAVE IMPEDED QUEUE>>       05716000
               CBLQUEUE := 0  <<EMPTY IMPEDED QUEUE>>                   05718000
               END                                                      05720000
            END;                                                        05722000
         IF LOGICAL(CBLBREAK) AND PINTYPE = 0 THEN  <<LOW PRIORITY?>>   05724000
L1:         TOS := @CBLSAVEDQUEUE                                       05726000
         ELSE  <<HIGH OR REGULAR PRIORITY>>                             05728000
            TOS := @CBLQUEUE;                                           05730000
         TOS := PS0;  <<IMPEDED QUEUE>>                                 05732000
         IF = THEN  <<EMPTY QUEUE?>>                                    05734000
            TOS := TOS+PIN  <<HEAD PIN>>                                05736000
         ELSE  <<NON-EMPTY QUEUE>>                                      05738000
            PCB(S0.(0:8)*PCBSIZE+8).(8:8) := PIN;  <<TAIL'S LINK>>      05740000
         TOS.(0:8) := PIN;  <<TAIL PIN>>                                05742000
         PS1 := TOS;  <<UPDATE IMPEDED QUEUE>>                          05744000
         PCBIQPTR := 0;  <<MY LINK>>                                    05746000
         IF UNLOCKTBL THEN FUNLOCKCB(CBTL,0); <<UNLOCK TABLE?> <<01393>>05748000
         IF CONDLOCK THEN                                      <<01393>>05750000
            BEGIN                                              <<01393>>05752000
            SETCARRY;                                          <<01393>>05754000
            RETURN;                                            <<01393>>05756000
            END;                                               <<01393>>05758000
                                                               <<01393>>05760000
         IMPEDE(0)  <<IMPEDE SELF>>                                     05762000
                                                                        05764000
         <<SLEEP>>                                                      05766000
                                                                        05768000
         END                                                            05770000
   ELSE  <<NOT LOCKED>>                                                 05772000
      BEGIN                                                             05774000
      IF LOGICAL(CBLBREAK) AND PINTYPE = 0 THEN GO L1;  <<LOW PRI.?>>   05776000
      TOS := PIN;  <<MY PIN>>                                           05778000
      TOS.(0:8) := %201;  <<LOCK BIT AND COUNT>>                        05780000
      TOS.(1:1) := CBLBREAK;  <<BREAK MODE>>                            05782000
      CBLCONTROL := TOS;  <<UPDATE CONTROL WORD>>                       05784000
      IF UNLOCKTBL THEN FUNLOCKCB(CBTL,0);  <<UNLOCK TABLE?>>  <<01393>>05786000
      PSEUDOENABLE                                                      05788000
      END                                                               05790000
   END;                                                                 05792000
$ CONTROL SEGMENT = FILESYS1                                            05794000
PROCEDURE FUNLOCKCB (CBL,FLAGS);                                        05796000
   <<UNLOCKS A CONTROL BLOCK TABLE OR A SINGLE CONTROL BLOCK.           05798000
                                                                        05800000
     INPUT VARIABLES:                                                   05802000
         CBL - CONTROL BLOCK LOCK                                       05804000
         FLAGS - SPECIAL REQUEST MODES                                  05806000
            (13:1) - DESTROY BREAK QUEUE                                05808000
            (14:1) - CREATE BREAK QUEUE                                 05810000
                                                                        05812000
     NOTE THAT DB MUST BE SET TO THE DATA SEGMENT CONTAINING THE        05814000
     CONTROL BLOCK TABLE>>                                              05816000
   VALUE CBL,FLAGS;                                                     05818000
   INTEGER POINTER CBL;                                                 05820000
   LOGICAL FLAGS;                                                       05822000
   OPTION PRIVILEGED,UNCALLABLE;                                        05824000
   BEGIN                                                                05826000
   INTEGER PIN = Q+1;  <<CURRENT PROCESS NR.>>                          05828000
                                                                        05830000
   TOS := GETPROCNUM;  <<PIN NR.>>                                      05832000
   PSEUDODISABLE;                                                       05834000
   TOS := CBLCOUNT-1;  <<DECREMENT COUNT>>                              05836000
   IF = THEN  <<LAST REFERENCE?>>                                       05838000
      BEGIN                                                             05840000
      IF FLAGS.(14:1) THEN  <<CREATE BREAK QUEUE?>>                     05842000
         BEGIN                                                          05844000
         IF LOGICAL(CBLBREAK) THEN GO L1;  <<ALREADY IN BREAK MODE?>>   05846000
         CBLCONTROL := %040000;  <<BREAK MODE>>                         05848000
         CBLSAVEDQUEUE := CBLQUEUE;  <<SAVE IMPEDED QUEUE>>             05850000
         CBLQUEUE := 0  <<EMPTY IMPEDED QUEUE>>                         05852000
         END                                                            05854000
      ELSE  <<UNIMPEDE NEXT PROCESS>>                                   05856000
         BEGIN                                                          05858000
         IF FLAGS.(13:1) THEN  <<RESTORE SAVED QUEUE?>>                 05860000
            BEGIN                                                       05862000
            CBLBREAK := 0;  <<CLEAR BREAK MODE BIT>>                    05864000
            TOS := CBLQUEUE;  <<BREAK QUEUE>>                           05866000
            TOS := CBLSAVEDQUEUE;  <<SAVED QUEUE>>                      05868000
            IF = THEN  <<EMPTY SAVED QUEUE?>>                           05870000
               DEL                                                      05872000
            ELSE IF S1 = 0 THEN  <<EMPTY BREAK QUEUE?>>                 05874000
               DELB                                                     05876000
            ELSE  <<MERGE QUEUES>>                                      05878000
               BEGIN                                                    05880000
               PCB(BS1*PCBSIZE+8).(8:8) := S0.(8:8);  <<TAIL LINK>>     05882000
               BS1 := TOS.(0:8)  <<TAIL PIN>>                           05884000
               END;                                                     05886000
            CBLQUEUE := TOS;  <<NEW IMPEDED QUEUE>>                     05888000
            CBLSAVEDQUEUE := 0  <<EMPTY SAVED QUEUE>>                   05890000
            END;                                                        05892000
L1:      TOS := CBLQUEUE;  <<IMPEDED QUEUE>>                            05894000
         IF = THEN  <<EMPTY QUEUE?>>                                    05896000
            BEGIN                                                       05898000
            TOS.(1:1) := CBLBREAK;  <<BREAK MODE>>                      05900000
            CBLCONTROL := TOS  <<UNLOCKED>>                             05902000
            END                                                         05904000
         ELSE  <<NON-EMPTY QUEUE>>                                      05906000
            BEGIN                                                       05908000
            PIN := S0.(8:8);  <<SAVE HEAD PIN>>                         05910000
            TOS := PCBIQPTR;  <<NEW HEAD PIN>>                          05912000
            IF <> THEN TOS.(8:8) := TOS;  <<INSERT NEW HEAD PIN?>>      05914000
            PCB(X).(8:8) := 0;  <<CLEAR IMPEDED LINK>>                  05916000
            CBLQUEUE := TOS;  <<NEW IMPEDED QUEUE>>                     05918000
            CBLPIN := PIN;  <<PIN HOLDING LOCK>>                        05920000
            UNIMPEDE(PIN*PCBSIZE)  <<START HEAD PIN>>                   05922000
            END                                                         05924000
         END                                                            05926000
      END                                                               05928000
   ELSE  <<NOT LAST REFERENCE>>                                         05930000
      CBLCOUNT := TOS;   <<UPDATE COUNT>>                               05932000
   PSEUDOENABLE                                                         05934000
   END;                                                                 05936000
$ CONTROL SEGMENT = FILESYS1                                            05940000
PROCEDURE FGETCB (NEWVECTOR,DST,CB,VECTOR,FLAGS,S1,O1,S2,O2);  <<01393>>05942000
   <<SETS DB TO THE DATA SEGMENT CONTAINING THE SPECIFIED               05944000
     CONTROL BLOCK, INITIALIZES A POINTER TO THE CONTROL BLOCK AND      05946000
     (OPTIONALLY) LOCKS THE CONTROL BLOCK.  ALSO CHECKS TO SEE IF THE   05948000
     CONTROL BLOCK HAS MOVED, AS MAY BE THE CASE WITH AN FCB.  IF SO,   05950000
     THEN NEWVECTOR CONTAINS THE NEW VECTOR; OTHERWISE NEWVECTOR        05952000
     CONTAINS THE ORIGINAL VECTOR.                               01.03  05954000
                                                                        05956000
     INPUT VARIABLES:                                                   05958000
         VECTOR - CONTROL BLOCK VECTOR                                  05960000
         FLAGS - SPECIAL REQUEST MODES                                  05962000
            (1:1)  - CONDITIONAL LOCK (QUEUE, NO IMPEDE, RETURN  01393  05964000
                     PSEUDO-DISABLED) *** SET IN FGETCB ***      01393  05966000
            (14:1) - CREATE BREAK QUEUE                                 05968000
            (15:1) - LOCK CONTROL BLOCK                                 05970000
                                                                        05972000
         S1,O1   - PARAMETERS FOR CALL TO RELSIR                 01393  05974000
         S2,O2     (USED TO RELEASE SIRS, IF ANY)                01393  05976000
                                                                 01393  05978000
     OUTPUT VARIABLES:                                                  05980000
         NEWVECTOR - NEW VECTOR OF CONTROL BLOCK                        05982000
         DST - CALLER'S DST NR. (-1 IF DB NOT CHANGED)                  05984000
         CB - CONTROL BLOCK DB-REL. POINTER                             05986000
                                                                        05988000
     CONDITION CODE:                                                    05990000
         CCE - CB IN MY PXFILE AREA                                     05992000
         CCL - CB IN OTHER PXFILE AREA                                  05994000
         CCG - CB IN DATA SEGMENT                                       05996000
                                                                 01393  05998000
                                                                        06000000
     NOTE THAT THE OUTPUT VARIABLES ARE RETURNED BY A PARTIAL           06002000
     CUTBACK OF THE STACK>>                                             06004000
   VALUE NEWVECTOR,DST,CB,VECTOR,FLAGS,S1,O1,S2,O2;            <<01393>>06006000
   INTEGER NEWVECTOR,DST,VECTOR,S1,O1,S2,O2;                   <<01393>>06008000
   INTEGER POINTER CB;                                                  06010000
   LOGICAL FLAGS;                                                       06012000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                      <<01393>>06014000
   BEGIN                                                       <<+1.C3>>06016000
   INTEGER PMAP=Q-4;                                           <<01393>>06018000
   DEFINE SIR1= PMAP.(12:2)=3#,                                <<01393>>06020000
          SIR2= PMAP.(14:2)=3#,                                <<01393>>06022000
          CONDLOCK=SIR1#;                                      <<01393>>06024000
   INTEGER POINTER ACB = PS0;                   <<ACB POINTER>><<+1.C3>>06026000
   INTEGER POINTER FCB = CB;                    <<FCB POINTER>><<+1.C3>>06028000
   INTEGER VECTOROFFSET  = Q+1;         <<OFFSET FROM VT BASE>><<+1.C3>>06030000
   INTEGER VECTORDST     = Q+2;           <<DST OF THE VECTOR>><<+1.C3>>06032000
   INTEGER STACKDST      = Q+3;               <<STACK DST NR.>><<+1.C3>>06034000
   INTEGER EXTRADST      = Q+4;     <<EXTRA DATA SEG. DST NR.>><<+1.C3>>06036000
   INTEGER POINTER CBTAB = Q+5;          <<C.B. TABLE POINTER>><<+1.C3>>06038000
   INTEGER POINTER VT    = Q+6;          <<V.T. ENTRY POINTER>><<+1.C3>>06040000
                                                               <<+1.C3>>06042000
   TOS := VECTOR;                                              <<+1.C3>>06044000
   ASSEMBLE(DUP,STBX);              <<X := VECTOR ; TOS := S0>><<+1.C3>>06046000
   NEWVECTOR := TOS;<<VECTOR--INDICATE VECTOR HAS NOT CHANGED>><<+1.C3>>06048000
   TOS := TOS MAKE'AN'OFFSET;           <<VECTOROFFSET -- Q+1>><<+1.C3>>06050000
   TOS := X.(6:10);                       <<VECTOR DST -- Q+2>><<+1.C3>>06052000
   TOS := PCB'STK;      <<GET PCB03.(1:10)>><<STACKDST -- Q+3>><<+1.C3>>06054000
   X := X-1;                               <<POINT X TO PCB02>><<+1.C3>>06056000
   TOS := ABSOLUTE(X).(1:10);               <<EXTRADST -- Q+4>><<+1.C3>>06058000
   IF = THEN ASSEMBLE(STBX,LDXA)                               <<+1.C3>>06060000
   ELSE ASSEMBLE(DUP,STBX);                                    <<+1.C3>>06062000
      <<X := TOS := CURRENTDST -- EITHER STACKDST OR EXTRADST>><<+1.C3>>06064000
                                                               <<+1.C3>>06066000
   <<* * * FIND CONTROL BLOCK TABLE * * *>>                    <<+1.C3>>06068000
                                                               <<+1.C3>>06070000
   DST := -1;                       <<INDICATE DB NOT CHANGED>><<+1.C3>>06072000
   IF TOS <> VECTORDST THEN              << TOS IS CURRENTDST>><<+1.C3>>06074000
      BEGIN                                  <<DIFFERENT DSTS>><<+1.C3>>06076000
      TOS := 0;               <<ZERO FOR RESULT OF EXCHANGEDB>><<+1.C3>>06078000
      X := VECTORDST;                                          <<+1.C3>>06080000
      ASSEMBLE(LDXA,DUP);              <<TOS := VECTORDST;DUP>><<+1.C3>>06082000
      IF TOS = STACKDST THEN               <<TOS IS VECTORDST>><<+1.C3>>06084000
         TOS := TOS LAND 0;              <<NEED EXCHANGEDB(0)>><<+1.C3>>06086000
      DST := EXCHANGEDB(*);                << * IS VECTORDST >><<+1.C3>>06088000
      END;                                                     <<+1.C3>>06090000
   IF STACKCHECK(X) THEN                                       <<JB.IV>>06092000
      BEGIN                                                    <<+1.C3>>06094000
      IF X = STACKDST THEN          <<CURRENTDST IS MY STACK?>><<+1.C3>>06096000
         BEGIN                                                 <<+1.C3>>06098000
         TOS := CCE;                            <<MY STACK CC>><<+1.C3>>06100000
         DL'IN'MY'STACK;                                       <<+1.C3>>06102000
         END                                                   <<+1.C3>>06104000
      ELSE                                      <<OTHER STACK>><<+1.C3>>06106000
         BEGIN                                                 <<+1.C3>>06108000
         TOS := CCL;                         <<OTHER STACK CC>><<+1.C3>>06110000
         DL'IN'HIS'STACK;                                      <<+1.C3>>06112000
         END;                                                  <<+1.C3>>06114000
      CONV'DLTOCBTAB;                         <<CBTAB POINTER>><<+1.C3>>06116000
      END                                                      <<+1.C3>>06118000
   ELSE                                            <<C.B. DST>><<+1.C3>>06120000
      BEGIN                                                    <<+1.C3>>06122000
      TOS := AD'FSCBTAB'AND'ZERO;               <<TOS := CCG >><<+1.C3>>06124000
      END;                              <<TOS := @CBTAB (=0) >><<+1.C3>>06126000
   ASSEMBLE(XCH);                                              <<+1.C3>>06128000
   CONDCODE := TOS;<<SET CONDITON CODE ; TOS IS @CBTAB -- Q+5>><<+1.C3>>06130000
                                                               <<+1.C3>>06132000
   <<* * * CHECK FOR EASY CASE * * *>>                         <<+1.C3>>06134000
                                                               <<+1.C3>>06136000
   PSEUDODISABLE;                                              <<+1.C3>>06138000
   ASSEMBLE(DUP,STBX);              <<X := TOS := @CBTAB--Q+5>><<+1.C3>>06140000
   TOS := TOS + CBTOVERHEAD + VECTOROFFSET;       <<VT -- Q+6>><<+1.C3>>06142000
   @CB := X + VTADR;                          << X IS @CBTAB >><<+1.C3>>06144000
   TOS := CBTLOCK;                                             <<+1.C3>>06146000
   TOS := VTCONTROL;                                           <<+1.C3>>06148000
   TOS := FLAGS LAND 6; <<FLAGS.(13:2)=CREATE/DESTROY BREAK Q>><<+1.C3>>06150000
   ASSEMBLE(OR,OR;DEL);                                        <<+1.C3>>06152000
   IF = THEN                                                   <<+1.C3>>06154000
      BEGIN                                       <<EASY CASE>><<+1.C3>>06156000
$     IF X2 = ON                                               <<+1.C3>>06158000
      IF CBTDSTX <> VECTORDST                                  <<+1.C3>>06160000
      OR NOT (0 <= VECTOROFFSET <= CBTVTSIZE-VTENTRY)          <<+1.C3>>06162000
      OR NOT(CBTOVERHEAD+CBTVTSIZE <= VTADR <= CBTSIZE)        <<+1.C3>>06164000
      THEN BEGIN PSEUDOENABLE; FTROUBLE(450); END;   <<+1.C3>> <<KJ.03>>06166000
$     IF                                                       <<+1.C3>>06168000
      IF FLAGS THEN                      <<LOCK CONTROL BLOCK>><<+1.C3>>06170000
         VTCONTROL := GETPROCNUM + %100400;      <<%201:MYPIN>><<+1.C3>>06172000
      PSEUDOENABLE;                                            <<+1.C3>>06174000
      END                                      <<OF EASY CASE>><<+1.C3>>06176000
   ELSE                                                        <<+1.C3>>06178000
      BEGIN                                  <<DIFFICULT CASE>><<+1.C3>>06180000
      PSEUDOENABLE;                                            <<+1.C3>>06182000
      FLOCKCB(CBTLOCK,0);                        <<LOCK TABLE>><<+1.C3>>06184000
      @CB := @CBTAB+VTADR;            <<CONTROL BLOCK POINTER>><<+1.C3>>06186000
$     IF X2 = ON                                               <<+1.C3>>06188000
      IF CBTDSTX <> VECTORDST                      <<BAD DST?>><<+1.C3>>06190000
      OR NOT (0 <= VECTOROFFSET <= CBTVTSIZE-VTENTRY)          <<+1.C3>>06192000
      OR NOT(CBTOVERHEAD+CBTVTSIZE <= VTADR <= CBTSIZE)        <<+1.C3>>06194000
      THEN FTROUBLE(450);                            <<+1.C3>> <<KJ.03>>06196000
                                                                        06198000
$     IF                                                       <<+1.C3>>06200000
      IF FLAGS THEN                                            <<01882>>06202000
         BEGIN      << Lock control block. >>                  <<01882>>06204000
         IF CONDLOCK THEN FLAGS.(1:1):=1;                      <<01393>>06206000
         FLOCKCB(VTCONTROL,FLAGS,CBTLOCK);                     <<01393>>06208000
         IF CARRY THEN           << Queued for control block >><<01393>>06210000
            BEGIN                                              <<01393>>06212000
            IF SIR1 THEN   <<Need to release one or more sirs>><<01393>>06214000
               BEGIN                                           <<01393>>06216000
               IF O1<>-1 THEN RELSIR(S1,O1);                   <<01393>>06218000
               IF SIR2 AND O2 <> -1 THEN RELSIR(S2,O2);        <<01393>>06220000
               END;                                            <<01393>>06222000
            IMPEDE(0);            << Wait for control block  >><<01393>>06224000
            IF SIR1 THEN    <<Need to re-get one or more sirs>><<01393>>06226000
               BEGIN                                           <<01393>>06228000
               O1:=GETSIR(S1);                                 <<01393>>06230000
               IF SIR2 THEN O2:=GETSIR(S2);                    <<01393>>06232000
               END;                                            <<01393>>06234000
            END;                                               <<01393>>06236000
         END        << lock control block >>                   <<01882>>06238000
      ELSE                                     <<UNLOCK TABLE>><<+1.C3>>06240000
         FUNLOCKCB(CBTLOCK,0);                                 <<+1.C3>>06242000
      END;        << of difficult case >>                      <<01882>>06244000
                                                                        06246000
                                                                        06250000
   RETURN 7;                                                   <<01393>>06252000
   END;                                                                 06254000
$ CONTROL SEGMENT = FILESYS1                                            06258000
PROCEDURE FRELCB (DST,VECTOR,FLAGS);                           <<+1.C3>>06260000
   <<RESETS DB TO THE DATA SEGMENT SPECIFIED BY DST, FROM THE DATA      06262000
     SEGMENT CONTAINING THE CONTROL BLOCK SPECIFIED BY VECTOR,          06264000
     AND (OPTIONALLY) UNLOCKS THE CONTROL BLOCK.                        06266000
                                                                        06268000
     INPUT VARIABLES:                                                   06270000
         DST - DST PARAMETER FROM FGETCB                                06272000
         VECTOR - VECTOR PARAMETER TO FGETCB                            06274000
         FLAGS - SPECIAL REQUEST MODES                                  06276000
            (13:1) - DESTROY BREAK QUEUE                                06278000
            (14:1) - CREATE BREAK QUEUE                                 06280000
            (15:1) - UNLOCK CONTROL BLOCK                               06282000
     >>                                                                 06284000
   VALUE DST,VECTOR,FLAGS;                                              06286000
   INTEGER DST,VECTOR;                                                  06288000
   LOGICAL FLAGS;                                                       06290000
   OPTION PRIVILEGED,UNCALLABLE;                                        06292000
   BEGIN                                                       <<+1.C3>>06294000
   INTEGER VECTOROFFSET  = Q+1;        <<OFFSET FROM VT START>><<+1.C3>>06296000
   INTEGER STACKDST      = Q+2;               <<STACK DST NR.>><<+1.C3>>06298000
   INTEGER EXTRADST      = Q+3;     <<EXTRA DATA SEG. DST NR.>><<+1.C3>>06300000
   INTEGER POINTER CBTAB = Q+4;          <<C.B. TABLE POINTER>><<+1.C3>>06302000
   INTEGER POINTER VT    = Q+5;          <<V.T. ENTRY POINTER>><<+1.C3>>06304000
                                                               <<+1.C3>>06306000
   TOS :=  LOG(VECTOR) MAKE'AN'OFFSET;  <<VECTOROFFSET -- Q+1>><<+1.C3>>06308000
   TOS := PCB'STK;      <<GET PCB03.(1:10)>><<STACKDST -- Q+2>><<+1.C3>>06310000
   X := X-1;                               <<POINT X TO PCB02>><<+1.C3>>06312000
   TOS := ABSOLUTE(X).(1:10);               <<EXTRADST -- Q+3>><<+1.C3>>06314000
   IF = THEN ASSEMBLE(STBX) ELSE ASSEMBLE(DUP,STAX);           <<+1.C3>>06316000
             <<X := CURRENTDST -- EITHER EXTRADST OR STACKDST>><<+1.C3>>06318000
                                                               <<+1.C3>>06320000
   IF FLAGS THEN                       <<UNLOCK CONTROL BLOCK>><<+1.C3>>06322000
      BEGIN                                                    <<+1.C3>>06324000
                                                               <<+1.C3>>06326000
      <<* * * FIND CONTROL BLOCK TABLE * * *>>                 <<+1.C3>>06328000
                                                               <<+1.C3>>06330000
      IF STACKCHECK(X) THEN                                    <<JB.IV>>06332000
         BEGIN                                                 <<+1.C3>>06334000
         IF X = STACKDST THEN        <<CURRENTDST = MY STACK?>><<+1.C3>>06336000
            DL'IN'MY'STACK                                     <<+1.C3>>06338000
         ELSE                                   <<OTHER STACK>><<+1.C3>>06340000
            DL'IN'HIS'STACK;                                   <<+1.C3>>06342000
         CONV'DLTOCBTAB;                      <<@CBTAB -- Q+4>><<+1.C3>>06344000
         END                                                   <<+1.C3>>06346000
      ELSE                                         <<C.B. DST>><<+1.C3>>06348000
         TOS := AD'FSCBTAB;                   <<@CBTAB -- Q+4>><<+1.C3>>06350000
                                                               <<+1.C3>>06352000
   <<* * * CHECK FOR EASY CASE * * *>>                         <<+1.C3>>06354000
                                                               <<+1.C3>>06356000
      PSEUDODISABLE;                                           <<+1.C3>>06358000
      TOS := S0 + CBTOVERHEAD + VECTOROFFSET;    <<@VT -- Q+5>><<+1.C3>>06360000
      TOS := GETPROCNUM + %100400;               <<%201:MYPIN>><<+1.C3>>06362000
      IF TOS = VTCONTROL AND INTEGER( LOGICAL(VTQUEUE)         <<+1.C3>>06364000
      LOR ( LOGICAL(CBTLOCK) LOR (FLAGS LAND 6) ) ) = 0  THEN  <<+1.C3>>06366000
                        <<FLAGS.(13:2)=CREATE/DESTROY BREAK Q>><<+1.C3>>06368000
         BEGIN                                    <<EASY CASE>><<+1.C3>>06370000
$        IF X2 = ON                                            <<+1.C3>>06372000
         IF VECTOR.(6:10) <> CBTDSTX                           <<+1.C3>>06374000
         OR NOT(0 <= VECTOROFFSET <= CBTVTSIZE-VTENTRY)        <<+1.C3>>06376000
         OR NOT(CBTOVERHEAD+CBTVTSIZE <= VTADR <= CBTSIZE)     <<+1.C3>>06378000
         THEN BEGIN PSEUDOENABLE; FTROUBLE(451); END; <<+1.C3>><<KJ.03>>06380000
$        IF                                                    <<+1.C3>>06382000
         VTCONTROL := 0;               <<UNLOCK CONTROL BLOCK>><<+1.C3>>06384000
         PSEUDOENABLE;                                         <<+1.C3>>06386000
         END                               <<END OF EASY CASE>><<+1.C3>>06388000
      ELSE                                                     <<+1.C3>>06390000
         BEGIN                                    <<HARD CASE>><<+1.C3>>06392000
         PSEUDOENABLE;                                         <<+1.C3>>06394000
         FLOCKCB(CBTLOCK,0);                     <<LOCK TABLE>><<+1.C3>>06396000
$        IF X2 = ON                                            <<+1.C3>>06398000
         IF VECTOR.(6:10) <> CBTDSTX                           <<+1.C3>>06400000
         OR NOT(0 <= VECTOROFFSET <= CBTVTSIZE-VTENTRY)        <<+1.C3>>06402000
         OR NOT(CBTOVERHEAD+CBTVTSIZE <= VTADR <= CBTSIZE)     <<+1.C3>>06404000
         THEN FTROUBLE(451);                          <<+1.C3>><<KJ.03>>06406000
$        IF                                                    <<+1.C3>>06408000
         FUNLOCKCB(VTCONTROL,FLAGS);   <<UNLOCK CONTROL BLOCK>><<+1.C3>>06410000
         FUNLOCKCB(CBTLOCK,0)                  <<UNLOCK TABLE>><<+1.C3>>06412000
         END;                                     <<HARD CASE>><<+1.C3>>06414000
      END;                                 <<END OF 'IF FLAG'>><<+1.C3>>06416000
                                                                        06418000
   <<* * * RESET DB * * *>>                                             06420000
                                                                        06422000
   IF DST <> -1 THEN EXCHANGEDB(DST)  <<RESTORE DB?>>                   06424000
   END;                                                                 06426000
$ CONTROL SEGMENT = FILESYS5                                            06428000
PROCEDURE FCREATECB (CB,VECTOR,STRATEGY,SIZE,TYPE);                     06430000
   <<FINDS SPACE IN A CONTROL BLOCK TABLE FOR A CONTROL BLOCK OF        06432000
     THE SPECIFIED SIZE AND TYPE:                                       06434000
                                                                        06436000
     INPUT VARIABLES:                                                   06438000
         STRATEGY - CONTROL BLOCK TABLE INSERTION STRATEGY              06440000
            >0 - USE STRATEGY NUMBER AS EXISTANT CBT DST NUMBER         06442000
                 (EITHER NOBUF OR SYSTEM CBT, NOT PXFILE CBT)           06444000
             0 - USE THE PXFILE CONTROL BLOCK TABLE                     06446000
            -1 - USE/CREATE A USER (NOBUF) CONTROL BLOCK TABLE          06448000
            -2 - USE/CREATE A SYSTEM CONTROL BLOCK TABLE                06450000
            -3 - CREATE NON-EXPANDABLE CONTROL BLOCK TABLE              06452000
            -4 - TRY STRATEGY 0, THEN TRY STRATEGY -1                   06454000
           -69 - SPECIAL KLUDGE FOR UCOP - CREATE USER CBT              06456000
         SIZE - CONTROL BLOCK SIZE IN WORDS                             06458000
         TYPE - CONTROL BLOCK TYPE                                      06460000
                                                                        06462000
     OUTPUT VARIABLES:                                                  06464000
         CB - DB-REL. CONTROL BLOCK POINTER                             06466000
         VECTOR - CONTROL BLOCK VECTOR                                  06468000
                                                                        06470000
     CONDITION CODE:                                                    06472000
         CCE - OK                                                       06474000
         CCL - NO ROOM                                                  06476000
                                                                        06478000
     NOTE THAT THE OUTPUT VARIABLES ARE RETURNED BY A PARTIAL           06480000
     CUTBACK OF THE STACK.  ALSO, NOTE THAT DB MUST BE SET TO THE       06482000
     STACK WHEN THIS PROCEDURE IS CALLED.  IF SUCCESSFUL DB WILL        06484000
     BE SET TO THE DATA SEGMENT CONTAINING THE NEW CONTROL BLOCK;       06486000
     OTHERWISE DB IS UNCHANGED>>                                        06488000
   VALUE CB,VECTOR,STRATEGY,SIZE,TYPE;                                  06490000
   INTEGER POINTER CB;                                                  06492000
   INTEGER VECTOR,STRATEGY,SIZE,TYPE;                                   06494000
   OPTION PRIVILEGED,UNCALLABLE;                                        06496000
   BEGIN                                                                06498000
   EQUATE                                                               06500000
   C0 = CBTVT4*VTENTRY,    <<VT SIZE - BUFFERED ACB CBT>>               06502000
   C1 = CBTVT3*VTENTRY,    <<VT SIZE - SYSTEM CBT>>                     06504000
   C2 = CBTVT2*VTENTRY,    <<VT SIZE - USER CBT>>                       06506000
   C3 = CBTOVERHEAD+C0+1,  <<TOTAL OVERHEAD FOR BUFFERED ACB CBT>>      06508000
   C4 = 64,                <<MAX. NR. VT ENTRIES>>                      06510000
   C5 = C4*VTENTRY,        <<MAX. VT SIZE>>                             06512000
   C6 = 4*VTENTRY;         <<VT SIZE INCREMENT>>                        06514000
   EQUATE                                                      <<00300>>06516000
   C10 = 128,              <<SHARED FCB CBT LIST SIZE>>        <<00300>>06518000
   C11 = 128;              << DITTO >>                         <<00300>>06520000
   DEFINE                                                               06522000
   DSTXSIZE = (ABSOLUTE(ABSOLUTE(DSTP)+DSTX&LSL(2)).(3:13)-1)&LSL(2)#;  06524000
   INTEGER ARRAY VTSIZE (-3:-1)=PB := C0,C1,C2;                         06526000
   INTEGER POINTER PXFILE;  <<PCBX FILE SECTION POINTER>>               06528000
   INTEGER POINTER PXFCBT;  <<NOBUF CBT TABLE>>                         06530000
   INTEGER PXFCBTNR := 0;  <<NOBUF CBT INDEX>>                          06532000
   INTEGER POINTER CBTAB;  <<CONTROL BLOCK TABLE POINTER>>              06534000
   INTEGER DSTX;  <<CURRENT CBT DST NR. (0 IF PXFILE)>>                 06536000
   INTEGER SHFCBX := 5;  << SHARED FCB CBT INDEX >>            <<00300>>06538000
   LOGICAL NEWDSTX := FALSE;  <<NEW DST CBT CREATED?>>                  06540000
   INTEGER A := -1;       << for File SIR >>                   <<01992>>06542000
                                                                        06544000
   SUBROUTINE CREATECBT;                                                06546000
      <<CREATES AND INITIALIZES A DATA SEGMENT CONTROL BLOCK TABLE.     06548000
        DSTX IS INITIALIZED WITH THE DST NUMBER>>                       06550000
      BEGIN                                                             06552000
$     IF X1 = ON                                                        06554000
        IF NEWDSTX THEN FTROUBLE(465); <<SHOULD CREATE ONE ONLY!  1.04>>06556000
$     IF                                                                06558000
                                                                        06560000
      <<* * * GET NEW DATA SEGMENT * * *>>                              06562000
                                                                        06564000
      TOS := 0;  <<FOR RESULT OF GETDATASEG>>                           06566000
      IF STRATEGY = -3 THEN  <<NON-EXPANDABLE?>>                        06568000
         BEGIN                                                          06570000
         TOS := C3+SIZE;  <<INIT. SIZE>>                                06572000
         ASSEMBLE(DUP)  <<MAX. SIZE>>                                   06574000
         END                                                            06576000
      ELSE  <<EXPANDABLE>>                                              06578000
         BEGIN                                                          06580000
         TOS := FSEGINIT;  <<INIT. SIZE>>                               06582000
         TOS := FSEGMAX  <<MAX. SIZE>>                                  06584000
         END;                                                           06586000
      DSTX := GETDATASEG(*,*);  <<GET DATA SEGMENT>>                    06588000
      IF <> THEN GO NOLUCK;  <<ERROR?>>                                 06590000
      NEWDSTX := TRUE;  <<SET NEW DST CBT CREATED FLAG>>                06592000
      IF STRATEGY = -2 THEN  << IF SHARED FCB DSTN, >>         <<00300>>06594000
         ADB0(SHFCBX) := DSTX;  << PUT INTO TABLE TABLE >>     <<00300>>06596000
                                                                        06598000
      <<* * * INITIALIZE NEW DATA SEGMENT * * *>>                       06600000
                                                                        06602000
      EXCHANGEDB(DSTX);  <<SET DB TO NEW DATA SEG.>>                    06604000
      @CBTAB := 0;  <<INIT. CB POINTER>>                                06606000
      FSSIZE := DSTXSIZE;  <<DATA SEG. SIZE>>                           06608000
      FSDSTX := DSTX;  <<DST NR.>>                                      06610000
      FSVTSIZE := VTSIZE(STRATEGY);  <<VECTOR TABLE SIZE>>              06612000
      CBTTYPEF := -STRATEGY;  << TYPE OF CBT >>                <<00429>>06614000
      ASSEMBLE(ZERO,ZERO);                                              06616000
      FSLOCK := TOS;  <<LOCK WORD>>                                     06618000
      FSQUEUE := TOS;  <<IMPEDED QUEUE>>                                06620000
      TOS := @FSVT; PS0 := 0;  <<CLEAR VECTOR TABLE>>                   06622000
      ASSEMBLE(DUP,INCB); TOS := VTSIZE(STRATEGY)-1;           <<00300>>06624000
      ASSEMBLE(MOVE 2);                                        <<00300>>06626000
      PS0 := FSSIZE-S0;  <<INIT. SINGLE GARBAGE CB>>                    06628000
      DEL                                                               06630000
      END;                                                              06632000
                                                                        06634000
$  IF X0 = ON                                                           06636000
   IF MONOTHER THEN  <<MONITORING?>>                                    06638000
      BEGIN                                                             06640000
      TOS := "FC"; TOS := "RE"; TOS := "AT"; TOS := "EC";               06642000
      TOS := "B ";                                                      06644000
      ASSEMBLE(ZERO,DZRO);                                              06646000
      FTITLE(*,*,*,*);                                                  06648000
      DEBUG                                                             06650000
      END;                                                              06652000
$  IF                                                                   06654000
                                                                        06656000
   SETPXFILE;  <<SET PXFILE POINTER>>                                   06658000
   @PXFCBT := @PXFCBT1;  <<INIT. NOBUF TABLE POINTER>>                  06660000
                                                                        06662000
   <<* * * LOCATE OR CREATE CONTROL BLOCK TABLE * * *>>                 06664000
                                                                        06666000
   IF STRATEGY > 0 THEN  <<CBT DST ALREADY EXISTS?>>                    06668000
      BEGIN                                                             06670000
      DSTX := STRATEGY;  <<CBT DST NR.>>                                06672000
      EXCHANGEDB(DSTX);  <<SET DB TO CBT DST>>                          06674000
      @CBTAB := 0  <<INIT. CBT POINTER>>                                06676000
      END                                                               06678000
   ELSE IF STRATEGY = 0 OR STRATEGY = -4 THEN  <<USE PXFILE CBT?>>      06680000
      BEGIN                                                             06682000
      IF PXFNOCB THEN GO NOLUCK;  <<CAN'T USE PXFILE?>>                 06684000
      DSTX := 0;  <<PXFILE DST NR.>>                                    06686000
      @CBTAB := @PXFCBTAB  <<INIT. CBT POINTER>>                        06688000
      END                                                               06690000
   ELSE IF STRATEGY = -1 THEN  <<USE A NOBUF CBT?>>                     06692000
      BEGIN                                                             06694000
L1:   DSTX := PXFCBT;  <<NOBUF CBT DST NR.>>                            06696000
      IF = THEN  <<CREATE A NOBUF CBT?>>                                06698000
         BEGIN                                                          06700000
         PUSH(Q); TOS := -TOS+@PXFCBT;  <<SAVE Q-REL. INDEX>>           06702000
         CREATECBT;  <<CREATE CBT>>                                     06704000
         AQ0(TOS) := DSTX  <<INSERT DST IN NOBUF TABLE>>                06706000
         END                                                            06708000
      ELSE  <<USE NOBUF DST>>                                           06710000
         BEGIN                                                          06712000
         EXCHANGEDB(DSTX);  <<SET DB TO CBT DST>>                       06714000
         @CBTAB := 0  <<INIT. CBT POINTER>>                             06716000
         END                                                            06718000
      END                                                               06720000
   ELSE IF STRATEGY = -2 THEN   << USE A SYSTEM CBT? >>        <<00300>>06722000
L2:   BEGIN  << BUILD A TABLE TABLE, IF WE HAVEN'T ONE >>      <<00300>>06724000
      A := GETSIR(FISIR);       << Protect Table Table >>      <<01992>>06726000
      IF ABSOLUTE(SHFCBDST) = 0 THEN BEGIN                     <<00300>>06728000
         TOS := GETDATASEG(C10,C11);                           <<00300>>06730000
         IF <> THEN GO NFG;     << ERROR? >>                   <<00300>>06732000
         ABSOLUTE(SHFCBDST) := S0;  << POST DST NR. >>         <<00300>>06734000
         EXCHANGEDB(S0);                                       <<00300>>06736000
         FSSIZE := C10;  << CONSTRUCT HEADER. TABLE TABLE >>   <<00300>>06738000
         FSDSTX := TOS;  << LOOKS LIKE A CBT WITHOUT VECTORS.>><<00300>>06740000
         FSVTSIZE := 0;                                        <<00300>>06742000
         FSLOCK := 0;                                          <<00300>>06744000
         FSQUEUE := 0;                                         <<00300>>06746000
         TOS := 3; ASSEMBLE(DUP,INCB);                         <<00300>>06748000
         TOS := C10-5; ASSEMBLE(MOVE 3);                       <<00300>>06750000
         END                                                   <<00300>>06752000
      ELSE EXCHANGEDB(ABSOLUTE(SHFCBDST));                     <<00300>>06754000
      DSTX := ADB0(SHFCBX);  << GET A SYS CBT NR. >>           <<00300>>06758000
      IF = THEN  <<CREATE SYSTEM CBT?>>                                 06760000
         CREATECBT  << CREATE CONTROL BLOCK TABLE >>           <<00300>>06762000
      ELSE  <<USE SYSTEM CBT>>                                          06764000
         BEGIN                                                          06766000
         EXCHANGEDB(DSTX);  <<SET DB TO CBT DST>>                       06768000
         @CBTAB := 0  <<INIT. CBT POINTER>>                             06770000
         END;                                                  <<00300>>06772000
      RELSIR(FISIR,A);                                         <<01992>>06774000
      END                                                               06776000
   ELSE IF STRATEGY = -3 THEN  <<CREATE NON-EXPANDABLE CBT?>>           06778000
      CREATECBT      << BUILD ONE & SET DB TO IT >>            <<00300>>06780000
   ELSE IF STRATEGY = -69 THEN  <<SPECIAL KLUDGE FOR UCOP?>>            06782000
      BEGIN COMMENT  To insure that a CBT exists for a job,    <<00441>>06784000
UCOP calls us to pre-allocate one, and puts its name into      <<00441>>06786000
PXFCBT1.  Whether it is in fact used depends on the CB         <<00441>>06788000
allocation strategy as well as on what files the job opens.    <<00441>>06790000
;                                                              <<00441>>06792000
      STRATEGY := -1;  <<FAKE USER CBT STRATEGY>>                       06794000
      CREATECBT;  <<CREATE EMPTY CBT>>                                  06796000
      TOS := CCE;                                                       06798000
      GO EXIT                                                           06800000
      END                                                               06802000
   ELSE  <<ILLEGAL STRATEGY!>>                                          06804000
           FTROUBLE(466); << ILLEGAL STRATEGY>>                <<KJ.03>>06806000
$  IF X2 = ON                                                           06808000
   TOS := DSTX;                                                         06810000
   IF = THEN TOS := TOS+PCB'STK;  <<STACK?>>                            06812000
        IF TOS <> CBTDSTX THEN FTROUBLE(460); <<BAD DST?>>     <<KJ.03>>06814000
$  IF                                                                   06816000
                                                                        06818000
   <<* * * LOCK CONTROL BLOCK TABLE * * *>>                             06820000
                                                                        06822000
   FLOCKCB(CBTLOCK,0);  <<LOCK TABLE>>                                  06824000
   @CB := @CBTVT+CBTVTSIZE;  <<FIRST CB>>                               06826000
                                                                        06828000
   <<* * * FIND VECTOR TABLE ENTRY * * *>>                              06830000
                                                                        06832000
   TOS := @CBTVT;  <<ENTRY POINTER>>                                    06834000
   TOS := 0;  <<ENTRY NR.>>                                             06836000
   TOS := CBTVTSIZE/VTENTRY;  <<ENTRY COUNTER>>                         06838000
   DO BEGIN                                                             06840000
      IF PS2 = 0 THEN  <<EUREKA?>>                                      06842000
         BEGIN                                                          06844000
         DEL;        << entry counter >>                       <<01992>>06846000
         GO GOTVT                                                       06848000
         END;                                                           06850000
      @PS2 := @PS2+VTENTRY;  <<NEXT ENTRY>>                             06852000
      ASSEMBLE(INCB,DECA)                                               06854000
      END UNTIL =;                                                      06856000
   DEL;       << entry counter >>                              <<01992>>06858000
                                                                        06860000
   <<* * * EXPAND VECTOR TABLE * * *>>                                  06862000
                                                                        06864000
   IF CBTYPE <> CBGARBAGE THEN GO NOFIT;  <<FIRST CB NOT GARBAGE?>>     06866000
   TOS := CBSIZE; TOS := C6; TOS := C5-CBTVTSIZE;                       06868000
   MIN3;  <<GET MIN OF THE THREE>>                                      06870000
   TOS := (TOS/VTENTRY)*VTENTRY;  <<MAKE IT A MULTIPLE OF VTENTRY>>     06872000
   ASSEMBLE(DUP,DUP);                                                   06874000
   IF TOS < VTENTRY THEN GO NOFIT2;  << not enough >>          <<01992>>06876000
   CBTVTSIZE := TOS+CBTVTSIZE;  <<ADJ. VT SIZE>>                        06878000
   TOS := CBSIZE-S0;  <<NEW GARBAGE BLOCK SIZE>>                        06880000
   ASSEMBLE(XCH);                                                       06882000
   @CB := @CB+TOS;  <<ADJ. FIRST CB POINTER>>                           06884000
   ASSEMBLE(TEST);                                                      06886000
   IF <> THEN CBDESCRIP := S0;  <<NEW GARBAGE DESCRIPTOR?>>             06888000
   DEL;                                                                 06890000
                                                                        06892000
   <<* * * FIND SPACE FOR NEW CONTROL BLOCK * * *>>                     06894000
                                                                        06896000
GOTVT:                                                                  06898000
   IF S0 >= 64 THEN GO NOFIT;  <<ILLEGAL ENTRY NR.?>>                   06900000
   DO BEGIN                                                             06902000
      IF CBTYPE = CBGARBAGE THEN                               <<00300>>06904000
        IF SIZE <= CBSIZE THEN GO GOTCB  << FIT >>             <<00300>>06906000
        ELSE IF @CB+CBSIZE = @CBTAB+CBTSIZE THEN               <<00300>>06908000
         GO EXPNT;  << LAST BLOCK IS GARBAGE >>                <<00300>>06910000
      @CB := @CB+CBSIZE  <<NEXT CB>>                                    06912000
      END UNTIL @CB = @CBTAB+CBTSIZE;                                   06914000
                                                                        06916000
   <<* * * EXPAND CONTROL BLOCK TABLE * * *>>                           06918000
                                                                        06920000
EXPNT:                                                         <<00300>>06922000
   IF DSTX = 0 THEN  <<STACK?>>                                         06924000
      BEGIN                                                             06926000
      IF PXFCBTSIZE+SIZE > PXFCBTSIZEMAX THEN GO NOFIT;  <<MAX?>>       06928000
      IF PXFSIZE-PXFOVERHEAD-PXFCBTSIZE-PXFAFTSIZE < SIZE THEN          06930000
         BEGIN                                                          06932000
         TOS := FALTPXFILE(SIZE);  <<EXPAND PXFILE AREA>>               06934000
         IF < THEN GO NOFIT;  <<ERROR?>>                                06936000
         @PXFILE := @PXFILE+S0;  <<RE-INIT.>>                           06938000
         @PXFCBT := @PXFCBT+S0;  <<RE-INIT.>>                           06940000
         @CBTAB := @CBTAB+S0;  <<RE-INIT.>>                             06942000
         @PS2 := @PS2+S0;  << ADJUST VT ENTRY PNTR >>          <<00300>>06944000
         @CB := @CB+TOS    << ADJUST CTRL BLK PNTR >>          <<00300>>06946000
         END;                                                           06948000
      CBTSIZE := CBTSIZE+SIZE;  <<EXPAND CB TABLE>>                     06950000
      END                                                               06952000
   ELSE  <<DATA SEGMENT>>                                               06954000
      BEGIN                                                             06956000
      ALTDSEGSIZE(DSTX,SIZE+@CB-CBTSIZE);  << EXPAND D. S. >>  <<00300>>06958000
      IF <> THEN GO NOFIT;  <<ERROR?>>                                  06960000
      CBTSIZE := DSTXSIZE;  <<NEW SIZE>>                                06962000
      END;                                                              06964000
   CBDESCRIP := CBTSIZE-(@CB-@CBTAB);   << NEW GARBAGE SIZE >> <<00300>>06966000
                                                                        06968000
 << Set up new control block at the end of the garbage area. >><<00300>>06970000
                                                                        06972000
GOTCB:                                                                  06974000
   CBSIZE := CBSIZE-SIZE;  <<ADJ. GARBAGE CB SIZE>>                     06976000
   @CB := @CB+CBSIZE;  <<SET POINTER TO NEW CB>>                        06978000
   TOS := @CB; PS0 := 0;  <<CLEAR CB>>                                  06980000
   ASSEMBLE(DUP,INCB); TOS := SIZE-1; ASSEMBLE(MOVE 3);                 06982000
   CBDESCRIP := TYPE&LSL(14)+SIZE;  <<INIT. CB DESCRIPTOR>>             06984000
                                                                        06986000
   <<* * * INITIALIZE NEW VECTOR TABLE ENTRY * * *>>                    06988000
                                                                        06990000
   TOS := TOS&LSL(10);  <<ADJUST VT ENTRY NR.>>                         06992000
   TOS := DSTX;  <<DST NR.>>                                            06994000
   IF = THEN TOS := TOS+PXFDSTX;  <<STACK?>>                            06996000
   VECTOR := TOS+TOS;  <<CB VECTOR>>                                    06998000
   PS0 := @CB-@CBTAB;  <<INIT. CB INDEX>>                               07000000
$  IF X2 = ON                                                           07002000
    IF CBTDSTX<>VECTOR.(6:10) THEN FTROUBLE(460); <<BAD DST?>> <<KJ.03>>07004000
   IF NOT (0 <= VECTOR.(0:6) <= CBTVTSIZE/VTENTRY-1) THEN               07006000
        FTROUBLE(454); <<BAD VT INDEX?>>                       <<KJ.03>>07008000
   IF NOT (CBTOVERHEAD+CBTVTSIZE <= PS0 <= CBTSIZE-1) THEN              07010000
        FTROUBLE(464); << BAD CB POINTER?>>                    <<KJ.03>>07012000
$  IF                                                                   07014000
   TOS := GETPROCNUM;  <<PIN NR.>>                                      07016000
   TOS.(0:8) := %201;  <<MARK AS LOCKED>>                               07018000
   ASSEMBLE(INCB,ZERO);                                                 07020000
   DPS2 := TOS;  <<INIT. REMAINDER OF VT ENTRY>>                        07022000
                                                                        07024000
   <<* * * UNLOCK CONTROL BLOCK TABLE * * *>>                           07026000
                                                                        07028000
   FUNLOCKCB(CBTLOCK,0);  <<UNLOCK TABLE>>                              07030000
   TOS := CCE;                                                          07032000
   GO EXIT;                                                             07034000
                                                                        07036000
   <<* * * TRY ALTERNATE STRATEGY * * *>>                               07038000
                                                                        07040000
NOFIT2:                                                        <<01992>>07042000
   DDEL;      << 2 0's >>                                      <<01992>>07044000
NOFIT:                                                                  07046000
   DDEL;      << VT entry pointer and index >>                 <<01992>>07048000
   FUNLOCKCB(CBTLOCK,0);  <<UNLOCK TABLE>>                              07050000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                07052000
                                                                        07054000
NOLUCK:                                                                 07056000
   IF STRATEGY = -1 THEN  <<TRY ANOTHER NOBUF CBT?>>                    07058000
      BEGIN                                                             07060000
      IF NEWDSTX THEN GO NFG;  <<JUST CREATED NEW CBT!>>                07062000
      PXFCBTNR := PXFCBTNR+1;  <<NEXT INDEX>>                           07064000
      @PXFCBT := @PXFCBT+1;  <<NEXT NOBUF TABLE POINTER>>               07066000
      IF PXFCBTNR = PXFCBTMAX THEN GO NFG;  <<NO MORE?>>                07068000
      GO L1                                                             07070000
      END;                                                              07072000
   IF STRATEGY = -4 THEN  <<TRY A NOBUF CBT?>>                          07074000
      BEGIN                                                             07076000
      STRATEGY := -1;  <<NOBUF STRATEGY>>                               07078000
      GO L1                                                             07080000
      END;                                                              07082000
   IF STRATEGY = -2 THEN  << SHARED FCB CBT? >>                <<00300>>07084000
      BEGIN                                                    <<00300>>07086000
      SHFCBX := SHFCBX+1;  << TRY ANOTHER SYSTEM CBT >>        <<00300>>07088000
      IF SHFCBX >= C11 THEN GO NFG; << TABLE TABLE FULL! >>    <<00300>>07090000
      GO L2   << TRY ANOTHER FCB DST. >>                       <<00300>>07092000
      END;                                                     <<00300>>07094000
                                                                        07096000
   <<* * * ERROR RECOVERY * * *>>                                       07098000
                                                                        07100000
NFG:                                                                    07102000
   IF NEWDSTX THEN  <<PURGE NEW CBT DST?>>                              07104000
      BEGIN                                                             07106000
      IF (-3 <= STRATEGY <= -1) THEN RELDATASEG(DSTX);  <<PURGE?>>      07108000
      IF STRATEGY = -1 THEN PXFCBT := 0;  <<CLEAR NOBUF DST?>>          07110000
      END;                                                              07112000
   TOS := CCL;  <<NO ROOM>>                                             07114000
                                                                        07116000
EXIT:                                                                   07118000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           07120000
   RETURN 3                                                             07122000
   END;            << procedure FCREATECB >>                            07124000
$ CONTROL SEGMENT = FILESYS5                                            07126000
PROCEDURE FDELETECB (VECTOR);                                           07128000
 << Deletes the control block having the specified vector.       00822  07130000
                                                                        07132000
     INPUT VARIABLES:                                                   07134000
         VECTOR - CONTROL BLOCK VECTOR                                  07136000
                                                                        07138000
     THIS PROCEDURE MAY BE CALLED WITH DB AT ANY DATA SEGMENT>>         07140000
   VALUE VECTOR;                                                        07142000
   INTEGER VECTOR;                                                      07144000
   OPTION PRIVILEGED,UNCALLABLE;                                        07146000
   BEGIN                                                                07148000
   INTEGER POINTER PXFILE;  <<PXFILE POINTER>>                          07150000
   INTEGER POINTER CBTAB;  <<CB TABLE POINTER>>                         07152000
   INTEGER CBTTYPE;  <<CB TABLE TYPE NR.>>                              07154000
   INTEGER POINTER BLK;  <<ACB BLOCK BUFFER POINTER>>                   07156000
 << ADDED VARIABLES MUST PRECEDE THIS POINT. >>                <<00300>>07158000
<< Parameters to FGETCB follow; do not rearrange. >>           <<00433>>07160000
   INTEGER NEWVECTOR;  <<NEW VECTOR>>                                   07162000
   INTEGER DST;  <<ORIG. DST>>                                          07164000
   INTEGER POINTER CB;  <<CONTROL BLOCK POINTER>>                       07166000
   INTEGER POINTER ACB = CB;                                            07168000
   DOUBLE CBPARMS = DST;  <<DST AND CB>>                                07170000
                                                                        07172000
$  IF X0 = ON                                                           07174000
   IF MONOTHER THEN  <<MONITORING?>>                                    07176000
      BEGIN                                                             07178000
      TOS := "FD"; TOS := "EL"; TOS := "ET"; TOS := "EC";               07180000
      TOS := "B ";                                                      07182000
      ASSEMBLE(ZERO,DZRO);                                              07184000
      FTITLE(*,*,*,*);                                                  07186000
      DEBUG                                                             07188000
      END;                                                              07190000
$  IF                                                                   07192000
                                                                        07194000
   <<* * * LOCATE CONTROL BLOCK * * *>>                                 07196000
                                                                        07198000
   FGETCB(*,*,*,VECTOR,0);  << SET NEWVECTOR, DST, CB >>       <<00300>>07200000
   PUSH(STATUS); TOS := TOS.CC;                                <<00300>>07202000
   CBTTYPE := -TOS+2;                                          <<00300>>07204000
   CASE *CBTTYPE OF                                            <<00300>>07206000
    BEGIN                                                      <<00300>>07208000
      BEGIN  << CCE: IN MY STACK >>                            <<00300>>07210000
      SETPXFILE;  <<INIT. PXFILE>>                                      07212000
      TOS := @PXFCBTAB;  <<CB TABLE POINTER>>                           07214000
      END;                                                     <<00300>>07216000
      BEGIN  << CCL: IN OTHER STACK >>                         <<00300>>07218000
      SETOTHERPXFILE;  <<INIT. PXFILE>>                                 07220000
      TOS := @PXFCBTAB;  <<CB TABLE POINTER>>                           07222000
      END;                                                     <<00300>>07224000
      BEGIN  << CCG: IN DATA SEGMENT >>                        <<00300>>07226000
      TOS := 0;  <<CB TABLE POINTER>>                                   07228000
      END;                                                     <<00300>>07230000
    END;  << OF CBTTYPE CASE >>                                <<00300>>07232000
   @CBTAB := TOS;  <<CB TABLE POINTER>>                                 07234000
   VECTOR := NEWVECTOR;  <<NEW VECTOR (JUST IN CASE)>>                  07236000
                                                                        07238000
   <<* * * LOCK CONTROL BLOCK TABLE * * *>>                             07240000
                                                                        07242000
   FLOCKCB(CBTLOCK,0);  <<LOCK CBT>>                                    07244000
                                                                        07246000
COMMENT  GET CONTROL BLOCK TABLE TYPE:                         <<00300>>07248000
  0 = PXFILE                                                   <<00300>>07250000
  1 = NOBUF [EXPANDABLE]                                       <<00300>>07252000
  2 = SYSTEM SHARED FCB                                        <<00300>>07254000
  3 = NON-EXPANDABLE [BUFFERED PACB];                          <<00300>>07256000
                                                               <<00300>>07258000
   CBTTYPE := CBTTYPEF;                                        <<00300>>07260000
                                                               <<00300>>07262000
   <<* * * CLEAR VECTOR TABLE ENTRY * * *>>                             07264000
                                                                        07266000
   TOS := @CBTVT+VECTOR.(0:6)*VTENTRY;  <<VT ENTRY POINTER>>            07268000
   ASSEMBLE(DZRO,ZERO);                                                 07270000
   DPS3 := TOS; PS1(2) := TOS;  <<CLEAR ENTRY>>                         07272000
                                                                        07274000
   <<* * * COMBINE CB WITH PREDECESSOR IF GARBAGE * * *>>               07276000
                                                                        07278000
   TOS := @CBTVT+CBTVTSIZE;  <<FIRST CB POINTER>>                       07280000
   IF @CB <> @PS0 THEN  <<NOT FIRST CB?>>                               07282000
      BEGIN                                                             07284000
      WHILE @PS0(PS0.(2:14)) <> @CB DO TOS := TOS+X;                    07286000
      IF PS0.(0:2) = CBGARBAGE THEN  <<PRED. IS GARBAGE?>>              07288000
         BEGIN                                                          07290000
         PS0.(2:14) := CBSIZE+X;  <<NEW GARBAGE SIZE>>                  07292000
         @CB := TOS  <<NEW CB POINTER>>                                 07294000
         END                                                            07296000
      END;                                                              07298000
                                                                        07300000
   <<* * * COMBINE CB WITH SUCCESSOR IF GARBAGE * * *>>                 07302000
                                                                        07304000
   TOS := @CB+CBSIZE;  <<SUCCESSOR CB POINTER>>                         07306000
   IF @PS0 <> @CBTAB+CBTSIZE AND PS0.(0:2) = CBGARBAGE THEN             07308000
      CBSIZE := CBSIZE+PS0.(2:14);  <<NEW GARBAGE SIZE>>                07310000
                                                                        07312000
   <<* * * MAKE GARBAGE OUT OF (COMBINED) CONTROL BLOCK * * *>>         07314000
                                                                        07316000
   CBTYPE := CBGARBAGE;  <<MAKE TYPE GARBAGE>>                          07318000
                                                                        07320000
   <<* * * DETERMINE IF CB TABLE IS EMPTY * * *>>                       07322000
                                                                        07324000
   @CB := @CBTVT+CBTVTSIZE;  <<FIRST CB>>                               07326000
   IF CBTYPE = CBGARBAGE AND @CB+CBSIZE = @CBTAB+CBTSIZE AND            07328000
    LOGICAL(CBTTYPE.(15:1)) THEN                               <<00300>>07330000
    BEGIN   << CBT IS EMPTY AND NOT SHARED. >>                 <<00300>>07332000
    EXCHANGEDB(0);  << Set DB to stack >>                      <<00433>>07334000
    IF CBTTYPE = 1 THEN    << IF NOBUF CBT, >>                 <<00433>>07336000
      BEGIN        << CLEAR OUT PXFILE POINTERS TO IT >>       <<00300>>07338000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              07340000
      TOS := @PXFCBT1;  <<FIRST USER CBT DST NR.>>                      07342000
      TOS := PXFCBTMAX;  <<NR. USER CBT'S>>                             07344000
      DO BEGIN                                                          07346000
         IF VECTOR.(6:10) = PS1 THEN PS1 := 0;  <<CLEAR DST NR.?>>      07348000
         ASSEMBLE(INCB,DECA)                                            07350000
         END UNTIL =;                                                   07352000
      DDEL;                                                             07354000
      END;  << OF CLEAR PXFILE POINTERS >>                     <<00300>>07356000
COMMENT  LATER, ADD PROVISION TO PURGE SHARED FCB CBT'S        <<00300>>07358000
AND DELETE THEIR NAMES FROM THE TABLE TABLE.  ;                <<00300>>07360000
$     IF X1 = ON                                                        07362000
comment -  DB should not have been at this segment before      <<00433>>07364000
we put it there with FGETCB.  It's a no-no to leave DB at a    <<00433>>07366000
nonexistent segment. ;                                         <<00433>>07368000
     IF DST = -1 OR DST = VECTOR.(6:10) THEN FTROUBLE(461);    <<KJ.03>>07370000
$     IF                                                                07372000
      RELDATASEG(VECTOR.(6:10))  <<RELEASE DST>>                        07374000
    END  << OF CBT IS EMPTY AND NOT SHARED >>                  <<00300>>07376000
   ELSE  <<UNLOCK C.B. TABLE>>                                          07378000
      FUNLOCKCB(CBTLOCK,0);  <<UNLOCK TABLE>>                           07380000
   IF DST <> -1 THEN EXCHANGEDB(DST)  <<RESET DB TO ORIG.>>             07382000
   END;      << procedure FDELETECB >>                                  07384000
$ PAGE "MPE-IV FILE SYSTEM - ACCESS CONTROL BLOCK MAINTENANCE"          07386000
<<----------------------------------------------------------------------07388000
*                                                                      *07390000
*  ACCESS CONTROL BLOCK (ACB) MAINTENANCE PROCEDURES                    07392000
*                                                                      *07394000
---------------------------------------------------------------------->>07396000
                                                                        07398000
$ CONTROL SEGMENT = FILESYS1                                            07404000
                                                               <<04517>>07406000
PROCEDURE UNLOCACB(AFTE,DST,ACB,PACBV,LACBV,FLAGS);   <<DS.03>><<+1.C3>>07408000
<<**********************************************************>> <<04517>>07410000
<<  This procedure is called by FOPEN and FOPENDA           >> <<04678>>07412000
<< and it  is  used  to  update the LACB (Logical ACB) from >> <<04678>>07416000
<< the PACB and to unlock the ACB via FUNLOCKCB.  DB must   >> <<04517>>07418000
<< set to the data segment containing the ACB upon entrance.>> <<04517>>07420000
<< Upon exit, DB is reset to the callers original DB.       >> <<04517>>07422000
<<   INPUT VARIABLES:                                       >> <<04517>>07424000
<<       AFTE - AFT Word 0                                  >> <<04517>>07426000
<<       DST - Caller's original DST number.                >> <<04517>>07428000
<<       ACB - ACB DB-Relative pointer.                     >> <<04517>>07430000
<<       PACBV - Physical ACB Vector                        >> <<04517>>07432000
<<       LACBV - Logical ACB Vector                         >> <<04517>>07434000
<<       FLAGS - Flag word                                  >> <<04517>>07436000
<<          (13:1) - Destroy bread queue                    >> <<04517>>07438000
<<          (14:1) - Create break queue                     >> <<04517>>07440000
<<                                                          >> <<04517>>07442000
<<   Again, DB must be set to the data segment containing   >> <<04517>>07444000
<<   the ACB and upon exit, DB will be set the callers DB   >> <<04517>>07446000
<<**********************************************************>> <<04517>>07448000
                                                               <<04517>>07450000
   VALUE AFTE,DST,PACBV,LACBV,FLAGS;                           <<DS.03>>07452000
   INTEGER AFTE,DST,PACBV,LACBV;                               <<DS.03>>07454000
   LOGICAL FLAGS;                                                       07456000
   INTEGER ARRAY ACB;                                                   07458000
   OPTION PRIVILEGED,UNCALLABLE;                                        07460000
   BEGIN                                                       <<+1.C3>>07462000
   DOUBLE ARRAY ACBDBL (*) = ACB;                              <<+1.C3>>07464000
   INTEGER PACBOFFSET      = Q+1;      <<OFFSET FROM VT TABLE>><<+1.C3>>07466000
   INTEGER STACKDST        = Q+2;             <<STACK DST NR.>><<+1.C3>>07468000
   INTEGER EXTRADST        = Q+3;   <<EXTRA DATA SEG. DST NR.>><<+1.C3>>07470000
   INTEGER CURRENTDST      = Q+4;                <<CURRENTDST>><<+1.C3>>07472000
   INTEGER POINTER PXFILE  = Q+5;            <<PXFILE POINTER>><<+1.C3>>07474000
   INTEGER POINTER CBTAB   = Q+6;        <<C.B. TABLE POINTER>><<+1.C3>>07476000
   INTEGER POINTER VT      = Q+7;        <<V.T. ENTRY POINTER>><<+1.C3>>07478000
   INTEGER ARRAY LACB (*)  = Q+8;               <<LACB BUFFER>><<+1.C3>>07480000
                                                               <<+1.C3>>07482000
   IF FSTYPE OR MSGTYPE THEN                                   <<HM.00>>07484000
   BEGIN << NORMAL FILE >>                            <<DS.00>><<+1.C3>>07486000
                                                               <<+1.C3>>07488000
   <<* * * INITIALIZE LOCAL VARIABLES * * *>>                  <<+1.C3>>07490000
                                                               <<+1.C3>>07492000
   TOS := LOGICAL(PACBV) MAKE'AN'OFFSET;  <<PACBOFFSET -- Q+1>><<+1.C3>>07494000
   TOS := PCB'STK;     <<GET PCB03.(1:10)>><<STACK DST -- Q+2>><<+1.C3>>07496000
   X := X-1;                               <<POINT X TO PCB02>><<+1.C3>>07498000
   TOS := ABSOLUTE(X).(1:10);              <<EXTRA DST -- Q+3>><<+1.C3>>07500000
   IF = THEN ASSEMBLE(STBX,LDXA) ELSE ASSEMBLE(DUP,STBX);      <<+1.C3>>07502000
    <<X := TOS :=  CURRENT DST -- EITHER EXTRADST OR STACKDST>><<+1.C3>>07504000
   IF STACKCHECK(X) THEN                                       <<JB.IV>>07506000
      BEGIN                                                    <<+1.C3>>07508000
      IF X = STACKDST THEN             <<CURRENTDST=MY STACK?>><<+1.C3>>07510000
         DL'IN'MY'STACK                                        <<+1.C3>>07512000
      ELSE                                      <<OTHER STACK>><<+1.C3>>07514000
         DL'IN'HIS'STACK;                                      <<+1.C3>>07516000
      CONV'DLTOPXFILE;                           <<PXFILE Q+5>><<+1.C3>>07518000
      ASSEMBLE(DUP);                <<ANOTHER COPY OF @PXFILE>><<+1.C3>>07520000
      CONV'PXFILETOCBTAB;                         <<CBTAB Q+6>><<+1.C3>>07522000
      END                                                      <<+1.C3>>07524000
   ELSE                                            <<C.B. DST>><<+1.C3>>07526000
      TOS := AD'FSCBTAB'AND'ZERO; <<PXFILE AND CBTAB POINTERS>><<+1.C3>>07528000
   TOS := 0;                                     <<VT POINTER>><<+1.C3>>07530000
                                                               <<+1.C3>>07532000
                                                               <<+1.C3>>07534000
   <<* * * MAKE ADJUSTMENTS FOR BREAK/UNBREAK * * *>>          <<+1.C3>>07536000
                                                               <<+1.C3>>07538000
   IF FLAGS&LSR(1) THEN                         <<BREAK MODE?>><<+1.C3>>07540000
      BEGIN                                                    <<+1.C3>>07542000
      ACBBREAK := 1;                         <<SET BREAK MODE>><<+1.C3>>07544000
      IF = THEN ACBSAVEEOFS := ACBEOFS      <<SAVE EOF FLAGS?>><<+1.C3>>07546000
      END;                                                     <<+1.C3>>07548000
   IF FLAGS&LSR(2) THEN                      <<NO BREAK MODE?>><<+1.C3>>07550000
      BEGIN                                                    <<+1.C3>>07552000
      ACBBREAK := 0;                       <<CLEAR BREAK MODE>><<+1.C3>>07554000
      ACBEOFS := ACBSAVEEOFS              <<RESTORE EOF FLAGS>><<+1.C3>>07556000
      END;                                                     <<+1.C3>>07558000
   FLAGS.(15:1) := 1;                        <<SET UNLOCK BIT>><<+1.C3>>07560000
                                                               <<+1.C3>>07562000
   <<* * * COPY LACB PART OF ACB TO STACK * * *>>              <<+1.C3>>07564000
                                                               <<+1.C3>>07566000
   IF LACBV <> 0 THEN                          <<LACB EXISTS?>><<+1.C3>>07568000
      BEGIN                                                    <<+1.C3>>07570000
<< First item stored back is LACB(2). >>                                07572000
      TOS := ACBNAME1;   << LACB(2 & 3) >>                              07574000
      TOS := ACBNAME2;                                                  07576000
      TOS := ACBFOPTIONS;                                               07578000
      TOS := ACBAOPTIONS;                                               07580000
      TOS := ACBRSIZE;                                                  07582000
      TOS := ACBBSIZE;                                                  07584000
      TOS := ACBDUM;                                                    07586000
      TOS := ACBCTL;                                                    07588000
      TOS := ACBLSTATE;                                                 07590000
      TOS := ACBMODW;                                                   07592000
      TOS := ACBERROR;                                                  07594000
      TOS := ACBTLOG;    << LACB(15) >>                                 07596000
      END;                                                     <<+1.C3>>07598000
                                                               <<+1.C3>>07600000
   <<* * * CHECK FOR EASY CASE * * *>>                         <<+1.C3>>07602000
                                                               <<+1.C3>>07604000
   PSEUDODISABLE;                                              <<+1.C3>>07606000
   @VT := @CBTVT + PACBOFFSET;                                 <<+1.C3>>07608000
   TOS := GETPROCNUM + %100400;                                <<+1.C3>>07610000
   IF TOS=VTCONTROL AND                                        <<+1.C3>>07612000
   INTEGER(LOGICAL(VTQUEUE)LOR(LOGICAL(CBTLOCK)                <<+1.C3>>07614000
   LOR (FLAGS LAND 6) ) ) = 0 THEN                             <<+1.C3>>07616000
                        <<FLAGS.(13:2)=CREATE/DESTROY BREAK Q>><<+1.C3>>07618000
      BEGIN                                                    <<+1.C3>>07620000
$     IF X2 = ON                                               <<+1.C3>>07622000
      IF PACBV.(6:10) <> CBTDSTX                               <<+1.C3>>07624000
      OR NOT (0 <= PACBOFFSET <= CBTVTSIZE-VTENTRY)            <<+1.C3>>07626000
      OR NOT (CBTOVERHEAD+CBTVTSIZE <= VTADR <= CBTSIZE)       <<+1.C3>>07628000
      THEN BEGIN PSEUDOENABLE;FTROUBLE(453);END;      <<+1.C3>><<KJ.03>>07630000
$     IF                                                       <<+1.C3>>07632000
      VTCONTROL := 0;                  <<UNLOCK CONTROL BLOCK>><<+1.C3>>07634000
      PSEUDOENABLE;                                            <<+1.C3>>07636000
      END                                                      <<+1.C3>>07638000
   ELSE                                                        <<+1.C3>>07640000
      BEGIN                                                    <<+1.C3>>07642000
      PSEUDOENABLE;                                            <<+1.C3>>07644000
      FLOCKCB(CBTLOCK,0);                        <<LOCK TABLE>><<+1.C3>>07646000
$     IF X2 = ON                                               <<+1.C3>>07648000
      IF PACBV.(6:10) <> CBTDSTX                               <<+1.C3>>07650000
      OR NOT (0 <= PACBOFFSET <= CBTVTSIZE-VTENTRY)            <<+1.C3>>07652000
      OR NOT (CBTOVERHEAD+CBTVTSIZE <= VTADR <= CBTSIZE)       <<+1.C3>>07654000
      THEN FTROUBLE(453);                             <<+1.C3>><<KJ.03>>07656000
$     IF                                                       <<+1.C3>>07658000
      FUNLOCKCB(VTCONTROL,FLAGS);      <<UNLOCK CONTROL BLOCK>><<+1.C3>>07660000
      FUNLOCKCB(CBTLOCK,0);                    <<UNLOCK TABLE>><<+1.C3>>07662000
      END;                                 <<END OF HARD CASE>><<+1.C3>>07664000
                                                               <<+1.C3>>07666000
   <<* * * UPDATE LACB FROM STACK * * *>>                      <<+1.C3>>07668000
                                                               <<+1.C3>>07670000
   IF LACBV <> 0 THEN                          <<LACB EXISTS?>><<+1.C3>>07672000
      BEGIN                                                    <<+1.C3>>07674000
      IF CURRENTDST<>STACKDST THEN                             <<+1.C3>>07676000
         BEGIN                                                 <<+1.C3>>07678000
         EXCHANGEDB(0);                                        <<+1.C3>>07680000
         CURRENTDST := STACKDST;                               <<+1.C3>>07682000
         SETPXFILE;              <<RESET PXFILE FOR OUR STACK>><<+1.C3>>07684000
         END;                                                  <<+1.C3>>07686000
      IF LACBV.(6:10) = STACKDST THEN        <<LACB IN STACK?>><<+1.C3>>07688000
         BEGIN                                                 <<+1.C3>>07690000
         TOS := LOGICAL(LACBV) MAKE'AN'OFFSET;                 <<+1.C3>>07692000
         TOS := TOS + @PXFVT;                        <<@BLOCK>><<+1.C3>>07694000
         TOS := PS0+@PXFCBTAB+2;        <<LACB TARGET ADDRESS>><<+1.C3>>07696000
         ASSEMBLE(DELB);                                       <<+1.C3>>07698000
         TOS := @LACB;                  <<LACB SOURCE ADDRESS>><<+1.C3>>07700000
         TOS := SIZELACB-2;                       <<LACB SIZE>><<+1.C3>>07702000
         ASSEMBLE(MOVE 3)                       <<UPDATE LACB>><<+1.C3>>07704000
         END                                                   <<+1.C3>>07706000
      ELSE                                <<LACB IN DATA SEG.>><<+1.C3>>07708000
         BEGIN                                                 <<+1.C3>>07710000
         TOS := LACBV.(6:10);                                  <<+1.C3>>07712000
         TOS := 0;              <<WILL HOLD LACB DISPLACEMENT>><<+1.C3>>07714000
         TOS := @S0;                   <<TARGET STACK ADDRESS>><<+1.C3>>07716000
         TOS := S2;                          <<SOURCE DST NR.>><<+1.C3>>07718000
         TOS := (LOG(LACBV) MAKE'AN'OFFSET) + AD'FSVT;         <<+1.C3>>07720000
         TOS := 1;                                             <<+1.C3>>07722000
         ASSEMBLE(MFDS 4);           <<GET V.T. ENTRY POINTER>><<+1.C3>>07724000
         TOS := TOS+2;                      <<ADJ. LACB DISP.>><<+1.C3>>07726000
         TOS := @LACB;                 <<SOURCE STACK ADDRESS>><<+1.C3>>07728000
         TOS := SIZELACB-2;                       <<LACB SIZE>><<+1.C3>>07730000
         ASSEMBLE(MTDS 4)                       <<UPDATE LACB>><<+1.C3>>07732000
         END                                                   <<+1.C3>>07734000
      END;                                                     <<+1.C3>>07736000
   IF CURRENTDST=STACKDST THEN CURRENTDST := 0;                <<+1.C3>>07738000
   IF DST<>-1 AND DST<>CURRENTDST THEN EXCHANGEDB(DST);        <<+1.C3>>07740000
   RETURN;                                       <<FOR FSTYPE>><<+1.C3>>07742000
   END;                                               <<DS.00>><<+1.C3>>07744000
                                                                        07746000
   <<* * * RESET DB TO CALLER'S ORIGINAL DB * * *>>            <<01.03>>07748000
                                                                        07750000
   IF DST <> -1 THEN EXCHANGEDB(DST)  <<RESTORE DB?>>                   07752000
   END;       << procedure UNLOCACB >>                                  07754000
$ CONTROL SEGMENT = FILESYS5                                            07756000
PROCEDURE SETACB (DST,ACB,PACBV,LACBV,FLAGS,AFTX,AOPTIONS,FOPTIONS,     07758000
   DTYPE,RSIZE,BSIZE,NUMBUFFERS,BLOCKFACTOR,DADDR,FCBSI,PINFO,          07760000
   DNTYPE'DISP,DISKADR,ENDPTR,EOFPTR,MSGINFO);                 <<HM.00>>07762000
   <<CREATES AN ACB (PHYSICAL ACB AND LOGICAL ACB, IF AOPTION BIT       07764000
     SET) AND PLACES THEM IN THE APPROPRIATE CONTROL BLOCK              07766000
     TABLE.                                                             07768000
                                                                        07770000
     INPUT VARIABLES:                                                   07772000
         FLAGS - PACB LOCKED FLAG                                       07774000
         AFTX - AFT ENTRY INDEX (FILE NUMBER)                           07776000
         AOPTIONS - AOPTIONS FROM FOPEN                                 07778000
         FOPTIONS - FOPTIONS FROM FOPEN                                 07780000
         DTYPE - DEVICE TYPE                                            07782000
         RSIZE - RECORD SIZE (IN BYTES)                                 07784000
         BSIZE - BLOCK SIZE (IN WORDS)                                  07786000
         NUMBUFFERS - NUMBER OF BUFFERS                                 07788000
         BLOCKFACTOR - BLOCKING FACTOR                                  07790000
         DADDR - LOGICAL DEVICE NUMBER (OF FIRST EXTENT IF DISC)        07792000
         FCBSI - FCB SIZE (NON-ZERO IF FCB WILL GO IN SAME CB TABLE)    07794000
         PINFO - SPOOLFILE INFO ARRAY                                   07796000
         DNTYPE'DISP - NAME TYPE AND DISPOSITION                        07798000
         DISKADR - DISK ADDRESS (FOR MULTI ACCESS SCAN)                 07800000
         ENDPTR  - END OF FILE DATA BLOCK                        HM.00  07802000
         EOFPTR  - EOF IN REC/BLOCKS                             HM.00  07804000
         MSGINFO - IPC FILE INFO ARRAY                           HM.00  07806000
                                                                        07808000
     OUTPUT VARIABLES:                                                  07810000
         DST - CALLER'S ORIGINAL DST NUMBER (ALWAYS 0)           01.03  07812000
         ACB - DB-REL. POINTER TO ACB                                   07814000
         PACBV - PHYSICAL ACB VECTOR                                    07816000
         LACBV - LOGICAL ACB VECTOR (IF EXISTANT)                       07818000
         FLAGS - FURTHER INFO                                           07820000
                                                                        07822000
     CONDITION CODE:                                                    07824000
         CCE - OK                                                       07826000
         CCL - ERROR                                                    07828000
                                                                        07830000
     NOTE THAT THE OUTPUT VARIABLES ARE RETURNED BY A PARTIAL           07832000
     CUTBACK OF THE STACK.  ALSO, DB MUST BE SET TO THE STACK WHEN      07834000
     THIS PROCEDURE IS CALLED.  IF SUCCESSFUL DB WILL BE SET TO         07836000
     THE DATA SEGMENT CONTAINING THE NEW ACB UPON RETURNING;            07838000
     OTHERWISE DB WILL BE UNCHANGED>>                                   07840000
   VALUE DST,PACBV,LACBV,FLAGS,AFTX,AOPTIONS,FOPTIONS,DTYPE,RSIZE,      07842000
      BSIZE,NUMBUFFERS,BLOCKFACTOR,DADDR,FCBSI,DNTYPE'DISP,             07844000
      DISKADR,ENDPTR,EOFPTR;                                   <<HM.00>>07846000
   INTEGER DST,PACBV,LACBV,AFTX,DTYPE,RSIZE,BSIZE,NUMBUFFERS,           07848000
      BLOCKFACTOR,DADDR,DNTYPE'DISP;                                    07850000
   INTEGER ARRAY ACB;                                                   07852000
   LOGICAL FLAGS,AOPTIONS,FOPTIONS,FCBSI;                               07854000
   ARRAY PINFO,MSGINFO;                                        <<HM.00>>07856000
   DOUBLE DISKADR,ENDPTR,EOFPTR;                               <<HM.00>>07858000
   OPTION PRIVILEGED,UNCALLABLE;                                        07860000
   BEGIN                                                                07862000
   EQUATE SLOP = CBTOVERHEAD+9+CBTVT4*VTENTRY;                          07864000
   INTEGER POINTER PXFILE;  <<PXFILE POINTER>>                          07866000
   DOUBLE ACBPARMS = ACB;  <<ACB AND PACBV>>                            07868000
   INTEGER ACBSI;  <<ACB SIZE - IN WORDS>>                              07870000
   INTEGER ACBX;  <<UTILITY VARIABLE>>                                  07872000
   DOUBLE POINTER ACBDBL = ACB;                                         07874000
   INTEGER POINTER BLK;  <<ACB BUFFER POINTER>>                         07876000
   DOUBLE POINTER BLKDBL = BLK;                                         07878000
   INTEGER P1 = DISKADR+0;                                              07880000
   INTEGER P2 = DISKADR+1;                                              07882000
   INTEGER POINTER LACB;  <<LACB POINTER>>                              07884000
   LOGICAL OLDSIR;  <<OLD FMAVT SIR>>                                   07886000
   LOGICAL PACBLOCKED;  <<PACB LOCKED FLAG>>                            07888000
                                                               <<HM.00>>07890000
   <<IPC ACCESS>>                                              <<HM.00>>07892000
   ARRAY IPCINFO(0:3)=Q;                                       <<HM.00>>07894000
   DOUBLE FILELIMIT=IPCINFO;                                   <<HM.00>>07896000
   DOUBLE NUMHEADEREC=IPCINFO+2;                               <<HM.00>>07898000
   LOGICAL MSGFILE,SAVEMSGFILE;                                <<HM.00>>07900000
                                                                        07902000
   <<SPOOLFILE ACCESS>>                                                 07904000
                                                                        07906000
   ARRAY SPINFO (0:13) = Q;                                             07908000
   LOGICAL SPOOLF = SPINFO+0;                                           07910000
   INTEGER POINTER XDDEP = SPINFO+1;                                    07912000
   INTEGER SPVDEV = SPINFO+5;                                           07914000
   INTEGER SPFOPT = SPINFO+6;                                           07916000
   INTEGER SPAOPT = SPINFO+7;                                           07918000
   INTEGER SPREC  = SPINFO+8;                                           07920000
   INTEGER SPSTATE= SPINFO+9;                                           07922000
   ARRAY SPFN (*) = SPINFO+10;                                          07924000
                                                                        07926000
$  IF X0 = ON                                                           07928000
   IF MONOTHER THEN  <<MONITORING?>>                                    07930000
      BEGIN                                                             07932000
      TOS := "SE"; TOS := "TA"; TOS := "CB";                            07934000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        07936000
      FTITLE(*,*,*,*);                                                  07938000
      DEBUG                                                             07940000
      END;                                                              07942000
$  IF                                                                   07944000
                                                                        07946000
   SETPXFILE;  <<INIT. PXFILE POINTER>>                                 07948000
   DST := 0;  <<INDICATE DB SET TO STACK>>                              07950000
   MOVE SPINFO := PINFO, (14);                                          07952000
   MSGFILE:=(FOPMSGFILE);                                      <<HM.00>>07954000
   IF AOPCOPY THEN MSGFILE:=FALSE;                             <<HM.00>>07956000
   SAVEMSGFILE:=(MSGFILE LAND NOT AOPWRITE);                   <<HM.00>>07958000
   IF MSGFILE THEN MOVE IPCINFO:=MSGINFO,(4);                  <<HM.00>>07960000
                                                                        07962000
   <<* * * CHECK LOGICAL/PHYSICAL ACB REQUIREMENTS * * *>>              07964000
                                                                        07966000
   LACBV := 0;                                                          07968000
   PACBLOCKED := FLAGS;                                                 07970000
   FLAGS := AOPMULTAC;                                                  07972000
   IF <> THEN  <<LACB REQUIRED?>>                                       07974000
      BEGIN                                                             07976000
      OLDSIR := GETSIR(FMAVTSIR);                                       07978000
      TOS := FLAGS;                                                     07980000
      TOS.(14:1) := 0;                                                  07982000
      IF <> THEN TOS:=%11;                                     <<HM.00>>07984000
      IF (LOGICAL(DTYPE) LAND %70) <> DIRACC THEN  <<NON-DISC?>>        07986000
         BEGIN                                                          07988000
         TOS.(13:1) := 1;                                               07990000
         DISKADR := 0D                                                  07992000
         END;                                                           07994000
      FLAGS := TOS;                                                     07996000
      P1.(0:8) := DADDR;                                                07998000
      IF (PACBV := SCANFMAVT(FLAGS LAND %14,P1,P2,0)) <> 0 THEN         08000000
         BEGIN                                                          08002000
         FLAGS.(11:1) := 1;                                             08004000
                       << Conditionally lock PACB>>            <<01393>>08006000
         FGETCB(0,0,DUM,PACBV,IF PACBLOCKED THEN 0 ELSE 1,     <<01393>>08008000
                FMAVTSIR,OLDSIR);                              <<01393>>08010000
   << If CB locked by another process, FMAVT SIR is released by  01393>>08012000
   << FGETCB; process is impeded until CB is free; SIRs are re-  01393>>08014000
   << acquired in FGETCB.  This dynamically reverses the lock    01393>>08016000
   << order of these resources!!! This conditional lock sequence 01393>>08018000
   << must be followed by EVERYONE locking both SIR(s) and PACB! 01393>>08020000
         @ACB := TOS;  <<INIT. ACB POINTER>>                            08022000
         DDEL;  <<DISCARD DST AND NEW VECTOR>>                          08024000
         GOTO CLACB                                                     08026000
         END                                                            08028000
      END;                                                              08030000
                                                                        08032000
   <<* * * ALLOCATE PHYSICAL ACB STORAGE * * *>>                        08034000
                                                                        08036000
   ACBSI := SIZEACB + (IF MSGFILE THEN MSGACBEXTEND ELSE 0);   <<HM.00>>08038000
   IF NOT AOPINHIBITBUF THEN  <<BUFFERING?>>                            08040000
      BEGIN                                                             08042000
      IF NUMBUFFERS > 16 THEN  <<TOO MANY BUFFERS?>>           <<HM.00>>08044000
         NUMBUFFERS:=16;                                       <<HM.00>>08046000
      IF MSGFILE THEN                                          <<HM.00>>08048000
         BEGIN                                                 <<HM.00>>08050000
         IF NUMBUFFERS <= 1 THEN NUMBUFFERS:=2;                <<HM.00>>08052000
         IF DBL(NUMBUFFERS) > (FILELIMIT/DBL(BLOCKFACTOR)) THEN<<HM.00>>08054000
            NUMBUFFERS:=INT(FILELIMIT)/BLOCKFACTOR;            <<HM.00>>08056000
         ACBSI:=ACBSI+NUMBUFFERS;                              <<HM.00>>08058000
         END;                                                  <<HM.00>>08060000
L1:   TOS := BSIZE*NUMBUFFERS;       << buffer data space >>   <<01992>>08062000
      IF OVERFLOW OR TOS > MAXBUFFERS THEN          << too much. >>     08064000
         IF (NUMBUFFERS := NUMBUFFERS/2) = 0                   <<03035>>08066000
            OR MSGFILE AND NUMBUFFERS = 1 THEN GO NFG          <<03035>>08068000
            ELSE GO L1;   << try fewer buffers >>                       08070000
                                                                        08072000
      <<* * * CREATE PHYSICAL ACB WITH BUFFERS * * *>>                  08074000
                                                                        08076000
      ACBSI := ACBSI+NUMBUFFERS*(BSIZE+BLKBUFDISP); <<ACB SIZE <<00822>>08078000
      TOS := 0; TOS := 0;                                               08080000
      TOS := IF FLAGS=0 THEN -3  << ONE ACCESS - NON-EXP CBT >><<00300>>08082000
         ELSE -3;  << MULTI-ACCESS - NON-EXPANDABLE CBT >>     <<00300>>08084000
      TOS := ACBSI;                                                     08086000
      END                                                               08088000
   ELSE   << no buffering >>                                   <<00822>>08090000
      BEGIN                                                             08092000
      TOS := 0; TOS := 0;                                               08094000
      TOS := IF FLAGS=0 THEN -4  << SINGLE - PXFILE OR NOBUF >><<00300>>08096000
         ELSE -3;  << MULTI-ACCESS - NON-EXPANDABLE CBT >>     <<00300>>08098000
      TOS := ACBSI  <<SIZE>>                                            08100000
      END;                                                              08102000
   FCREATECB(*,*,*,*,CBPACB);  <<CREATE PACB>>                          08104000
   IF < THEN GO NFG;  <<ERROR?>>                                        08106000
   ACBPARMS := TOS;  <<ACB POINTER AND ACB VECTOR>>                     08108000
                                                                        08110000
   <<* * * INITIALIZE PHYSICAL ACB * * *>>                              08112000
                                                                        08114000
   ACBSHCNTS := 0;  <<INIT LACB COUNTS>>                                08116000
   ACBHIBLK := -1D;                                                     08118000
   ACBDTYPE := DTYPE;  <<DEVICE TYPE>>                                  08120000
   ACBDADDR := DADDR;  <<LOG. DEV. NR.>>                                08122000
   IF SPOOLF THEN  <<SPOOLFILE ACCESS?>>                                08124000
      BEGIN                                                             08126000
      ACBSPXDDX := @XDDEP;                                              08128000
      IF INTEGER(SPOOLF) > 0 THEN  <<VIRTUAL DEVICE?>>                  08130000
         BEGIN                                                          08132000
         ACBSPOOLIO := LOGICAL(ACBSPXDDX.(0:1)) LOR 2;                  08134000
         ACBSPVDEV := SPVDEV;                                           08136000
         ACBSPFOPT := SPFOPT;                                           08138000
         ACBSPAOPT := SPAOPT;                                           08140000
         ACBSPTYRC := SPREC                                             08142000
         END                                                            08144000
      END;                                                              08146000
   ACBRSIZE := RSIZE;  <<RECORD SIZE - IN BYTES>>                       08148000
   ACBBSIZE := BSIZE;  <<BLOCK SIZE - IN WORDS>>                        08150000
   ACBDNTD := DNTYPE'DISP;  << name type & disposition >>      <<*****>>08152000
   ACBBLKFACT := BLOCKFACTOR;  <<BLOCKING FACTOR>>                      08154000
   IF (SAVEMSGFILE OR AOPAPPEND) AND NOT AOPCOPY THEN          <<HM.00>>08156000
      BEGIN                                                    <<HM.00>>08158000
      IF MSGFILE OR FOPVARIABLE THEN ACBBLK:=ENDPTR;           <<HM.00>>08160000
      ACBFPTR:=EOFPTR;                                         <<HM.00>>08162000
      END;                                                     <<HM.00>>08164000
   IF NOT AOPINHIBITBUF THEN  <<BUFFERING?>>                            08166000
      BEGIN                                                             08168000
      ACBBUFSIZE := BLKBUFDISP+BSIZE;  <<block buffer size>>   <<00822>>08170000
      ACBNUMBUFS := NUMBUFFERS-1;  <<NR. BUFFERS LESS 1>>               08172000
      ACBBUFUSED := 0;  << init. record pointer >>             <<*****>>08174000
                                                                        08176000
      <<* * * INITIALIZE BLOCK BUFFERS * * *>>                          08178000
                                                                        08180000
      IF NOT MSGFILE OR AOPCOPY THEN                           <<HM.00>>08182000
         BEGIN                                                 <<HM.00>>08184000
         @BLK := @ACBBUFPOOL;  <<FIRST BLOCK BUFFER>>          <<HM.00>>08186000
         TOS := NUMBUFFERS;  <<NR. BUFFERS>>                   <<HM.00>>08188000
         DO BEGIN                                              <<HM.00>>08190000
            BLKBLOCK := -1D;  <<MARK BUFFER EMPTY>>            <<HM.00>>08192000
            @BLK := @BLK+ACBBUFSIZE;  <<NEXT BLOCK BUFFER>>    <<HM.00>>08194000
            TOS := TOS-1                                       <<HM.00>>08196000
            END UNTIL =;                                       <<HM.00>>08198000
         DEL                                                   <<HM.00>>08200000
         END;                                                  <<HM.00>>08202000
      END;                                                              08204000
                                                                        08206000
   <<* * * CREATE LOGICAL ACB * * *>>                                   08208000
                                                                        08210000
CLACB:                                                                  08212000
   IF FLAGS THEN  <<CREATE LACB?>>                                      08214000
      BEGIN                                                             08216000
      IF ACBSHCNT = %377 THEN GO NFG2;  <<TOO MANY ACCESSORS>> <<01.03>>08218000
                                                                        08220000
      <<* * * ALLOCATE LOGICAL ACB STORAGE * * *>>                      08222000
                                                                        08224000
      EXCHANGEDB(0);  <<RESET DB TO STACK>>                             08226000
      FCREATECB(DUM,0,-4,SIZELACB                              <<HM.00>>08228000
        +(IF MSGFILE THEN MSGLACBEXTEND ELSE 0),CBLACB);       <<HM.00>>08230000
      IF < THEN  <<ERROR?>>                                             08232000
         BEGIN                                                          08234000
         IF NOT FLAGS.(11:1) THEN DELACB(PACBV,0);  <<DELETE PACB?>>    08236000
         GO NFG                                                         08238000
         END;                                                           08240000
      LACBV := TOS;  <<LACB VECTOR>>                                    08242000
      @LACB := TOS;  <<LACB POINTER>>                                   08244000
                                                                        08246000
      <<* * * INITIALIZE LOGICAL ACB * * *>>                            08248000
                                                                        08250000
      LACBFNUM := AFTX;    << file nr. >>                               08252000
      LACBPACB := PACBV;  <<PACB VECTOR>>                               08254000
      EXCHANGEDB(PACBV.(6:10));  <<RESET DB TO PACB>>                   08256000
      IF NOT FLAGS.(11:1) THEN                                          08258000
         BEGIN                                                 <<04519>>08260000
         ACBFMAVTX := SCANFMAVT(FLAGS LAND %15,P1,P2,PACBV);            08262000
         IF ACBFMAVTX = 0    << Out of FMAVT entries        >> <<04519>>08264000
            THEN GO NOFMAVT;                                   <<04519>>08266000
         END;                                                  <<04519>>08268000
      ACBSHCNT := ACBSHCNT+1;                                           08270000
      IF AOPREAD THEN ACBSHCNTIN := ACBSHCNTIN+1                        08272000
      END;                                                              08274000
                                                                        08276000
   <<* * * INITIALIZE PACB WITH LACB VARIABLES * * *>>                  08278000
                                                                        08280000
   ACBFNUM := AFTX;  <<FILE NUMBER>>                                    08282000
   ACBFOPTIONS := FOPTIONS;  <<FOPTIONS>>                               08284000
   ACBAOPTIONS := AOPTIONS;  <<AOPTIONS>>                               08286000
   ACBLSTATE := 0;  <<CLEAR MISC. STATE FLAGS>>                         08288000
   IF (AOPINHIBITBUF) AND (AOPMULTIREC) AND (ACBDTYPE < CARDR) AND      08290000
      NOT ACBCIRFILE AND NOT ACBMSGFILE AND                    <<HM.00>>08292000
      ((BSIZE.(9:7) = 0) OR (DTYPE=FDISC))                     <<01115>>08294000
     THEN ACBSTREAM := 1;   <<STREAM I/O>>                     <<01115>>08296000
   ACBCTL := 0;                                                         08298000
   ACBMODE := 0;                                                        08300000
   ACBERROR := 0;                                                       08302000
   ACBTLOG := 0;                                                        08304000
   IF AOPINHIBITBUF THEN  <<TERMINAL KLUDGE?>>                          08306000
      BEGIN                                                             08308000
      ACBRSIZE := RSIZE;                                                08310000
      ACBBSIZE := BSIZE                                                 08312000
      END;                                                              08314000
   ACBSTOPCHAR := 0;                                           <<00.06>>08316000
                                                                        08318000
   IF MSGFILE THEN                                             <<HM.00>>08320000
      BEGIN                                                    <<HM.00>>08322000
      IF NOT FLAGS.(11:1)   <<ACB JUST CREATED>>               <<HM.00>>08324000
      AND (TOS:=FCINITACB(ACB,FILELIMIT,NUMHEADEREC,ENDPTR))   <<HM.00>>08326000
      <> SUCCESSFUL THEN                                       <<HM.00>>08328000
          GO NFG3;                                             <<HM.00>>08330000
      IF NOT ACBCOPY AND (TOS:=FCOPEN(ACB,LACBV)) <> SUCCESSFUL<<HM.00>>08332000
         THEN GO NFG3;                                         <<HM.00>>08334000
      END;                                                     <<04741>>08336000
                                                               <<04741>>08338000
   TOS := CCE;                                                 <<04741>>08340000
   GO EXIT;                                                             08342000
                                                                        08344000
NOFMAVT:                                                       <<04519>>08346000
   EXCHANGEDB(0);                                              <<04519>>08348000
   DELACB(PACBV,LACBV);                                        <<04519>>08350000
   TOS := CCG;                                                 <<04519>>08352000
   GO EXIT;                                                    <<04519>>08354000
                                                               <<04519>>08356000
NFG3:                                                          <<HM.00>>08358000
   EXCHANGEDB(0);     << DB from PACB to the stack >>          <<04156>>08360000
   DELACB(PACBV,LACBV);                                        <<HM.00>>08362000
   GO NFG;                                                     <<HM.00>>08364000
                                                               <<HM.00>>08366000
NFG2: FRELCB(0,PACBV,1) ;                                      <<01.03>>08368000
NFG:                                                                    08370000
   TOS := CCL;                                                          08372000
                                                                        08374000
EXIT:                                                                   08376000
   IF FLAGS THEN RELSIR(FMAVTSIR,OLDSIR);                               08378000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           08380000
   RETURN 19;                                                  <<HM.00>>08382000
   END;       << procedure SETACB >>                                    08384000
$ CONTROL SEGMENT = FILESYS7                                            08386000
PROCEDURE DELACB (PACBV,LACBV,ACCESS'TYPE);                    <<04796>>08388000
 VALUE   ACCESS'TYPE,PACBV,LACBV;                              <<04796>>08390000
 INTEGER ACCESS'TYPE,PACBV,LACBV;                              <<04796>>08392000
 OPTION  PRIVILEGED,UNCALLABLE,VARIABLE;                       <<04796>>08394000
                                                               <<04589>>08396000
 <<*********************************************************>> <<04589>>08398000
 << Deletes the LACB and, if this is the last accessor to   >> <<04589>>08400000
 << the PACB, it deletes the PACB also.  If the LACBV is    >> <<04589>>08402000
 << zero, then the file was not open multi-access.          >> <<04589>>08404000
 <<                                                         >> <<04796>>08406000
 << Input variable:                                         >> <<04796>>08408000
 <<   PACBV, LACBV - Physical and Logical ACB vectors.      >> <<04796>>08410000
 <<   ACCESS'TYPE  - Sent by FCLOSE. It is the access type  >> <<04796>>08412000
 <<                  of the file.  If read, then ACB share  >> <<04796>>08414000
 <<                  in count must by decremented.          >> <<04796>>08416000
 <<*********************************************************>> <<04589>>08418000
                                                               <<04589>>08420000
   BEGIN                                                                08422000
   INTEGER POINTER ACB;  <<ACB POINTER>>                                08424000
   INTEGER FMAVTX;                                                      08426000
   INTEGER CNT := 0,GMULTAC;                                   <<HM.00>>08428000
   LOGICAL PMAP = Q-4;                                         <<04796>>08430000
   DEFINE                                                      <<04796>>08432000
      FCLOSE'MODE     = PMAP.(15:1)#,                          <<04796>>08434000
      READ'ACCESS     = ACCESS'TYPE = 0#;                      <<04796>>08436000
                                                                        08438000
$  IF X0 = ON                                                           08440000
   IF MONOTHER THEN  <<MONITORING?>>                                    08442000
      BEGIN                                                             08444000
      TOS := "DE"; TOS := "LA"; TOS := "CB";                            08446000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        08448000
      FTITLE(*,*,*,*);                                                  08450000
      DEBUG                                                             08452000
      END;                                                              08454000
$  IF                                                                   08456000
                                                                        08458000
   <<*******************************************************>> <<04589>>08460000
   << If the file was opened multi-access (LACB exists),    >> <<04589>>08462000
   << then delete the LACB and decrement the ACB share cnt. >> <<04589>>08464000
   << and the read access share cnt. if open for read.  Ob- >> <<04589>>08466000
   << tain the Index of the FMAVT of the files entry and the>> <<04589>>08468000
   << global multi access bits for use by SCANFMAVT to de-  >> <<04589>>08470000
   << lete the corresponding FMAVT entry.                   >> <<04589>>08472000
   <<*******************************************************>> <<04589>>08474000
                                                               <<04589>>08476000
   IF LACBV <> 0 THEN  <<LACB EXISTS?>>                                 08478000
      BEGIN                                                             08480000
      FDELETECB(LACBV);  <<DELETE LACB>>                                08482000
      FGETCB(0,0,DUM,PACBV,0);  <<GET PACB>>                   <<01.02>>08484000
      @ACB := TOS;  <<INIT. ACB VECTOR>>                                08486000
      GMULTAC:=ACBGLOBALMULTAC;                                <<HM.00>>08488000
      IF FCLOSE'MODE AND READ'ACCESS                           <<04796>>08490000
         THEN ACBSHCNTIN := ACBSHCNTIN - 1;                    <<04796>>08492000
      ACBSHCNT := ACBSHCNT-1;                                           08494000
      CNT := ACBSHCNT;                                                  08496000
      FMAVTX := ACBFMAVTX;                                              08498000
      ASSEMBLE(XCH);                                                    08500000
      FRELCB(*,*,0)  <<RELEASE PACB>>                          <<04589>>08502000
      END;                                                              08504000
                                                               <<04589>>08506000
   <<*******************************************************>> <<04589>>08508000
   << If this is the last accessor to the PACB, then delete >> <<04589>>08510000
   << the FMAVT entry via SCANFMAVT and delete the PACB.    >> <<04589>>08512000
   <<*******************************************************>> <<04589>>08514000
                                                               <<04589>>08516000
   IF CNT <= 0 THEN                                                     08518000
      BEGIN                                                             08520000
      IF LACBV<>0 THEN SCANFMAVT(2+GMULTAC&LSL(3),FMAVTX,0,0); <<HM.00>>08522000
      FDELETECB(PACBV)  <<DELETE PACB>>                                 08524000
      END                                                               08526000
   END;                                                                 08528000
$PAGE                                                          <<04519>>08530000
$ CONTROL SEGMENT = FILESYS5                                            08532000
INTEGER PROCEDURE SCANFMAVT (FLAG,ONE,TWO,VECT);                        08534000
 VALUE   FLAG,ONE,TWO,VECT;                                             08536000
 INTEGER FLAG,ONE,TWO,VECT;                                             08538000
 OPTION  PRIVILEGED,UNCALLABLE;                                         08540000
                                                               <<04519>>08542000
<<**********************************************************>> <<04519>>08544000
<< SCANFMAVT will do one of the following:                  >> <<04519>>08546000
<< (1) Search for an entry based on Disk Address of the file>> <<04519>>08548000
<<     and Job or System multi.                             >> <<04519>>08550000
<< (2) Add a new entry.                                     >> <<04519>>08552000
<< (3) Delete an entry.                                     >> <<04519>>08554000
<<                                                          >> <<04519>>08556000
<< INPUT VARIABLES:                                         >> <<04519>>08558000
<<    FLAG.(12:1)=0 JOB, =1 SYSTEM MULTI-ACCESS             >> <<04519>>08560000
<<        .(13:1)=0 DISK,=1 DEVICE                          >> <<04519>>08562000
<<        .(14:2)=0 SEARCH FOR ENTRY(SCANFMAVT_PACB VECT)   >> <<04519>>08564000
<<               =1 ADD NEW ENTRY   (SCANFMAVT_FMAVT INDEX) >> <<04519>>08566000
<<               =2 DELETE ENTRY    (ONE=INDEX)             >> <<04519>>08568000
<<                                                          >> <<04519>>08570000
<<    ONE - Word one of the FMAVT , LDEV and HODA.          >> <<04519>>08572000
<<    TWO - Word two of the FMAVT , LODA.                   >> <<04519>>08574000
<<    VECT- Word three, the PACBV for adding an entry.      >> <<04519>>08576000
<<                                                          >> <<04519>>08578000
<< OUTPUT VARIABLES:                                        >> <<04519>>08580000
<<    SCANFMAVT - If we are adding an entry, the word index >> <<04519>>08582000
<<                into the FMAVT of the added entry.        >> <<04519>>08584000
<<                If we are searching for an entry, the     >> <<04519>>08586000
<<                PACBV, word 3, of the entry is returned.  >> <<04519>>08588000
<<                                                          >> <<04519>>08590000
<<   Returned condition code for Scan option:               >> <<04519>>08592000
<<                                                          >> <<04519>>08594000
<<      CCG - File's entry not found                        >> <<04519>>08596000
<<      CCE - File's entry found with either system multi-  >> <<04519>>08598000
<<            access opened by a process in the same job as >> <<04519>>08600000
<<            current opener.                               >> <<04519>>08602000
<<      CCL - Entry found, but caller is not eligible.      >> <<04519>>08604000
<<                                                          >> <<04519>>08606000
<<**********************************************************>> <<04519>>08608000
$PAGE                                                          <<04519>>08610000
  BEGIN                                                                 08612000
   INTEGER CURR'FMAVT'SIZE=DB+0,<< Cur size of FMAVT, words >> <<04519>>08614000
           MAX'FMAVT'SIZE=DB+2,<< Max. allow. size to grow  >> <<04519>>08616000
           ENTRY'SIZE=DB+1; << Entry size, 4 words at pres. >> <<04519>>08618000
   INTEGER ARRAY FMAVTP(*) = DB + 0; << DB pointer in FMAVT >> <<04519>>08620000
   LOGICAL FOUND'ENTRY;     << Found entry looking for?     >> <<04519>>08622000
                                                               <<04519>>08624000
   DEFINE JOB =    FLAG.(12:1) = 0#,                           <<04519>>08626000
          SYSTEM = FLAG.(12:1) = 1#,                           <<04519>>08628000
          MODE   = FLAG.(14:2)#,                               <<04519>>08630000
          JITDST = (6:10)#;                                    <<04519>>08632000
   INTEGER TEST:=0,      << TEST against word 0 of entry.   >> <<04519>>08634000
           INDEX := 0,   << Index into FMAVT.               >> <<04519>>08636000
           ORIG'DB,      << DB upon entrance into procedure >> <<04519>>08638000
           DL'VAL,       << Value of DL from PUSH(DL)       >> <<04519>>08640000
            Q'VAL,       << Value of  Q from PUSH( Q)       >> <<04519>>08642000
           Q'REL'DL,     << Negative offset of Q to DL      >> <<04519>>08644000
           Q'REL'PXGLOB, << Q rel. neg. offset to PXGLOBAL  >> <<04519>>08646000
           BLANK;        << Index into FMAVT for blanking.  >> <<04519>>08648000
                                                               <<04519>>08650000
   EQUATE  SEARCH = 0, ADD = 1, DELETE = 2;                    <<04519>>08652000
                                                                        08654000
$  IF X0 = ON                                                           08656000
   IF MONOTHER THEN  <<MONITORING?>>                                    08658000
      BEGIN                                                             08660000
      TOS := "SC"; TOS := "AN"; TOS := "FM"; TOS := "AV";               08662000
      TOS := "T ";                                                      08664000
      ASSEMBLE(ZERO,DZRO);                                              08666000
      FTITLE(*,*,*,*);                                                  08668000
      DEBUG                                                             08670000
      END;                                                              08672000
$  IF                                                                   08674000
                                                                        08676000
   << Set TEST word to be compared with word zero of FMAVT  >> <<04519>>08678000
   << entries.  Set up Device, Global and JIT DST bits.     >> <<04519>>08680000
                                                               <<04519>>08682000
   SCANFMAVT := 0;                                             <<04519>>08684000
   IF MODE <> DELETE THEN                                      <<04519>>08686000
      BEGIN  << not deleting an entry >>                       <<01815>>08688000
      IF MODE=SEARCH  OR  JOB  THEN                            <<04519>>08690000
         BEGIN       << not adding a G-multi entry >>          <<01815>>08692000
         PUSH(DL); DL'VAL := TOS;                              <<04519>>08694000
         PUSH( Q);  Q'VAL := TOS;                              <<04519>>08696000
         Q'REL'DL := DL'VAL - Q'VAL;                           <<04519>>08698000
         Q'REL'PXGLOB := Q'REL'DL - AQ0(Q'REL'DL - 1);         <<04519>>08700000
         TEST := AQ0(Q'REL'PXGLOB+6).JITDST;                   <<04519>>08702000
         END;                                                           08704000
      TEST.(0:1) := 1;   << Bit 1 always on in FMAVT(0)     >> <<04519>>08706000
      TEST.(1:2) := FLAG.(12:2); << Device and Global bits. >> <<04519>>08708000
      END;                                                              08710000
                                                               <<04519>>08712000
   ORIG'DB := EXCHANGEDB(FMAVT);                               <<04519>>08714000
$PAGE                                                          <<04519>>08716000
   <<*******************************************************>> <<04519>>08718000
   << Now, either delete, add or scan for an entry.         >> <<04519>>08720000
   <<*******************************************************>> <<04519>>08722000
                                                               <<04519>>08724000
   CASE MODE OF                                                <<04519>>08726000
      BEGIN                                                    <<04519>>08728000
                                                               <<04519>>08730000
      <<****************************************************>> <<04519>>08732000
      << Searching for an entry.  Check against words 0 to 2>> <<04519>>08734000
      <<****************************************************>> <<04519>>08736000
                                                               <<04519>>08738000
      BEGIN                                                    <<04519>>08740000
      CONDCODE := CCG;      << Assume entry not found.      >> <<04519>>08742000
      FOUND'ENTRY := FALSE;                                    <<04519>>08744000
      INDEX := ENTRY'SIZE;  << Start at word 4, entry 1.    >> <<04519>>08746000
      WHILE INDEX < CURR'FMAVT'SIZE AND NOT FOUND'ENTRY DO     <<04519>>08748000
         BEGIN                                                 <<04519>>08750000
         IF FMAVTP(INDEX) <> 0 AND       << Used entry?     >> <<04519>>08752000
            FMAVTP(INDEX).(2:1) = TEST.(2:1) AND << Device? >> <<04519>>08754000
            FMAVTP(INDEX+1) = ONE AND  << LDEV and HODA     >> <<04519>>08756000
            FMAVTP(INDEX+2) = TWO THEN << LODA matches      >> <<04519>>08758000
            BEGIN  << Found a matching entry                >> <<04519>>08760000
            IF FMAVTP(INDEX).JITDST = TEST.JITDST OR           <<04519>>08762000
               FMAVTP(INDEX).JITDST = 0 THEN                   <<04519>>08764000
               BEGIN  << Matched JOB or G-multi (any job)   >> <<04519>>08766000
               SCANFMAVT := FMAVTP(INDEX + 3); << PACBV     >> <<04519>>08768000
               CONDCODE := CCE;                                <<04519>>08770000
               END                                             <<04519>>08772000
            ELSE                                               <<04519>>08774000
               CONDCODE := CCL;                                <<04519>>08776000
            FOUND'ENTRY := TRUE;                               <<04519>>08778000
            END;                                               <<04519>>08780000
         INDEX := INDEX + ENTRY'SIZE;                          <<04519>>08782000
         END;                                                  <<04519>>08784000
      END;                                                     <<04519>>08786000
$PAGE                                                          <<04519>>08788000
      <<****************************************************>> <<04519>>08790000
      << Adding an entry.  First, try to find an unused en- >> <<04519>>08792000
      << try.  If none available, enlarge table.  MAX'FMAVT'>> <<04519>>08794000
      << SIZE is largest possible.  When we hit that, we    >> <<04519>>08796000
      << zero it out, and if we try to expand again, FAIL ! >> <<04519>>08798000
      <<****************************************************>> <<04519>>08800000
                                                               <<04519>>08802000
      BEGIN                                                    <<04519>>08804000
      INDEX := ENTRY'SIZE; << Start at entry 1, word 4.     >> <<04519>>08806000
      WHILE INDEX < CURR'FMAVT'SIZE AND FMAVTP(INDEX) <> 0     <<04519>>08808000
         DO INDEX := INDEX + ENTRY'SIZE;                       <<04519>>08810000
                                                               <<04519>>08812000
      IF INDEX < CURR'FMAVT'SIZE THEN                          <<04519>>08814000
         BEGIN                     << Found an unused entry >> <<04519>>08816000
         FMAVTP(INDEX)   := TEST;  << Word 0                >> <<04519>>08818000
         FMAVTP(INDEX+1) := ONE;   << Word 1, LDEV and HODA >> <<04519>>08820000
         FMAVTP(INDEX+2) := TWO;   << LODA of disc address  >> <<04519>>08822000
         FMAVTP(INDEX+3) := VECT;  << Word 3, PACBV         >> <<04519>>08824000
         SCANFMAVT := INDEX;       << Return word index     >> <<04519>>08826000
         END                                                   <<04519>>08828000
      ELSE                                                     <<04519>>08830000
         BEGIN << No more unused entrys, enlarge table.     >> <<04519>>08832000
         IF MAX'FMAVT'SIZE = 0 THEN RETURN;                    <<04519>>08834000
         CURR'FMAVT'SIZE := CURR'FMAVT'SIZE + 128;             <<04519>>08836000
         IF CURR'FMAVT'SIZE >= MAX'FMAVT'SIZE THEN             <<04519>>08838000
            BEGIN                                              <<04519>>08840000
            CURR'FMAVT'SIZE := MAX'FMAVT'SIZE;                 <<04519>>08842000
            MAX'FMAVT'SIZE  := 0; << Can expand no more!    >> <<04519>>08844000
            END;                                               <<04519>>08846000
                                                               <<04519>>08848000
         << Expand and blank out table.                     >> <<04519>>08850000
                                                               <<04519>>08852000
         ALTDSEGSIZE(FMAVT,128);    << Enlarge table.       >> <<04519>>08854000
         IF <> THEN RETURN;         << No can do!           >> <<04519>>08856000
         BLANK := INDEX;                                       <<04519>>08858000
         DO                                                    <<04519>>08860000
           BEGIN                                               <<04519>>08862000
           FMAVTP(BLANK) := 0;                                 <<04519>>08864000
           BLANK := BLANK + ENTRY'SIZE;                        <<04519>>08866000
           END                                                 <<04519>>08868000
         UNTIL BLANK >= CURR'FMAVT'SIZE;                       <<04519>>08870000
                                                               <<04519>>08872000
         << Now fill in new entry.                          >> <<04519>>08874000
                                                               <<04519>>08876000
         FMAVTP(INDEX)   := TEST;  << Word 0                >> <<04519>>08878000
         FMAVTP(INDEX+1) := ONE;   << Word 1, LDEV and HODA >> <<04519>>08880000
         FMAVTP(INDEX+2) := TWO;   << LODA of disc address  >> <<04519>>08882000
         FMAVTP(INDEX+3) := VECT;  << Word 3, PACBV         >> <<04519>>08884000
         SCANFMAVT := INDEX;       << Return word index     >> <<04519>>08886000
         END;  << No more unused entrys, enlarge table.     >> <<04519>>08888000
      END;  << Adding an entry.                             >> <<04519>>08890000
$PAGE                                                          <<04519>>08892000
      <<****************************************************>> <<04519>>08894000
      << Delete an entry.  Zero out word 0 to delete.       >> <<04519>>08896000
      <<****************************************************>> <<04519>>08898000
                                                               <<04519>>08900000
      FMAVTP(ONE) := 0;  << It's gone, finished, no more!!! >> <<04519>>08902000
                                                               <<04519>>08904000
    END;  << End of CASE MODE OF Search, Add or Delete!     >> <<04519>>08906000
   EXCHANGEDB(ORIG'DB);  << Get back to DB upon entry.      >> <<04519>>08908000
  END;                                                                  08910000
$ PAGE "MPE-IV BASELINE FILE SYSTEM - FILE ACCESS SUPPORT"              08912000
<<----------------------------------------------------------------------08914000
*                                                                      *08916000
*  FILE ACCESS SUPPORT PROCEDURES                                      *08918000
*                                                                      *08920000
---------------------------------------------------------------------->>08922000
                                                                        08924000
$CONTROL SEGMENT=FILESYS1                                      <<01115>>08926000
DOUBLE PROCEDURE DISCSIZE(LDEV);                               <<01115>>08928000
                                                               <<01115>>08930000
   VALUE LDEV;                                                 <<01115>>08932000
   INTEGER LDEV;                                               <<01115>>08934000
                                                               <<01115>>08936000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01115>>08938000
                                                               <<01115>>08940000
   COMMENT   THIS PROCEDURE RETURNS THE NUMBER OF SECTORS      <<01115>>08942000
             FOR THE DISC ON DEVICE LDEV.  IT COMPUTES         <<01115>>08944000
             THIS NUMBER BASED ON THE TYPE AND SUBTYPE OF      <<01115>>08946000
             THE DEVICE AND, FOR FLOPPY DISCS, WHETHER         <<01115>>08948000
             AN HP OR IBM FORMAT FLOPPY IS MOUNTED AND         <<01115>>08950000
             WHETHER THE FLOPPY IS ONE OR TWO SIDED.           <<01115>>08952000
             THE COUNT IS COMPUTED BY MULTIPLYING THE          <<01115>>08954000
             MAXIMUM NUMBER OF CYLINDERS ON THE DEVICE BY      <<01115>>08956000
             THE NUMBER OF SECTORS PER CYLINDER.  THIS MAY     <<01115>>08958000
             BE AN OPTIMISTIC ESTIMATE IF ANY TRACK SPARING    <<01115>>08960000
             HAS BEEN DONE.  THE NUMBER RETURNED IS THE        <<01115>>08962000
             PROPER VALUE FOR A FOREIGN DISC FILESIZE.         <<01115>>08964000
           ;                                                   <<01115>>08966000
                                                               <<01115>>08968000
   BEGIN                                                       <<01115>>08970000
                                                               <<01115>>08972000
      INTEGER TYPE, SUBTYPE, TTTT, OLDDB;                      <<01115>>08974000
                                                               <<01115>>08976000
      << IF IN SPLIT STACK, GET OUT >>                         <<01115>>08978000
      CHECKDB;                                                 <<01115>>08980000
      IF <> THEN OLDDB:=EXCHANGEDB(0)  <<GET STACK>>           <<01115>>08982000
            ELSE OLDDB:=0;                                     <<01115>>08984000
                                                               <<01115>>08986000
      TYPE:=LDEVTOTYPE(LDEV);                                  <<01115>>08988000
      SUBTYPE:=LDEVTOSUBTYPE(LDEV);                            <<01115>>08990000
                                                               <<01115>>08992000
      << COMPUTE SIZE >>                                       <<01115>>08994000
                                                               <<01115>>08996000
      COMMENT COMPUTE THE DISC SIZE HERE *** ;                 <<01115>>08998000
                                                               <<01115>>09000000
      DISCSIZE:=2000000000D;  <<DEFAULT VALUE>>                <<01115>>09002000
                                                               <<01115>>09004000
      IF TYPE=0 THEN <<REAL DISC>>                             <<01115>>09006000
         IF NOT (4<=SUBTYPE<=9) THEN GO XIT <<DEFAULT>>        <<01115>>09008000
          ELSE                                                 <<01115>>09010000
           CASE SUBTYPE-4 OF <<DISCSIZE:=SEC/CYL * CYL>>       <<01115>>09012000
            BEGIN                                              <<01115>>09014000
             <<ST 4>> DISCSIZE:=96D*410D;                      <<01115>>09016000
             <<ST 5>> DISCSIZE:=48D*410D;                      <<01115>>09018000
             <<ST 6>> DISCSIZE:=144D*410D;                     <<01115>>09020000
             <<ST 7>> DISCSIZE:=144D*410D;                     <<01115>>09022000
             <<ST 8>> DISCSIZE:=240D*822D;                     <<01115>>09024000
             <<ST 9>> DISCSIZE:=576D*822D;                     <<01115>>09026000
            END                                                <<01115>>09028000
      ELSE IF TYPE=2 THEN <<FLEXIBLE DISC>>                    <<01115>>09030000
         BEGIN                                                 <<01115>>09032000
           TOS:=REQSTATUS(LDEV); <<GET TTTT STATUS FIELD>>     <<01115>>09034000
           ASSEMBLE(XCH;DEL;EXF 3:4);                          <<01115>>09036000
           TTTT:=TOS;                                          <<01115>>09038000
           IF 0<=TTTT<=8 THEN <<VALID>>                        <<01115>>09040000
             CASE TTTT OF                                      <<01115>>09042000
               BEGIN                                           <<01115>>09044000
                 <<0000>> DISCSIZE:=0D;        <<EMPTY DRV>>   <<01115>>09046000
                 <<0001>>     ;                <<BLANK 1-SIDED>> <<FDF>>09048000
                 <<0010>> DISCSIZE:=30D*67D;   <<HP 1-SIDED>>  <<01115>>09050000
                 <<0011>>     ;                <<DOESN'T OCCUR>> <<FDF>>09052000
                 <<0100>>     ;                <<DOESN'T OCCUR>> <<FDF>>09054000
                 <<0101>>     ;                <<DOESN'T OCCUR>> <<FDF>>09056000
                 <<0110>> DISCSIZE:=60D*67D;   <<HP 2-SIDED>>  <<01115>>09058000
                 <<0111>>     ;                <<DOESN'T OCCUR>> <<FDF>>09060000
                 <<1000>> DISCSIZE:=26D*75D;   <<IBM 1-SIDED>> <<01115>>09062000
               END;                                            <<01115>>09064000
         END;                                                  <<01115>>09066000
                                                               <<01115>>09068000
XIT:  IF OLDDB<>0 THEN EXCHANGEDB(OLDDB); <<RESTORE DB>>       <<01115>>09070000
   END; <<DISCSIZE>>                                           <<01115>>09072000
<<**********************************************************>> <<04517>>09074000
<<   FCONVBLK has been deleted and replaced with FCONV'BLK  >> <<04517>>09076000
<<**********************************************************>> <<04517>>09078000
                                                               <<04517>>09080000
$ PAGE "MPE-IV BASELINE FILE SYSTEM - DISC SPACE MAINTENANCE"           09084000
<<----------------------------------------------------------------------09086000
*                                                                      *09088000
*  DISC SPACE MAINTENANCE PROCEDURES                                    09090000
*                                                                      *09092000
---------------------------------------------------------------------->>09094000
                                                                        09096000
$ CONTROL SEGMENT = FILESYS6                                            09098000
INTEGER PROCEDURE FCREATE (DEVICE,FCB,FOPTIONS,RSIZE,BF,SECTOFF,NUMEXTS,09100000
   FLIM,INITALLOC,SPOOLF,XDDX,PVINFO);                         <<RV.PV>>09102000
   <<CREATES A NEW DISC FILE BY MAPPING THE FILE INTO EXTENTS,          09104000
     ALLOCATING THE INITIAL EXTENTS, AND INITIALIZES THE FCB BUFFER     09106000
     FOR THE FILE.                                                      09108000
                                                                        09110000
     INPUT PARAMETERS:                                                  09112000
         DEVICE - POSITIVE => LOGICAL DEVICE NUMBER                     09114000
                  NEGATIVE => DEVICE CLASS TABLE INDEX                  09116000
         FCB - FCB BUFFER                                               09118000
         FOPTIONS - FOPTIONS                                            09120000
         RSIZE - RECORD SIZE (POS. BYTES)                               09122000
         BF - BLOCKING FACTOR                                           09124000
         SECTOFF - NUMBER OF USER LABELS                                09126000
         NUMEXTS - NUMBER OF EXTENTS                                    09128000
         FLIM - NUMBER OF RECORDS IN THE FILE                           09130000
         INITALLOC - NUMBER OF INITIALLY ALLOCATED EXTENTS              09132000
                                                                        09134000
     OUTPUT PARAMETERS:                                                 09136000
         FCREATE - ERROR RETURN FROM DISKALLOC                          09138000
            0 - NO ERROR                                                09140000
            1 - Space not available                            ((DFS00))09142000
            2 - I/O error                                      ((DFS00))09144000
            3 - Free space allocation disabled                 ((DFS00))09146000
            4 - Device not available                           ((DFS00))09148000
            5 - Invalid device                                 ((DFS00))09150000
            6 - Extent size greater than 65K sectors           ((DFS00))09152000
            7 - Data offset greater thant 255 sectors          ((DFS00))09154000
                                                                        09156000
     NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS PROCEDURE          09158000
     IS CALLED>>                                                        09160000
   VALUE   DEVICE,FOPTIONS,RSIZE,BF,SECTOFF,NUMEXTS,FLIM,               09162000
           INITALLOC,SPOOLF,XDDX,PVINFO;                       <<RV.PV>>09164000
   INTEGER DEVICE,RSIZE,BF,NUMEXTS,                            <<00117>>09166000
           INITALLOC,XDDX,PVINFO;                              <<RV.PV>>09168000
   LOGICAL FOPTIONS,SPOOLF,SECTOFF;                            <<00117>>09170000
   INTEGER ARRAY FCB;                                                   09172000
   DOUBLE FLIM;                                                         09174000
   OPTION PRIVILEGED,UNCALLABLE;                                        09176000
   BEGIN                                                                09178000
   DOUBLE ARRAY FCBDBL (*) = FCB;                                       09180000
   DOUBLE POINTER EXTMAP;         << Extent map to FCLEAR.  >> <<04279>>09182000
   INTEGER FCBLEN;  <<FCB LENGTH>>                                      09184000
   LOGICAL EXTSIZE;   << NR. SECTORS IN EXTENT >>              <<00117>>09186000
   LOGICAL LASTEXTSIZE;  << NR. SECTORS IN LAST EXTENT >>      <<00117>>09188000
   INTEGER                                                     <<04330>>09190000
      I             ,  << Utility variable.                 >> <<04330>>09192000
      FLAB'ULAB'EXTS,  << Num. of extents needed for labels.>> <<04330>>09194000
      LDEV          ;  << LDEV of extent to FCLEAR.         >> <<04330>>09196000
   LOGICAL                                                     <<04330>>09198000
      CLEAR'NUM     ,  << Number of sectors to FCLEAR.      >> <<04330>>09200000
      CLEAR'SECTS   ,  << Total number of sectors to clear. >> <<04330>>09202000
      LI=I          ,                                          <<04330>>09204000
      SPB           ;  << Sectors per block                 >> <<04330>>09206000
                                                               <<04330>>09208000
   DOUBLE SECTTOT,  << # file sectors, includ. lablels.     >> <<04279>>09210000
          SECTADDR; << Sector Address of extent to FCLEAR.  >> <<04279>>09212000
   INTEGER                                                     <<04279>>09214000
       P1=SECTADDR; << Word one of sector address.          >> <<04279>>09216000
   INTEGER POINTER XDDEP;  <<XDD SUBENTRY>>                             09218000
   DOUBLE SPDADDR;  <<SPOOLFILE LABEL ADDRESS>>                         09220000
                                                                        09222000
$  IF X0 = ON                                                           09224000
   IF MONOTHER THEN  <<MONITORING?>>                                    09226000
      BEGIN                                                             09228000
      TOS := "FC"; TOS := "RE"; TOS := "AT"; TOS := "E ";               09230000
      ASSEMBLE(DZRO,DZRO);                                              09232000
      FTITLE(*,*,*,*);                                                  09234000
      DEBUG                                                             09236000
      END;                                                              09238000
$  IF                                                                   09240000
                                                                        09242000
   IF INTEGER (SPOOLF) > 0 THEN                                         09244000
      BEGIN                                                             09246000
      @XDDEP := XDDX;                                                   09248000
      SPDADDR := XDDSPOOLINFO(0D,2,XDDEP);  <<GET LABEL ADDR>> <<+1.03>>09250000
      END;                                                              09252000
   TOS:=GETBLKSIZE(RSIZE,BF,FOPTIONS);                         <<00630>>09254000
   SPB := (TOS+127)&LSR(7);  << SECTORS PER BLOCK >>                    09256000
   SECTOFF := ((SECTOFF+SPB)/SPB)*SPB;  <<OFFSET TO DATA>>              09258000
   IF SECTOFF > 255 THEN  << TOO BIG? >>                       <<00117>>09260000
      BEGIN                                                             09262000
      TOS := 7;                                                <<03509>>09264000
      GO EXIT                                                           09266000
      END;                                                              09268000
                                                                        09270000
   <<* * * COMPUTE FILE SIZE IN BLOCKS * * *>>                          09272000
                                                                        09274000
   IF FOPMSGFILE THEN FLIM:=FLIM+2D;  <<OPEN/CLOSE REC>>       <<HM.00>>09276000
   << Calculate number of blocks in the file for data   >>     <<01968>>09278000
   TOS := FLIM;                   << file limit >>             <<01968>>09280000
   TOS := DOUBLE(LOGICAL(BF));     << block factor >>          <<01968>>09282000
   ASMB(DDIV);                    << calc. # blks in file  >>  <<01968>>09284000
   IF TOS<>0D THEN TOS:=TOS+1D;   << round up if necessary >>  <<01968>>09286000
   <<  Calculate number of sectors in file for data  >>        <<01968>>09288000
   TOS := TOS*DOUBLE(SPB);       << Sectors in file >>         <<01968>>09290000
   IF OVERFLOW THEN  << Result is greater than the >>          <<01968>>09292000
      BEGIN          << largest positive doubleword. >>        <<01968>>09294000
E3:   TOS := 1;  << Error code >>                              <<03509>>09296000
      GO EXIT                                                  <<01968>>09298000
      END;                                                     <<01968>>09300000
   TOS := TOS+DOUBLE(SECTOFF);   << Add label sectors >>       <<01968>>09302000
   IF OVERFLOW OR CARRY THEN GO E3;   << Too big. >>           <<01968>>09304000
   SECTTOT := DS1;               << Total sectors in file >>   <<01968>>09306000
   IF NUMEXTS > MAXEXTENTS THEN  << Too many extents? >>       <<01968>>09308000
      NUMEXTS := MAXEXTENTS      << Maximum extents allowed >> <<01968>>09310000
   ELSE IF NUMEXTS < 1 THEN                                    <<01968>>09312000
      NUMEXTS := DEFNUMEXTS;     << Default no. of extents >>  <<01968>>09314000
   TOS := DOUBLE(NUMEXTS);       << No. of extents to try for>><<01968>>09316000
   ASMB(DDIV);                   << Sectors/extent, lv rmndr >><<01968>>09318000
   IF TOS <> 0D THEN TOS:=TOS+1D;<< Round up, if necessary >>  <<01968>>09320000
   IF S1 <> 0 THEN                                             <<01968>>09322000
      BEGIN       << Extent size > 2**16 sectors. >>           <<01968>>09324000
      TOS := 6;                                                <<03509>>09326000
      GO EXIT                                                  <<01968>>09328000
      END;                                                     <<01968>>09330000
   EXTSIZE := TOS;  <<NR. SECTORS IN EXTENT>>                           09332000
   IF (LI := EXTSIZE MOD SPB) <> 0 THEN                        <<00117>>09334000
      BEGIN                                                    <<01968>>09336000
      EXTSIZE := EXTSIZE-LI+SPB;   << Adjust extent size >>    <<01968>>09338000
      IF OVERFLOW OR CARRY THEN GO E3;   << Too big. >>        <<01968>>09340000
      END;                                                     <<01968>>09344000
   <<* * * RECOMPUTE LAST EXTENT SIZE * * *>>                           09346000
                                                                        09348000
   IF FOPMSGFILE THEN                                          <<HM.00>>09350000
      BEGIN                                                    <<HM.00>>09352000
      FLIM:=DBL(EXTSIZE/SPB)*DBL(NUMEXTS*BF)-DBL(BF);          <<HM.00>>09354000
      TOS := NUMEXTS;                                          <<HM.00>>09356000
      TOS := EXTSIZE;                                          <<HM.00>>09358000
      END                                                      <<HM.00>>09360000
   ELSE                                                        <<HM.00>>09362000
      BEGIN                                                    <<HM.00>>09364000
      TOS := SECTTOT;  <<TOTAL NR. SECTORS>>                   <<HM.00>>09366000
      TOS := EXTSIZE;  <<NR. SECTORS IN EXTENT>>               <<HM.00>>09368000
      ASSEMBLE(LDIV,TEST);                                     <<HM.00>>09370000
      IF <> THEN  <<SMALLER LAST EXTENT?>>                     <<HM.00>>09372000
         ASSEMBLE(INCB)                                        <<HM.00>>09374000
      ELSE  <<LAST EXTENT SAME SIZE>>                          <<HM.00>>09376000
         TOS := TOS+EXTSIZE;                                   <<HM.00>>09378000
      END;                                                     <<HM.00>>09380000
   LASTEXTSIZE := TOS;  <<NR. SECTORS LAST EXTENT>>                     09382000
   NUMEXTS := TOS MOD (MAXEXTENTS+1);  <<ADJUST NR. EXTENTS>>           09384000
                                                                        09386000
   <<* * * INITIALIZE FCB BUFFER * * *>>                                09388000
                                                                        09390000
   FCBLEN := SIZEBFCB+NUMEXTS&LSL(1);  <<FCB SIZE>>                     09392000
   TOS := @FCB; PS0 := 0;  <<CLEAR FCB BUFFER>>                         09394000
   ASSEMBLE(DUP,INCB); TOS := FCBLEN-1; ASSEMBLE(MOVE 3);               09396000
   FCBFOPTIONS := FOPTIONS;  <<FOPTIONS>>                               09398000
   FCBDEVICE := DEVICE;  <<DEVICE SPECIFICATION>>                       09400000
   FCBFLIM := FLIM;                                                     09402000
   FCBEXTSIZE := EXTSIZE;                                               09404000
   FCBLASTEXTSIZE := LASTEXTSIZE;  <<LAST EXTENT SIZE>>                 09406000
   FCBBLKFACT := BF;                                                    09408000
   FCBSECTPBLK := SPB;                                                  09410000
   FCBSECTOFF := SECTOFF;                                               09412000
   FCBNUMEXTS := NUMEXTS-1;                                             09414000
                                                                        09416000
   <<* * * ALLOCATE INITIAL EXTENTS OF FILE * * *>>                     09418000
                                                                        09420000
   IF INITALLOC <= 0 THEN  << No extent allocation? >>         <<01084>>09422000
      INITALLOC := 1  <<ALLOCATE FILE LABEL EXTENT>>                    09424000
   ELSE IF INITALLOC > NUMEXTS THEN  <<TOO MANY?>>                      09426000
      INITALLOC := NUMEXTS;  <<NR. EXT'S IN FILE>>                      09428000
   << Calculate minimum number of extents needed for labels >> <<04279>>09430000
      FLAB'ULAB'EXTS := (SECTOFF+EXTSIZE-1)/EXTSIZE;           <<04279>>09432000
      IF FLAB'ULAB'EXTS > INITALLOC                            <<04279>>09434000
         THEN INITALLOC := FLAB'ULAB'EXTS;                     <<04279>>09436000
   TOS := @FCBEXTMAP;  <<EXTENT MAP POINTER>>                           09438000
   X := 0;  <<EXTENT NR.>>                                              09440000
   TOS := INITALLOC;  <<EXTENT COUNTER>>                                09442000
   DO BEGIN                                                             09444000
      TOS := 0;  <<FIRST HALF OF EXTENT ENTRY>>                         09446000
      TOS := IF X = NUMEXTS-1 THEN LASTEXTSIZE ELSE EXTSIZE;            09448000
      DPS3(X) := TOS;  <<INIT. EXTENT ENTRY>>                           09450000
      ASSEMBLE(INCX,DECA)                                               09452000
      END UNTIL =;                                                      09454000
   IF INTEGER(SPOOLF) > 0 THEN  <<SPOOLED FILE?>>                       09456000
      BEGIN                                                             09458000
      FCBLABEL := SPDADDR;                                              09460000
      TOS := 0;                                                         09462000
      END                                                               09464000
   ELSE  <<REGULAR FILE>>                                               09466000
      BEGIN                                                             09468000
      TOS := DISKALLOC(IF SPOOLF THEN 0 ELSE DEVICE,INITALLOC,          09470000
         FCBEXTMAP,PVINFO).(8:8);  <<ALLOCATE EXTENTS>>        <<RV.PV>>09472000
      IF <> THEN GO EXIT;  <<ERROR>>                                    09474000
      FCBPVINFO := PVINFO;                                     <<RV.PV>>09476000
                                                               <<04279>>09478000
      << FCLEAR the label extents, usually only the first.  >> <<04279>>09480000
                                                               <<04279>>09482000
      @EXTMAP := @FCBEXTMAP;                                   <<04279>>09484000
      CLEAR'SECTS := SECTOFF;                                  <<04330>>09486000
      FOR I:=1 UNTIL FLAB'ULAB'EXTS DO                         <<04279>>09488000
         BEGIN                                                 <<04279>>09490000
         SECTADDR := EXTMAP(I-1);    << LDEV, HODA and LODA >> <<04279>>09492000
         LDEV := P1.(0:8);           << LDEV of extent.     >> <<04279>>09494000
         P1.(0:8) := 0;              << Clear out LDEV.     >> <<04279>>09496000
         IF CLEAR'SECTS > EXTSIZE    << Whole extent        >> <<04330>>09498000
            THEN CLEAR'NUM := EXTSIZE                          <<04330>>09500000
            ELSE CLEAR'NUM := CLEAR'SECTS;                     <<04330>>09502000
         FCLEAR(FALSE,LDEV,SECTADDR,CLEAR'NUM);                <<04279>>09504000
         CLEAR'SECTS := CLEAR'SECTS - CLEAR'NUM; << Cut back>> <<04330>>09506000
         END;                                                  <<04279>>09508000
                                                               <<04279>>09510000
      END;                                                              09512000
                                                                        09514000
   <<* * * INITIALIZE FCB BUFFER AGAIN * * *>>                          09516000
                                                                        09518000
   TOS := @I;  <<TEMP CELL>>                                            09520000
   TOS := LDT; TOS := FCBLDEV*LDTENTRY+2;                               09522000
   TOS := 1;                                                            09524000
   ASSEMBLE(MFDS 4);                                                    09526000
   FCBDTYPE := I;  <<DEVICE TYPE OF FIRST EXTENT>>                      09528000
   FCBSUBTYPE := LPDT(FCBLDEV*LPDTENTRY+1);  <<SUB-TYPE>>               09530000
                                                                        09532000
EXIT:                                                                   09534000
   FCREATE := TOS  <<ERROR NR.>>                                        09536000
   END;         << procedure FCREATE >>                                 09538000
$ CONTROL SEGMENT = FILESYS1                                            09540000
INTEGER PROCEDURE FCLEAR (ASCII,DADDR,SECTADDR,NUM);                    09542000
   <<CLEARS CONTIGUOUS DISC SPACE TO 0'S (BINARY) OR BLANKS (ASCII).    09544000
                                                                        09546000
     INPUT VARIABLES:                                                   09548000
         ASCII - FILL VALUE TO BE USED                                  09550000
            TRUE => ASCII FILE - USE "  "                               09552000
            FALSE => BINARY FILE - USE 0                                09554000
         DADDR - LOGICAL DEVICE NUMBER OF DISC                          09556000
         SECTADDR - STARTING SECTOR NUMBER                              09558000
         NUM - NUMBER OF SECTORS TO BE CLEARED                          09560000
                                                                        09562000
     OUTPUT VARIABLES:                                                  09564000
         FCLEAR - NOT USED                                              09566000
                                                                        09568000
     THIS PROCEDURE MAY BE CALLED WITH DB SET TO THE STACK OR ANY       09570000
     FILE DATA SEGMENT.  NOTE THAT I/O ERRORS ARE NOT REPORTED TO       09572000
     THE CALLING PROCEDURE>>                                            09574000
   VALUE ASCII,DADDR,SECTADDR,NUM;                                      09576000
   LOGICAL ASCII,DADDR,NUM;                                             09578000
   DOUBLE SECTADDR;                                                     09580000
   OPTION PRIVILEGED,UNCALLABLE;                                        09582000
   BEGIN                                                                09584000
   INTEGER P1 = SECTADDR;  <<SECTOR NR. - FIRST HALF>>                  09586000
   INTEGER P2 = SECTADDR+1;  <<SECTOR NR. - SECOND HALF>>               09588000
   DOUBLE DL := 0D;                                                     09590000
   LOGICAL L = DL+1;                                                    09592000
                                                                        09594000
$  IF X0 = ON                                                           09596000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               09598000
      BEGIN                                                             09600000
      TOS := "FC"; TOS := "LE"; TOS := "AR";                            09602000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        09604000
      FTITLE(*,*,*,*);                                                  09606000
      DEBUG                                                             09608000
      END;                                                              09610000
$  IF                                                                   09612000
                                                                        09614000
   DO BEGIN                                                             09616000
      L := IF NUM > 255 THEN 255 ELSE NUM;                              09618000
      TOS := ATTACHIO(DADDR,0,0,0,IF ASCII THEN 6 ELSE 5,               09620000
         L&LSL(7),P1,P2,BFLAGS);  <<CLEAR SECTORS>>            <<+0.05>>09622000
      DEL;                                                              09624000
      IF TOS.(8:8) <> 1 THEN RETURN;  <<ATTIO ERROR?>>                  09626000
      SECTADDR := SECTADDR+DL;                                          09628000
      NUM := NUM-L                                                      09630000
      END UNTIL =                                              <<01968>>09632000
   END;                                                                 09634000
$CONTROL SEGMENT = FILESYS7    << FSECTORS >>                           09636000
DOUBLE PROCEDURE FSECTORS (FLAB);                                       09638000
   <<COMPUTES THE TOTAL NUMBER OF SECTORS CURRENTLY ALLOCATED BY THE    09640000
     FILE OF THE SPECIFIED LABEL.                                       09642000
                                                                        09644000
     INPUT VARIABLES:                                                   09646000
         FLAB - FILE LABEL POINTER                                      09648000
                                                                        09650000
     OUTPUT VARIABLES:                                                  09652000
         FSECTORS - NUMBER OF SECTORS ALLOCATED                         09654000
                                                                        09656000
     >>                                                                 09658000
   INTEGER ARRAY FLAB;                                                  09660000
   OPTION UNCALLABLE,PRIVILEGED;                                        09662000
   BEGIN                                                                09664000
   DOUBLE RESULT = FSECTORS;                                            09666000
   DOUBLE ARRAY FLABDBL (*) = FLAB;                                     09668000
                                                                        09670000
$  IF X0 = ON                                                           09672000
   IF MONOTHER THEN  <<MONITORING?>>                                    09674000
      BEGIN                                                             09676000
      TOS := "FS"; TOS := "EC"; TOS := "TO"; TOS := "RS";               09678000
      ASSEMBLE(DZRO,DZRO);                                              09680000
      FTITLE(*,*,*,*);                                                  09682000
      DEBUG                                                             09684000
      END;                                                              09686000
$  IF                                                                   09688000
                                                                        09690000
   TOS := @FLEXTMAP;  <<EXTENT ENTRY POINTER>>                          09692000
   TOS := FLNUMEXTS;  <<EXTENT COUNTER>>                                09694000
   DO BEGIN                                                             09696000
      IF DPS1 <> 0D THEN  <<EXTENT ALLOCATED?>>                         09698000
         BEGIN                                                          09700000
         TOS := 0;  << HIGH ORDER EXTENT SIZE >>               <<00300>>09702000
         IF S1 = 0 THEN  <<LAST EXTENT?>>                               09704000
            TOS := FLLASTEXTSIZE                                        09706000
         ELSE  <<REGULAR EXTENT>>                                       09708000
            TOS := FLEXTSIZE;                                           09710000
         RESULT := RESULT+TOS  <<ADD TO TOTAL>>                         09712000
         END;                                                           09714000
      ASSEMBLE(INCB,INCB; DECA)                                         09716000
      END UNTIL <                                                       09718000
   END;                                                                 09720000
$ PAGE "    MPE-IV BASELINE FILE SYSTEM - FILE I/O SUPPORT"             09722000
<<**********************************************************>> <<04517>>09724000
<<  GETEOF has been deleted, was used only by GETREC!       >> <<04517>>09726000
<<**********************************************************>> <<04517>>09728000
                                                               <<04517>>09730000
                                                               <<00630>>09734000
                                                               <<00630>>09736000
<<***********************************************************>><<00630>>09738000
$CONTROL SEGMENT=FILESYS6                                      <<00630>>09740000
                                                               <<00630>>09742000
INTEGER PROCEDURE GETBLKSIZE(RECSIZE,BLKFACTOR,FOPTIONS);      <<00630>>09744000
  VALUE RECSIZE,BLKFACTOR,FOPTIONS;                            <<00630>>09746000
  INTEGER RECSIZE,   <<IN POS BYTES>>                          <<00630>>09748000
          BLKFACTOR;                                           <<00630>>09750000
  LOGICAL FOPTIONS;                                            <<00630>>09752000
  OPTION UNCALLABLE;                                           <<00630>>09754000
BEGIN                                                          <<00630>>09756000
  DEFINE OVFL= QSTATUS.(4:1) #;                                <<00630>>09758000
  INTEGER QSTATUS= Q-1;                                        <<00630>>09760000
  LOGICAL ERROR:= FALSE;                                       <<00630>>09762000
                                                               <<00630>>09764000
                                                               <<00630>>09766000
  TOS:=(RECSIZE+1)/2 * BLKFACTOR;                              <<00630>>09768000
  IF < OR OVERFLOW THEN ERROR:=TRUE;                           <<00630>>09770000
  IF FOPMSGFILE THEN                                           <<HM.00>>09772000
    BEGIN  <<MESSAGE FILE>>                                    <<HM.00>>09774000
    TOS:=TOS+2+BLKFACTOR*IPCBLKOVERHEAD;                       <<HM.00>>09776000
    IF < OR OVERFLOW THEN ERROR:=TRUE;                         <<HM.00>>09778000
    END                                                        <<HM.00>>09780000
  ELSE IF FOPRIO THEN                                          <<HM.00>>09782000
    BEGIN                                                      <<00630>>09784000
    TOS:=TOS + (BLKFACTOR+15)/16;  <<FOR ACTIVE REC TABLE>>    <<00630>>09786000
    IF < OR OVERFLOW THEN ERROR:=TRUE;                         <<00630>>09788000
    END;                                                       <<00630>>09790000
  GETBLKSIZE:=TOS.(1:15); <<ALWAYS POSITIVE>>                  <<00630>>09792000
  OVFL:=IF ERROR THEN 1 ELSE 0;                                <<00630>>09794000
END; <<PROCEDURE GETBLKSIZE>>                                  <<00630>>09796000
                                                               <<00630>>09798000
                                                               <<00630>>09800000
<<***********************************************************>><<00630>>09802000
$CONTROL SEGMENT = FILESYS6    << GETBLKFACTOR >>                       09804000
                                                               <<00630>>09806000
INTEGER PROCEDURE GETBLKFACTOR(BLKSIZE,RECSIZE,FOPTIONS);      <<00630>>09808000
  VALUE BLKSIZE,RECSIZE,FOPTIONS;                              <<00630>>09810000
  INTEGER BLKSIZE,  <<IN POS WORDS>>                           <<00630>>09812000
          RECSIZE;  <<IN POS BYTES>>                           <<00630>>09814000
  LOGICAL FOPTIONS;                                            <<00630>>09816000
  OPTION UNCALLABLE;                                           <<00630>>09818000
BEGIN                                                          <<00630>>09820000
  INTEGER WDRSIZE;                                             <<00630>>09822000
                                                               <<00630>>09824000
                                                               <<00630>>09826000
  WDRSIZE:=(RECSIZE+1)/2;                                      <<00630>>09828000
  IF FOPMSGFILE THEN                                           <<HM.00>>09830000
     TOS:=(BLKSIZE-2)/(WDRSIZE+IPCBLKOVERHEAD)                 <<HM.00>>09832000
  ELSE IF FOPRIO THEN                                          <<HM.00>>09834000
    BEGIN                                                      <<00630>>09836000
    TOS:=16D*DOUBLE(BLKSIZE) / (16D*DOUBLE(WDRSIZE)+1D);       <<00630>>09838000
    DELB;                                                      <<00630>>09840000
    END                                                        <<HM.00>>09842000
 ELSE                                                          <<HM.00>>09844000
    TOS:=BLKSIZE/WDRSIZE;                                      <<HM.00>>09846000
  GETBLKFACTOR:=TOS;                                           <<00630>>09848000
END; <<PROCEDURE GETBLKFACTOR>>                                <<00630>>09850000
<<**********************************************************>> <<04517>>09852000
<< SETART has been deleted, used only in GETREC.            >> <<04517>>09854000
<<**********************************************************>> <<04517>>09856000
                                                               <<04517>>09858000
<<**********************************************************>> <<04517>>09862000
<< FSETEOF has been deleted, used only in GETREC.           >> <<04517>>09864000
<<**********************************************************>> <<04517>>09866000
                                                               <<04517>>09868000
$ CONTROL SEGMENT = FILESYS7                                            09872000
LOGICAL PROCEDURE FCHECKEOF (PACBV);                           <<04517>>09874000
                                                               <<04517>>09876000
<<**********************************************************>> <<04517>>09878000
<< This procedure cycles through the file buffers, quiescing>> <<04517>>09880000
<< I/O and checking for hardware EOF.  If detected, then    >> <<04517>>09882000
<< true is returned and the block buffer containing the EOF >> <<04517>>09884000
<< is the current buffer.                                   >> <<04517>>09886000
<<                                                          >> <<04517>>09888000
<<          Input Variables:                                >> <<04517>>09890000
<<             PACBV - Physical ACB Vector                  >> <<04517>>09892000
<<                                                          >> <<04517>>09894000
<<          Outpt Variables:                                >> <<04517>>09896000
<<             FCHECKEOF - Hardware EOF Flag                >> <<04517>>09898000
<<                FALSE - OK                                >> <<04517>>09900000
<<                TRUE  - EOF Detected                      >> <<04517>>09902000
<<                                                          >> <<04517>>09904000
<< Usefull for non-disc buffered files.  Note that DB can   >> <<04517>>09906000
<< be anywhere upon entrance into this procedure.           >> <<04517>>09908000
<<**********************************************************>> <<04517>>09910000
                                                               <<04517>>09912000
   VALUE PACBV; LOGICAL PACBV;                                 <<04517>>09914000
   OPTION PRIVILEGED,UNCALLABLE;                                        09916000
   BEGIN                                                                09918000
   INTEGER POINTER                                             <<04517>>09920000
      ACB;               <<  ACB DB relative pointer        >> <<04517>>09922000
   DOUBLE POINTER ACBDBL = ACB;                                         09924000
   INTEGER                                                     <<04517>>09926000
      NEWVECTOR,         <<  Return vector from FGETCB      >> <<04517>>09928000
      DSTX;              <<  DST # upon procedure entrance  >> <<04517>>09930000
   INTEGER I,J;                                                         09932000
   INTEGER POINTER BLK;  <<BLOCK POINTER>>                              09934000
   DOUBLE POINTER BLKDBL = BLK;                                         09936000
                                                                        09938000
$  IF X0 = ON                                                           09940000
   IF MONOTHER THEN  <<MONITORING?>>                                    09942000
      BEGIN                                                             09944000
      TOS := "FC"; TOS := "HE"; TOS := "CK"; TOS := "EO";               09946000
      TOS := "F ";                                                      09948000
      ASSEMBLE(ZERO,DZRO);                                              09950000
      FTITLE(*,*,*,*);                                                  09952000
      DEBUG                                                             09954000
      END;                                                              09956000
$  IF                                                                   09958000
                                                                        09960000
                                                               <<04517>>09962000
   <<*******************************************************>> <<04517>>09964000
   << Set DB to Data Segment containing the ACB via FGETCB. >> <<04517>>09966000
   << We do not lock the CB since it was previously locked  >> <<04517>>09968000
   << by callin LOC'ACB.                                    >> <<04517>>09970000
   <<*******************************************************>> <<04517>>09972000
                                                               <<04517>>09974000
   ASSEMBLE(ZERO,DZRO) ;      << Dummys for return values   >> <<04517>>09976000
   FGETCB(*,*,*,PACBV,0);                                      <<04517>>09978000
   @ACB := TOS;               << Obtain CB DB relative pntr >> <<04517>>09980000
   DSTX := TOS;               << DST number of original DB  >> <<04517>>09982000
   NEWVECTOR := TOS;          << Should be same as PACBV    >> <<04517>>09984000
                                                               <<04517>>09986000
                              << VT plus CB offset.         >> <<04517>>09988000
   J := ACBNUMBUFS+1;      << Number of buffers >>             <<*****>>09990000
   I := ACBCURRBUF;                                                     09992000
   DO BEGIN                                                             09994000
      @BLK := @ACBBUFPOOL+(I MOD J)*ACBBUFSIZE;                <<*****>>09996000
      IF BLKBLOCK >= 0D THEN  <<NON-EMPTY BUFFER?>>                     09998000
         BEGIN                                                          10000000
         TOS := BLKBLOCK+1D;  <<NEXT BLOCK NR.>>                        10002000
         X := ACBBLKFACT;                                               10004000
         MPYD;                                                          10006000
         ACBFPTR := TOS;  <<UPDATE EOF POINTER>>                        10008000
         BLKBLOCK := -1D;  <<MARK BUFFER EMPTY>>                        10010000
                                                                        10012000
         <<* * * COMPLETE PENDING I/O * * *>>                           10014000
                                                                        10016000
         IF BLKIOPEND THEN                                     <<*****>>10018000
            BEGIN                                                       10020000
            IF BLKIOQX <> 0 THEN  <<I/O IN PROGRESS?>>                  10022000
               BEGIN                                                    10024000
               TOS := WAITFORIO(BLKIOQX);  <<WAIT FOR COMPLETION>>      10026000
$              IF X1 = ON                                               10028000
               IF <> THEN FTROUBLE(476);  <<ERROR?>>           <<KJ.03>>10030000
$              IF                                                       10032000
               BLKIOCB := TOS;  <<SET IOCB>>                            10034000
               BLKIOQX := 0  <<CLEAR IOQX>>                             10036000
               END;                                                     10038000
            BLKIOCOMP := 0                                              10040000
            END;                                                        10042000
                                                                        10044000
         <<* * * CHECK FOR HARDWARE EOF * * *>>                         10046000
                                                                        10048000
         IF BLKLSTAT.(13:3) = 2 THEN  <<EOF?>>                          10050000
            BEGIN                                                       10052000
            ACBCURRBUF := (I+1) MOD J;                         <<*****>>10054000
            TOS := TRUE;  <<EOF DETECTED>>                              10056000
            GO EXIT                                                     10058000
            END                                                         10060000
         END;                                                           10062000
      I := (I+1) MOD J     << next buffer >>                   <<*****>>10064000
      END UNTIL I = ACBCURRBUF;                                         10066000
   TOS := FALSE;  <<NO EOF DETECTED>>                                   10068000
                                                                        10070000
EXIT:                                                                   10072000
   FCHECKEOF := TOS; <<SET EOF FLAG>>                          <<04517>>10074000
   FRELCB(DSTX,NEWVECTOR,0);    << Set DB back to original  >> <<04517>>10076000
   END;      << procedure FCHECKEOF >>                                  10078000
<<**********************************************************>> <<04517>>10080000
<<  GETREC has been deleted and replaced by IOMOVE.         >> <<04517>>10082000
<<  FQUIESCEIO has been deleted and replace by FQUIESCE'IO  >> <<04517>>10084000
<<**********************************************************>> <<04517>>10086000
                                                               <<04517>>10088000
$ PAGE "MPE-IV BASELINE FILE SYSTEM - CALLABLE INTRINSIC SUPPORT"       10100000
<<----------------------------------------------------------------------10102000
*                                                                      *10104000
*  SUPPORT PROCEDURES FOR CALLABLE INTRINSICS                          *10106000
*                                                                      *10108000
---------------------------------------------------------------------->>10110000
                                                                        10112000
$ CONTROL SEGMENT = FILESYS5                                            10114000
INTEGER PROCEDURE FINDAFTENT;                                           10116000
   <<FINDS AN AVAILABLE AFT ENTRY AND RETURNS THE ENTRY NUMBER          10118000
     AS THE RESULT.                                                     10120000
                                                                        10122000
     OUTPUT VARIABLES:                                                  10124000
         FINDAFTENT - ENTRY NUMBER                                      10126000
            0 - NO ENTRY AVAILABLE OR PXFILE EXPANSION FAILURE          10128000
            N - AFT ENTRY NUMBER = FILE NUMBER (1 <= N <= 255)          10130000
         Condition Code -                                        18479  10132000
            CCE              no error                            18479  10134000
            CCG              no AFT entries left (>255)          18479  10136000
            CCL              PXFILE expansion failed             18479  10138000
                                                                        10140000
     NOTE THAT THIS PROCEDURE MUST BE CALLED WITH DB SET TO THE         10142000
     STACK>>                                                            10144000
   OPTION PRIVILEGED,UNCALLABLE;                                        10146000
   BEGIN                                                                10148000
   ENTRY FINDANYAFTENT;                                        <<01815>>10150000
   EQUATE C0 = PXFOVERHEAD,    <<PXFILE OVERHEAD>>                      10152000
          C1 = CBTOVERHEAD,    <<PXFILE CB TABLE OVERHEAD>>             10154000
          C2 = CBTVT1*VTENTRY, <<PXFILE INITIAL VT SIZE>>               10156000
          C3 = 1,              <<PXFILE INITIAL GARBAGE CB SIZE>>       10158000
          C4 = C0+C1+C3,       << Initial PXFILE size less VT>><<*****>>10160000
          C5 = C1+C3,          << Initial CBT size less VT >>  <<*****>>10162000
          C6 = C2-1,           <<INITIAL VT SIZE LESS 1>>               10164000
          C7 = C0+C1;          << Initial empty CB idx, no VT>><<*****>>10166000
   LOGICAL FIND'ANY;        << True if any AFT entry is OK >>  <<01815>>10168000
   INTEGER POINTER PXFILE = Q+2;  <<PXFILE pointer>>           <<01815>>10170000
   INTEGER IVTSIZE = Q+3;      << initial VT size >>           <<01815>>10172000
                                                                        10174000
$  IF X0 = ON                                                           10176000
   IF MONOTHER THEN  <<MONITORING?>>                                    10178000
      BEGIN                                                             10180000
      TOS := "FI"; TOS := "ND"; TOS := "AF"; TOS := "TE";               10182000
      TOS := "NT";                                                      10184000
      ASSEMBLE(ZERO,DZRO);                                              10186000
      FTITLE(*,*,*,*);                                                  10188000
      DEBUG                                                             10190000
      END;                                                              10192000
$  IF                                                                   10194000
                                                                        10196000
   << For FOPEN and FOPENDA, any AFT entry (including 1 and >> <<01708>>10198000
   << 2 - $STDIN and $STDLIST) can be assigned.  For all    >> <<01708>>10200000
   << other callers, only AFT 3 or greater can be assigned. >> <<01708>>10202000
   FIND'ANY := FALSE;                                          <<01708>>10204000
   GO START;                                                   <<01708>>10206000
FINDANYAFTENT:                                                 <<01708>>10208000
   FIND'ANY := TRUE;                                           <<01708>>10210000
START:                                                         <<01708>>10212000
                                                               <<01708>>10214000
   <<* * * CHECK FOR VIRGIN PXFILE AREA * * *>>                         10216000
                                                                        10218000
   FINDPXFILE;  <<INIT. PXFILE POINTER>>                                10220000
   IF PXFCBTSIZE = 0 THEN  <<UNFORMATTED PXFILE?>>                      10222000
      BEGIN COMMENT  Here on the first FOPEN after creating    <<*****>>10224000
the process.  Set up a PXFILE control block table which,       <<*****>>10226000
if NOCB, is vestigial.              ;                          <<*****>>10228000
                                                               <<*****>>10230000
      TOS := IF PXFNOCB THEN 0 ELSE C2;  << Set IVTSIZE >>     <<*****>>10232000
      TOS := PXFCBT1;  <<SAVE PRE-ALLOCATED CBT DST NR.>>               10234000
      IF PXFSIZE < C4+IVTSIZE THEN                             <<*****>>10236000
         BEGIN  << Initial size too small; expand >>           <<*****>>10238000
         TOS := FALTPXFILE(128);  <<EXPAND PXFILE>>                     10240000
         IF < THEN RETURN;  <<ERROR?>>                                  10242000
         @PXFILE := @PXFILE+TOS  <<RE-INIT. PXFILE>>                    10244000
         END;                                                           10246000
      PXFCBT1 := TOS;  <<RESTORE PRE-ALLOCATED CBT DST NR.>>            10248000
      PXFCBTSIZE := IVTSIZE+C5;  << Initial CB table size >>   <<*****>>10250000
      PXFVTSIZE := IVTSIZE;    << Initial vector table size >> <<*****>>10252000
      PXFDSTX := PCB'STK;      << Post stack DST nr. >>        <<*****>>10254000
      TOS := @PXFVT; PS0 := 0;    << Clear vector table >>     <<*****>>10256000
      IF PXFNOCB THEN DEL ELSE BEGIN                           <<*****>>10258000
         ASSEMBLE(DUP,INCB); TOS := C6; ASSEMBLE(MOVE 3);      <<*****>>10260000
         END;                                                  <<*****>>10262000
      PXFILE(IVTSIZE+C7) := C3; << Initial garbage CB size >>  <<*****>>10264000
      DEL    << Discard IVTSIZE >>                             <<*****>>10266000
      END;                                                              10268000
   ASSEMBLE(DZRO,DZRO);                                                 10270000
   PXFFOPEN := TOS;  <<INIT. FOPEN ERROR NR.>>                          10272000
   PXFCOPEN := TOS;  <<INIT. COPEN ERROR NR.>>                          10274000
   PXFDOPEN := TOS;  <<INIT. DOPEN ERROR NR.>>                          10276000
   PXFKOPEN := TOS;  <<INIT. KOPEN ERROR NR.>>                          10278000
                                                                        10280000
   <<* * * SEARCH AFT FOR FREE ENTRY * * *>>                            10282000
                                                                        10284000
   IF FIND'ANY THEN                                            <<01708>>10286000
      BEGIN       << FINDANYAFTENT >>                          <<01815>>10288000
      TOS := 1;    << entry nr. >>                             <<01815>>10290000
      TOS := PXFAFTSIZE/AFTENTRY;  << entry counter >>         <<01815>>10292000
      TOS := @PXFILE+PXFSIZE-AFTENTRY;  << entry pointer >>    <<01815>>10294000
      END                                                      <<01815>>10296000
   ELSE                                                        <<01815>>10298000
      BEGIN       << FINDAFTENT >>                             <<01815>>10300000
      TOS := 3;    << entry nr. >>                             <<01815>>10302000
      TOS := PXFAFTSIZE/AFTENTRY - 2;  << entry counter >>     <<01815>>10304000
      TOS := @PXFILE+PXFSIZE-AFTENTRY-2*AFTENTRY;  << ptr >>   <<01815>>10306000
      END;                                                     <<01815>>10308000
                                                               <<01815>>10310000
   ASSEMBLE(XBX,DELB);  <<PUT COUNTER IN X>>                            10312000
   WHILE <> AND DPS0 <> 0D DO  <<ENTRY NOT AVAILABLE?>>                 10314000
      BEGIN                                                             10316000
      TOS := TOS-AFTENTRY;  <<NEXT ENTRY>>                              10318000
      ASSEMBLE(INCB,DECX)                                               10320000
      END;                                                              10322000
   IF S1 > 255 THEN          <<INVALID ENTRY NR.?>>            <<02357>>10324000
      BEGIN                                                    <<02357>>10326000
      CONDCODE:=CCG;                                           <<02357>>10328000
      RETURN;                                                  <<02357>>10330000
      END;                                                     <<02357>>10332000
                                                                        10334000
   <<* * * EXPAND AFT IF NECESSARY * * *>>                              10336000
                                                                        10338000
   IF X = 0 THEN  <<EXPAND AFT?>>                                       10340000
      BEGIN                                                             10342000
      IF PXFSIZE-PXFOVERHEAD-PXFCBTSIZE-PXFAFTSIZE < 10 THEN            10344000
         BEGIN                                                          10346000
         TOS := FALTPXFILE(24);  <<EXPAND PXFILE>>                      10348000
         IF < THEN          <<ERROR?>>                         <<02357>>10350000
            BEGIN                                              <<02357>>10352000
            CONDCODE:=CCL;                                     <<02357>>10354000
            RETURN;                                            <<02357>>10356000
            END;                                               <<02357>>10358000
         @PXFILE := @PXFILE+TOS  <<RE-INIT.>>                           10360000
         END;                                                           10362000
      PXFAFTSIZE := PXFAFTSIZE+AFTENTRY  <<ADJ. AFT SIZE>>              10364000
      END;                                                              10366000
   DPS0 := 0D; DPS0(1) := 0D;  <<CLEAR ENTRY>>                          10368000
   DEL;                                                                 10370000
   FINDAFTENT := TOS; <<AFT ENTRY NR.>>                        <<02357>>10372000
   CONDCODE:=CCE;                                              <<02357>>10374000
   END;      << procedure FINDAFTENT >>                                 10376000
$ CONTROL SEGMENT = FILESYS5                                            10378000
LOGICAL PROCEDURE FNFORMAT (STRING,FN,GN,AN,LW);                        10380000
   <<PARSES THE SPECIFIED FILE REFERENCE STRING INTO SIMPLE FILE        10382000
     NAMES AND PLACES THESE NAMES INTO THE SPECIFIED BYTE ARRAYS.       10384000
                                                                        10386000
     INPUT VARIABLES:                                                   10388000
         STRING - FILE REFERENCE STRING                                 10390000
                                                                        10392000
     OUTPUT VARIABLES:                                                  10394000
         FNFORMAT - FILE REFERENCE FORMAT TYPE                          10396000
            0 - FULL NAME                                               10398000
            1 - ACCOUNT NAME ABSENT                                     10400000
            2 - GROUP AND ACCOUNT NAMES ABSENT                          10402000
            3 - NULL NAME                                               10404000
            4 - INVALID NAME                                            10406000
         FN - LOCAL FILE NAME                                           10408000
         GN - GROUP NAME                                                10410000
         AN - ACCOUNT NAME                                              10412000
         LW - LOCKWORD                                                  10414000
                                                                        10416000
     THE RESULTING SIMPLE FILE NAMES ARE 8 BYTES LONG, LEFT             10418000
     JUSTIFIED, UPSHIFTED AND HAVE TRAILING BLANKS ADDED.  IF A         10420000
     SIMPLE FILE NAME IS NOT IN THE FILE REFERENCE THE CORRESPONDING    10422000
     BYTE ARRAY WILL BE BLANK>>                                         10424000
   VALUE STRING;                                                        10426000
   BYTE POINTER STRING;                                                 10428000
   ARRAY FN,GN,AN,LW;                                                   10430000
   OPTION PRIVILEGED,UNCALLABLE;                                        10432000
   BEGIN                                                                10434000
   INTEGER STRLEN;       << To save string length for return >><<02350>>10436000
   ARRAY BLANX (*) = PB := "        ";                                  10438000
   INTEGER SCODE;                                                       10440000
   LOGICAL GT1;                                                         10442000
   BYTE POINTER BP;                                                     10444000
                                                                        10446000
   LOGICAL SUBROUTINE FILLCHKMV (TADDR,FADDR);                          10448000
      <<CHECKS, UPSHIFTS AND MOVES TO THE SPECIFIED TARGET ARRAY        10450000
        A SIMPLE FILE NAME.  ALSO ADVANCES THE FILE NAME POINTER        10452000
        OVER THE SIMPLE FILE NAME.                                      10454000
                                                                        10456000
        INPUT VARIABLES:                                                10458000
            TADDR - TARGET WORD ARRAY                                   10460000
            FADDR - SOURCE BYTE POINTER                                 10462000
                                                                        10464000
        OUTPUT VARIABLES:                                               10466000
            FILLCHKMV - ERROR FLAG                                      10468000
               0 - ILLEGAL SIMPLE FILE NAME                             10470000
               1 - LEGAL SIMPLE FILE NAME                               10472000
            FADDR - NEW SOURCE BYTE POINTER                             10474000
                                                                        10476000
        NOTE THAT THE SOURCE BYTE POINTER (FADDR) IS BY REFERENCE>>     10478000
      VALUE TADDR;                                                      10480000
      POINTER TADDR;                                                    10482000
      BYTE POINTER FADDR;                                               10484000
      BEGIN                                                             10486000
      TOS := TOS := @FADDR;                                             10488000
      MOVE * := * WHILE AN,1;  <<DELIMIT NAME>>                         10490000
      GT1 := TOS;                                                       10492000
      X := STRLEN := GT1-LOGICAL(@FADDR);  <<Name length>>     <<02350>>10494000
      IF NOT (0 <= X <= 8) THEN RETURN;  <<ILLEGAL LENGTH?>>            10496000
      @BP := @FADDR;                                                    10498000
      TOS := @TADDR&LSL(1);                                             10500000
      MOVE * := BP WHILE ANS;  <<MOVE AND UPSHIFT NAME>>                10502000
      @FADDR := GT1;  <<ADVANCE STRING POINTER>>                        10504000
      FILLCHKMV := 1;                                                   10506000
      X := STRLEN;  << Return length through X register >>     <<02350>>10508000
      END;                                                              10510000
                                                                        10512000
   INTEGER SUBROUTINE BUMPNAMPTR (STRING);                              10514000
      <<CHECKS THE FILE NAME DELIMITER POINTED TO BY STRING,            10516000
        RETURNS THE DELIMITER TYPE AS THE RESULT AND SETS STRING        10518000
        TO THE FIRST CHARACTER OF THE SIMPLE FILE NAME FOLLOWING        10520000
        THE DELIMITER.                                                  10522000
                                                                        10524000
        INPUT VARIABLES:                                                10526000
            STRING - FILE NAME POINTER                                  10528000
                                                                        10530000
        OUTPUT VARIABLES:                                               10532000
            BUMPNAMPTR - DELIMITER TYPE                                 10534000
               0 - ILLEGAL DELIMITER                                    10536000
               1 - "." => GROUP/ACCOUNT NAME NEXT                       10538000
               2 - "/" => LOCKWORD NEXT                                 10540000
      >>                                                                10542000
      BYTE POINTER STRING;                                              10544000
      BEGIN                                                             10546000
      IF STRING > %200 THEN  <<SPECIAL NAME DELIMITER?>>                10548000
         BEGIN                                                          10550000
         STRING := LOGICAL(INTEGER(STRING)) LAND %177;                  10552000
         BUMPNAMPTR := 1                                                10554000
         END                                                            10556000
      ELSE  <<REGULAR NAME DELIMITER>>                                  10558000
         BEGIN                                                          10560000
         IF STRING = "." THEN                                           10562000
            BUMPNAMPTR := 1                                             10564000
         ELSE IF STRING = "/" THEN                                      10566000
            BUMPNAMPTR := 2                                             10568000
         ELSE  <<ILLEGAL DELIMITER>>                                    10570000
            RETURN;                                                     10572000
         @STRING := @STRING+1  <<SKIP OVER DELIMITER>>                  10574000
         END                                                            10576000
      END;                                                              10578000
                                                                        10580000
   MOVE FN := BLANX,(4);  <<CLEAR LOCAL NAME>>                          10582000
   MOVE GN := BLANX,(4);  <<CLEAR GROUP NAME>>                          10584000
   MOVE AN := BLANX,(4);  <<CLEAR ACCOUNT NAME>>                        10586000
    << CHECK FOR NULL NAME >>                                           10588000
   IF NOT (%101 <= INTEGER(STRING) <= %132) AND                         10590000
      NOT (%141 <= INTEGER(STRING) <= %172) THEN  <<NOT ALPHABETIC?>>   10592000
      BEGIN                                                    <<00104>>10594000
       IF (%60 <=INTEGER(STRING)<=%71) THEN                    <<00104>>10596000
       TOS:=4 ELSE TOS:=3;                                     <<00104>>10598000
       GO EXIT;                                                <<00104>>10600000
      END;                                                     <<00104>>10602000
   IF NOT FILLCHKMV(FN,STRING) THEN GO INV;  <<INVALID LOCAL NAME?>>    10604000
   SCODE := BUMPNAMPTR(STRING);  <<SKIP OVER DELIMITER>>                10606000
   IF SCODE = 2 THEN  <<LOCKWORD NEXT?>>                                10608000
      BEGIN                                                             10610000
      IF NOT FILLCHKMV(LW,STRING) THEN GO INV;  <<INVALID LOCKWORD?>>   10612000
      IF   X=0 THEN        << Special meaning: null lockword >><<02350>>10614000
           LW:="/ "   << Forces lkwd viol if lockword exists >><<02350>>10616000
      ELSE IF NOT (%101<=INTEGER(LW.(0:8))<=%132) <<Not alpha>><<02350>>10618000
           THEN GO INV;                                        <<02350>>10620000
      SCODE := BUMPNAMPTR(STRING);  <<SKIP OVER DELIMITER>>             10622000
      IF SCODE = 2 THEN GO INV  <<LOCKWORD NEXT?>>                      10624000
      END;                                                              10626000
   IF SCODE = 1 THEN  <<GROUP/ACCOUNT NAME NEXT?>>                      10628000
      BEGIN                                                             10630000
      IF NOT FILLCHKMV(GN,STRING) THEN GO INV;  <<INVALID GROUP NAME?>> 10632000
      SCODE := BUMPNAMPTR(STRING);  <<SKIP OVER DELIMITER>>             10634000
      IF SCODE = 2 THEN GO INV;  <<LOCKWORD NEXT?>>                     10636000
      IF SCODE = 1 THEN  <<ACCOUNT NAME NEXT?>>                         10638000
         BEGIN                                                          10640000
         IF NOT FILLCHKMV(AN,STRING) THEN GO INV;  <<INVAL. ACCT NAME?>>10642000
         IF STRING = "." OR STRING = "/" THEN GO INV;          <<04795>>10644000
                                                               <<04795>>10646000
         TOS := 0  <<FULL NAME>>                                        10648000
         END                                                            10650000
      ELSE                                                              10652000
         TOS := 1  <<ACCT. NAME ABSENT>>                                10654000
      END                                                               10656000
   ELSE  <<NO GROUP/ACCOUNT NAME>>                                      10658000
      TOS := 2;  <<GROUP AND ACCT. NAMES ABSENT>>                       10660000
   GO EXIT;                                                             10662000
                                                                        10664000
INV:                                                                    10666000
   TOS := 4;                                                            10668000
                                                                        10670000
EXIT:                                                                   10672000
   FNFORMAT := TOS  <<FORMAT TYPE>>                                     10674000
   END;      << procedure FNFORMAT >>                                   10676000
$ CONTROL SEGMENT = FILESYS5                                   <<04132>>10678000
LOGICAL PROCEDURE FQFORMAT (FREF,FN,GN,AN,LW);                 <<04132>>10680000
   COMMENT                                                     <<04132>>10682000
   TRIES TO OBTAIN FILE REFERENCE STRING FROM :FILE CMD        <<04132>>10684000
   PARSES THE FILE REFERENCES INTO SIMPLE FILE NAMES           <<04132>>10686000
                                                               <<04132>>10688000
   INPUT VARIABLES:                                            <<04132>>10690000
      FREF - FILE REF. STRING                                  <<04132>>10692000
      FN   - LOCAL FILE NAME                                   <<04132>>10694000
      GN   - GROUP NAME                                        <<04132>>10696000
      AN   - ACCOUNT NAME                                      <<04132>>10698000
      LW   - LOCKWORD                                          <<04132>>10700000
                                                               <<04132>>10702000
   OUTPUT VARIABLES:                                           <<04132>>10704000
      FQFORMAT - FILE REFERENCE FORMAT TYPE                    <<04132>>10706000
         0 - FULL NAME                                         <<04132>>10708000
         1 - ACCOUNT NAME ABSENT                               <<04132>>10710000
         2 - GROUP AND ACCOUNT NAMES ABSENT                    <<04132>>10712000
         4 - INVALID NAME                                      <<04132>>10714000
      FREF - NEW FILE REF. STRING                              <<04132>>10716000
      FN   - NEW LOCAL FILE NAME                               <<04132>>10718000
      GN   - GROUP NAME                                        <<04132>>10720000
      AN   - ACCOUNT NAME                                      <<04132>>10722000
      LW   - LOCKWORD                                          <<04132>>10724000
                                                               <<04132>>10726000
   NOTE: ONLY FOLLOWING :FILE COMMAND ARE VALID:               <<04132>>10728000
         :FILE X = Y                                           <<04132>>10730000
         :FILE X = *Y;                                         <<04132>>10732000
                                                               <<04132>>10734000
VALUE FREF;                                                    <<04132>>10736000
BYTE POINTER FREF;                                             <<04132>>10738000
ARRAY FN,GN,AN,LW;                                             <<04132>>10740000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04132>>10742000
                                                               <<04132>>10744000
BEGIN                                                          <<04132>>10746000
INTEGER I;                                                     <<04132>>10748000
BYTE POINTER BFNAME;  <<PNT TO FILE REF. STRING IN JDT>>       <<04132>>10750000
ARRAY FTAB(0:120);    <<:FILE COMMAND PARM. BUFFER >>          <<04132>>10752000
LOOP:                                                          <<04132>>10754000
IF INTEGER(FREF) = "*" THEN                                    <<04132>>10756000
  BEGIN                                                        <<04132>>10758000
  MOVE FREF := FREF(1),(8);                                    <<04132>>10760000
  FREF(8) := " ";                                              <<04132>>10762000
  MOVE FREF := FREF WHILE ANS;                                 <<04132>>10764000
  GN := "."; AN := ".";                                        <<04132>>10766000
  IF XRETJTENTRY (FREF,GN,AN,I,FTAB) = 0 THEN                  <<04132>>10768000
     BEGIN                                                     <<04132>>10770000
     I := FTAB.(8:8);    <<FORMAL DESIGNATOR NAME SIZE (W)>>   <<04132>>10772000
     <<CHECK (PMAP OF FEQ) IF :FILE X=Y OR :FILE X=*Y>>        <<04132>>10774000
     IF FTAB(I+1)  = 1 AND (FTAB(I+2) = %1000 OR FTAB(I+2) = 0)<<04132>>10776000
        THEN BEGIN                                             <<04132>>10778000
        @BFNAME := @FTAB(I+4)&LSL(1); <<SET PNT TO FILE REF.>> <<04132>>10780000
        I := FTAB(I+3).(0:8);  <<FILE REF. STRING SIZE>>       <<04132>>10782000
        MOVE FREF := BFNAME,(I);  <<COPY FILE REF. STRING>>    <<04132>>10784000
        FREF(I) := " ";                                        <<04132>>10786000
        I := FNFORMAT(FREF,FN,GN,AN,LW);  <<CHECK IF VALID>>   <<04132>>10788000
        IF I = 3 THEN GOTO LOOP;  <<MORE FILE EQ?>>            <<04132>>10790000
        END                                                    <<04132>>10792000
        ELSE GOTO E;                                           <<04132>>10794000
     END                                                       <<04132>>10796000
     ELSE GOTO E;  <<FILE EQ. NOT FOUND>>                      <<04132>>10798000
  END                                                          <<04132>>10800000
  ELSE                                                         <<04132>>10802000
E:                                                             <<04132>>10804000
  I := 4;                                                      <<04132>>10806000
FQFORMAT := I;  <<FORMAT TYPE>>                                <<04132>>10808000
END;                                                           <<04132>>10810000
$ CONTROL SEGMENT = FILESYS5                                            10812000
INTEGER PROCEDURE FMLNAME (FD,GN,AN,FOPTIONS);                          10814000
   VALUE FD;                                                            10816000
   BYTE POINTER FD;                                                     10818000
   BYTE ARRAY GN,AN;                                                    10820000
   INTEGER FOPTIONS;                                                    10822000
   OPTION PRIVILEGED,UNCALLABLE;                                        10824000
   COMMENT                                                              10826000
     SCANS FORMAL DESIGNATOR:                                           10828000
       $STDLIST      RETURNS  1                                         10830000
       $NEWPASS      RETURNS  2                                         10832000
       $OLDPASS      RETURNS  3                                         10834000
       $STDIN        RETURNS  4                                         10836000
       $STDINX       RETURNS  5                                         10838000
       $NULL         RETURNS  6                                         10840000
       *ACTUAL NAME  RETURNS  0                                         10842000
       ACTUAL NAME   RETURNS  0                                         10844000
   ;                                                                    10846000
   BEGIN                                                                10848000
   BYTE ARRAY TABLE (*) =PB := "STDLISTNEWPASSOLDPASSSTDINXSTDINNULL";  10850000
   INTEGER ARRAY INX (*) =PB := 7,7,7,6,5,4;                   <<01.01>>10852000
   INTEGER ARRAY RSLT (*) =PB := 1,2,3,5,4,6;                  <<01.01>>10854000
  ARRAY FTAB(0:120);                                           <<TL.02>>10856000
   BYTE POINTER BP;                                                     10858000
   INTEGER I;                                                           10860000
                                                                        10862000
   IF INTEGER(FD) = %52 THEN  <<"*"?>>                                  10864000
      BEGIN                                                             10866000
      MOVE FD := FD(1),(35);                                            10868000
      FD(8) := " ";                                                     10870000
      MOVE FD := FD WHILE ANS;                                          10872000
      GN := "."; AN := ".";                                             10874000
      IF XRETJTENTRY(FD,GN,AN,I,FTAB) <> 0 THEN                         10876000
         BEGIN   << ERROR: NO FILE EQN FOR NAME >>             <<00117>>10878000
         FOPDESIGNATOR := 7;                                            10880000
         RETURN;                                                        10882000
         END;                                                           10884000
      FOPNOEQUATE := 0;                                                 10886000
      END                                                               10888000
   ELSE IF INTEGER(FD) = %44 THEN  <<"$"?>>                             10890000
      BEGIN                                                             10892000
      FD(8) := " ";                                                     10894000
      MOVE FD(1) := FD(1) WHILE ANS;                                    10896000
                                                               <<01.01>>10898000
      @BP := @TABLE;                                                    10900000
      FOR I := 0 STEP 1 UNTIL 5 DO                                      10902000
         BEGIN                                                          10904000
         TOS := @FD(1);                                                 10906000
         TOS := @BP;                                                    10908000
         TOS := INX(I);                                                 10910000
         @BP := @BP+S0;                                                 10912000
                                                               <<01.01>>10914000
         IF * = *PB, (TOS) THEN                                <<01.01>>10916000
            BEGIN                                                       10918000
            MOVE FD := FD(1),(35);                                      10920000
            FOPDESIGNATOR := RSLT(I);                          <<01.01>>10922000
            RETURN;                                                     10924000
            END;                                                        10926000
         END;                                                           10928000
      FOPDESIGNATOR := 7;  << ERROR: $ NOT FOLLOWED BY STDIN, ETC.>>    10930000
      RETURN;                                                           10932000
      END;                                                              10934000
   FMLNAME := 1;  << NAME, NOT $STDIN, ETC. >>                 <<00117>>10936000
   END;     << procedure FMLNAME >>                                     10938000
                                                               <<02568>>10940000
$CONTROL SEGMENT=FILESYS6                                      <<02568>>10942000
                                                               <<02568>>10944000
LOGICAL PROCEDURE PARSE'DENSITY(PARM,PARMLEN,DEN'VALUE);       <<02568>>10946000
   VALUE PARMLEN;                                              <<02568>>10948000
   INTEGER                                                     <<02568>>10950000
      DEN'VALUE,  << Output: internal density rep >>           <<02568>>10952000
      PARMLEN;    << Input:  length of PARM in bytes. >>       <<02568>>10954000
   BYTE ARRAY PARM;                                            <<02568>>10956000
   OPTION UNCALLABLE;                                          <<02568>>10958000
BEGIN                                                          <<02568>>10960000
                                                               <<02568>>10962000
   << This procedure takes any string of alphanumeric >>       <<02568>>10964000
   << characters, and returns TRUE if it is a valid   >>       <<02568>>10966000
   << parameter for the "DEN" keyword of the FOPEN    >>       <<02568>>10968000
   << device parameter.  It also returns the internal >>       <<02568>>10970000
   << representation of that string in "DEN'VALUE".   >>       <<02568>>10972000
                                                               <<02568>>10974000
   INTEGER                                                     <<02568>>10976000
      ENTRYNO;  << Return from SEARCH >>                       <<02568>>10978000
   BYTE POINTER                                                <<02568>>10980000
      DICT'PTR; << Points to definition in DEN'DICT >>         <<02568>>10982000
   BYTE ARRAY PDENSITY(*) = PB :=                              <<04517>>10984000
      7,4,"6250",DEN'6250,                                     <<02568>>10986000
      7,4,"1600",DEN'1600,                                     <<02568>>10988000
      0;                                                       <<02568>>10990000
   EQUATE                                                      <<02568>>10992000
      PDENSITYL = 15;                                          <<02568>>10994000
   BYTE ARRAY                                                  <<02568>>10996000
      DEN'DICT(0:PDENSITYL-1);   << Local dict copy >>         <<02568>>10998000
                                                               <<02568>>11000000
                                                               <<02568>>11002000
   MOVE DEN'DICT := PDENSITY,(PDENSITYL);                      <<02568>>11004000
                                                               <<02568>>11006000
   ENTRYNO := SEARCH(PARM,PARMLEN,DEN'DICT,DICT'PTR);          <<02568>>11008000
   IF ENTRYNO <> 0 THEN                                        <<02568>>11010000
      BEGIN      << Valid parameter >>                         <<02568>>11012000
      PARSE'DENSITY := TRUE;                                   <<02568>>11014000
      DEN'VALUE := DICT'PTR;                                   <<02568>>11016000
      END;                                                     <<02568>>11018000
                                                               <<02568>>11020000
END;   << of PARSE'DENSITY >>                                  <<02568>>11022000
                                                               <<02568>>11024000
                                                              <<SP.ENV>>11026000
$CONTROL SEGMENT=FILESYS6                                     <<SP.ENV>>11028000
                                                              <<SP.ENV>>11030000
INTEGER PROCEDURE PARSE'DEV'PARMS(BYTE'STRING,DEVPARMS);      <<SP.ENV>>11032000
   BYTE ARRAY BYTE'STRING;                                    <<SP.ENV>>11034000
   LOGICAL ARRAY DEVPARMS;                                    <<SP.ENV>>11036000
   OPTION UNCALLABLE;                                          <<01901>>11038000
                                                              <<SP.ENV>>11040000
   BEGIN                                                      <<SP.ENV>>11042000
                                                              <<SP.ENV>>11044000
   COMMENT                                                    <<SP.ENV>>11046000
                                                              <<SP.ENV>>11048000
     This procedure parses the keyword parameters such as     <<SP.ENV>>11050000
              ENV=environment file name                       <<SP.ENV>>11052000
              OUTQ=outqname                                   <<SP.ENV>>11054000
              DEN=density                                      <<02524>>11056000
     separated by semicolons, in the Device parameter of      <<SP.ENV>>11058000
     FOPEN and in the Job File Equation table produced by     <<SP.ENV>>11060000
     the :FILE command. This string beginning with the Device <<SP.ENV>>11062000
     parameter is in BYTE'STRING. An example string is  ;     <<SP.ENV>>11064000
       << LP;ENV=EPOC.PUB.SYS;OUTQ=FAST (CR)>>                <<SP.ENV>>11066000
   COMMENT                                                    <<SP.ENV>>11068000
                                                              <<SP.ENV>>11070000
     This procedure is called by FOPEN and by FILECOMVALS.    <<SP.ENV>>11072000
     The first call to PARSE'DEV'PARMS should be made with    <<SP.ENV>>11074000
     the first word of DEVPARMS set to 0, indicating it is    <<SP.ENV>>11076000
     uninitialized.                                           <<SP.ENV>>11078000
                                                              <<SP.ENV>>11080000
  The DEVPARMS array is a structured array and it looks like: <<SP.ENV>>11082000
                                                              <<SP.ENV>>11084000
      _____________________________________________           <<SP.ENV>>11086000
      |                                           |           <<SP.ENV>>11088000
      |    TOKEN 1        |          INDEX1       |           <<SP.ENV>>11090000
      |-------------------------------------------|           <<SP.ENV>>11092000
      |    TOKEN 2        |          INDEX2       |           <<SP.ENV>>11094000
      |-------------------------------------------|           <<SP.ENV>>11096000
                           .                                  <<SP.ENV>>11098000
                           .                                  <<SP.ENV>>11100000
                           .                                  <<SP.ENV>>11102000
      |-------------------------------------------|           <<SP.ENV>>11104000
      |    -1             |  next avail pointer   |           <<SP.ENV>>11106000
      |-------------------------------------------|           <<SP.ENV>>11108000
      |   LEN1            |  value string         |           <<SP.ENV>>11110000
      |-------------------------------------------|           <<SP.ENV>>11112000
      |   LEN2            |  value string         |           <<SP.ENV>>11114000
      |-------------------------------------------|           <<SP.ENV>>11116000
      |                    .                      |           <<SP.ENV>>11118000
                           .                                  <<SP.ENV>>11120000
                           .                                  <<SP.ENV>>11122000
      |___________________________________________|           <<SP.ENV>>11124000
                                                              <<SP.ENV>>11126000
                                                              <<SP.ENV>>11128000
                                                              <<SP.ENV>>11130000
     Note that the -1 is at DEVPARMS(2*NUM'DP'TOKENS)          <<02524>>11132000
     where NUM'DP'TOKENS is the number of different kinds      <<02524>>11134000
     of tokens there are.  NUM'DP'TOKENS must be changed if    <<02524>>11136000
     new tokens are added.  Tokens are:                        <<02524>>11138000
           ENV   =  "EN"                                      <<SP.ENV>>11140000
           OUTQ  =  "OQ"                                      <<SP.ENV>>11142000
           DEN   =  "DN"                                       <<02524>>11144000
                                                              <<SP.ENV>>11146000
    All tokens are two bytes.                                 <<SP.ENV>>11148000
                                                              <<SP.ENV>>11150000
                          END OF COMMENT;                     <<SP.ENV>>11152000
                                                              <<SP.ENV>>11154000
   BYTE POINTER BP;                                           <<SP.ENV>>11156000
   BYTE ARRAY PKEYLIST(*) = PB :=                             <<SP.ENV>>11160000
        7,3,"ENV",ENV'DEFN,    << DEFN = 2 character token. >> <<02524>>11164000
        8,4,"OUTQ",OUTQ'DEFN,                                  <<02524>>11166000
        7,3,"DEN",DEN'DEFN,                                    <<02524>>11168000
        0;                     << end of keylist. >>           <<02524>>11170000
   EQUATE                                                      <<02524>>11172000
      PKEYLISTL   = 23,  << length of "SEARCH" dict. >>        <<02524>>11174000
      MAXPARMS    = 10,  << max. number of dev. parms >>       <<02524>>11176000
      NUMKEYWORDS = NUM'DP'TOKENS;                             <<02524>>11178000
   LOGICAL                                                     <<02524>>11180000
      FIRST,                                                   <<02524>>11182000
      CONTINUE;          << parsing flag >>                    <<02524>>11184000
   BYTE ARRAY KEYLIST(0:PKEYLISTL-1);                         <<SP.ENV>>11186000
   DOUBLE ARRAY PARMS(0:MAXPARMS-1);                           <<02524>>11188000
   DOUBLE DL':=[8/"=",8/";",8/%15,8/0]D;                                11190000
      BYTE ARRAY DELIMITERS(*) = DL';                                   11192000
   INTEGER                                                     <<02524>>11194000
      NUMPARMS,   << return from MYCOMMAND >>                  <<02524>>11196000
      J,          << loop variable         >>                  <<02524>>11198000
      I;          << parm index thru keyword loop >>           <<02524>>11200000
   BYTE ARRAY BDEVPARMS(*) = DEVPARMS;                        <<SP.ENV>>11202000
   EQUATE                                                     <<SP.ENV>>11206000
       CAR'RETURN = %15,                                       <<02524>>11208000
       EQUAL = 0,                                             <<SP.ENV>>11210000
       SEMICOLON  = 1,                                        <<SP.ENV>>11212000
       CR = 2;                                                <<SP.ENV>>11214000
   EQUATE                                                     <<SP.ENV>>11216000
       SUCCESSFUL = 0,                                        <<SP.ENV>>11218000
       EXPECT'EQUAL = 1,                                      <<SP.ENV>>11220000
       UNDEFINED'KEYWORD = 2,                                 <<SP.ENV>>11222000
       EXPECT'SEMI'CR    = 3,                                 <<SP.ENV>>11224000
       DEVPARMS'OVERFLOW = 4,                                  <<02524>>11226000
       DEVARRAY'OVERFLOW = 5;                                  <<02524>>11228000
   INTEGER INDEX,NEXTDELIM,PARMLEN;                            <<02524>>11230000
   INTEGER ENTRYNO;                                           <<SP.ENV>>11232000
   BYTE POINTER DEFN;                                         <<SP.ENV>>11234000
   BYTE POINTER BDEV'PTR;                                      <<02524>>11236000
   BYTE ARRAY COPY'BYTE'STRING(0:BDEVPARM'END);                <<02524>>11240000
                                                               <<02524>>11242000
   LOGICAL SUBROUTINE GETNEXT;                                 <<02524>>11244000
      << explodes one entry from parms array >>                <<02524>>11246000
   BEGIN                                                       <<02524>>11248000
      IF I+1 > MAXPARMS THEN  << more than we can handle >>    <<02524>>11250000
         BEGIN                                                 <<02524>>11252000
         PARSE'DEV'PARMS := DEVPARMS'OVERFLOW;                 <<02524>>11254000
         RETURN;                                               <<02524>>11256000
         END;                                                  <<02524>>11258000
      TOS := PARMS(I);  << get full entry >>                   <<02524>>11260000
      NEXTDELIM := S0.(11:5);  << get trailing delim >>        <<02524>>11262000
      PARMLEN := TOS&LSR(8);   << pick up length >>            <<02524>>11264000
      @BP := TOS;  << parm pointer >>                          <<02524>>11266000
      I := I+1;                                                <<02524>>11268000
      GETNEXT := TRUE;   << no overflow >>                     <<02524>>11270000
   END;  << of get next >>                                     <<02524>>11272000
                                                               <<02524>>11274000
   LOGICAL SUBROUTINE UPDATE'DEV'PARM;                         <<02524>>11276000
                                                               <<02524>>11278000
   BEGIN                                                      <<SP.ENV>>11280000
                                                              <<SP.ENV>>11282000
      << Subroutine UPDATE'DEV'PARMS matches the token to >>  <<SP.ENV>>11284000
      << previous entry in DEVPARMS and builds a string and >><<SP.ENV>>11286000
      << length entry and indexes it.  >>                     <<SP.ENV>>11288000
   INDEX := DEVPARMS(J*2+1) := NEXT'AVAIL'PTR;                <<SP.ENV>>11292000
   NEXT'AVAIL'PTR := NEXT'AVAIL'PTR + 1 +                      <<02524>>11294000
        ( LOGICAL(PARMLEN)+2 )&LSR(1);                         <<02524>>11296000
   IF NEXT'AVAIL'PTR > DEVPARM'END + 1  THEN                   <<02524>>11298000
      BEGIN                                                   <<SP.ENV>>11300000
      PARSE'DEV'PARMS := DEVPARMS'OVERFLOW;                   <<SP.ENV>>11302000
      END                                                     <<SP.ENV>>11306000
   ELSE                                                       <<SP.ENV>>11308000
      BEGIN                                                   <<SP.ENV>>11310000
      UPDATE'DEV'PARM := TRUE;                                 <<02524>>11312000
      DEVPARMS(INDEX) := PARMLEN + 1;                          <<02524>>11314000
      MOVE BDEVPARMS( (INDEX+1)&LSL(1) ) := BP,(PARMLEN+1);    <<02524>>11316000
      END;                                                    <<SP.ENV>>11318000
   END;     << subroutine UPDATE'DEV'PARMS >>                 <<SP.ENV>>11320000
                                                              <<SP.ENV>>11322000
                                                              <<SP.ENV>>11324000
   FIRST := TRUE;                                              <<02524>>11326000
   PARSE'DEV'PARMS := 0;    << initialize >>                  <<SP.ENV>>11328000
   IF DEVPARMS = 0 THEN                                       <<SP.ENV>>11330000
      BEGIN      << initialize array >>                       <<SP.ENV>>11332000
      MOVE DEVPARMS(1) := DEVPARMS,(NUMKEYWORDS*2);           <<SP.ENV>>11334000
      DEVPARMS(NUMKEYWORDS*2) := -1;                          <<SP.ENV>>11336000
      NEXT'AVAIL'PTR := (NUMKEYWORDS+1)*2;                     <<02524>>11338000
                << next available cell >>                     <<SP.ENV>>11340000
                                                              <<SP.ENV>>11342000
      END;                                                    <<SP.ENV>>11344000
   MOVE COPY'BYTE'STRING := BYTE'STRING,(BDEVPARM'END);        <<02524>>11346000
      << Set up keyword array and search for keywords  >>     <<SP.ENV>>11348000
      << in BYTE'STRING >>                                    <<SP.ENV>>11350000
   COPY'BYTE'STRING(BDEVPARM'END) := %15;  << CR terminator >> <<02524>>11352000
   CONTINUE := TRUE;                                          <<SP.ENV>>11354000
       MOVE COPY'BYTE'STRING := COPY'BYTE'STRING WHILE ANS,0;  <<01882>>11356000
   DO                                                         <<SP.ENV>>11358000
      BEGIN                                                   <<SP.ENV>>11360000
      IF BPS0 = "." OR BPS0 = "/" OR BPS0 = "#" OR            <<SP.ENV>>11362000
              BPS0 = "*" THEN                                 <<SP.ENV>>11364000
         BEGIN  DEL; TOS := TOS +1; ASSEMBLE(DUP);                      11366000
               MOVE * := * WHILE ANS,0;                        <<01882>>11368000
         END                                                            11370000
      ELSE  CONTINUE := FALSE;                                <<SP.ENV>>11372000
      END                                                     <<SP.ENV>>11374000
   UNTIL NOT CONTINUE;                                        <<SP.ENV>>11376000
   @BP := TOS;                                                 <<02524>>11380000
   DEL;                                                        <<02524>>11382000
   IF BP = ";" THEN                                            <<02524>>11384000
      BEGIN          << indicates some keywords >>             <<02524>>11386000
                                                               <<02524>>11388000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<02524>>11390000
      MYCOMMAND(COPY'BYTE'STRING,DELIMITERS,MAXPARMS,          <<02524>>11392000
                NUMPARMS,PARMS);                               <<02524>>11394000
      I := 1;  << skip first parameter, i.e. DEVICE >>         <<02524>>11396000
                                                               <<02524>>11398000
      DO BEGIN  << search for valid keywords >>                <<02524>>11400000
                                                               <<02524>>11402000
         IF NOT GETNEXT THEN RETURN;                           <<02524>>11404000
                                                               <<02524>>11406000
         ENTRYNO := SEARCH(BP,PARMLEN,KEYLIST,DEFN);           <<02524>>11408000
         IF ENTRYNO = 0 THEN                                   <<02524>>11410000
            BEGIN   << keyword not in table >>                 <<02524>>11412000
            IF FIRST THEN RETURN;                              <<02524>>11414000
            PARSE'DEV'PARMS := UNDEFINED'KEYWORD;              <<02524>>11416000
            RETURN;                                            <<02524>>11418000
            END;                                               <<02524>>11420000
                                                               <<02524>>11422000
         IF NEXTDELIM <> EQUAL THEN                            <<02524>>11424000
            BEGIN                                              <<02524>>11426000
            IF FIRST THEN RETURN;                              <<02524>>11428000
            PARSE'DEV'PARMS := EXPECT'EQUAL;                   <<02524>>11430000
            RETURN;                                            <<02524>>11432000
            END;                                               <<02524>>11434000
                                                               <<02524>>11436000
         IF FIRST THEN                                         <<02524>>11438000
            BEGIN            <<make sure terminated by CR>>    <<02524>>11440000
            SCAN COPY'BYTE'STRING UNTIL CAR'RETURN, 1;         <<02524>>11442000
            J := TOS - LOGICAL(@COPY'BYTE'STRIN);              <<02524>>11444000
            IF J >= BDEVPARM'END THEN                          <<02524>>11446000
               BEGIN         <<no CR, missing or lost in trans><<02524>>11448000
               PARSE'DEV'PARMS := DEVARRAY'OVERFLOW;           <<02524>>11450000
               RETURN;                                         <<02524>>11452000
               END;                                            <<02524>>11454000
            END;                                               <<02524>>11456000
                                                               <<02524>>11458000
         FIRST := FALSE;                                       <<02524>>11460000
         IF NOT GETNEXT THEN RETURN;                           <<02524>>11462000
                                                               <<02524>>11464000
         << if keyword already defined in DEVPARMS, then >>    <<02524>>11466000
         << replace it, else make a new token entry.     >>    <<02524>>11468000
                                                               <<02524>>11470000
         J := -1;                                              <<02524>>11472000
         CONTINUE := TRUE;                                     <<02524>>11474000
                                                               <<02524>>11476000
         DO BEGIN    << see if exists already >>               <<02524>>11478000
            J := J + 1;                                        <<02524>>11480000
            @BDEV'PTR := @BDEVPARMS(J&LSL(2));                 <<02524>>11482000
            IF BDEV'PTR = DEFN,(2) THEN                        <<02524>>11484000
               CONTINUE := FALSE       << replace old >>       <<02524>>11486000
            ELSE IF DEVPARMS(J&LSL(1)) = 0 THEN                <<02524>>11488000
               BEGIN                                           <<02524>>11490000
               MOVE BDEV'PTR := DEFN,(2);                      <<02524>>11492000
               CONTINUE := FALSE;      << add new entry >>     <<02524>>11494000
               END;                                            <<02524>>11496000
            END                                                <<02524>>11498000
         UNTIL NOT CONTINUE OR (J+1 >= NUMKEYWORDS);           <<02524>>11500000
                                                               <<02524>>11502000
         << should always drop out of above with continue  >>  <<02524>>11504000
         << equal to false. Other test is just precaution >>   <<02524>>11506000
         << against DEVPARMS being clobberred.             >>  <<02524>>11508000
                                                               <<02524>>11510000
         IF NOT CONTINUE THEN                                  <<02524>>11512000
            BEGIN                                              <<02524>>11514000
            IF NOT UPDATE'DEV'PARM THEN RETURN;                <<02524>>11516000
            END;                                               <<02524>>11518000
                                                               <<02524>>11520000
         END                                                   <<02524>>11522000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<02524>>11524000
                                                               <<02524>>11526000
      IF NEXTDELIM <> CR THEN                                  <<02524>>11528000
         BEGIN                                                 <<02524>>11530000
         PARSE'DEV'PARMS := EXPECT'SEMI'CR;                    <<02524>>11532000
         END;                                                  <<02524>>11534000
                                                               <<02524>>11536000
      END;                                                              11538000
   END;     << procedure PARSE'DEV'PARMS >>                   <<SP.ENV>>11540000
                                                              <<SP.ENV>>11542000
   LOGICAL PROCEDURE GET'DEV'PARM(TOKEN, DEVPARMS, INDEX);    <<SP.ENV>>11544000
                                                              <<SP.ENV>>11546000
      VALUE TOKEN;                                            <<SP.ENV>>11548000
      INTEGER TOKEN;                                           <<01863>>11550000
      INTEGER ARRAY DEVPARMS;                                  <<01863>>11552000
      INTEGER INDEX;                                          <<SP.ENV>>11554000
   OPTION UNCALLABLE;                                          <<01901>>11556000
                                                              <<SP.ENV>>11558000
   << GET'DEV'PARM is passed the token of a device parameter >><<01815>>11560000
   << and the array DEVPARMS which was previously formatted >><<SP.ENV>>11562000
   << by the procedure PARSE'DEV'PARMS >>                     <<SP.ENV>>11564000
   << See PARSE'DEV'PARMS for a list of tokens. >>            <<SP.ENV>>11566000
                                                              <<SP.ENV>>11568000
   BEGIN                                                      <<SP.ENV>>11570000
                                                              <<SP.ENV>>11572000
   INTEGER I;                                                 <<SP.ENV>>11574000
                                                              <<SP.ENV>>11576000
   I := INDEX := 0;                                           <<SP.ENV>>11578000
   IF DEVPARMS <> 0 THEN DO                                             11580000
      BEGIN                                                   <<SP.ENV>>11582000
      IF DEVPARMS(I) = TOKEN THEN                              <<02524>>11584000
         BEGIN   << Token found >>                            <<SP.ENV>>11586000
         INDEX := DEVPARMS(I+1);                               <<02524>>11588000
         IF DEVPARMS(INDEX) > 1                                <<02524>>11590000
            THEN GET'DEV'PARM := TRUE                          <<02524>>11592000
            ELSE INDEX := 0; << NULL PARM = NO PARM >>         <<02524>>11594000
         END;                                                  <<02524>>11596000
      END                                                      <<02524>>11598000
   UNTIL DEVPARMS( (I:=I+2) ) <= 0;                            <<02524>>11600000
   END;     << procedure GET'DEV'PARM >>                      <<SP.ENV>>11602000
                                                              <<SP.ENV>>11604000
$ CONTROL SEGMENT = FILESYS6                                            11606000
LOGICAL PROCEDURE FILECOMVALS (N1,N2,N3,FD,DEVL,FOPT,AOPT,NBUFS,DISP,   11608000
   RSIZE,NUMEXTS,INITALLOC,BF,FILESIZE,FILECODE,STATE,PMAP,    <<01815>>11610000
   FMSG,DEVPARMS,DP'ERROR);                                    <<02524>>11612000
                                                               <<02524>>11614000
COMMENT                                                        <<02524>>11616000
   <<THIS PROCEDURE MERGES THE SPECIFIED FOPEN PARAMETERS WITH THOSE    11618000
     OF THE APPROPRIATE :FILE COMMAND, IF ANY, PENDING AGAINST          11620000
     THE FILE.                                                          11622000
                                                                        11624000
     INPUT PARAMETERS:                                                  11626000
         N1 - LOCAL FILE NAME                                           11628000
         N2 - GROUP NAME                                                11630000
         N3 - ACCOUNT NAME                                              11632000
         FD - FORMAL FILE DESIGNATOR                                    11634000
         DEVL - DEVICE CLASS OR LOGICAL DEVICE NUMBER                   11636000
         FOPT - FOPTIONS                                                11638000
         AOPT - AOPTIONS                                                11640000
         NBUFS - (0:4)OUTPRI,(4:7)NUMCOPIES,(11:5)NUMBUFFERS            11642000
         DISP - FCLOSE DISPOSITION                                      11644000
         RSIZE - RECORD SIZE                                            11646000
         NUMEXTS - NUMBER OF EXTENTS                                    11648000
         INITALLOC - NUMBER OF EXTENTS TO BE ALLOCATED                  11650000
         BF - BLOCKING FACTOR                                           11652000
         FILESIZE - NUMBER OF RECORDS IN FILE                           11654000
         FILECODE - FILE CODE                                           11656000
         STATE - FOPEN STATE WORD                                       11658000
         PMAP - FOPEN PARAMETER BIT MAP                                 11660000
         DEVPARMS - device parameter keyword array              SP.ENV  11662000
                   - see procedure PARSE'DEV'PARMS for info     SP.ENV  11664000
                                                                        11666000
     OUTPUT VARIABLES:                                                  11668000
         FILECOMVALS - FILE EQUATION FLAG                               11670000
            FALSE - NO FILE EQUATION                                    11672000
            TRUE - FILE EQUATION AFFECTED                               11674000
         DP'ERROR - contains the result of the call            <<02524>>11676000
                    to PARSE'DEV'PARMS                         <<02524>>11678000
         PLUS ALL INPUT PARAMETERS                                      11680000
                                                                        11682000
     THIS PROCEDURE MUST BE CALLED WITH DB SET TO THE STACK>>           11684000
                                                               <<02524>>11686000
;  << end of comment >>                                        <<02524>>11688000
                                                               <<02524>>11690000
   BYTE ARRAY N1,N2,N3,FD,DEVL,FMSG;                           <<TL.02>>11692000
   LOGICAL FOPT,AOPT;                                                   11694000
   INTEGER NBUFS,DISP,RSIZE,NUMEXTS,INITALLOC,BF,FILECODE;              11696000
   LOGICAL STATE,PMAP;                                                  11698000
   DOUBLE FILESIZE;                                                     11700000
   LOGICAL ARRAY DEVPARMS;                                    <<SP.ENV>>11702000
   LOGICAL DP'ERROR;                                           <<02524>>11704000
   OPTION PRIVILEGED,UNCALLABLE;                                        11706000
   BEGIN                                                                11708000
   INTEGER RESULT = FILECOMVALS;                                        11710000
   INTEGER SCAN'LEN; << len of device field to 1st CR/semi. >> <<02524>>11714000
   EQUATE CR'SEMI'COLON = %6473;                              <<SP.ENV>>11716000
   INTEGER ARRAY FTAB (0:120); <<:FILE COMMAND PARM BUFF>>     <<TL.02>>11718000
   BYTE ARRAY BFTAB (*) = FTAB;                                         11720000
   ARRAY LFTAB (*) = FTAB;                                     <<01333>>11722000
   INTEGER I;  <<UTILITY VARIABLE>>                                     11724000
   BYTE POINTER BSCAN;                                                  11726000
   INTEGER POINTER WSCAN;                                               11728000
   DOUBLE POINTER WSCANDBL = WSCAN;                                     11730000
    BYTE ARRAY COPY'DEVL(0:MAXDEVLEN);  <<Room for terminator>><<02524>>11732000
                                                                        11736000
   <<* * * GET :FILE PARAMETERS FROM JOB TABLE * * *>>                  11738000
                                                                        11740000
   I := 3;                                                              11742000
   IF XRETJTENTRY(N1,N2,N3,I,FTAB) = 0 THEN  <<:FILE COMMAND?>>         11744000
      BEGIN                                                             11746000
                                                                        11748000
      <<* * * MERGE PARAMETERS * * *>>                                  11750000
                                                                        11752000
      I := FTAB.(8:8);  <<NR. WORDS FOR FORMAL DESIGNATOR>>             11754000
      @BSCAN := @BFTAB(2);  <<SET TO FORMAT DESIGNATOR>>                11756000
      FTAB(1).(0:1) := 0;  <<CLEAR MYSTERY BIT>>                        11758000
      I := I&LSL(1);  <<NR. BYTES FOR FORMAL DESIGNATOR>>               11760000
      MOVE FD := BSCAN,(I);  <<COPY FORMAL DESIGNATOR>>                 11762000
      FD(I) := " ";  <<APPEND TRAILING BLANK>>                          11764000
      @BSCAN := @BSCAN+I+6;  <<SET TO ACTUAL DESIGNATOR>>               11766000
      @FTAB := @FTAB+I&LSR(1)+1;  <<SET TO FIRST BIT MAP>>              11768000
      @BFTAB := @FTAB&LSL(1);                                           11770000
      TOS := FTAB;  <<FIRST BIT MAP>>                                   11772000
      IF LS0.(15:1) THEN  <<RETURN NEW NAME?>>                          11774000
         BEGIN                                                          11776000
         I := BFTAB(4);                                                 11778000
         MOVE FD := BSCAN,(I);                                          11780000
         FD(I) := " ";                                                  11782000
         @BSCAN := @BSCAN+I                                             11784000
         END;                                                           11786000
      IF LS0.(14:1) THEN  <<RETURN NEW DEVICE CLASS?>>                  11788000
                << or device parms such as "ENV=", "OUTQ=">>  <<SP.ENV>>11790000
         BEGIN                                                          11792000
         I := BFTAB(5);  <<NR. BYTES FOR DEVICE CLASS NAME>>            11794000
                 << + device parm keywords length >>          <<SP.ENV>>11796000
         MOVE COPY'DEVL := BSCAN,(MAXDEVLEN);                  <<02524>>11800000
         COPY'DEVL(MAXDEVLEN) := %15;                          <<02524>>11802000
         SCAN COPY'DEVL UNTIL CR'SEMI'COLON,1;                 <<02524>>11804000
         SCAN'LEN := TOS - LOGICAL(@COPY'DEVL);                <<02524>>11806000
         IF SCAN'LEN >= I THEN  << NO KEYWORDS >>              <<02524>>11808000
            SCAN'LEN := I;                                     <<02524>>11810000
         IF SCAN'LEN <> 0 THEN  << device exists >>            <<02524>>11812000
            BEGIN                                              <<02524>>11814000
            MOVE DEVL := BSCAN,(SCAN'LEN);                     <<02524>>11816000
            DEVL(SCAN'LEN) := " ";    << terminator >>         <<02524>>11818000
            END;                                               <<02524>>11820000
         IF SCAN'LEN <> I AND BSCAN(SCAN'LEN) = ";" THEN       <<02524>>11822000
            BEGIN          << keywords >>                      <<02524>>11824000
            DP'ERROR := PARSE'DEV'PARMS(BSCAN,DEVPARMS);       <<02524>>11826000
            END;                                               <<02524>>11828000
         @BSCAN := @BSCAN+I  <<SKIP OVER DEVICE CLASS NAME>>            11830000
                             << and device parameters >>      <<SP.ENV>>11832000
         END;                                                           11834000
      @WSCAN := (@BSCAN+1)&LSR(1);  <<SET TO FOPTIONS>>                 11836000
      IF LS0.(13:1) THEN FOPT.FOPDOMAINF := WSCAN.FOPDOMAINF;           11838000
      IF LS0.(12:1) THEN FOPT.FOPASCIIF := WSCAN.FOPASCIIF;             11840000
      IF LS0.(11:1) THEN                                                11842000
         FOPT.FOPDESIGNATORF := WSCAN.FOPDESIGNATORF                    11844000
      ELSE                                                              11846000
         FOPT.FOPDESIGNATORF := 0;  <<MAKE ACTUAL>>                     11848000
      IF LS0.(10:1) THEN FOPT.FOPFORMATF := WSCAN.FOPFORMATF;           11850000
      IF LS0.(9:1) THEN FOPT.FOPCONTROLF := WSCAN.FOPCONTROLF;          11852000
      IF LFTAB(1).(0:1) THEN FOPT.FILETYPE:=WSCAN.FILETYPE;    <<HM.01>>11854000
      IF LFTAB(1).(1:1) THEN                                   <<01333>>11856000
         BEGIN                                                 <<01333>>11858000
         FTAB(1).(1:1) := WSCAN.FOPLABELLEDF;                  <<01333>>11860000
         FOPT.FOPLABELLEDF := WSCAN.FOPLABELLEDF;              <<01333>>11862000
         END;                                                  <<01333>>11864000
      @WSCAN := @WSCAN+1;  <<SET TO AOPTIONS>>                          11866000
      IF LS0.(8:1) THEN AOPT.AOPCOPYF:=WSCAN.AOPCOPYF;         <<HM.00>>11868000
      IF LS0.(7:1) THEN                                                 11870000
         BEGIN                                                          11872000
         AOPT.AOPACTYPEF := WSCAN.AOPACTYPEF;                           11874000
         PMAP.(5:1) := 1                                                11876000
         END;                                                           11878000
      IF LS0.(6:1) THEN AOPT.AOPMULTIRECF := WSCAN.AOPMULTIRECF;        11880000
      IF LS0.(5:1) THEN AOPT.AOPACMODEF := WSCAN.AOPACMODEF;            11882000
      IF LS0.(4:1) THEN AOPT.AOPINHIBITBUFF := WSCAN.AOPINHIBITBUFF;    11884000
      IF LS0.(3:1) THEN NBUFS.(11:5) := WSCAN(1).(3:5);                 11886000
      IF LS0.(2:1) THEN DISP := WSCAN(1).(13:3);                        11888000
      IF LS0.(1:1) THEN RSIZE := WSCAN(2);                              11890000
      IF LS0.(0:1) THEN                                                 11892000
         BEGIN                                                          11894000
         BF := WSCAN(3).(8:8);                                          11896000
         STATE.DEFAULTBF := 0                                           11898000
         END;                                                           11900000
      DEL;  <<DELETE FIRST BIT MAP>>                                    11902000
      TOS := FTAB(1);  <<SECOND BIT MAP>>                               11904000
      IF LS0.(15:1) THEN INITALLOC := WSCAN(1).(8:5)+1;        <<01968>>11906000
      IF LS0.(14:1) THEN NUMEXTS := WSCAN(3).(0:5)+1;                   11908000
      IF LS0.(13:1) THEN FILESIZE := WSCANDBL(2);                       11910000
      IF LS0.(12:1) THEN FILECODE := WSCAN(6);                          11912000
      IF LS0.(11:1) THEN NBUFS.(0:4) := WSCAN(7).(0:4);                 11914000
      IF LS0.(10:1) THEN NBUFS.(4:7) := WSCAN(7).(4:7);                 11916000
      IF LS0.( 9:1) THEN AOPT.AOPMULTACF := WSCAN.AOPMULTACF;           11918000
      IF LS0.( 8:1) THEN AOPT.AOPNOWAITF := WSCAN.AOPNOWAITF;           11920000
      IF LS0.(7:1) THEN AOPT.AOPLOCKINGF := WSCAN.AOPLOCKINGF; <<01815>>11922000
      IF LS0.(1:2) <> 0 THEN                                   <<02568>>11924000
         BEGIN    << Forms/Tape Label >>                       <<02568>>11926000
         @BSCAN := (@WSCAN+10)&LSL(1);                         <<01815>>11928000
         FMSG(1) := LS0.(1:2);                                 <<02568>>11930000
         MOVE FMSG(2) := BSCAN,(168);                          <<01815>>11932000
         END;    << KSAM/FORMS/LABEL >>                        <<01815>>11934000
      RESULT := RESULT+1      << return True >>                         11936000
      END                                                               11938000
   END;     << procedure FILECOMVALS >>                                 11940000
PROCEDURE STUFF'DEV'PARMS(DEVPARMS,RESULT);                    <<02524>>11942000
VALUE RESULT;                                                  <<02524>>11944000
ARRAY DEVPARMS;                                                <<02524>>11946000
INTEGER RESULT;                                                <<02524>>11948000
                                                               <<02524>>11950000
OPTION UNCALLABLE;                                             <<02524>>11952000
BEGIN                                                          <<02524>>11954000
   INTEGER PARM'INDEX,DEVLEN;                                  <<02524>>11956000
   LOGICAL CONTINUE := TRUE;                                   <<02524>>11958000
   BYTE POINTER OUTPUT' = RESULT;                              <<02524>>11960000
                                                               <<02524>>11962000
   BYTE ARRAY BDEVPARMS(*) = DEVPARMS;                         <<02524>>11964000
                                                               <<02524>>11968000
   MOVE OUTPUT' := OUTPUT' WHILE ANS,0;                        <<02524>>11970000
   DO                                                          <<02524>>11972000
      BEGIN                                                    <<02524>>11974000
         IF BPS0 = "." OR BPS0 = "/" OR                        <<02524>>11976000
            BPS0 = "*" OR BPS0 = "#" THEN                      <<02524>>11978000
            BEGIN                                              <<02524>>11980000
               DEL;                                            <<02524>>11982000
               TOS := TOS + 1;                                 <<02524>>11984000
               ASSEMBLE(DUP);                                  <<02524>>11986000
               MOVE * := * WHILE ANS,0;                        <<02524>>11988000
            END                                                <<02524>>11990000
         ELSE                                                  <<02524>>11992000
            CONTINUE := FALSE;                                 <<02524>>11994000
      END                                                      <<02524>>11996000
   UNTIL NOT CONTINUE;                                         <<02524>>11998000
   DEVLEN := TOS - LOGICAL(@OUTPUT');                          <<02524>>12000000
   DEL;                                                        <<02524>>12002000
   IF GET'DEV'PARM(OUTQ'TOKEN,DEVPARMS,PARM'INDEX) THEN        <<02524>>12006000
   BEGIN                                                       <<02524>>12008000
      MOVE OUTPUT'(DEVLEN) := ";OUTQ=";                        <<02524>>12010000
      DEVLEN := DEVLEN + 6;                                    <<02524>>12012000
      MOVE OUTPUT'(DEVLEN) := BDEVPARMS((PARM'INDEX+1)&LSL(1)),<<02524>>12014000
                             (DEVPARMS(PARM'INDEX) - 1);       <<02524>>12016000
      DEVLEN := DEVLEN + INTEGER(DEVPARMS(PARM'INDEX)) - 1;    <<02524>>12018000
   END;                                                        <<02524>>12020000
   IF GET'DEV'PARM(DEN'TOKEN,DEVPARMS,PARM'INDEX) THEN         <<02524>>12022000
   BEGIN                                                       <<02524>>12024000
      MOVE OUTPUT'(DEVLEN) := ";DEN=";                         <<02524>>12026000
      DEVLEN := DEVLEN + 5;                                    <<02524>>12028000
      MOVE OUTPUT'(DEVLEN) := BDEVPARMS((PARM'INDEX+1)&LSL(1)),<<02524>>12030000
                             (DEVPARMS(PARM'INDEX) - 1);       <<02524>>12032000
      DEVLEN := DEVLEN + INTEGER(DEVPARMS(PARM'INDEX)) - 1;    <<02524>>12034000
   END;                                                        <<02524>>12036000
   OUTPUT'(DEVLEN) := %15;                                     <<02524>>12038000
END; << procedure STUFF'DEV'PARMS >>                           <<02524>>12040000
$ CONTROL SEGMENT = FILESYS4                                            12042000
LOGICAL PROCEDURE FLOCKWORD (USERLW,FLAB,A,B,PACBV);                    12044000
   <<CHECKS THE SUPPLIED LOCKWORD AGAINST THE FILE LOCKWORD.  IF        12046000
     NONE IS SUPPLIED AND THE FILE HAS A LOCKWORD THEN THE USER         12048000
     IS PROMPTED FOR THE LOCKWORD.                               00822  12050000
                                                                        12052000
     INPUT VARIABLES:                                                   12054000
         USERLW - SUPPLIED LOCKWORD (8 BYTES WITH TRAILING BLANKS)      12056000
         FLAB - FILE LABEL POINTER                                      12058000
         A - CALLER'S GETSIR(FISIR) RESULT                              12060000
         B - CALLER'S GETSIR(FMAVTSIR) RESULT                           12062000
         PACBV - MULTIACCESS PACB VECTOR                                12064000
            0 - PACB NOT LOCKED                                         12066000
            N - VECTOR OF LOCKED PACB                                   12068000
                                                                        12070000
     OUTPUT VARIABLES:                                                  12072000
         FLOCKWORD - ERROR FLAG                                         12074000
            0 - LOCKWORD VIOLATION                                      12076000
            1 - SUPPLIED LOCKWORD MATCHES FILE LOCKWORD                 12078000
            2 - PROMPTED LOCKWORD MATCHES FILE LOCKWORD                 12080000
         USERLW - SUPPLIED OR PROMPTED LOCKWORD                         12082000
                                                                        12084000
     NOTE THAT THE FILE SIR IS RELEASED IF THE SUPPLIED LOCKWORD        12086000
     DOES NOT MATCH THE FILE LOCKWORD.  THIS IS BECAUSE WE DON'T        12088000
     WANT TO HOLD THE SIR WHILE WE ARE PROMPTING THE USER FOR           12090000
     THE LOCKWORD; THE TERMINAL READ IS BLOCKED AND THE USER MAY        12092000
     TAKE AN INDETERMINATE AMOUNT OF TIME TO RESPOND.  ALSO, DB         12094000
     MUST BE SET TO THE STACK WHEN THIS PROCEDURE IS CALLED>>           12096000
   VALUE A,B,PACBV;                                                     12098000
   BYTE ARRAY USERLW;                                                   12100000
   ARRAY FLAB;                                                          12102000
   INTEGER A,B,PACBV;                                                   12104000
   OPTION UNCALLABLE,PRIVILEGED;                                        12106000
   BEGIN                                                                12108000
   BYTE POINTER FILELW;  <<FILE LOCKWORD>>                              12110000
   INTEGER CNT;  <<MESSAGE LENGTH>>                                     12112000
   BYTE ARRAY MESSAGE (0:37);  <<MESSAGE BUFFER>>                       12114000
                                                                        12116000
$  IF X0 = ON                                                           12118000
   IF MONOTHER THEN  <<MONITORING?>>                                    12120000
      BEGIN                                                             12122000
      TOS := "FL"; TOS := "OC"; TOS := "KW"; TOS := "OR";               12124000
      TOS := "D ";                                                      12126000
      ASSEMBLE(ZERO,DZRO);                                              12128000
      FTITLE(*,*,*,*);                                                  12130000
      DEBUG                                                             12132000
      END;                                                              12134000
$  IF                                                                   12136000
                                                                        12138000
   @FILELW := @FLLOCKWORD&LSL(1);  <<FILE LOCKWORD>>                    12140000
   X := -1;                                                    <<00600>>12142000
   WHILE (X:=X+1)<8 DO IF FILELW(X) = 0 THEN FILELW(X):=" ";   <<00600>>12144000
   IF USERLW = FILELW,(8) THEN  <<LOCKWORD MATCH?>>                     12146000
      BEGIN                                                             12148000
      TOS := 1;                                                         12150000
      GO EXIT                                                           12152000
      END;                                                              12154000
   RELSIR(FISIR,A);  <<RELEASE FILE SIR>>                               12156000
   IF PACBV <> 0 THEN  <<UNLOCK PACB?>>                                 12158000
      BEGIN                                                             12160000
      FGETCB(0,0,DUM,PACBV,0);  <<FIND PACB>>                  <<01.02>>12162000
      ASSEMBLE(DEL,XCH);                                                12164000
      FRELCB(*,*,1)  <<RELEASE PACB>>                                   12166000
      END;                                                              12168000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);  <<RELEASE FMAVT SIR>>           12170000
   IF FILELW = " " THEN  <<NO FILE LOCKWORD?>>                          12172000
      BEGIN                                                             12174000
      IF USERLW="/" THEN                                       <<02350>>12176000
         BEGIN                                                 <<02350>>12178000
         USERLW:=" ";     << set to blank to match file lw >>  <<02350>>12180000
         TOS:=1;          << treat as a match; no error    >>  <<02350>>12182000
         END                                                   <<02350>>12184000
      ELSE                << skip prompt; return error     >>  <<02350>>12186000
E0:   TOS := 0;                                                         12188000
      GO EXIT                                                           12190000
      END;                                                              12192000
   IF USERLW <> " " THEN GO E0;  <<MISMATCH?>>                          12194000
                                                                        12196000
   <<* * * PROMPT USER FOR LOCKWORD * * *>>                             12198000
                                                                        12200000
   TOS := @MESSAGE; BPS0 := " ";                                        12202000
   ASSEMBLE(DUP,INCB); MOVE * := *,(37);  <<CLEAR BUFFER>>              12204000
                                                                        12206000
   MOVE MESSAGE := "LOCKWORD: ",2;                                      12208000
   ASSEMBLE(DUP);                                                       12210000
   TOS := @FLLOCNAME&LSL(1);                                            12212000
   MOVE * := *,(8);  <<LOCAL FILE NAME>>                                12214000
   SCAN * UNTIL " ",1;                                                  12216000
   BPS0 := ".";                                                         12218000
   ASSEMBLE(INCA,DUP);                                                  12220000
   TOS := @FLGRPNAME&LSL(1);                                            12222000
   MOVE * := *,(8);  <<GROUP NAME>>                                     12224000
   SCAN * UNTIL " ",1;                                                  12226000
   BPS0 := ".";                                                         12228000
   ASSEMBLE(INCA,DUP);                                                  12230000
   TOS := @FLACCTNAME&LSL(1);                                           12232000
   MOVE * := *,(8);  <<ACCOUNT NAME>>                                   12234000
   SCAN * UNTIL " ",1;                                                  12236000
   BPS0 := "?";                                                         12238000
   CNT := TOS+1-@MESSAGE;  <<MESSAGE LENGTH>>                           12240000
                                                                        12242000
   IF NOT FREPLY(MESSAGE,CNT) THEN GO E0;  <<PROMPTING ERROR?>>         12244000
   MOVE USERLW := MESSAGE,(8);  <<PROMPTED LOCKWORD>>                   12246000
   IF USERLW <> FILELW,(8) THEN GO E0;  <<MISMATCH?>>                   12248000
   TOS := 2;                                                            12250000
EXIT:                                                                   12252000
   FLOCKWORD := TOS                                                     12254000
   END;                                                                 12256000
$ PAGE " MPE-IV BASELINE FILE SYSTEM - UNCALLABLE INTRINSICS"           12258000
<<----------------------------------------------------------------------12260000
*                                                                      *12262000
*  UNCALLABLE (MPE SUPPORT) INTRINSICS                                 *12264000
*                                                                      *12266000
---------------------------------------------------------------------->>12268000
                                                                        12270000
$ CONTROL SEGMENT = FILESYS4                                            12272000
INTEGER PROCEDURE FLABIO (LDEV,SECTOR,FUNC,FLAB);                       12274000
   <<THIS PROCEDURE READS AND WRITES FILE LABELS.  IT ALSO CHECKS FOR   12276000
     DATA CREDIBILITY VIA A CHECKSUM ON THE FILE LABEL.                 12278000
                                                                        12280000
     INPUT VARIABLES:                                                   12282000
         LDEV - LOGICAL DEVICE NUMBER OF FILE LABEL                     12284000
         SECTOR - SECTOR NUMBER OF FILE LABEL                           12286000
         FUNC - I/O MODE                                                12288000
            0 - READ                                                    12290000
            1 - WRITE                                                   12292000
         FLAB - FILE LABEL POINTER                                      12294000
                                                                        12296000
     OUTPUT VARIABLES:                                                  12298000
         FLABIO - ERROR FLAG                                            12300000
            0 - OK                                                      12302000
            1 - HARD ERROR - DIRECTORY ENTRY SHOULD BE FLAGGED          12304000
            2 - SOFT ERROR - DIRECTORY ENTRY SHOULD NOT BE FLAGGED      12306000
                                                                        12308000
     NOTE THAT THIS PROCEDURE IS USED BY INITIAL/SYSDUMP, STORE/RESTORE 12310000
     AND LOG AS WELL AS THE FILE SYSTEM.  ALSO, DB MUST BE SET TO THE   12312000
     STACK WHEN THIS PROCEDURE IS CALLED>>                              12314000
   VALUE LDEV,SECTOR,FUNC;                                              12316000
   INTEGER LDEV,FUNC;                                                   12318000
   DOUBLE SECTOR;                                                       12320000
   INTEGER ARRAY FLAB;                                                  12322000
   OPTION PRIVILEGED,UNCALLABLE;                                        12324000
   BEGIN                                                                12326000
   DEFINE READ = NOT LOGICAL(FUNC)#,                                    12328000
          WRITE = LOGICAL(FUNC)#;                                       12330000
   INTEGER P1 = SECTOR;  <<SECTOR NUMBER - FIRST HALF>>                 12332000
   INTEGER P2 = SECTOR+1;  <<SECTOR NUMBER - SECOND HALF>>              12334000
   DOUBLE POINTER FLABDBL = FLAB;                                       12336000
                                                               <<01901>>12338000
   SUBROUTINE CHEKFLAB;                                        <<01901>>12340000
   << This routine checks that the 1st extent in the file label<<01901>>12342000
   << (just read or about to be written) is not zero and at    <<01901>>12344000
   << least the sector address matches the address passed in as<<01901>>12346000
   << a parameter to FLABIO.>>                                 <<01901>>12348000
   BEGIN                                                       <<01901>>12350000
   TOS:=FLLABEL;                                               <<01901>>12352000
   IF = THEN BEGIN      << Addr of 1st extent is zero >>       <<01901>>12354000
             DDEL;                                             <<01901>>12356000
             GO INVFL;                                         <<01901>>12358000
             END                                               <<01901>>12360000
   ELSE BEGIN                                                  <<01901>>12362000
        << It would be too expensive to convert vol. number >> <<01901>>12364000
        << in flabel to ldev for every read or write of a   >> <<01901>>12366000
        << file label.  But at least we can check that the  >> <<01901>>12368000
        << sector address matches the parameter SECTOR.     >> <<01901>>12370000
        S1.(0:8):=0;       << Zero out volume number     >>    <<01901>>12372000
        IF TOS <> SECTOR   << Address doesn't match      >>    <<01901>>12374000
        THEN GO INVFL;                                         <<01901>>12376000
        END;                                                   <<01901>>12378000
   END;                                                        <<01901>>12380000
                                                                        12382000
$  IF X0 = ON                                                           12384000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               12386000
      BEGIN                                                             12388000
      TOS := "FL"; TOS := "AB"; TOS := "IO";                            12390000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        12392000
      FTITLE(*,*,*,*);                                                  12394000
      DEBUG                                                             12396000
      END;                                                              12398000
$  IF                                                                   12400000
                                                               <<+0.06>>12402000
   <<* * * VERIFY THAT CALLER HAS FILE SIR * * *>>             <<+0.06>>12404000
                                                               <<+0.06>>12406000
$  IF X2 = ON                                                  <<+0.06>>12408000
   <<The idea was that if the caller was fooling around with >><<04138>>12410000
   <<the file label he should have the file SIR.  However it >><<04138>>12412000
   <<was found that good calls to do label I/O may not own   >><<04138>>12414000
   <<file SIR - and so the check was commented out 12/10/76  >><<04138>>12416000
   <<We will leave it in until such time we wish to track    >><<04138>>12418000
   <<down all callers and start enforcing this rule.         >><<04138>>12420000
<< IF GETPROCNUM <> SIR(FISIR*SIRENTRY).(0:8)    >>            <<04138>>12422000
<<    THEN FTROUBLE(0);                          >>            <<04138>>12424000
$  IF                                                          <<+0.06>>12426000
                                                                        12428000
   P1.(0:8):=0;         << Zero out volume number of SECTOR >> <<01901>>12430000
   IF WRITE THEN  <<UPDATE CHECKSUM?>>                                  12432000
      BEGIN                                                             12434000
      <<*** To catch bad file labels *** >>                    <<01901>>12436000
      CHEKFLAB;                                                <<01901>>12438000
      CHECKSUM;  <<GENERATE NEW CHECKSUM>>                              12440000
      FLCHECKSUM := TOS  <<UPDATE CHECKSUM>>                            12442000
      END;                                                              12444000
   TOS := ATTACHIO(LDEV,0,0,@FLAB,FUNC,128,P1,P2,BFLAGS);      <<01901>>12446000
   DEL;                                                                 12448000
   IF TOS.(8:8) <> 1 THEN  <<ATTACHIO ERROR?>>                          12450000
      BEGIN                                                             12452000
      IF READ THEN GO SOFT;  <<READ FAILURE?>>                          12454000
      GO HARD  <<WRITE FAILURE>>                                        12456000
      END;                                                              12458000
   IF READ THEN  <<VERIFY CHECKSUM?>>                                   12460000
      BEGIN                                                             12462000
      <<*** To catch bad file labels *** >>                    <<01901>>12464000
      CHEKFLAB;                                                <<01901>>12466000
      CHECKSUM;  <<GENERATE CHECKSUM>>                                  12468000
      ASSEMBLE(TEST);                                                   12470000
      IF = OR FLCHECKSUM <> 0 THEN  <<VERIFY CHECKSUM?>>                12472000
         IF TOS <> FLCHECKSUM THEN  <<CHECKSUM MISMATCH?>>              12474000
            BEGIN                                                       12476000
     INVFL: FLLABEL := 0D;  <<INVALIDATE FIRST EXTENT>>        <<01901>>12478000
            FLNUMEXTS := 0;  <<INVALIDATE REMAINING EXTENTS>>           12480000
            GO HARD                                                     12482000
            END                                                         12484000
      END;                                                              12486000
   TOS := 0;  <<NO ERROR>>                                              12488000
   GO EXIT;                                                             12490000
                                                                        12492000
HARD:                                                                   12494000
   TOS := 1;  <<HARD ERROR>>                                            12496000
   GO EXIT;                                                             12498000
                                                                        12500000
SOFT:                                                                   12502000
   TOS := 2;  <<SOFT ERROR>>                                            12504000
                                                                        12506000
EXIT:                                                                   12508000
   FLABIO := TOS  <<ERROR NR.>>                                         12510000
   END;                                                                 12512000
                                                                        12516000
$ CONTROL SEGMENT = FILESYS4                                            12518000
PROCEDURE FLABIOERR (FLAG,FILENUM,FGANAME);                             12520000
                                                               <<04516>>12522000
  <<********************************************************>> <<04516>>12524000
  << This procedure flags a director entry as having a bad  >> <<04516>>12526000
  << file label and prints an error message of the opera-   >> <<04516>>12528000
  << tor's console.  Also, invalidated the FCB to prevent   >> <<04516>>12530000
  << further access of the file.                            >> <<04516>>12532000
  <<                                                        >> <<04516>>12534000
  << Input Variables:                                       >> <<04516>>12536000
  <<   FLAG - Error severity code                           >> <<04516>>12538000
  <<      1 - Hard error (write failure or checksum wrong)  >> <<04516>>12540000
  <<      2 - Soft error (Read failure)                     >> <<04516>>12542000
  <<   FILENUM - File number                                >> <<04516>>12544000
  <<      0 - File number not available                     >> <<04516>>12546000
  <<      N - File number                                   >> <<04516>>12548000
  <<   FGANAME - File Name Array (Optional, used if File-   >> <<04516>>12550000
  <<                              num = 0 )                 >> <<04516>>12552000
  <<      1st. 8 bytes - File name                          >> <<04516>>12554000
  <<      2nd. 8 bytes - Group name                         >> <<04516>>12556000
  <<      3rd. 8 bytes - Account name                       >> <<04516>>12558000
  <<                                                        >> <<04516>>12560000
  << Note that this procedure is used by those modules that >> <<04516>>12562000
  << also use FLABIO.  Also, DB must be set to the stack    >> <<04516>>12564000
  << when this procedure is called.                         >> <<04516>>12566000
  <<********************************************************>> <<04516>>12568000
                                                               <<04516>>12570000
   VALUE FLAG,FILENUM,FGANAME;                                          12572000
   LOGICAL FLAG;                                                        12574000
   INTEGER FILENUM,FGANAME;                                             12576000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                               12578000
   BEGIN                                                                12580000
   LOGICAL PMAP = Q-4;  <<PARAMETER BIT MAP>>                           12582000
   INTEGER I,J,K;  <<UTILITY INTEGERS>>                                 12584000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   12586000
   INTEGER FOPTIONS := 0;  <<FOPTIONS>>                                 12588000
   INTEGER LDEV := 0;  <<LOGICAL DEVICE NR.>>                           12590000
   INTEGER ARRAY FILEID (0:11);  <<FILE NAME BUFFER>>                   12592000
   BYTE ARRAY FILEID'B (*) = FILEID;                           <<04516>>12594000
   DEFINE FN = FILEID#,  <<LOCAL FILE NAME>>                            12596000
          GN = FILEID(4)#,  <<GROUP NAME>>                              12598000
          AN = FILEID(8)#;  <<ACCOUNT NAME>>                            12600000
   INTEGER ARRAY FID (0:13);                                            12602000
   BYTE ARRAY FID'B (*) = FID;                                 <<04516>>12604000
                                                               <<04516>>12606000
   INTEGER ACBDST;  <<STACK DST NR.>>                                   12608000
   INTEGER FCBV;  <<FCB VECTOR>>                                        12612000
   DOUBLE                                                      <<04624>>12614000
      FCB'CB'ADDR,      << Control block DST and offset.    >> <<04624>>12616000
      FCB'STK'ADDR;     << Stack DST and offset of FCB.     >> <<04624>>12618000
   INTEGER POINTER FCB; << FCB pointer to stack array.      >> <<04624>>12620000
   DOUBLE POINTER FCBDBL = FCB; << Double FCB.              >> <<04624>>12622000
   INTEGER FCBMQ;       << Q offset to FCB stack array.     >> <<04624>>12624000
   LOGICAL FCB'FLAG;    << Flag word returned by LOCK'CB.   >> <<04624>>12626000
   LOGICAL ACB'FLAGS;         << Flags sent to LOC'ACB      >> <<04516>>12628000
                                                               <<04516>>12630000
   <<*******************************************************>> <<04516>>12632000
   << ACB'POINTERS - Below are the declarations and equates >> <<04516>>12634000
   << for the PACB and AFT arrays.  LOC'ACB places the AFT  >> <<04516>>12636000
   << at ACB(-4) to ACB(-1) and the PACB follows.           >> <<04516>>12638000
                                                               <<04516>>12640000
   INTEGER ACBMQ;                                              <<04516>>12642000
   INTEGER AFTE;    <<AFT entry word 0, type and $NULL bit. >> <<04516>>12644000
   INTEGER PACBV;   << Physical ACB Vector                  >> <<04516>>12646000
   INTEGER LACBV;   << Logical  ACB Vector                  >> <<04516>>12648000
   INTEGER IOQX;    << No-wait I/O pending Queue index.     >> <<04516>>12650000
                                                               <<04516>>12652000
   << The order of the above declarationa cannot be changed >> <<04516>>12654000
   << in any way.  Also, the ACB declaration must immed-    >> <<04516>>12656000
   << iately follow.                                        >> <<04516>>12658000
                                                               <<04516>>12660000
   INTEGER ARRAY ACB(0:SIZEXACB-1) = Q;                        <<04516>>12662000
                                                               <<04516>>12664000
   <<  If any variables are needed to be added to this      >> <<04516>>12666000
   << procedure, they should be added after ACB since ACB'  >> <<04516>>12668000
   << LOCATION won't have to be changes.                    >> <<04516>>12670000
   <<*******************************************************>> <<04516>>12672000
                                                               <<04516>>12674000
                                                                        12676000
$  IF X0 = ON                                                           12678000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               12680000
      BEGIN                                                             12682000
      TOS := "FL"; TOS := "AB"; TOS := "IO"; TOS := "ER";               12684000
      TOS := "R ";                                                      12686000
      ASSEMBLE(ZERO,DZRO);                                              12688000
      FTITLE(*,*,*,*);                                                  12690000
      DEBUG                                                             12692000
      END;                                                              12694000
$  IF                                                                   12696000
                                                                        12698000
   IF FILENUM <> 0 OR PMAP THEN  <<FILE NAME AVAILABLE?>>               12700000
      BEGIN                                                             12702000
      IF FILENUM <> 0 THEN  <<FILE IS OPEN?>>                           12704000
         BEGIN                                                          12706000
                                                               <<04516>>12708000
         <<*************************************************>> <<04516>>12710000
         <<  Copy our AFT entry and ACB's onto the stack    >> <<04516>>12712000
         <<  into our Q relative array.                     >> <<04516>>12714000
         <<*************************************************>> <<04516>>12716000
                                                                        12718000
         CRIT := SETCRITICAL;                                           12720000
         PUSH(STATUS);      << FLAG.(0:1) set to privmode   >> <<04516>>12722000
         ACB'FLAGS := TOS;  << bit of STATUS register       >> <<04516>>12724000
         ACB'FLAGS.(1:15):=0; <<Privmode check only         >> <<04516>>12726000
         GET'ACB'Q'LOC;                                        <<04516>>12728000
         LOC'ACB(ACBDST,ACBMQ,FILENUM,ACB'FLAGS);              <<04516>>12730000
         ACBDST := TOS;  << LOC'ACB returns DST on TOS      >> <<04516>>12732000
                                                               <<04516>>12734000
                                                               <<04516>>12736000
         IF < THEN  <<ILLEGAL FILE NR.?>>                               12738000
            BEGIN                                                       12740000
            RESETCRITICAL(CRIT);                                        12742000
            GO UNKNOWN                                                  12744000
            END;                                                        12746000
         MOVE FN := ACBNAME , (4);       << Move local copy >> <<04624>>12748000
                                         << of file name.   >> <<04516>>12750000
                                                                        12752000
         <<*************************************************>> <<04624>>12754000
         << Allocate FCB array on stack and set up pointer. >> <<04624>>12756000
         << Copy the FCB into the stack via LOCK'CB.  We are>> <<04624>>12758000
         << copying the FCB w/o the extent map.             >> <<04624>>12760000
         <<*************************************************>> <<04624>>12762000
                                                               <<04624>>12764000
         PUSH(S); @FCB:=TOS+1;<< Allocate and set FCB.      >> <<04624>>12766000
         ASSEMBLE(ADDS SIZEBFCB);                              <<04624>>12768000
         GET'FCB'Q'LOC;       << Set FCBMQ for LOCK'CB.     >> <<04624>>12770000
         LOCK'CB(0,0,FCBMQ,ACBFCB.DSTN,ACBFCB VTA);            <<04624>>12772000
         FCB'CB'ADDR  := TOS; <<  CB DST and offset.        >> <<04624>>12774000
         FCB'STK'ADDR := TOS; << STK DST and offset.        >> <<04624>>12776000
         FCB'FLAG := TOS;     << Flag word, not used here.  >> <<04624>>12778000
                                                               <<04624>>12780000
         TOS := FCB'STK'ADDR; << Targer addresses, to stack.>> <<04624>>12782000
         TOS := FCB'CB'ADDR;  << Source , from FCB.         >> <<04624>>12784000
         TOS := SIZEBFCB;     << Copy 1st. 36 words.        >> <<04624>>12786000
         MOVE'DS'5;           << They're off!               >> <<04624>>12788000
                                                               <<04624>>12790000
         MOVE GN := FCBGN,(8);<< Group and Account.         >> <<04624>>12792000
                                                               <<04624>>12794000
         << Now invalidate the FCB!                         >> <<04624>>12796000
                                                               <<04624>>12798000
         IF FLAG THEN                                          <<04624>>12800000
            BEGIN             << Prevent further access.    >> <<04624>>12802000
            FCBDISP := HARDFLABERR;                            <<04624>>12804000
            FCBUSERLBL := 0;  << Clear User Labels.         >> <<04624>>12806000
            FCBEOF  := 0D;    << Clear EOF.                 >> <<04624>>12808000
            FCBFLIM := 0D;    << Clear File Limit.          >> <<04624>>12810000
            << Now copy changed FCB back to Control Block.  >> <<04624>>12812000
            TOS := FCB'CB'ADDR;  << Target, to CB.          >> <<04624>>12814000
            TOS := FCB'STK'ADDR; << Source, from stack.     >> <<04624>>12816000
            TOS := SIZEBFCB;     << Copy 36 words back.     >> <<04624>>12818000
            MOVE'DS'5;           << They're off!            >> <<04624>>12820000
            END;                                               <<04624>>12822000
                                                               <<04624>>12824000
         << Unlock FCB and ACB now.                         >> <<04624>>12826000
         UNLOCK'CB(0,ACBFCB.DSTN,ACBFCB VTA);                  <<04624>>12828000
         UNLOC'ACB(ACBMQ,0);  << Release ACB >>                <<04516>>12830000
                                                               <<04516>>12832000
         RESETCRITICAL(CRIT)                                            12834000
         END                                                            12836000
      ELSE  <<USE SUPPLIED FILE NAME>>                                  12838000
         @FILEID'B := FGANAME&LSL(1);                          <<04516>>12840000
                                                                        12842000
      <<* * * COMPOSE FILE NAME FOR MESSAGE * * *>>                     12844000
                                                                        12846000
      K := -1;                                                          12848000
      FOR I := 0 STEP 8 UNTIL 23 DO                                     12850000
         BEGIN                                                          12852000
         FOR J := 0 STEP 1 UNTIL 7 DO                                   12854000
            IF FILEID'B(I+J) <> " " THEN                       <<04516>>12856000
               FID'B(K := K+1) := FILEID'B(I+J);               <<04516>>12858000
         FID'B(K := K+1) := "."                                <<04516>>12860000
         END;                                                           12862000
      FID'B(K) := 0;                                           <<04516>>12864000
                                                                        12866000
      <<* * * FLAG DIRECTORY ENTRY * * *>>                              12868000
                                                                        12870000
      IF FCBPERMANENT AND FLAG THEN  <<FLAG DIRECTORY?>>       <<04624>>12872000
         DIRECSETFLAG (0,0D,AN,GN,FN);<<SET FLAG>>             <<38.PV>>12874000
      END                                                               12876000
   ELSE  <<UNKNOWN FILE NAME>>                                          12878000
UNKNOWN:                                                                12880000
      MOVE FID := ("UNKNOWN",0);                                        12882000
                                                                        12884000
   <<* * * PRINT MESSAGE ON OPERATOR CONSOLE * * *>>                    12886000
                                                                        12888000
   GENMSG(1,FLABERRNO,%10000,FCBLDEV,@FID'B,,,,0);             <<04624>>12890000
   << FILE LABEL ERROR MESSAGE >>                              <<0U.EB>>12892000
                                                                        12894000
   END;                                                                 12896000
$ CONTROL SEGMENT = FILESYS4                                            12900000
LOGICAL PROCEDURE FREPLY (MESSAGE,LENGTH);                              12902000
   <<WRITES THE SPECIFIED MESSAGE ON $STDLIST AND READS THE REPLY       12904000
     FROM $STDIN.                                                       12906000
                                                                        12908000
     INPUT VARIABLES:                                                   12910000
         MESSAGE - MESSAGE TO BE WRITTEN                                12912000
         LENGTH - MESSAGE LENGTH IN BYTES                               12914000
                                                                        12916000
     OUTPUT VARIABLES:                                                  12918000
         FREPLY - ERROR INDICATION                                      12920000
            TRUE - OK                                                   12922000
            FALSE - ERROR                                               12924000
         MESSAGE - REPLY TO MESSAGE (8 CHAR'S WITH BLANKS ADDED)        12926000
                                                                        12928000
     NOTE THAT THIS PROCEDURE IS USED BY THE CI AND STORE/RESTORE AS    12930000
     WELL AS THE FILE SYSTEM.  ALSO, DB MUST BE SET TO THE STACK WHEN   12932000
     THIS PROCEDURE IS CALLED>>                                         12934000
   VALUE LENGTH;                                                        12936000
   BYTE ARRAY MESSAGE;                                                  12938000
   INTEGER LENGTH;                                                      12940000
   OPTION UNCALLABLE,PRIVILEGED;                                        12942000
   BEGIN                                                                12944000
   EQUATE C0 = 9*5,  <<LOCKWORD MASK LENGTH>>                  <<+0.05>>12946000
          C1 = C0+2+1;  <<CR,LF PLUS 1 FOR ROUNDOFF>>          <<+0.05>>12948000
   LOGICAL                                                     <<06.EB>>12950000
      HARDCOPY:=FALSE,                                         <<06.EB>>12952000
      ECHOWASOFF:=TRUE;                                        <<06.EB>>12954000
   INTEGER POINTER PCBX;  <<PXGLOB POINTER>>                            12956000
   INTEGER POINTER BUF;  <<TERMINAL MESSAGE BUFFER>>                    12958000
   BYTE POINTER BBUF;  <<SAME>>                                         12960000
                                                                        12962000
$  IF X0 = ON                                                           12964000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               12966000
      BEGIN                                                             12968000
      TOS := "FR"; TOS := "EP"; TOS := "LY";                            12970000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        12972000
      FTITLE(*,*,*,*);                                                  12974000
      DEBUG                                                             12976000
      END;                                                              12978000
$  IF                                                                   12980000
                                                                        12982000
   SETPCBX;  <<INIT. PCBX POINTER>>                                     12984000
   IF PXGJOBTYPE <> 1 THEN GO NFG;  <<NOT SESSION?>>                    12986000
   PUSH(S);                                                             12988000
   ASSEMBLE(INCA,DUP);                                                  12990000
   @BUF := TOS;  <<MESSAGE BUFFER>>                                     12992000
   @BBUF := TOS&LSL(1);                                                 12994000
   TOS := (LENGTH+C1)&LSR(1);  <<NR. WORDS FOR BUFFER>>        <<+0.05>>12996000
   ASSEMBLE(ADDS 0);  <<ALLOCATE BUFFER>>                               12998000
   MOVE BBUF := MESSAGE,(LENGTH);  <<COPY MESSAGE>>                     13000000
   BBUF(LENGTH) := %15;  <<INSERT CR>>                                  13002000
   BBUF(LENGTH+1) := %12;  <<INSERT LF>>                                13004000
   LENGTH := LENGTH+2;                                                  13006000
   TOS := ATTACHIO(PXGSTDLIST,0,0,0,35,0,0,0,BBFLAGS); <<TYPE>><<+0.05>>13008000
   IF S0 <> 4 AND S0 <= 8 THEN  <<HARD COPY DEVICE?>>                   13010000
      BEGIN                                                             13012000
      HARDCOPY := TRUE;                                        <<06.EB>>13014000
      MOVE BBUF(LENGTH) :=                                              13016000
         ("MMMMMMMM",%15,"WWWWWWWW",%15,"XXXXXXXX",%15,        <<+0.05>>13018000
          "mmmmmmmm",%15,"xxxxxxxx",%15);  <<LOCKWORD MASK>>   <<+0.05>>13020000
      LENGTH := LENGTH+C0                                      <<+0.05>>13022000
      END;                                                              13024000
   DDEL;                                                                13026000
   IF NOT HARDCOPY THEN << TURN ECHO OFF >>                    <<06.EB>>13028000
      BEGIN                                                    <<06.EB>>13030000
      TOS := ATTACHIO(PXGSTDIN,0,0,0,9,0,0,0,BFLAGS);          <<06.EB>>13032000
      ECHOWASOFF := TOS;<<TRUE IF ECHO WAS ALREADY OFF>>       <<06.EB>>13034000
      DEL;                                                     <<06.EB>>13036000
      END;                                                     <<06.EB>>13038000
   TOS := ATTACHIO(PXGSTDLIST,0,0,@BUF,1,-LENGTH,%320,0,       <<+0.04>>13040000
      BFLAGS);  <<ASK FOR LOCKWORD>>                           <<+0.05>>13042000
   DEL;                                                                 13044000
   IF TOS.(8:8) <> 1 THEN GO NFG;  <<ATTACHIO ERROR?>>                  13046000
   TOS := FREAD(1,BUF,-10); << READ LOCKWORD >>                <<04134>>13050000
   IF <> THEN GOTO NFG; << ERROR DURING READ >>                <<04134>>13052000
   X := TOS;                                                   <<04134>>13054000
   IF NOT (1 <= X <= 8) THEN GO NFG;  <<ILLEGAL AMOUNT?>>               13056000
   BBUF(X) := %15;  <<SPECIAL FOR MOVE TERMINATOR>>                     13058000
   TOS := @MESSAGE; BPS0 := " ";  <<BLANK FILL>>                        13060000
   ASSEMBLE(DUP,INCB); MOVE * := *,(7);                                 13062000
   MOVE MESSAGE := BBUF WHILE ANS;  <<COPY AND UPSHIFT REPLY>>          13064000
   TOS := TRUE;  <<OK>>                                                 13066000
   GO EXIT;                                                             13068000
                                                                        13070000
NFG:                                                                    13072000
   TOS := FALSE;  <<ERROR>>                                             13074000
                                                                        13076000
EXIT:                                                                   13078000
   FREPLY := TOS;                                              <<06.EB>>13080000
   IF NOT HARDCOPY AND NOT ECHOWASOFF THEN << TURN ECHO ON >>  <<06.EB>>13082000
      ATTACHIO(PXGSTDIN,0,0,0,8,0,0,0,BFLAGS);                 <<06.EB>>13084000
   END;                                                                 13086000
$ PAGE " MPE-IV FILE SYSTEM - FOPENDA "                                 13088000
$ CONTROL SEGMENT = FILESYS6                                            13092000
INTEGER PROCEDURE FOPENDA (DADDR,DISKADR,AOPTIONS,NUMBUFFERS,FILECODE,  13094000
   ASEC,DISP,FOPTIONS,PVINFO,MSGINFO);                         <<HM.00>>13096000
     <<THIS PROCEDURE OPENS AN OLD DISC FILE WHOSE FILE LABEL IS ON THE 13098000
     SPECIFIED LOGICAL DEVICE AT THE SPECIFIED SECTOR NUMBER.           13100000
                                                                        13102000
     INPUT VARIABLES:                                                   13104000
         DADDR - LOGICAL DEVICE NUMBER OF FILE LABEL                    13106000
         DISKADR - SECTOR NUMBER OF FILE LABEL                          13108000
         AOPTIONS - AOPTIONS                                            13110000
         NUMBUFFERS - NUMBER OF BUFFERS                                 13112000
         FILECODE - FILE CODE                                           13114000
         ASEC - ACCESS TYPE FROM AOPTIONS                               13116000
         DISP - DISPOSITION (FROM FILE EQN) AND NAME TYPE               13118000
         FOPTIONS - USER'S FOPTIONS                              HM.00  13120000
         MSGINFO - IPC INFO ARRAY                                HM.00  13122000
                                                                        13124000
     OUTPUT VARIABLES:                                                  13126000
         FOPENDA - FILE NUMBER                                          13128000
                                                                        13130000
     CONDITION CODE:                                                    13132000
         CCE - OK                                                       13134000
         CCL - ERROR                                                    13136000
                                                                        13138000
     NOTE THAT THIS PROCEDURE IS INTENDED FOR THE LOADER AS WELL AS THE 13140000
     FILE SYSTEM.  ALSO, DB MUST BE SET TO THE STACK WHEN THIS          13142000
     PROCEDURE IS CALLED>>                                              13144000
   VALUE DADDR,DISKADR,AOPTIONS,NUMBUFFERS,FILECODE,           <<RV.PV>>13146000
         ASEC,DISP,FOPTIONS,PVINFO;                            <<HM.00>>13148000
   INTEGER DADDR,NUMBUFFERS,FILECODE,ASEC,DISP,PVINFO;         <<RV.PV>>13150000
   DOUBLE DISKADR;                                                      13152000
   LOGICAL AOPTIONS,FOPTIONS;                                  <<HM.00>>13154000
   ARRAY MSGINFO;                                              <<HM.00>>13156000
   OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                               13158000
   BEGIN                                                                13160000
   LOGICAL PMAP = Q-4;  <<PARAMETER BIT MAP>>                           13162000
   INTEGER TEMP;  <<UTILITY VARIABLE>>                                  13164000
   INTEGER CLID;  <<COLD LOAD ID>>                                      13166000
$  IF X9=OFF                                                   <<00630>>13168000
   LOGICAL DISABLERIO := %10101; <<TRUE -- AIDS DISC PATCH>>   <<00630>>13170000
$  IF X9=ON                                                    <<00630>>13172000
   LOGICAL DISABLERIO := %01010; <<FALSE -- AIDS DISC PATCH>>  <<00630>>13174000
$  IF                                                          <<00630>>13176000
                                                                        13178000
   <<MISC. FILE PARAMETERS>>                                            13180000
                                                                        13182000
   INTEGER FILENUM = FOPENDA;                                           13184000
   INTEGER RSIZE;  <<REC. SIZE - POS. BYTES>>                           13186000
   INTEGER BF;  <<BLOCKING FACTOR>>                                     13188000
   INTEGER ATYPE;  <<ACCESS TYPE - FROM AOPTIONS>>                      13190000
   INTEGER EXCL;  <<ACCESS MODE>>                                       13192000
                                                                        13194000
   <<MISC. DEVICE PARAMETERS>>                                          13196000
                                                                        13198000
   INTEGER VDADDR;  <<VOLUME TABLE INDEX>>                              13200000
   INTEGER ARRAY DEVINFO (0:8);  <<DEVICE INFO>>                        13202000
                                                                        13204000
   <<PCBX VARIABLES>>                                                   13206000
                                                                        13208000
   INTEGER POINTER PXFILE;  <<PXFILE POINTER>>                          13210000
                                                                        13212000
   <<AFT VARIABLES>>                                                    13214000
                                                                        13216000
   INTEGER AFTX;  <<AFT INDEX (FILE NR.)>>                              13218000
                                                                        13220000
   <<ACB VARIABLES>>                                                    13222000
                                                                        13224000
   INTEGER PACBV;  <<PHYSICAL ACB VECTOR>>                              13226000
   INTEGER LACBV;  <<LOGICAL ACB VECTOR>>                               13228000
   DOUBLE ACBV'S = PACBV;  <<ACB VECTORS>>                              13230000
   LOGICAL LACBF;  <<LOG/PHYS ACB FLAG>>                                13232000
   INTEGER ACBDST;                                                      13234000
   INTEGER POINTER ACB;  <<ACB POINTER>>                                13236000
   DOUBLE POINTER ACBDBL = ACB;                                         13238000
   DOUBLE ACBPARMS = ACBDST;  <<DST AND ACB>>                           13240000
                                                                        13242000
   <<FCB VARIABLES>>                                                    13244000
                                                                        13246000
   LOGICAL                                                     <<04624>>13250000
      FCBV := 0,             << FCB Vector.                 >> <<04624>>13252000
      SHFCB := FALSE,        << Do we have a shared FCB?    >> <<04624>>13254000
      NEWFCB := FALSE;       << Was a new FCB created?      >> <<04624>>13256000
   INTEGER                                                     <<04624>>13258000
      FCBSI,                 << Size of our FCB.            >> <<04624>>13260000
      EMSI;                  << Extent map size.            >> <<04624>>13262000
   DOUBLE FCBPARMS;          << FCB(0) and FCB(1).          >> <<04624>>13264000
   INTEGER                                                     <<04624>>13266000
      FCB'0=FCBPARMS,        << FCB(0), contains the size.  >> <<04624>>13268000
      FCBMQ;                 << Q relative offset of FCB.   >> <<04624>>13270000
   ARRAY FCB(0:SIZEDFCB);    << Local FCB buffer.           >> <<04624>>13272000
   DOUBLE ARRAY FCBDBL(*)=FCB;                                 <<04624>>13274000
                                                                        13276000
   <<FILE LABEL VARIABLES>>                                             13278000
                                                                        13280000
   INTEGER POINTER FLAB;  <<FILE LABEL POINTER>>                        13282000
   DOUBLE POINTER FLABDBL = FLAB;                                       13284000
   INTEGER FNAMEMQ; << Q relative address of the FLAB. >>      <<04624>>13286000
   INTEGER P1 = DISKADR;  <<FIRST HALF OF FILE LABEL SECTOR NR.>>       13288000
   INTEGER P2 = DISKADR+1;  <<SECOND HALF OF FILE LABEL SECTOR NR.>>    13290000
                                                                        13292000
   <<RESOURCE FLAGS>>                                                   13294000
                                                                        13296000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   13298000
   INTEGER B;  <<USED BY GETSIR FOR FMAVTSIR>>                          13300000
   LOGICAL PACBLOCKED := FALSE;  <<SPECIAL PACB LOCK FLAG>>             13302000
   LOGICAL A;  <<USED BY GETSIR>>                                       13304000
   LOGICAL RESOURCES := FALSE;  <<FOR ERROR RECOVERY>>                  13306000
   DEFINE DISKLOCK = (15:1)#,  <<DISKALLOC CALLED?>>                    13308000
          SIRLOCK = (14:1)#,  <<GETSIR CALLED?>>                        13310000
          FCBLOCK = (13:1)#,  <<FCB LOCKED VIA FGETCB?>>                13312000
          ACBLOCK = (12:1)#,  <<PHYSICAL ACB CREATED?>>                 13314000
          FMAVTLOCK = (11:1)#;  <<FMAVTSIR CALLED>>                     13316000
                                                                        13318000
   <<SPOOLFILE ACCESS>>                                                 13320000
                                                                        13322000
   INTEGER POINTER PINFO;                                               13324000
   ARRAY SPINFO(0:13) = Q;                                              13326000
   LOGICAL SPOOLF = SPINFO+0;                                           13328000
   INTEGER POINTER XDDEP = SPINFO+1;                                    13330000
   INTEGER SPDADDR       = SPINFO+2;                                    13332000
   DOUBLE  SPDISKADDR    = SPINFO+3;                                    13334000
   INTEGER SPVDEV = SPINFO+5;                                           13336000
   INTEGER SPFOPT = SPINFO+6;                                           13338000
   INTEGER SPAOPT = SPINFO+7;                                           13340000
   INTEGER SPREC  = SPINFO+8;                                           13342000
   INTEGER SPSTATE= SPINFO+9;                                           13344000
   ARRAY SPFN(*) = SPINFO+10;                                           13346000
                                                               <<HM.00>>13348000
   <<MSG FILE ACCESS>>                                         <<HM.00>>13350000
                                                               <<HM.00>>13352000
   LOGICAL MSGFILE:=FALSE;                                     <<HM.00>>13354000
   DOUBLE ARRAY DMSGINFO(*)=MSGINFO;                           <<HM.00>>13356000
   DEFINE FILELIMIT=DMSGINFO#;                                 <<HM.00>>13358000
   DEFINE NUMHEADEREC=DMSGINFO(1)#;                            <<HM.00>>13360000
                                                               <<00630>>13362000
                                                               <<00630>>13364000
   INTEGER SUBROUTINE ADJUSTOPS;                               <<00630>>13366000
   BEGIN                                                       <<00630>>13368000
      COMMENT:                                                 <<00630>>13370000
         RESOLVE ANY INCONSISTENCIES VIS-A-VIS FOPS AND AOPS.  <<00630>>13372000
         RETURN ERROR CODE (>=0), OR -1 IF NO ERRORS;          <<00630>>13374000
                                                               <<00630>>13376000
      ADJUSTOPS := -1;                                         <<00630>>13378000
      IF DISABLERIO AND FLRIO THEN                             <<00630>>13380000
         BEGIN                                                 <<00630>>13382000
         ADJUSTOPS := UNIMPL;                                  <<00630>>13384000
         END                                                   <<00630>>13386000
      ELSE IF FLCIRFILE THEN                                   <<HM.00>>13388000
         BEGIN                                                 <<HM.00>>13390000
         IF AOPSEMI THEN                                       <<HM.00>>13392000
            AOPACMODE:=IF AOPREAD THEN 3 ELSE 1;               <<HM.00>>13394000
         IF NOT AOPREAD THEN                                   <<HM.00>>13396000
            BEGIN                                              <<HM.00>>13398000
            IF NOT AOPCOPY THEN AOPINHIBITBUF:=0;              <<HM.00>>13400000
            IF AOPMULTAC = 0 THEN AOPMULTAC:=2;                <<HM.00>>13402000
            IF AOPWRITESAVE THEN                               <<HM.00>>13404000
               ATYPE:=3  <<SET IT TO APPEND>>                  <<HM.00>>13406000
            ELSE IF AOPACTYPE > 3 THEN                         <<HM.00>>13408000
               BEGIN                                           <<HM.00>>13410000
               TOS:=ACCVIOL;                                   <<HM.00>>13412000
               GO ERR;                                         <<HM.00>>13414000
               END;                                            <<HM.00>>13416000
            END;                                               <<HM.00>>13418000
         IF NOT AOPINHIBITBUF THEN AOPMULTIREC:=0;             <<HM.00>>13420000
         END                                                   <<HM.00>>13422000
      ELSE IF FLRIO THEN                                       <<00630>>13424000
        BEGIN                                                  <<00630>>13426000
        AOPCOPY := 0;                                          <<HM.00>>13428000
        IF NOT AOPINHIBITBUF THEN                              <<00630>>13430000
           BEGIN                                               <<00630>>13432000
           AOPMULTIREC := 0;                                   <<00630>>13434000
           AOPNOWAIT := 0;                                     <<00630>>13436000
           END;                                                <<00630>>13438000
        END;                                                   <<00630>>13440000
   END; <<SUBROUTINE ADJUSTOPS>>                               <<00630>>13442000
                                                               <<HM.00>>13444000
                                                               <<HM.00>>13446000
   SUBROUTINE CHECKMSGEXCLSN;                                  <<HM.00>>13448000
      BEGIN                                                    <<HM.00>>13450000
      IF (FCBEXCLSTAT = -1) THEN                               <<HM.00>>13452000
         BEGIN  <<FILE ALREADY OPENED EXCLUSIVELY>>            <<HM.00>>13454000
         IF ATYPE = 0 THEN                                     <<HM.00>>13456000
            BEGIN  <<USER IS A READER>>                        <<HM.00>>13458000
            IF FCBOCNTIN > 0 THEN GO E1;<<ALREADY READ OPENED>><<HM.00>>13460000
            END                                                <<HM.00>>13462000
         ELSE IF FCBOCNTOUT > 0 THEN <<USER IS A WRITER>>      <<HM.00>>13464000
            GO E1;  <<ALREADY OPENED FOR WRITE>>               <<HM.00>>13466000
         EXCL:=1; AOPACMODE:=1;  <<CHANGE USER TO EXCLUSIVE>>  <<01675>>13468000
         END                                                   <<HM.00>>13470000
      ELSE IF FCBEXCLSTAT > 0 THEN                             <<HM.00>>13472000
         BEGIN  <<ALREADY OPENED FOR ONE RDR, MULTIPLE WTR>>   <<HM.00>>13474000
         IF ATYPE = 0 AND FCBOCNTIN > 0 THEN GO E1;            <<HM.00>>13476000
         EXCL:=2; AOPACMODE:=2;  <<CHANGE USER TO SEMI>>       <<01675>>13478000
         END                                                   <<01675>>13480000
      ELSE                                                     <<01675>>13482000
         BEGIN  <<ALREADY OPENED SHARE>>                       <<01675>>13484000
         EXCL:=3; AOPACMODE:=3;                                <<01675>>13486000
         END;                                                  <<01675>>13488000
      END;  <<CHECKMSGEXCLSN>>                                 <<01675>>13490000
                                                               <<00630>>13492000
                                                                        13494000
   SUBROUTINE LABELIO (RW);                                             13496000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           13498000
                                                                        13500000
        INPUT VARIABLES:                                                13502000
            RW - I/O MODE                                               13504000
               0 - READ                                                 13506000
               1 - WRITE                                                13508000
                                                                        13510000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE IS   13512000
        CALLED>>                                                        13514000
      VALUE RW;                                                         13516000
      INTEGER RW;                                                       13518000
      BEGIN                                                             13520000
      X := FLABIO(DADDR,DISKADR,RW,FLAB);  <<R/W LABEL>>                13522000
      IF <> THEN  <<ERROR?>>                                            13524000
         BEGIN                                                          13526000
         IF NOT LOGICAL(RW) THEN  <<READ?>>                             13528000
            FLABIOERR(X,0)                                              13530000
         ELSE  <<WRITE>>                                                13532000
            FLABIOERR(X,0,@FLLOCNAME);                                  13534000
         TOS := LBLIOERR;                                               13536000
         GO ERR                                                         13538000
      ; HELP  <<FOR DUMMY CALL>>;                              <<00117>>13540000
         END                                                            13542000
      END;                                                              13544000
   SUBROUTINE UPDATE'FCB(FCBV);                                <<04624>>13546000
   VALUE FCBV;LOGICAL FCBV;                                    <<04624>>13548000
                                                               <<04624>>13550000
      <<****************************************************>> <<04624>>13552000
      << Updates the actual FCB in the control block (where >> <<04624>>13554000
      << ever it may be) by overlaying  it with the updated >> <<04624>>13556000
      << FCB that exists on the stack. Do not copy FCB(0).  >> <<04624>>13558000
      <<****************************************************>> <<04624>>13560000
                                                               <<04624>>13562000
      BEGIN                                                    <<04624>>13564000
      GET'FCB'Q'LOC;                                           <<04624>>13566000
      LOCK'CB(0,0,FCBMQ,FCBV.DSTN,FCBV VTA);                   <<04624>>13568000
      TOS := TOS + 1;   << Copy to FCB(1) in control block. >> <<04624>>13570000
      ASSEMBLE(DXCH);   << Switch source and targer address.>> <<04624>>13572000
      TOS := TOS + 1;   << Copy from FCB(1) in stack.       >> <<04624>>13574000
      TOS := FCBSI -1 ; << Now copy the FCB back to CB table>> <<04624>>13576000
      MOVE'DS'5;                                               <<04624>>13578000
      DEL;              << Delete FLAGS parm. from LOCK'CB. >> <<04624>>13580000
      UNLOCK'CB(0,FCBV.DSTN,FCBV VTA);  << Unlock it.       >> <<04624>>13582000
                                                               <<04624>>13584000
      END;                                                     <<04624>>13586000
$PAGE                                                          <<04624>>13588000
                                                                        13590000
$  IF X0 = ON                                                           13592000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               13594000
      BEGIN                                                             13596000
      TOS := "FO"; TOS := "PE"; TOS := "ND"; TOS := "A ";               13598000
      ASSEMBLE(DZRO,DZRO);                                              13600000
      FTITLE(*,*,*,*);                                                  13602000
      DEBUG                                                             13604000
      END;                                                              13606000
$  IF                                                                   13608000
                                                                        13610000
   <<* * * INITIALIZE PARAMETERS * * *>>                                13612000
                                                                        13614000
   CRIT := SETCRITICAL;                                                 13616000
   CHECKDB;  <<WHERE'S DB?>>                                            13618000
   IF <> THEN  <<DB NOT AT STACK?>>                                     13620000
      BEGIN                                                             13622000
      TOS := EXCHANGEDB(0);  <<SET DB TO STACK>>                        13624000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              13626000
      PXFFOPEN := ILLDB;                                                13628000
      ASSEMBLE(ZERO,XCH);                                               13630000
      EXCHANGEDB(*);  <<RESET DB TO ORIG.>>                             13632000
      TOS := CCL;                                                       13634000
      GO EXIT                                                           13636000
      END;                                                              13638000
                                                               <<04624>>13640000
   <<*******************************************************>> <<04624>>13642000
   << FOPEN will set bit zero of the DADDR if the PACB has  >> <<04624>>13644000
   << already been locked (what a kludge!).  Set PACBLOCKED >> <<04624>>13646000
   << based on this bit.                                    >> <<04624>>13648000
   <<*******************************************************>> <<04624>>13650000
                                                               <<04624>>13652000
   IF DADDR.(0:1) = 1 THEN                                     <<04624>>13654000
      BEGIN                                                    <<04624>>13656000
      DADDR.(0:1) := 0;                                        <<04624>>13658000
      PACBLOCKED := TRUE;                                      <<04624>>13660000
      END;                                                     <<04624>>13662000
   SPOOLF := FALSE;                                                     13664000
   IF DADDR = 0 THEN  <<SPOOLFILE ACCESS?>>                             13666000
      BEGIN                                                             13668000
      @PINFO := P2;                                                     13670000
      MOVE SPINFO := PINFO,(14);                                        13672000
                                                               <<04272>>13674000
      <<****************************************************>> <<04272>>13676000
      << Obtain disk address from XDD and extract the       >> <<04272>>13678000
      << LDEV (DADDR) and Disk Address.  %2 signifies give  >> <<04272>>13680000
      << me the Disk Address! XDDEP is the offset into the  >> <<04272>>13682000
      << XDD of the entry we are using.                     >> <<04272>>13684000
      <<****************************************************>> <<04272>>13686000
                                                               <<04272>>13688000
      DISKADR := XDDSPOOLINFO(0D,%2,XDDEP);                    <<04272>>13690000
      IF DISKADR = 0D THEN                                     <<04272>>13692000
         BEGIN            << Invalid XDD entry, FSERR 88    >> <<04272>>13694000
         TOS := SPOOFLEINVL;                                   <<04272>>13696000
         GO ERR;                                               <<04272>>13698000
         END;                                                  <<04272>>13700000
                                                               <<04272>>13702000
      SPDADDR := P1.(0:8);    << Extract LDEV from 1st. word>> <<04272>>13704000
      DADDR   := SPDADDR;                                      <<04272>>13706000
      P1.(0:8):= 0;           << Zero out LDEV field.       >> <<04272>>13708000
      SPDISKADDR := DISKADR;  << Rest is Disk Address only. >> <<04272>>13710000
      MOVE PINFO := SPINFO,(14)                                         13712000
      END;                                                              13714000
   TOS := PMAP;  <<PARAMETER BIT MAP>>                                  13716000
   IF NOT LS0.(8:1) THEN AOPTIONS := 0;                        <<HM.00>>13718000
   IF NOT LS0.(9:1) THEN NUMBUFFERS := DEFBUFFERS;             <<HM.00>>13720000
   IF NOT LS0.(10:1) THEN FILECODE := 0;                       <<HM.00>>13722000
   IF NOT LS0.(11:1) THEN ASEC := 0;                           <<HM.00>>13724000
   IF NOT LS0.(12:1) THEN DISP := 0;                           <<HM.00>>13726000
   IF NOT LS0.(14:1) THEN PVINFO := 0;                         <<HM.00>>13728000
   ATYPE := AOPACTYPE;  <<ACCESS TYPE>>                                 13730000
   EXCL := AOPACMODE;  <<ACCESS MODE>>                                  13732000
   IF = THEN                                                            13734000
      BEGIN                                                             13736000
      IF ATYPE = 0 THEN TOS := 3 ELSE TOS := 1;                         13738000
      EXCL := TOS   <<SET EXCLUSIVE OPTIONS>>                           13740000
      END;                                                              13742000
   CLID := ABSOLUTE(CLOADID);  <<COLD LOAD ID>>                         13746000
                                                                        13748000
   <<*******************************************************>> <<04624>>13750000
   << If the file was opened for multi-access, then scan the>> <<04624>>13752000
   << FMAVT.  If the file has an entry in the table, than   >> <<04624>>13754000
   << the file was already opened multi-access and the      >> <<04624>>13756000
   << PACB already exists.  SCANFMAVT will return the PACBV >> <<04624>>13758000
   << in this case.  If the PACB has not already been locked>> <<04624>>13760000
   << by FOPEN, then go ahead and lock it via FGETCB.       >> <<04624>>13762000
   <<*******************************************************>> <<04624>>13764000
                                                                        13766000
   IF AOPMULTAC <> 0 THEN  <<MULTI-ACCESS?>>                            13768000
      BEGIN                                                             13770000
      B := GETSIR(FMAVTSIR);  <<GET FMAVT SIR>>                         13772000
      RESOURCES.FMAVTLOCK := TRUE;  <<SET RESOURCE FLAG>>               13774000
      IF (PACBV := SCANFMAVT(AOPGLOBALMULTAC&LSL(3),           <<HM.00>>13776000
        P1.(8:8)+DADDR&LSL(8),P2,0))<>0 AND NOT PACBLOCKED THEN<<HM.00>>13778000
         BEGIN                                                          13780000
                                                               <<04624>>13782000
         <<*************************************************>> <<04624>>13784000
         << Send FMAVT SIR to be released before impeding   >> <<04624>>13786000
         << on the ACB so as not to tie up the SIR for long >> <<04624>>13788000
         << periods of time.                                >> <<04624>>13790000
         <<*************************************************>> <<04624>>13792000
                                                               <<04624>>13794000
         FGETCB(0,0,DUM,PACBV,1,FMAVTSIR,B);                   <<01882>>13796000
         ASSEMBLE(DEL,DDEL);                                            13800000
         PACBLOCKED := TRUE;  <<SET LOCKED FLAG>>                       13802000
         EXCHANGEDB(0)  <<RESET DB TO STACK>>                           13804000
         END                                                            13806000
      END;                                                              13808000
                                                                        13810000
   <<* * * ALLOCATE AFT ENTRY * * *>>                                   13812000
                                                                        13814000
   TOS := FINDANYAFTENT;  << find AFT entry >>                 <<01815>>13816000
   IF < THEN GO E5        <<failed PXFILE expansion>>          <<02357>>13818000
   ELSE IF > THEN GO E4;  <<no entry left>>                    <<02357>>13820000
   AFTX := TOS;  <<AFT INDEX (FILE NR.)>>                               13822000
                                                                        13824000
   <<* * * READ FILE LABEL * * *>>                                      13826000
                                                                        13828000
   ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>                           13830000
   A := GETSIR(FISIR);  <<GET FILE INTEGRITY SIR>>                      13832000
   RESOURCES.SIRLOCK := TRUE;  <<SET SIR LOCKED FLAG>>                  13834000
   P1.(0:8) := 0;  <<CLEAR FIRST BYTE OF SECTOR NR.>>                   13836000
   LABELIO(0);  <<READ FILE LABEL>>                                     13838000
   IF FLMSGFILE AND (NOT AOPCOPY OR NOT AOPREAD) THEN          <<01675>>13840000
      BEGIN                                                    <<01675>>13842000
      SCANFMAVT(0,P1.(8:8)+DADDR&LSL(8),P2,0);                 <<01675>>13844000
      IF < THEN                                                <<01675>>13846000
         BEGIN  <<ANOTHER JOB/SESSION HAS MULTI ON THE FILE>>  <<01675>>13848000
         TOS:=NAVAILDEV;                                       <<01675>>13850000
         GO ERR;                                               <<01675>>13852000
         END;                                                  <<01675>>13854000
      MSGFILE:=TRUE;                                           <<01675>>13856000
      END;                                                     <<01675>>13858000
                                                               <<00630>>13860000
   TOS := ADJUSTOPS;                                           <<00630>>13862000
   IF S0>=0 THEN GOTO ERR;                                     <<00630>>13864000
   DEL;                                                        <<00630>>13866000
                                                               <<00630>>13868000
   TOS := FLRECSIZE;  <<REC. SIZE>>                                     13870000
   IF < THEN  <<NEG. BYTES?>>                                           13872000
      TOS := -TOS                                                       13874000
   ELSE  <<POS. WORDS>>                                                 13876000
      TOS := TOS&LSL(1);                                                13878000
   RSIZE := TOS;  <<REC. SIZE - POS. BYTES>>                            13880000
   IF FLLASTEXTSIZE = 0 THEN  <<COMPUTE LAST EXTENT SIZE?>>             13882000
      BEGIN                                                             13884000
      TOS := FLFLIM;                                                    13886000
      X:=GETBLKFACTOR(FLBLKSIZE,RSIZE,FLFOPTIONS);             <<00630>>13888000
      DIVD;                                                             13890000
      IF TOS <> 0 THEN TOS := TOS+1D;                                   13892000
      X := (FLBLKSIZE+127)&LSR(7);                                      13894000
      MPYD;                                                             13896000
      TOS := TOS+DOUBLE(LOGICAL(FLSECTOFF));                            13898000
      TOS := FLEXTSIZE;                                                 13900000
      ASSEMBLE(LDIV,DELB; TEST);                                        13902000
      IF = THEN TOS := TOS+FLEXTSIZE;                                   13904000
      FLLASTEXTSIZE := TOS  <<LAST EXTENT SIZE>>                        13906000
      END;                                                              13908000
   TOS:=FLFOPTIONS;                                            <<HM.00>>13910000
   IF MSGFILE AND NOT AOPCOPY THEN                             <<HM.00>>13912000
      TOS.FOPFORMATF:=FOPFORMAT;                               <<HM.00>>13914000
   FOPTIONS:=TOS;                                              <<HM.00>>13916000
                                                                        13918000
   <<* * * GET DEVICE INFORMATION * * *>>                               13920000
                                                                        13922000
   VDADDR := FLVTAB;  <<VOLUME TABLE INDEX>>                            13924000
   IF FLDEVNAME = 0 THEN  <<MPE/20 FILE?>>                              13926000
      BEGIN                                                             13928000
      TOS := @FLDEVNAME&LSL(1);                                         13930000
      MOVE * := "DISC    "  <<DEFAULT DEVICE CLASS>>                    13932000
      END;                                                              13934000
   IF BYTE(FLDEVNAME.(0:8)) = NUMERIC THEN  <<LOGICAL DEV. NR.?>>       13936000
      BEGIN                                                             13938000
      TOS := @FCB(SIZEDFCB)&LSL(1);  <<LDEV STRING BUFFER>>    <<04624>>13940000
      BPS0 := " ";  <<STRING TERMINATOR>>                               13942000
      TOS := TOS-1;  <<ADJ. STRING POINTER>>                            13944000
      TOS := DADDR;  <<LOGICAL DEVICE NR.>>                             13946000
      DO BEGIN   << CONVERT LDEV TO STRING FOR GETDEVINFO >>   <<00117>>13948000
         TOS := 10;                                                     13950000
         ASSEMBLE(DIV);                                                 13952000
         BPS2 := TOS+"0";  <<DIGIT CHAR.>>                              13954000
         ASSEMBLE(DECB,TEST)                                            13956000
         END UNTIL =;                                                   13958000
      ASSEMBLE(XCH,INCA);  <<GETDEVINFO RESULT AND STRING POINTER>>     13960000
L2:   X := GETDEVINFO(*,DEVINFO);  <<GET DEVICE INFO>>                  13962000
      IF <> THEN  <<ERROR?>>                                            13964000
         BEGIN                                                          13966000
         TOS := UNDEFDEV;                                               13968000
         GO ERR                                                         13970000
         END                                                            13972000
      END                                                               13974000
   ELSE  <<DEVICE CLASS>>                                               13976000
      BEGIN                                                             13978000
      X := GETDEVINFO(FLDEVNAME,DEVINFO);  <<GET DEVICE INFO>>          13980000
      IF <> THEN  <<UNKNOWN DEVICE CLASS?>>                             13982000
         BEGIN                                                          13984000
         TOS := 0;  <<FOR RESULT OF GETDEVINFO>>                        13986000
         TOS := @FCB&LSL(1);  <<STRING BUFFER>>                <<04624>>13988000
         MOVE BPS0 := "DISC ";  <<TRY "DISC" FOR DEVICE CLASS>>         13990000
         GO L2                                                          13992000
         END                                                            13994000
      END;                                                              13996000
                                                                        13998000
   <<* * * DETERMINE IF ACCESS IS LEGITIMATE * * *>>                    14000000
                                                                        14002000
   IF CLID <> FLCLID THEN  <<DIFFERENT COLD LOAD ID?>>                  14004000
      BEGIN                                                             14006000
      FLLOCK := LOGICAL(FLLOCK) LAND %7774;  <<CLEAR LOCK BITS>>        14008000
      FLFCBVECT := 0; <<CLEAR FCB VECTOR>>                     <<RV.PV>>14010000
      END;                                                              14012000
   CASE ATYPE OF                                                        14014000
      BEGIN                                                             14016000
                                                                        14018000
      <<READ ONLY>>                                                     14020000
                                                                        14022000
      IF LOGICAL(FLRESTORE) THEN GO E1;                                 14024000
                                                                        14026000
      <<WRITE ONLY - DATA DELETED>>                                     14028000
                                                                        14030000
OUTING:                                                                 14032000
      IF INTEGER(LOGICAL(FLSRL) LAND 5) <> 0 THEN GO E1;                14034000
                                                                        14036000
      <<WRITE ONLY - NO DATA DELETED>>                                  14038000
                                                                        14040000
      GO OUTING;                                                        14042000
                                                                        14044000
      <<APPEND ONLY>>                                                   14046000
                                                                        14048000
      GO OUTING;                                                        14050000
                                                                        14052000
      <<READ/WRITE>>                                                    14054000
                                                                        14056000
INOUT:BEGIN                                                             14058000
      TEMP := INTEGER(LOGICAL(FLSRL) LAND 5) <> 0;                      14060000
      CASE INTEGER(LOGICAL(TEMP) LAND 2)+FLRESTORE OF                   14062000
         BEGIN                                                          14064000
         ;  << ALLOW INPUT/OUTPUT >>                                    14066000
         GO E1;                                                         14068000
         ATYPE := 0;  << INPUT ONLY >>                                  14070000
         GO E1;                                                         14072000
         END;                                                           14074000
      END;                                                              14076000
                                                                        14078000
      <<UPDATE>>                                                        14080000
                                                                        14082000
      GO INOUT;                                                         14084000
                                                                        14086000
      <<EXECUTE>>                                                       14088000
                                                                        14090000
EXECUTE:                                                                14092000
      BEGIN    << STORE-RESTORE >>                             <<+1.03>>14094000
      CASE FLSR OF                                                      14096000
         BEGIN                                                          14098000
         ;  << INPUT/OUTPUT >>                                          14100000
         GO E1;                                                         14102000
         ATYPE := 0;  << INPUT ONLY >>                                  14104000
         GO E1                                                          14106000
         END                                                            14108000
      END;                                                              14110000
                                                                        14112000
      <<LOAD PROGRAM>>                                                  14114000
                                                                        14116000
      GO EXECUTE                                                        14118000
                                                                        14120000
      END;                                                              14122000
   IF EXCL = 1 AND FLSRL <> 0 THEN GO E0;                               14124000
   AOPACTYPE := ATYPE;  <<ADJUST ACCESS TYPE>>                          14126000
                                                                        14128000
   <<* * * LOCATE OR CREATE LOCAL FCB * * *>>                           14130000
                                                                        14132000
   FCB(0) := 0;    << ZERO out the FCB buffer.              >> <<04624>>14134000
   MOVE FCB(1) := FCB(0),(SIZEDFCB - 1);                       <<04624>>14136000
   FCBV := FLFCBVECT;  <<FCB VECTOR FROM FILE LABEL>>                   14138000
$PAGE                                                          <<04624>>14140000
   <<*******************************************************>> <<04624>>14142000
   << Obtain the FCB vector from the file label. (It was    >> <<04624>>14144000
   << previously zeroed out if the cold load ID's didn't    >> <<04624>>14146000
   << match).  If the FCB vector is still non-zero then     >> <<04624>>14148000
   << another process already has the file open and the FCB >> <<04624>>14150000
   << exists.  First, lock and copy the FCB to stack via    >> <<04624>>14152000
   << LOCK'CB.                                              >> <<04624>>14154000
   <<*******************************************************>> <<04624>>14156000
                                                               <<04624>>14158000
   IF FCBV <> 0 THEN << Does the FCB exist already?         >> <<04624>>14160000
      BEGIN                                                             14162000
      FCBPARMS := GETFCB'INFO(FCBV,0);    << Obtain size.   >> <<04624>>14164000
      FCBSI := FCB'0.SIZEF;                                    <<04624>>14166000
      GET'FCB'Q'LOC;                                           <<04624>>14168000
      LOCK'CB(0,0,FCBMQ,FCBV.DSTN,FCBV VTA);                   <<04624>>14170000
      TOS := FCBSI;                       << Copy the FCB.  >> <<04624>>14172000
      MOVE'DS'5;                          << Off they GO!   >> <<04624>>14174000
      DEL;                  << Delte FLAGS parameter.       >> <<04624>>14176000
      RESOURCES.FCBLOCK := TRUE;          << FCB is locked. >> <<04624>>14178000
                                                               <<04624>>14180000
                                                                        14182000
      <<* * * CHECK EXCLUSIVITY OF ACCESS * * *>>                       14184000
                                                                        14186000
      IF MSGFILE AND NOT AOPCOPY THEN                          <<HM.00>>14188000
         CHECKMSGEXCLSN                                        <<HM.00>>14190000
      ELSE                                                     <<HM.00>>14192000
         BEGIN                                                 <<HM.00>>14194000
         X := FCBEXCLSTAT;                                     <<HM.00>>14196000
         IF X = -1 THEN GO E1;  << SOMEONE WANTS EXCL ACCESS > <<HM.00>>14198000
         IF EXCL = 1 THEN GO E0;                               <<HM.00>>14200000
         CASE INTEGER(X>0 LAND 2)+INTEGER(EXCL = 2 LAND 1) OF  <<HM.00>>14202000
            BEGIN                                              <<HM.00>>14204000
                                                                        14206000
            <<SHARE VS. SHARE>>                                <<HM.00>>14208000
                                                                        14210000
            IF FCBCIRFILE THEN  <<CAN'T MIX RDRS AND WTRS>>    <<HM.00>>14212000
               BEGIN                                           <<HM.00>>14214000
               IF ATYPE = 0 AND FCBOCNTOUT <> 0                <<HM.00>>14216000
               OR ATYPE <> 0 AND FCBOCNTIN <> 0 THEN GO E1;    <<HM.00>>14218000
               END;                                            <<HM.00>>14220000
                                                                        14222000
            <<FILE-SHARE VS. CALLER EAR>>                      <<HM.00>>14224000
                                                                        14226000
            IF FCBOCNTOUT <> 0 THEN GO E0;                     <<HM.00>>14228000
                                                                        14230000
            <<FILE-EAR VS. CALLER SHARE>>                      <<HM.00>>14232000
                                                                        14234000
            BEGIN                                              <<HM.00>>14236000
L1:         IF (1 <= ATYPE <= 3) THEN GO E1;                   <<HM.00>>14238000
            AOPACTYPE := ATYPE := 0  <<MAKE INPUT ONLY>>       <<HM.00>>14240000
            END;                                               <<HM.00>>14242000
                                                                        14244000
         <<FILE-EAR VS. CALLER-EAR>>                                    14246000
                                                                        14248000
         BEGIN                                                          14250000
         IF FCBOCNTOUT <> 0 THEN GO E0;                                 14252000
            GO L1                                              <<HM.00>>14254000
            END                                                <<HM.00>>14256000
                                                                        14258000
            END;                                               <<HM.00>>14260000
         END;                                                  <<HM.00>>14262000
      SHFCB := TRUE;    << Set shared FCB flag.             >> <<04624>>14264000
      BF := FCBBLKFACT;  <<BLOCKING FACTOR>>                            14270000
      END  << OF FCB ALREADY EXISTS >>                         <<00300>>14272000
                                                               <<04624>>14274000
   <<*******************************************************>> <<04624>>14276000
   << Otherwise, the FCB does not yet exist.  Initialize the>> <<04624>>14278000
   << variables of the FCB based on the FLAB variables.     >> <<04624>>14280000
   <<*******************************************************>> <<04624>>14282000
                                                               <<04624>>14284000
   ELSE  <<CREATE LOCAL FCB FROM FILE LABEL>>                           14286000
      BEGIN                                                             14288000
                                                               <<04624>>14290000
      EMSI := (FLNUMEXTS+1)&LSL(1);  <<EXTENT MAP LENGTH>>              14292000
      FCBSI := SIZEBFCB+EMSI;  <<FCB LENGTH>>                           14294000
      IF NOT FLNEW THEN FLDESIGNATOR := 0;  <<MAKE ACTUAL?>>            14296000
      FCBFOPTIONS := FLFOPTIONS;  <<FOPTIONS>>                          14298000
      IF FCBVARIABLE AND ATYPE = 3 THEN                        <<HM.00>>14300000
         IF AOPCOPY OR AOPINHIBITBUF THEN                      <<HM.00>>14302000
            BEGIN                                              <<HM.00>>14304000
            TOS := ACCVIOL;                                    <<HM.00>>14306000
            GO ERR                                             <<HM.00>>14308000
            END;                                               <<HM.00>>14310000
      FCBDEVICE := DEVINFO;  <<LDEV OR DEVICE CLASS INDEX>>             14312000
      FCBFLIM := FLFLIM;      <<CURRENT FILE LIMIT>>                    14314000
      IF ATYPE <> 1 OR FLSTATUS <> 0 THEN  <<SET EOF?>>        <<HM.00>>14316000
         BEGIN                                                 <<HM.00>>14318000
         FCBEOF:=FLEOF;                                        <<HM.00>>14320000
         FCBSTART:=FLSTART;                                    <<HM.00>>14322000
         FCBEND:=FLEND;                                        <<HM.00>>14324000
         FCBHDRECS:=FLHDRECS;                                  <<HM.00>>14326000
         END;                                                  <<HM.00>>14328000
      FCBIMAGE := 0D;  <<INIT. VALUE FOR IMAGE>>                        14330000
      FCBUSERLBL := FLUSERLBL;  <<NR. USER LABELS>>                     14332000
      FCBEXTSIZE := FLEXTSIZE;  <<EXTENT SIZE>>                         14334000
      FCBLASTEXTSIZE := FLLASTEXTSIZE;  <<LAST EXTENT SIZE>>            14336000
      BF:=GETBLKFACTOR(FLBLKSIZE,RSIZE,FLFOPTIONS);            <<00630>>14338000
      FCBBLKFACT := BF;  <<BLOCKING FACTOR>>                            14340000
      FCBLKST := FLSTATUS;                                              14342000
      FCBDTYPE := FLDTYPE;  <<DEVICE TYPE NR.>>                         14344000
      FCBSUBTYPE := FLSUBTYPE;  <<DEVICE SUB-TYPE NR.>>                 14346000
      FCBSECTPBLK := (FLBLKSIZE+127)&LSR(7);  <<SECTORS PER BLOCK>>     14348000
      FCBSECTOFF := FLSECTOFF;                                          14350000
      FCBNUMEXTS := FLNUMEXTS;  <<NR. EXTENTS LESS 1>>                  14352000
      MOVE FCBGN := FLGRPNAME,(8);  <<GROUP NAME>>                      14354000
      IF MSGFILE THEN  <<MESSAGE FILE?>>                       <<HM.00>>14356000
         BEGIN                                                 <<HM.00>>14358000
         FILELIMIT:=FCBFLIM;                                   <<HM.00>>14360000
         NUMHEADEREC:=FCBHDRECS;                               <<HM.00>>14362000
         END;                                                  <<HM.00>>14364000
      FCBPVINFO := PVINFO;                                     <<RV.PV>>14366000
      VTABTOLDEV (FCBEXTMAP,FLEXTMAP,EMSI&LSR(1),FCBMVTABX);   <<RV.PV>>14368000
                                                                        14370000
      <<* * * BUMP EXTENT USE COUNTS * * *>>                            14372000
                                                                        14374000
      X := DISKALLOC(DADDR,-(FCBNUMEXTS+1),FCBEXTMAP,          <<RH.PV>>14376000
                     0);                                       <<RH.PV>>14378000
$     IF X1 = ON                                                        14380000
       IF <> THEN FTROUBLE(473); <<ERROR>>                     <<KJ.03>>14382000
$     IF                                                                14384000
      RESOURCES.DISKLOCK := TRUE;  <<SET DISKALLOC FLAG>>               14386000
      END;                                                              14388000
$PAGE                                                          <<04624>>14390000
   <<*******************************************************>> <<04624>>14392000
   <<               CREATE     AN      ACB                  >> <<04624>>14394000
   << Create an ACB via SETACB.  SETACB will intialize most >> <<04624>>14396000
   << of the ACB variables and will return with DB set to   >> <<04624>>14398000
   << the data segment containing the ACB. Below we calcu-  >> <<04624>>14400000
   << late the Q relative location of the File Name to be   >> <<04624>>14402000
   << used by LOCK'CB.  The PACB may already exist, depen-  >> <<04624>>14404000
   << ding on the PACBLOCKED flag, set if SCANFMAVT found   >> <<04624>>14406000
   << the file in its table, signifying that the file was   >> <<04624>>14408000
   << already opened multi-access and the PACB exists.  It  >> <<04624>>14410000
   << could also have already been locked in FOPEN in the   >> <<04624>>14412000
   << same manner.                                          >> <<04624>>14414000
   <<*******************************************************>> <<04624>>14416000
                                                                        14418000
   IF INTEGER(SPOOLF) > 0                                      <<04624>>14420000
      THEN FNAMEMQ := @SPFN - @Q0                              <<04624>>14422000
      ELSE FNAMEMQ := @FLAB - @Q0;                             <<04624>>14424000
   TEMP := FLFOPTIONS;  <<SAVE FOPTIONS>>                               14426000
   TOS := FALSE;                                                        14428000
   SETACB(0,DUM,0,0,PACBLOCKED,                                <<01.02>>14430000
      AFTX,AOPTIONS,FOPTIONS,FCBDTYPE,RSIZE,FLBLKSIZE,         <<03578>>14432000
      NUMBUFFERS,BF,DADDR,IF SHFCB THEN 0 ELSE FCBSI,SPINFO,            14434000
      DISP,DISKADR,FLEND,FLEOF,MSGINFO);                       <<HM.00>>14436000
   LACBF := TOS;                                                        14438000
   ACBV'S := TOS; ACBPARMS := TOS;                                      14440000
   PACBLOCKED := TOS;                                                   14442000
   IF < THEN GO E2;  <<ERROR?>>                                         14444000
   IF > THEN GO NOFMAVT;      << Out of FMAVT entries.      >> <<04519>>14446000
   RESOURCES.ACBLOCK := TRUE;  <<SET LOG/PHYS ACB LOCK>>                14448000
   ACBVDADDR := VDADDR;  <<VOLUME TABLE INDEX>>                         14450000
                                                               <<04624>>14452000
   <<*******************************************************>> <<04624>>14454000
   << Copy the file name from either the FLAB or SPFN (spool>> <<04624>>14456000
   << file name) to the ACB.  LOCK'CB is a tricky way to set>> <<04624>>14458000
   << up the variables to easily perform the MDS.           >> <<04624>>14460000
   <<*******************************************************>> <<04624>>14462000
                                                               <<04624>>14464000
   LOCK'CB(0,0,FNAMEMQ,PACBV.DSTN,PACBV VTA);                  <<04624>>14466000
   TOS := TOS + ACBNAME'DISP;  << @ACBNAME.                 >> <<04624>>14468000
   ASSEMBLE(DXCH);    << Exhange source and target addresses>> <<04624>>14470000
   TOS := 4;          << 8 characters (4 words) to transfer >> <<04624>>14472000
   MOVE'DS'5;         << Off they go!                       >> <<04624>>14474000
   DEL;               << Delete FLAGS parameter.            >> <<04624>>14476000
   UNLOCK'CB(0,PACBV.DSTN,PACBV VTA);                          <<04624>>14478000
                                                               <<04624>>14480000
   ACBPRIV := FILECODE.(0:1);  <<PRIVILEGED FILE?>>                     14482000
   ACBACCESS := ASEC;                                                   14484000
   ACBCARRIAGE := TEMP.FOPCONTROLF;                                     14486000
   IF INTEGER(SPOOLF) > 0 THEN                                 <<HM.00>>14488000
      ACBLSTATE := LOGICAL(ACBLSTATE) LOR LOGICAL(SPSTATE);    <<HM.00>>14490000
   IF INTEGER(SPOOLF) < 0 THEN                                 <<00.06>>14492000
      BEGIN  <<CHECK FOR SQUEEZE REQ>>                         <<00.06>>14494000
      IF SPOOLF.(14:1)=0 THEN ACBSPRSQ := 1;                   <<00.06>>14496000
      IF XDDSPOOLINFO(0D,%1000,XDDEP) = 1D THEN                <<00.06>>14498000
            ACBSPSQZ := 1;  <<TEST XDD SQZ BIT>>               <<00.06>>14500000
      END;                                                     <<00.06>>14502000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                14504000
$PAGE                                                          <<04624>>14506000
   <<*******************************************************>> <<04624>>14508000
   <<            CREATE  A  NEW  FCB                        >> <<04624>>14510000
   << If the file was not opened already, then an FCB does  >> <<04624>>14512000
   << not yet exist and one must be created.  Create the FCB>> <<04624>>14514000
   << via FCREATECB.  If the file was opened exclusively,   >> <<04624>>14516000
   << than attempt to put the FCB in the stack.  For message>> <<04624>>14518000
   << files and shared files, the FCB always goes in an     >> <<04624>>14520000
   << extra data segment.  Shared FCB's ALWAYS go in an ex- >> <<04624>>14522000
   << tra data segment.  Shared FCB's are NEVER put in a    >> <<04624>>14524000
   << processes stack!!!                                    >> <<04624>>14526000
   <<*******************************************************>> <<04624>>14528000
                                                                        14530000
   IF NOT SHFCB THEN                                           <<04624>>14532000
      BEGIN                                                             14534000
      FCREATECB(DUM,0,                                         <<01675>>14536000
      IF EXCL=1 AND NOT MSGFILE THEN -4 ELSE -2,FCBSI,CBFCB);  <<01675>>14538000
      IF < THEN GO E2;  <<ERROR?>>                                      14540000
      FCBV := TOS;   << FCREATECB returns the new FCBV.     >> <<04624>>14542000
      DEL;                        << Delete @FCB,dont need. >> <<04624>>14544000
      RESOURCES.FCBLOCK := TRUE;  << FCB is now locked.     >> <<04624>>14546000
      NEWFCB := TRUE;             << New FCB was created.   >> <<04624>>14548000
      EXCHANGEDB(0);              << Back to stack from FCB.>> <<04624>>14550000
      FCBACB := PACBV;            << Initialize PACB vector. >><<04624>>14552000
                                                               <<04624>>14554000
      END;                                                     <<04624>>14556000
                                                                        14560000
   <<*******************************************************>> <<04624>>14562000
   << Now check dynamic locking for the file. If a file was >> <<04624>>14564000
   << opened for locking than all others must open it for   >> <<04624>>14566000
   << locking and vise-versa.                               >> <<04624>>14568000
   <<*******************************************************>> <<04624>>14570000
                                                                        14572000
   IF AOPLOCKING THEN  << DYNAMIC LOCKING REQUESTED? >>        <<00300>>14574000
      BEGIN  << YES. ANY PRIOR ACCESS MUST BE LOCKING. >>      <<00300>>14576000
      IF FCBRIN = 0 THEN  <<ALLOCATE RIN?>>                             14578000
         BEGIN                                                          14580000
         IF SHFCB THEN GO MLTACC; <<EXIST ACCESS ISN'T LOCK>>  <<00300>>14582000
         TOS := ALLORIN(3);                                             14584000
         ASSEMBLE(TEST);                                                14586000
         FCBRIN := TOS;                                                 14588000
         IF = THEN                                                      14590000
            BEGIN                                                       14592000
            TOS := NORIN;                                               14594000
            GO ERR                                                      14596000
            END                                                         14598000
         END                                                            14600000
      END                                                               14602000
   ELSE  << DYNAMIC LOCKING NOT REQUESTED. >>                  <<00300>>14604000
      IF FCBRIN <> 0 THEN GO MLTACC;  <<OTHER USER IS LOCKING>><<00300>>14606000
   IF FCBOCNT = %377 THEN BEGIN                                <<00300>>14608000
          TOS:=TOOMANYOPEN;                                    <<KJ.03>>14610000
          GO ERR; << OPEN COUNT OVERFLOW >>                    <<00117>>14612000
          END;                                                 <<KJ.03>>14614000
$PAGE                                                          <<04624>>14616000
   <<*******************************************************>> <<04624>>14618000
   << Bump the appropriate FCB counts: Open, output and/or  >> <<04624>>14620000
   << input counts.  NOW, copy the FCB from the local array >> <<04624>>14622000
   << back to the control block via UPDATE'FCB.             >> <<04624>>14624000
   <<*******************************************************>> <<04624>>14626000
                                                               <<04624>>14628000
   FCBOCNT := FCBOCNT+1;  <<BUMP OPEN COUNT>>                           14630000
   IF ATYPE <> 0 THEN FCBOCNTOUT := FCBOCNTOUT+1;                       14632000
   IF ATYPE = 0 OR ATYPE >= 4 THEN FCBOCNTIN := FCBOCNTIN+1;            14634000
   << IF REQ'D, INCREMENT COUNT OF REQUESTORS OF "READ-ONLY             14636000
             SIMULTANEOUS ACCESS >>                                     14638000
   IF EXCL = 1 THEN FCBEXCLSTAT := -1;                                  14640000
   IF EXCL = 2 THEN FCBEXCLSTAT := FCBEXCLSTAT+1;                       14642000
   UPDATE'FCB(FCBV);              << Copy FCB to the CB!    >> <<04624>>14644000
                                                                        14646000
   <<*******************************************************>> <<04624>>14648000
   << Re-find the ACB and complete ACB initialization.      >> <<04624>>14650000
   <<*******************************************************>> <<04624>>14652000
                                                                        14654000
   FGETCB(0,0,DUM,PACBV,0);  <<RE-FIND ACB>>                   <<01.02>>14656000
   @ACB := TOS;  <<INIT. ACB POINTER>>                                  14658000
   IF NOT LACBF.(11:1) THEN ACBFCB := FCBV;  <<INIT FCB VECT>>          14660000
   IF MSGFILE AND NOT AOPCOPY AND NOT ACBREAD THEN             <<HM.00>>14662000
      BEGIN  <<WRITER, CHECK IF ACCESS:=APPEND>>               <<HM.00>>14664000
      IF ACBSHCNT > 1 OR ACBACTYPE > 1 THEN                    <<HM.00>>14666000
         ACBACTYPE:=3;                                         <<HM.00>>14668000
      END;                                                     <<HM.00>>14670000
   IF ACBCIRFILE AND ACBSHCNT <> 1 AND NOT ACBREAD THEN        <<HM.00>>14672000
      ACBACTYPE:=3;  <<SET TO APPEND IF NOT 1ST WRITER>>       <<HM.00>>14674000
                                                               <<04516>>14676000
   <<*******************************************************>> <<04516>>14678000
   << Copy the PACB to the LACB and unlock the ACB via the  >> <<04516>>14680000
   << procedure UNLOCACB.                                   >> <<04516>>14682000
   <<*******************************************************>> <<04516>>14684000
                                                               <<04516>>14686000
   TOS := 0; TOS := ACBPARMS; TOS := ACBV'S;                   <<DS.00>>14688000
   UNLOCACB(*,*,*,*,*,0); << RELEASE ACB >>                    <<DS.00>>14690000
                                                                        14692000
   <<*******************************************************>> <<04624>>14694000
   << Update the file label and write the updated FLAB      >> <<04624>>14696000
   << back to disk.                                         >> <<04624>>14698000
   <<*******************************************************>> <<04624>>14700000
                                                                        14702000
   FLCLID := CLID;  <<UPDATE COLD LOAD ID>>                             14704000
   IF FLFCBVECT = 0 THEN FLFCBVECT := FCBV;  <<UPDATE FCB VECTOR?>>     14706000
   IF FLPVINFO = 0 THEN FLPVINFO := PVINFO;                    <<00188>>14708000
   TOS := FLSTATUS;  <<CURRENT READ/WRITE STATUS>>                      14710000
   IF ATYPE = 0 OR ATYPE > 3 THEN TOS := TOS LOR 1;  <<READ?>>          14712000
   IF ATYPE > 0 THEN TOS := TOS LOR 2;  <<WRITE?>>                      14714000
   FLSTATUS := TOS;  <<UPDATE READ/WRITE STATUS>>                       14716000
   FLEXCL := EXCL = 1;                                                  14718000
   TOS := CALENDAR;  <<DAY AND YEAR>>                                   14720000
   FLLASTACC := S0;  <<UPDATE LAST ACCESS DATE>>                        14722000
   IF (1 <= ATYPE <= 6) THEN FLLASTMOD := TOS ELSE DEL;                 14724000
   LABELIO(1);  <<WRITE FILE LABEL>>                                    14726000
   RELSIR(FISIR,A);  <<RELEASE FILE INTEGRITY SIR>>                     14728000
                                                                        14730000
                                                               <<04624>>14734000
   UNLOCK'CB(0,FCBV.DSTN,FCBV VTA); << Unlock the FCB.      >> <<04624>>14736000
                                                               <<04624>>14738000
   IF RESOURCES.FMAVTLOCK THEN RELSIR(FMAVTSIR,B);  <<RELEASE SIR?>>    14740000
                                                               <<+0.04>>14742000
   <<* * * MEASUREMENT DATA ON OLD DISC FILE OPEN * * *>>      <<+0.04>>14744000
                                                               <<+0.04>>14746000
$  IF X3 = ON                                                  <<+0.04>>14748000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>14750000
   TOS := EFOPEN;  <<EVENT CODE>>                              <<+0.04>>14752000
   TOS := AFTX;  <<FILE NR.>>                                  <<+0.04>>14754000
   TOS := SPOOLF;  <<SPOOLING FLAG>>                           <<+0.04>>14756000
   IF < THEN  <<SPOOLER ACCESS?>>                              <<+0.04>>14758000
      BEGIN                                                    <<+0.04>>14760000
      DEL;                                                     <<+0.04>>14762000
      TOS := 2                                                 <<+0.04>>14764000
      END;                                                     <<+0.04>>14766000
   TOS.(0:2) := TOS;  <<INSERT ACCESSOR CODE>>                 <<+0.04>>14768000
   MMSTAT(*,*,AOPTIONS,FLFOPTIONS);  <<MEASURE EVENT>>         <<+0.05>>14770000
   MMSTAT(EFOPEN',RSIZE,FLBLKSIZE,                             <<+0.05>>14772000
      IF NUMBUFFERS > 16 THEN 16 ELSE NUMBUFFERS);             <<+0.04>>14774000
   TOS := EFOPEN';  <<EVENT CODE>>                             <<+0.04>>14776000
   TOS := FLFLIM;                                              <<+0.04>>14778000
   MMSTAT(*,*,*,FLNUMEXTS+1);  <<MEASURE EVENT>>               <<+0.05>>14780000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>14782000
$  IF                                                          <<+0.04>>14784000
                                                                        14786000
   <<* * * CONSTRUCT AFT ENTRY * * *>>                                  14788000
                                                                        14790000
   FOPENDA := AFTX;  <<FILE NR.>>                                       14792000
   FINDAFT;  <<AFT ENTRY POINTER>>                                      14794000
   TOS:=                                                       <<HM.00>>14796000
      IF MSGFILE AND NOT AOPCOPY THEN MSG'TYPE&LSL(12) ELSE 0; <<HM.00>>14798000
   TOS:=PACBV;                                                 <<HM.00>>14800000
   DPS2 := TOS;  <<INIT. FIRST HALF>>                                   14802000
   TOS := TOS+2;                                                        14804000
   TOS := LACBV; TOS := 0;                                              14806000
   DPS2 := TOS;  <<INIT. SECOND HALF>>                                  14808000
   TOS := CCE;  <<OK CONDITION CODE>>                                   14810000
   GO EXIT;                                                             14812000
                                                                        14814000
   <<* * * ERROR RECOVERY * * *>>                                       14816000
                                                                        14818000
E0:  << EXCL/SHR VIOLATION - THIS ACCESSOR >>                           14820000
   TOS := EXSHERR1;                                                     14822000
   GO ERR;                                                              14824000
                                                                        14826000
E1:  << EXCL VIOLATION - PREVIOUS ACCESSOR >>                           14828000
   TOS := EXSHERR2;                                                     14830000
   GO ERR;                                                              14832000
                                                                        14834000
E2:  << INSUFFICIENT MEMORY >>                                          14836000
   TOS := MEMPROB;                                                      14838000
   GO ERR;                                                              14840000
                                                                        14842000
E3:  << FILE CODE VIOLATION >>                                          14844000
   TOS := PRIVVIOL;                                                     14846000
   GO ERR;                                                              14848000
                                                                        14850000
E4:  << TOO MANY FILES OPEN BY THIS PROCESS >>                          14852000
   TOS := TMFP;                                                         14854000
   GO ERR;                                                              14856000
E5:  << No room left for PXFILE expansion   >>                 <<02357>>14858000
   TOS := NOROOMLEFT;                                          <<02357>>14860000
   GO ERR;                                                     <<02357>>14862000
                                                               <<02357>>14864000
NOFMAVT:                                                       <<04519>>14866000
   TOS := OUTFMAVT;           << Out of FMAVT entries.      >> <<04519>>14868000
   GO ERR;                                                     <<04519>>14870000
                                                               <<04519>>14872000
                                                                        14874000
MLTACC:                                                                 14876000
   TOS := MLTIACCERR;                                                   14878000
                                                                        14880000
   <<* * * RELEASE RESOURCES * * *>>                                    14882000
                                                                        14884000
ERR:                                                                    14886000
   EXCHANGEDB(0);  <<SET DB TO STACK>>                                  14888000
   IF PACBLOCKED THEN  <<UNLOCK PACB?>>                                 14890000
      BEGIN                                                             14892000
      FGETCB(0,0,DUM,PACBV,0);                                 <<01.02>>14894000
      ASSEMBLE(DEL,XCH);                                                14896000
      FRELCB(*,*,1)                                                     14898000
      END;                                                              14900000
   TOS := RESOURCES;                                                    14902000
   IF LS0.ACBLOCK THEN DELACB(PACBV,LACBV);                             14904000
   IF LS0.FCBLOCK THEN  <<UNLOCK FCB?>>                                 14906000
      BEGIN                                                             14908000
      IF NOT NEWFCB THEN   << UNLOCK OLD FCB? >>               <<00300>>14910000
         BEGIN                                                          14912000
                                                               <<04624>>14914000
         UNLOCK'CB(0,FCBV.DSTN,FCBV VTA);                      <<04624>>14916000
                                                               <<04624>>14918000
         END                                                            14920000
      ELSE  << Purge new FCB .                              >> <<04624>>14922000
         BEGIN                                                          14924000
         FDELETECB(FCBV)  <<DELETE NEW FCB>>                            14928000
         END                                                            14930000
      END;                                                              14932000
   IF LS0.SIRLOCK THEN RELSIR(FISIR,A);  <<RELEASE SIR>>                14934000
   IF LS0.FMAVTLOCK THEN RELSIR(FMAVTSIR,B);                            14936000
   IF TOS.DISKLOCK THEN  <<USE COUNTS BUMPED?>>                         14938000
      BEGIN                                                             14940000
                                                               <<04624>>14942000
      X := DISKDEALLOC(0,0,-(FCBNUMEXTS+1),FCBEXTMAP);  <<DECREMENT>>   14944000
$     IF X1 = ON                                                        14946000
      IF <> THEN FTROUBLE(469);  <<ERROR?>>                    <<KJ.03>>14948000
$     IF                                                                14950000
      END;                                                              14952000
                                                                        14954000
   SETPXFILE;  <<INIT. PXFILE POINTER>>                                 14956000
   SPOOLERRCODE;                                                        14958000
   PXFFOPEN := TOS;  <<ERROR NR.>>                                      14960000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                14962000
                                                                        14964000
EXIT:                                                                   14966000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           14968000
   RESETCRITICAL(CRIT)                                                  14970000
   END;        << procedure FOPENDA >>                                  14972000
$ PAGE " MPE-IV FILE SYSTEM - MORE UNCALLABLES "                        14976000
$ CONTROL SEGMENT = FILESYS7                                            14978000
DOUBLE PROCEDURE FRELSPACE (LDEV,FADDR,MVTABX);                <<00300>>14980000
   <<RELEASES THE DISC SPACE OF THE SPECIFIED FILE.            ((00630))14982000
                                                                        14984000
     INPUT PARAMETERS:                                                  14986000
         LDEV - LOGICAL DEVICE NUMBER                                   14988000
         FADDR - FILE LABEL SECTOR NUMBER                               14990000
         MVTABX - MOUNTED VOLUME TABLE INDEX                     RV.PV  14992000
                                                                        14994000
     OUTPUT PARAMETERS:                                                 14996000
         FRELSPACE - NUMBER OF SECTORS RELEASED (0 IF ERROR)   ((00630))14998000
                                                                        15000000
     NOTE THAT THIS PROCEDURE IS USED BY THE DIRECTORY SYSTEM  ((00630))15002000
     AS WELL AS BY THE FILE SYSTEM.  ALSO, DB MUST BE SET TO   ((00630))15004000
     THE STACK WHEN THIS PROCEDURE IS CALLED>>                 <<00630>>15006000
   VALUE LDEV,FADDR,MVTABX;                                    <<RV.PV>>15008000
   INTEGER LDEV,MVTABX;                                        <<RV.PV>>15010000
   DOUBLE FADDR;                                                        15012000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                      <<RV.PV>>15014000
   BEGIN                                                                15016000
   LOGICAL PMASK = Q-4;                                        <<RV.PV>>15018000
   DOUBLE RESULT = FRELSPACE;                                  <<00300>>15020000
   INTEGER POINTER PCBX;  <<PCBX POINTER>>                              15022000
   INTEGER CLID;  <<COLD LOAD ID>>                                      15024000
   LOGICAL A;  <<FOR GETSIR>>                                           15026000
   INTEGER count;                                              <<03509>>15028000
   POINTER ext'map'ptr;   << Pointer into extent map >>        <<03509>>15030000
   INTEGER POINTER FLAB;  <<FILE LABEL BUFFER>>                         15032000
                                                                        15034000
   SUBROUTINE LABELIO (RW);                                             15036000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           15038000
                                                                        15040000
        INPUT VARIABLES:                                                15042000
            RW - I/O MODE                                               15044000
               0 - READ                                                 15046000
               1 - WRITE                                                15048000
                                                                        15050000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE      15052000
        IS CALLED AND THAT I/O ERRORS ARE NOT DETECTED ON A WRITE       15054000
        REQUEST>>                                                       15056000
      VALUE RW;                                                         15058000
      INTEGER RW;                                                       15060000
      BEGIN                                                             15062000
      X := FLABIO(LDEV,FADDR,RW,FLAB);  <<R/W LABEL>>                   15064000
      IF <> THEN  <<ERROR?>>                                            15066000
         BEGIN                                                          15068000
         IF NOT LOGICAL(RW) THEN  <<READ?>>                             15070000
            FLABIOERR(X,0)  <<HANDLE ERROR>>                            15072000
         ELSE  <<WRITE>>                                                15074000
            BEGIN                                                       15076000
            FLABIOERR(X,0,@FLLOCNAME);  <<REPORT ERROR>>                15078000
            TOS := 0D;  <<0D TO BE INSERTED INTO JIT>>                  15080000
            TOS := PXGJITDST; TOS := JITPFP&LSL(1);                     15082000
            TOS := @S3;                                                 15084000
            TOS := 2;                                                   15086000
            ASSEMBLE(MTDS 4);  <<CLEAR JIT PASSED FILE CELL>>           15088000
            DDEL                                                        15090000
            END;                                                        15092000
         GO EXIT                                                        15094000
         END                                                            15096000
      END;                                                              15098000
                                                                        15100000
$  IF X0 = ON                                                           15102000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               15104000
      BEGIN                                                             15106000
      TOS := "FD"; TOS := "EL"; TOS := "ET"; TOS := "E ";               15108000
      ASSEMBLE(DZRO,DZRO);                                              15110000
      FTITLE(*,*,*,*);                                                  15112000
      DEBUG                                                             15114000
      END;                                                              15116000
$  IF                                                                   15118000
                                                                        15120000
   <<* * * READ FILE LABEL * * *>>                                      15122000
                                                                        15124000
   SETPCBX;  <<SET PCBX POINTER>>                                       15126000
   A := GETSIR(FISIR);  <<GET FILE INTEGRITY SIR>>                      15128000
   ALLOCFLAB;  <<ALLOCATE BUFFER>>                                      15130000
   LABELIO(0);  <<READ LABEL>>                                          15132000
                                                                        15134000
   <<* * * CHECK COLD LOAD ID OF FILE * * *>>                           15136000
                                                                        15138000
   IF FLFCBVECT <> 0 OR                                                 15140000
      INTEGER(LOGICAL(FLLOCK) LAND %160003) <> 0 THEN                   15142000
      BEGIN                                                             15144000
      CLID := ABSOLUTE(CLOADID);  <<COLD LOAD ID>>                      15146000
      IF CLID = FLCLID THEN  <<SAME COLD LOAD ID'S?>>                   15148000
         BEGIN                                                          15150000
         IF (2 <= FLDESIGNATOR <= 3) THEN  <<PASSED FILE?>>             15152000
            BEGIN                                                       15154000
            FLDESIGNATOR := 0;  <<MAKE ACTUAL>>                         15156000
            LABELIO(1);  <<WRITE LABEL>>                                15158000
            FRELSPACE := 1D                                    <<00300>>15160000
            END;                                                        15162000
         GO EXIT                                                        15164000
         END                                                            15166000
      END;                                                              15168000
                                                                        15170000
   <<* * * SET UP MVTABX * * *>>                               <<RV.PV>>15172000
   IF NOT PMASK THEN                                           <<RV.PV>>15174000
   BEGIN <<MVTABX NOT SUPPLIED>>                               <<RV.PV>>15176000
       MVTABX := 0;                                            <<RV.PV>>15178000
   END;                                                        <<RV.PV>>15180000
                                                               <<RV.PV>>15182000
   <<* * * DEALLOCATE DISC SPACE * * *>>                                15184000
                                                                        15186000
   VTABTOLDEV (FLEXTMAP,FLEXTMAP,FLNUMEXTS+1,MVTABX);          <<RV.PV>>15188000
    count := flnumexts;          << Number of extents - 1 >>   <<03509>>15190000
    @ext'map'ptr := @flextmap;   << Pointer to extent map >>   <<03509>>15192000
                                                               <<03509>>15194000
    WHILE count >= 0 DO                                        <<04137>>15196000
       BEGIN  << Run through extent map >>                     <<03509>>15198000
        IF ext'map'ptr <> 0                                    <<04137>>15200000
         THEN BEGIN                                            <<04137>>15202000
                                                               <<03509>>15204000
          << Get get ldev and disc address out of map >>       <<03509>>15206000
                                                               <<03509>>15208000
          TOS := ext'map'ptr.(0:8);   << Ldev >>               <<03509>>15210000
          TOS := ext'map'ptr.(8:8);   << High order address >> <<03509>>15212000
          TOS := ext'map'ptr(1);      << Low order address  >> <<03509>>15214000
                                                               <<03509>>15216000
          << Set size of extent, depending on if it is the >>  <<03509>>15218000
          << last extent.                                  >>  <<03509>>15220000
                                                               <<03509>>15222000
          IF count = 0 THEN                                    <<03509>>15224000
             TOS := DOUBLE(fllastextsize)  << Size of last >>  <<03509>>15226000
          ELSE                                                 <<03509>>15228000
             TOS := DOUBLE(flextsize);   << Size of others >>  <<03509>>15230000
                                                               <<03509>>15232000
          result := result + DS1;      << Add to total >>      <<03509>>15234000
                                       << of sectors.  >>      <<03509>>15236000
                                                               <<03509>>15238000
          Return'Disc'Space (*, *, *);                         <<03509>>15240000
         END;                                                  <<04137>>15242000
                                                               <<03509>>15244000
          << Increment ptr and decrement count. >>             <<03509>>15246000
                                                               <<03509>>15248000
          @ext'map'ptr := @ext'map'ptr + 2;                    <<03509>>15250000
          count := count - 1;                                  <<03509>>15252000
                                                               <<03509>>15254000
       END;  << Run through extent map >>                      <<03509>>15256000
                                                               <<03509>>15258000
                                                                        15262000
EXIT:                                                                   15264000
   RELSIR(FISIR,A)  <<RELEASE FILE INTEGRITY SIR>>                      15266000
   END;        << procedure FRELSPACE >>                                15268000
$ CONTROL SEGMENT = FILESYS7                                            15270000
PROCEDURE FPROCTERM;                                           <<KS.00>>15272000
                                                               <<04910>>15274000
<<**********************************************************>> <<04910>>15276000
<< Closes all currently opened files.  It first attempts to >> <<04910>>15278000
<< close the file with default disposition and non-restric- >> <<04910>>15280000
<< ted security.  If an FCLOSE fails, then the file is      >> <<04910>>15282000
<< closed with disposition -1 and any subsequent errors are >> <<04910>>15284000
<< ignored.                                                 >> <<04910>>15286000
<<                                                          >> <<04910>>15288000
<< Special entry point:                                     >> <<04910>>15290000
<<    FPROCTERJOB - This is used by the CI.  For this entry >> <<04910>>15292000
<<                  point, we begin closing the files at    >> <<04910>>15294000
<<                  file number 3, skipping $STDIN/LIST.    >> <<04910>>15296000
<<                  The CI will close these via FJCLOSE for >> <<04910>>15298000
<<                  a CI job or sesseion.                   >> <<04910>>15300000
<<**********************************************************>> <<04910>>15302000
                                                               <<04910>>15304000
   OPTION PRIVILEGED,UNCALLABLE;                                        15306000
   BEGIN                                                                15308000
   ENTRY FPROCTERMJOB;                                         <<04910>>15310000
   INTEGER FILENUM;   << FILE NR. >>                           <<DS.00>>15312000
   INTEGER LINENUM = FILENUM;                                           15314000
   INTEGER DSNUM = FILENUM;                                             15316000
   INTEGER POINTER AFT; << AFT ENTRY POINTER >>                <<DS.00>>15318000
   DOUBLE POINTER AFTDBL = AFT;                                         15320000
   INTEGER POINTER PXFILE; << PXFILE POINTER >>                <<DS.00>>15322000
   INTEGER PLABEL; << CCLOSE/DCLOSE PLABEL >>                  <<DS.00>>15324000
   INTEGER NRFILES; << NR. FILES IN AFT >>                     <<DS.00>>15326000
   INTEGER START'NUM;  << Start at file number 1 or 3?      >> <<04910>>15328000
                                                               <<04910>>15330000
   START'NUM := 1;     << Normal entry point.               >> <<04910>>15332000
   IF FALSE THEN                                               <<04910>>15334000
      BEGIN                                                    <<04910>>15336000
FPROCTERMJOB:          << Entry point for CI job or session.>> <<04910>>15338000
      START'NUM := 3;  << Skip over $STDIN  and $STDLIST.   >> <<04910>>15340000
      END;                                                     <<04910>>15342000
                                                               <<DS.00>>15344000
                                                                        15346000
$  IF X0 = ON                                                           15348000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               15350000
      BEGIN                                                             15352000
      TOS := "FP"; TOS := "RO"; TOS := "CT"; TOS := "ER";               15354000
      TOS := "M ";                                                      15356000
      ASSEMBLE(ZERO,DZRO);                                              15358000
      FTITLE(*,*,*,*);                                                  15360000
      DEBUG                                                             15362000
      END;                                                              15364000
$  IF                                                                   15366000
<< * * * CLOSE ALL KSAM FILE * * *>>                           <<KS.00>>15368000
   SETPXFILE;    <<SET PX AREA POINTER>>                       <<KS.00>>15370000
   FILENUM:=START'NUM;                                         <<04910>>15372000
   SETAFT;        <<INITIAL TO FILE NUMBER 1>>                 <<KS.00>>15374000
   NRFILES:=PXFAFTSIZE/AFTENTRY; <<# OF AFT ENTRIES>>          <<KS.00>>15376000
                                                               <<KS.00>>15378000
   WHILE <> DO                                                 <<KS.00>>15380000
   BEGIN                                                       <<KS.00>>15382000
     IF AFTKSTYPE THEN FCLOSE(FILENUM,0,0);                    <<KS.00>>15384000
     FILENUM:=FILENUM+1;   <<NEXT FILE NUMBER>>                <<KS.00>>15386000
     @AFT:=@AFT-AFTENTRY;  <<NEXT AFT ENTRY>>                  <<KS.00>>15388000
     NRFILES:=NRFILES-1;   <<AFT ENTRIES REMAINING>>           <<KS.00>>15390000
   END;                                                        <<KS.00>>15392000
                                                               <<DS.00>>15394000
   << * * * CLOSE ALL REMOTE FILES * * * >>                    <<DS.00>>15396000
                                                               <<DS.00>>15398000
   FILENUM := START'NUM;                                       <<04910>>15400000
   SETAFT; << FIRST AFT POINTER >>                             <<DS.00>>15402000
   SETPXFILE; << PX FILE AREA >>                               <<DS.00>>15404000
   NRFILES := PXFAFTSIZE/AFTENTRY; << NUMBER OF FILES >>       <<DS.00>>15406000
                                                               <<DS.00>>15408000
   WHILE <> DO << STEP THRU AFT >>                             <<DS.00>>15410000
   BEGIN                                                       <<DS.00>>15412000
      IF AFTRFTYPE THEN                                        <<DS.00>>15414000
      BEGIN << CLOSE REMOTE FILE >>                            <<DS.00>>15416000
         FCLOSE(FILENUM,0,0);                                  <<DS.RW>>15418000
         IF <> THEN <<ERROR?>>                                 <<DS.RW>>15420000
            FCLOSE(FILENUM,-1,0);                              <<DS.RW>>15422000
      END;                                                     <<DS.00>>15424000
      FILENUM := FILENUM + 1; << STEP TO NEXT FILE >>          <<DS.00>>15426000
      @AFT := @AFT - AFTENTRY; << NEXT AFT >>                  <<DS.00>>15428000
      NRFILES := NRFILES - 1; << AFT ENTRIES REMAINING >>      <<DS.00>>15430000
   END;                                                        <<DS.00>>15432000
                                                               <<DS.00>>15434000
   << * * * CLOSE ALL DS LINES * * * >>                        <<DS.00>>15436000
                                                               <<DS.00>>15438000
   DSNUM := START'NUM;                                         <<04910>>15440000
   SETAFT; << FIRST ENTRY AFT POINTER >>                       <<DS.00>>15442000
   PLABEL := ABSOLUTE(DSCLOSEPLABL); << DS CLOSE PLABEL >>     <<DS.00>>15444000
   NRFILES := PXFAFTSIZE/AFTENTRY; << NR. OF ENTRIES >>        <<DS.00>>15446000
                                                                        15448000
   WHILE <> DO  <<STEP THRU AFT>>                                       15450000
      BEGIN                                                             15452000
      IF AFTDSTYPE THEN  <<DS LINE OPEN?>>                              15454000
         BEGIN                                                          15456000
         TOS := DSNUM;  <<DS LINE NR.>>                                 15458000
         TOS := PLABEL;  <<DSCLOSE P-LABEL>>                            15460000
         IF = THEN SUDDENDEATH(52);  <<DS NOT ON SYSTEM?>>              15462000
         ASSEMBLE(PCAL 0)                                               15464000
         END;                                                           15466000
      DSNUM := DSNUM+1;  <<NEXT DS LINE NR.>>                           15468000
      @AFT := @AFT-AFTENTRY;  <<NEXT AFT ENTRY>>                        15470000
      NRFILES := NRFILES-1  <<NR. ENTRIES REMAINING>>                   15472000
      END;                                                              15474000
                                                                        15476000
    <<* * * CLOSE ALL EMULATED 3270S * * *>>                   <<00183>>15478000
                                                               <<00183>>15480000
    FILENUM := START'NUM;                                      <<04910>>15482000
    SETAFT;           << AFT PTR. TO FIRST >>                  <<00183>>15484000
    PLABEL := PLABEL3270;                                      <<01165>>15486000
    NRFILES := PXFAFTSIZE/AFTENTRY;                            <<00183>>15488000
                                                               <<00183>>15490000
    WHILE <> DO       << STEP THRU AFT >>                      <<00183>>15492000
      BEGIN                                                    <<00183>>15494000
      IF AFT3270TYPE THEN   << 3270 OPEN ? >>                  <<00183>>15496000
        BEGIN                                                  <<00183>>15498000
        TOS := 0;   << CLOSE3270 IS A TYPED PROCEDURE >>       <<00183>>15500000
        TOS := 1;   << SELECT CLOSE.  CONS3270 IS ZERO >>      <<00183>>15502000
        TOS := FILENUM;                                        <<00183>>15504000
        TOS := PLABEL;                                         <<00183>>15506000
        IF = THEN SUDDENDEATH(51);                             <<00183>>15508000
        ASMB(PCAL 0);       << CALL CLOSE3270 >>               <<00183>>15510000
        DEL;    << CLOSE3270 RETURN IS ALWAYS TRUE >>          <<00183>>15512000
        END;                                                   <<00183>>15514000
      FILENUM := FILENUM+1; << STEP TO NEXT >>                 <<00183>>15516000
      @AFT := @AFT-AFTENTRY;                                   <<00183>>15518000
      NRFILES := NRFILES-1; << NUM REMAINING >>                <<00183>>15520000
      END;                                                     <<00183>>15522000
                                                               <<00183>>15524000
   <<* * * CLOSE ALL CS LINES * * *>>                                   15526000
                                                                        15528000
   LINENUM := START'NUM;                                       <<04910>>15530000
   SETAFT;  <<AFT POINTER TO FIRST LINE NR.>>                           15532000
   PLABEL := ABSOLUTE(CCLOSEPLABL);  <<CCLOSE P-LABEL>>                 15534000
   NRFILES := PXFAFTSIZE/AFTENTRY;  <<NR. AFT ENTRIES>>                 15536000
                                                                        15538000
   WHILE <> DO  <<STEP THRU AFT>>                                       15540000
      BEGIN                                                             15542000
      IF AFTCSTYPE THEN  <<CS LINE OPEN?>>                              15544000
         BEGIN                                                          15546000
         TOS := LINENUM;  <<LINE NR.>>                                  15548000
         TOS := PLABEL;  <<CCLOSE P-LABEL>>                             15550000
         IF = THEN SUDDENDEATH(51);  <<CS NOT ON SYSTEM>>               15552000
         ASSEMBLE(PCAL 0)  <<CCLOSE LINE>>                              15554000
         END;                                                           15556000
      LINENUM := LINENUM+1;  <<NEXT FILE NR.>>                          15558000
      @AFT := @AFT-AFTENTRY;  <<NEXT AFT ENTRY>>                        15560000
      NRFILES := NRFILES-1  <<AFT ENTRIES REMAINING>>                   15562000
      END;                                                              15564000
                                                                        15566000
   <<* * * CLOSE ALL FILES * * *>>                                      15568000
                                                                        15570000
   FILENUM := START'NUM;                                       <<04910>>15572000
   SETAFT;  <<INIT. TO FILE NR. 1>>                                     15574000
   NRFILES := PXFAFTSIZE/AFTENTRY;  <<NR. AFT ENTRIES>>                 15576000
                                                                        15578000
   WHILE <> DO  <<STEP THRU AFT>>                                       15580000
      BEGIN                                                             15582000
      IF AFTMSGTYPE OR AFTFSTYPE AND AFTDBL <> 0D THEN <<OPEN?   HM.00>>15584000
         BEGIN                                                          15586000
         FCLOSE(FILENUM,0,0);  <<CLOSE FILE>>                           15588000
         IF <> THEN  <<ERROR?>>                                         15590000
            BEGIN                                                       15592000
            TOS := FILENUM;                                             15594000
            ASSEMBLE(DZRO,DECB);                                        15596000
            FCLOSE(*,*,*)  <<TRY AGAIN>>                                15598000
            END                                                         15600000
         END;                                                           15602000
      FILENUM := FILENUM+1;  <<NEXT FILE NR.>>                          15604000
      @AFT := @AFT-AFTENTRY;  <<NEXT AFT ENTRY>>                        15606000
      NRFILES := NRFILES-1  <<AFT ENTRIES REMAINING>>                   15608000
      END;                                                     <<00441>>15610000
   COMMENT  Release the CBT pre-allocated for us by UCOP, if   <<00441>>15612000
we got one and still have it.  ;                               <<00441>>15614000
   IF PXFCBT1 <> 0 THEN RELDATASEG(PXFCBT1);                   <<00441>>15616000
   END;        << procedure FPROCTERM >>                                15618000
$PAGE "FILEACCESS    MPE-IV FILE SYSTEM - FGETLOCKWORD"        <<04867>>15620000
$CONTROL PRIVILEGED                                            <<04867>>15622000
$CONTROL SEGMENT=FILESYS6A                                     <<04867>>15624000
INTEGER PROCEDURE FGETLOCKWORD(FILENUM,LOCKWORD,LENGTH);       <<04867>>15626000
VALUE FILENUM;                                                 <<04867>>15628000
                                                               <<04867>>15630000
INTEGER FILENUM,LENGTH;                                        <<04867>>15632000
BYTE ARRAY LOCKWORD;                                           <<04867>>15634000
OPTION UNCALLABLE,PRIVILEGED;                                  <<04867>>15636000
                                                               <<04867>>15638000
COMMENT                                                        <<04867>>15640000
                                                               <<04867>>15642000
    FGETLOCKWORD will get the LOCKWORD from the OPEN file.     <<04867>>15644000
  It is used by the CI to get the lockword for the UDC file for<<04867>>15646000
  COMMAND.PUB.SYS, so that during logon users will not be      <<04867>>15648000
  prompted for the lockword.                                   <<04867>>15650000
                                                               <<04867>>15652000
  File must be open EXR or EXL.                                <<04867>>15654000
                                                               <<04867>>15656000
  DB must be at the stack.                                     <<04867>>15658000
                                                               <<04867>>15660000
  Algorithm:                                                   <<04867>>15662000
    Make sure at stack                                         <<04867>>15664000
    Get the ACB for the file                                   <<04867>>15666000
    Make sure the file is opened exl or semi                   <<04867>>15668000
    Get the extent map from FCB of the file                    <<04867>>15670000
    Read the file label                                        <<04867>>15672000
    Extract the lockword                                       <<04867>>15674000
    Release ACB                                                <<04867>>15676000
                                                               <<04867>>15678000
  Returns: in                                                  <<04867>>15680000
    Function return: 0 if everything went fine otherwise the   <<04867>>15682000
                     file system error number.                 <<04867>>15684000
    LOCKWORD: (for eight bytes) the lockword (padded by        <<04867>>15686000
              blanks.  N.B.  If length = 0 this is undefined.  <<04867>>15688000
    LENGTH:    Length in bytes of the lockword, 0 if           <<04867>>15690000
               no lockword.                                    <<04867>>15692000
                                                               <<04867>>15694000
;                                                              <<04867>>15696000
                                                               <<04867>>15698000
BEGIN                                                          <<04867>>15700000
                                                               <<04867>>15702000
<<  Local declares >>                                          <<04867>>15704000
                                                               <<04867>>15706000
EQUATE READ = 0;                                               <<04867>>15708000
EQUATE EXTENT = 36;  <<Word in FLAB that is first extent map>> <<04867>>15710000
INTEGER ERR,LDEV;                                              <<04867>>15712000
DEFINE PMODE = %100000#;                                       <<04867>>15714000
DEFINE DEVICE = (0:8)#;                                        <<04867>>15716000
DEFINE ERRORCODE = FGETLOCKWORD#;                              <<04867>>15718000
                                                               <<04867>>15720000
DOUBLE EXTENT'MAP'D;                                           <<04867>>15722000
INTEGER EXTENT'MAP=EXTENT'MAP'D;                               <<04867>>15724000
LOGICAL BLANK := "  ";                                         <<04867>>15726000
INTEGER ARRAY FLAB(0:127);                                     <<04867>>15728000
LOGICAL ARRAY L'LOCKWORD(0:4);                                 <<04867>>15730000
BYTE ARRAY T'LOCKWORD(*)=L'LOCKWORD;                           <<04867>>15732000
                                                               <<04867>>15734000
<< The following variables must be in order >>                 <<04867>>15736000
                                                               <<04867>>15738000
INTEGER ACBMQ;                                                 <<04867>>15740000
INTEGER AFTE;                                                  <<04867>>15742000
INTEGER PACBV;                                                 <<04867>>15744000
INTEGER LACBV;                                                 <<04867>>15746000
INTEGER IOQX;                                                  <<04867>>15748000
INTEGER ARRAY ACB(0:SIZEXACB-1)=Q;                             <<04867>>15750000
INTEGER DSTX;                                                  <<04867>>15752000
                                                               <<04867>>15754000
ERRORCODE := 0;  << Default - everything went OK >>            <<04867>>15756000
CHECKDB;                                                       <<04867>>15758000
IF <> THEN                                                     <<04867>>15760000
  ERRORCODE := ILLDB                                           <<04867>>15762000
ELSE        << Stack OK - Process >>                           <<04867>>15764000
  BEGIN                                                        <<04867>>15766000
  GET'ACB'Q'LOC;                                               <<04867>>15768000
  LOC'ACB(0,ACBMQ,FILENUM,PMODE);                              <<04867>>15770000
  DSTX := TOS;                                                 <<04867>>15772000
  IF <> THEN                                                   <<04867>>15774000
    BEGIN                                                      <<04867>>15776000
    ERRORCODE := 72 <<INVFL replaces 72 when include is avail>><<04867>>15778000
    END                                                        <<04867>>15780000
  ELSE                                                         <<04867>>15782000
    BEGIN                                                      <<04867>>15784000
    IF NOT (ACBEXCLUSIVE LOR ACBSEMI) THEN                     <<04867>>15786000
      BEGIN                                                    <<04867>>15788000
      ERRORCODE := ACCVIOL;                                    <<04867>>15790000
      END                                                      <<04867>>15792000
    ELSE            << Got ACB and have exclusive (with >>     <<04867>>15794000
      BEGIN                << read?) access                    <<04867>>15796000
      EXTENT'MAP'D := GETFCB'INFO(ACBFCB,EXTENT);              <<04867>>15798000
      LDEV := EXTENT'MAP.DEVICE;                               <<04867>>15800000
      EXTENT'MAP.DEVICE := 0;  << Clear out LDEV part >>       <<04867>>15802000
      ERR := FLABIO(LDEV,EXTENT'MAP'D,READ,FLAB);              <<04867>>15804000
      IF ERR <> 0 THEN << ERR will be 1 or 2 if error >>       <<04867>>15806000
        BEGIN                                                  <<04867>>15808000
        FLABIOERR(ERR,FILENUM);                                <<04867>>15810000
        ERRORCODE := LBLIOERR;                                 <<04867>>15812000
        END                                                    <<04867>>15814000
      ELSE                                                     <<04867>>15816000
        BEGIN                                                  <<04867>>15818000
        MOVE T'LOCKWORD := "         ";                        <<04867>>15820000
                                                               <<04867>>15822000
      << Move the file label's lockword into temp area >>      <<04867>>15824000
                                                               <<04867>>15826000
        MOVE L'LOCKWORD := FLLOCKWORD,(4);                     <<04867>>15828000
        SCAN T'LOCKWORD UNTIL BLANK,1;                         <<04867>>15830000
        LENGTH := TOS - @T'LOCKWORD;                           <<04867>>15832000
        MOVE LOCKWORD := T'LOCKWORD,(8);                       <<04867>>15834000
        END                                                    <<04867>>15836000
      END;                                                     <<04867>>15838000
                                                               <<04867>>15840000
      <<  Unlock to ACB  >>                                    <<04867>>15842000
                                                               <<04867>>15844000
      UNLOC'ACB(ACBMQ,0);                                      <<04867>>15846000
                                                               <<04867>>15848000
    END                                                        <<04867>>15850000
  END                                                          <<04867>>15852000
END;  << FGETLOCKWORD >>                                       <<04867>>15854000
$PAGE "       MPE-IV FILE SYSTEM - WRITE'FOPEN'RECORD"         <<04515>>15856000
$ CONTROL SEGMENT = FILESYS6A                                  <<04515>>15858000
PROCEDURE WRITE'FOPEN'RECORD(RECSIZE,FORMMSG,SP'ACBBLK,        <<04515>>15860000
                             FILENUM);                         <<04515>>15862000
  VALUE RECSIZE,FILENUM;                                       <<04515>>15864000
  INTEGER RECSIZE,FILENUM;                                     <<04515>>15866000
  DOUBLE SP'ACBBLK;                                            <<04515>>15868000
  BYTE ARRAY FORMMSG;                                          <<04515>>15870000
                                                               <<04515>>15872000
<<**********************************************************>> <<04515>>15874000
<< This procedure writes a special FOPEN SPOOLFILE record   >> <<04515>>15876000
<< with a forms message if one has been supplied.  It is    >> <<04515>>15878000
<< called by FOPEN for every spoolfile.                     >> <<04515>>15880000
<<                                                          >> <<04515>>15882000
<< INPUT VARIABLES:                                         >> <<04515>>15884000
<<    FORMMSG - An array containing the forms message for   >> <<04515>>15886000
<<              the spoolfile, if one is given.             >> <<04515>>15888000
<<    RECSIZE - The size in words of the forms message.  If >> <<04515>>15890000
<<              no forms messages is to be written, than    >> <<04515>>15892000
<<              this value is zero (0).                     >> <<04515>>15894000
<<                                                          >> <<04515>>15896000
<< OUTPUT VARIABLES:                                        >> <<04515>>15898000
<<    SP'ACBBLK - The current block number for the spool-   >> <<04515>>15900000
<<                file.  Retrieved from ACB double (9).     >> <<04515>>15902000
<<                                                          >> <<04515>>15904000
<< NOTE: DB must be set to the stack upon entrance into     >> <<04515>>15906000
<<       this procedure.                                    >> <<04515>>15908000
<<**********************************************************>> <<04515>>15910000
                                                               <<04515>>15912000
BEGIN                                                          <<04515>>15914000
                                                               <<04515>>15916000
  LOGICAL FLAGS;                                               <<04515>>15918000
                                                               <<04515>>15920000
<<**********************************************************>> <<04515>>15922000
<<                                                          >> <<04515>>15924000
<<  ############### ACB POINTERS #################          >> <<04515>>15926000
<<                                                          >> <<04515>>15928000
<<  Below are the declarations and equates for the PACB and >> <<04515>>15930000
<<  AFT arrays.  They cannot be changed in any way and they >> <<04515>>15932000
<<  MUST BE THE LAST DECLARATIONS !!!!!!  LOC'ACB places    >> <<04515>>15934000
<<  the AFT at ACB(-4) to ACB(-1) and the PACB follows.     >> <<04515>>15936000
                                                               <<04515>>15938000
INTEGER ACBMQ;                                                 <<04515>>15940000
INTEGER AFTE;      << AFT entry word 0, type and $NULL bit  >> <<04515>>15942000
INTEGER PACBV;     << Physical ACB Vector                   >> <<04515>>15944000
INTEGER LACBV;     << Logical  ACB Vector                   >> <<04515>>15946000
INTEGER IOQX;      << No-Wait I/O pending Queue Index       >> <<04515>>15948000
                                                               <<04515>>15950000
                                                               <<04515>>15952000
                                                               <<04515>>15954000
INTEGER ARRAY ACB(0:SIZEXACB-1) = Q;                           <<04515>>15956000
DOUBLE ARRAY ACBDBL(*)=ACB;                                    <<04515>>15958000
LOGICAL DSTX;  <<DSTX returned by LOC'ACB, used by IOMOVE   >> <<04515>>15960000
                                                               <<04515>>15962000
<<  Do not place any declarations after this point!!!  Just >> <<04515>>15964000
<<  as important, do no stack any data before the call to   >> <<04515>>15966000
<<  to IOMOVE.  IOMOVE expects the ACB at Q-63, so no data  >> <<04515>>15968000
<<  can be stacked before the call!                         >> <<04515>>15970000
<<**********************************************************>> <<04515>>15972000
                                                               <<04515>>15974000
$  IF X0 = ON                                                  <<04515>>15976000
   IF MONCALLABLE THEN << Monitoring? >>                       <<04515>>15978000
      BEGIN                                                    <<04515>>15980000
         TOS := "WR"; TOS := "IT"; TOS := "E'"; TOS := "FO";   <<04515>>15982000
         TOS := "PE"; TOS := "N'"; TOS := "RE"; TOS := "CO";   <<04515>>15984000
         FTITLE(*,*,*,*);                                      <<04515>>15986000
         DEBUG;                                                <<04515>>15988000
      END;                                                     <<04515>>15990000
$  IF                                                          <<04515>>15992000
                                                               <<04515>>15994000
  <<********************************************************>> <<04515>>15996000
  << Place ACB on stack in its Q-relative location.         >> <<04515>>15998000
  <<********************************************************>> <<04515>>16000000
                                                               <<04515>>16002000
  PUSH(STATUS);    << FLAB.(0:1) set to privmode bit of the >> <<04515>>16004000
  FLAGS := TOS;    << STATUS registar.                      >> <<04515>>16006000
  FLAGS.(1:15):=0; << Privmode check only.                  >> <<04515>>16008000
  GET'ACB'Q'LOC;                                               <<04515>>16010000
  LOC'ACB(DSTX,ACBMQ,FILENUM,FLAGS);                           <<04515>>16012000
  DSTX := TOS;   << LOC'ACB returns DSTX on top of stack!   >> <<04515>>16014000
                                                               <<04515>>16016000
  ACBCTL := 0;                                                 <<04515>>16018000
  ACBNEWEOF := 1;                                              <<04515>>16020000
  TOS := 3;                 <<Mode, 3 signifies FOPEN record>> <<04515>>16022000
  TOS := @FORMMSG /2;       <<Word address of forms message >> <<04515>>16024000
  TOS := RECSIZE;           <<Word count of forms message   >> <<04515>>16026000
  IOMOVE(*,*,*);            << Write FOPEN spoolfile record >> <<04515>>16028000
                                                               <<04515>>16030000
  SP'ACBBLK := ACBBLK;      << Return current block number  >> <<04515>>16032000
                                                               <<04515>>16034000
  UNLOC'ACB(ACBMQ,0);        << Release that ACB !!!!       >> <<04515>>16036000
                                                               <<04515>>16038000
END;                                                           <<04515>>16040000
$PAGE "  MPE-IV FILE SYSTEM - FOPEN THAT THERE FILE!!!! "      <<04515>>16042000
<<----------------------------------------------------------------------16044000
*                                                                      *16046000
*  CALLABLE INTRINSICS                                                 *16048000
*                                                                      *16050000
---------------------------------------------------------------------->>16052000
                                                               <<04713>>16054000
$ CONTROL SEGMENT = FILESYS6A                                           16058000
INTEGER PROCEDURE FOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,      <<KS.00>>16060000
   RECSIZE,                                                    <<KS.00>>16062000
   DEVICE,FORMMSG,USERLABELS,BLOCKFACTOR,PRICOPBUFS,FILESIZE,           16064000
   NUMEXTENTS,INITALLOC,FILECODE);                                      16066000
   <<MUST BE CALLED WITH DB SET TO THE STACK>>                          16068000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,USERLABELS,BLOCKFACTOR,PRICOPBUFS,   16070000
   FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;                              16072000
   BYTE ARRAY FORMDESIGNATOR,DEVICE,FORMMSG;                            16074000
   LOGICAL FOPTIONS,AOPTIONS;                                           16076000
   INTEGER RECSIZE,USERLABELS,BLOCKFACTOR,PRICOPBUFS,NUMEXTENTS,        16078000
   INITALLOC,FILECODE;                                                  16080000
   DOUBLE FILESIZE;                                                     16082000
   OPTION VARIABLE,PRIVILEGED;                                          16084000
   BEGIN                                                                16086000
   << >>                                                                16088000
   ENTRY DFOPEN;  <<DIRECT ACCESS FILE ONLY ENTRY POINT>>      <<00199>>16090000
   ENTRY FSOPEN;  << SPOOLFILE SEC ENTRY POINT >>                       16092000
   ENTRY FJOPEN;  << JOB/CI $STDXX SEC ENTRY POINT >>                   16094000
   ENTRY KSOPEN; <<KSAM SPECIAL ENTRY POINT>>                  <<KS.00>>16096000
   ENTRY PVOPEN;  << CONDITIONAL MOUNT ENTRY POINT >>          <<RV.PV>>16098000
   ENTRY MUSTOPEN;<< ENTRY POINT TO BYPASS LOCKWORD CHECK>>    <<RV.PV>>16100000
   << >>                                                                16102000
   ARRAY fcreateerr (*) = PB := nospace, discioerr,            <<03509>>16104000
   disc'space'allocation'disabled, navaildev,                  <<03509>>16106000
   undefdev, badextent, badoffset;                             <<03509>>16108000
   ARRAY SPCREATEERR(*)=PB := SPOOLBADEXT,SPOOLDEVDOWN,SPOOLNOSPACE,    16110000
      SPOOLERROR,SPOOLNOCLASS,SPOOLBADOFF;                              16112000
   INTEGER RESULT = FOPEN;                                              16114000
   LOGICAL PMAP = Q-4;  <<PARAMETER BIT MAP>>                           16116000
   DEFINE P'AOPS= PMAP.(5:1) #;                                <<00107>>16118000
   LOGICAL CHECKSEC := TRUE; <<FALSE ==> NO ASEC CHECK>>       <<00107>>16120000
   LOGICAL KSF; <<ONLY TRUE IF KSOPEN ENTRY POINT USED>>       <<KS.00>>16122000
   LOGICAL REMOTE:=FALSE;          <<REMOTE FILE FLAG>>        <<KS.00>>16124000
   LOGICAL MUSTOPEN'; <<TRUE IF MUSTOPEN ENTRY POINT USED>>    <<RV.PV>>16126000
   LOGICAL REOPENSTD := FALSE;  << REOPEN STDIN OR STDLIST >>  <<04133>>16128000
   LOGICAL DIRACCF; <<ONLY TRUE IF DFOPEN ENTRY USED>>         <<00199>>16130000
   INTEGER POINTER ANPTR;                                               16132000
   INTEGER POINTER GNPTR;                                               16134000
   INTEGER DISP := 0;                                                   16136000
   DOUBLE LINKAGE'INDEXP := 0D;                                <<38.PV>>16138000
   INTEGER                                                     <<38.PV>>16140000
       LINKAGE = LINKAGE'INDEXP;                               <<38.PV>>16142000
   INTEGER JNUM;  <<JOB NUMBER>>                                        16144000
   LOGICAL SAVECHARS;  << Used in FSPOOLOPEN form FORMMSG.  >> <<04515>>16146000
   INTEGER SAVFOPNEQ;<< PRESERVE NO-EQUATE BIT >>              <<KJ.03>>16148000
   INTEGER SAVAOPS=REOPENSTD;                         <<01882>><<04133>>16150000
                                                               <<00630>>16152000
   EQUATE NEWDIRFILE = 0,    <<ADJUSTOPS PARAMS>>              <<00630>>16154000
          SERIALFILE = 1,                                      <<HM.00>>16156000
          MSGFILE    = 2;                                      <<HM.00>>16158000
$  IF X9=OFF                                                   <<00630>>16160000
   LOGICAL DISABLERIO := %10101; <<TRUE -- AIDS DISC PATCH>>   <<00630>>16162000
$  IF X9=ON                                                    <<00630>>16164000
   LOGICAL DISABLERIO := %01010; <<FALSE -- AIDS DISC PATCH>>  <<00630>>16166000
$  IF                                                          <<00630>>16168000
                                                                        16170000
   <<MISC. FILE PARAMETERS>>                                            16172000
                                                                        16174000
   INTEGER ARRAY FIDS (0:32);  <<FILE DESIGNATOR COPY>>                 16176000
   BYTE ARRAY FD (*) = FIDS;                                            16178000
   ARRAY FNAMES (0:15);  <<PARSED FILE NAMES>>                          16180000
   ARRAY FN (*) = FNAMES;  <<LOCAL FILE NAME>>                          16182000
   ARRAY GN (*) = FNAMES(4);  <<GROUP NAME>>                            16184000
   ARRAY AN (*) = FNAMES(8);  <<ACCOUNT NAME>>                          16186000
   ARRAY LW (*) = FNAMES(12);  <<LOCKWORD>>                             16188000
   BYTE ARRAY LWB(*) = LW;                                     <<DS.00>>16190000
   << Device specification copy >>                             <<02555>>16192000
   BYTE ARRAY DEVL(0:MAXDEVLEN);                               <<02555>>16194000
   INTEGER ARRAY WFMSG(0:85);                                  <<TL.02>>16196000
   BYTE ARRAY FMSG(*)=WFMSG;<<FILE EQUATION FORMS MSG>>        <<TL.02>>16198000
   BYTE ARRAY NOFORMS(0:1);                                    <<01139>>16200000
   LOGICAL FCOMTRIED := FALSE;  <<FILE EQUATION ATTEMPTED?>>            16202000
   LOGICAL DNTYPE := 0;  <<DESIGNATOR NAME TYPE>>                       16204000
INTEGER ARRAY MISC(0:3);  << for various local vars >>                  16206000
   DEFINE                                                               16208000
     DOMAIN =MISC(0)#,    << file domain from FOPS >>                   16210000
     BSIZE  =MISC(1)#,    << block size, words >>                       16212000
     DEFRS  =MISC(2)#,    << default rec. size, +words >>               16214000
     USECNT =MISC(3)#;    << device use count >>                        16216000
                                                                        16218000
                                                                        16220000
   <<MISC. DEVICE PARAMETERS>>                                          16222000
                                                                        16224000
   INTEGER DADDR := 0;  <<LOGICAL DEVICE NR.>>                          16226000
   LOGICAL VDADDR := 0;  <<VOLUME TABLE INDEX>>                         16228000
   INTEGER DTYPE := 0;  <<DEVICE TYPE>>                                 16230000
   DEFINE DACCCL = DTYPE.(10:3)#;  <<device access class>>     <<03578>>16232000
   ARRAY DEVINFO (0:8);  <<DEVICE INFO. TABLE>>                         16234000
   DOUBLE DISKADR;  <<DISC FILE SECTOR ADR.>>                           16236000
   INTEGER P1 = DISKADR;  <<SECTOR NR. - FIRST HALF>>                   16238000
   INTEGER P2 = DISKADR+1;  <<SECTOR NR. - SECOND HALF>>                16240000
   DOUBLE FADDR;  <<DISC FILE SECTOR NR.>>                              16242000
   INTEGER FADDRW1 = FADDR;  <<FILE ADDRESS - FIRST HALF>>              16244000
   INTEGER FADDRW2 = FADDR+1;  <<FILE ADDRESS - SECOND HALF>>           16246000
   INTEGER ACCESSW;  <<ALLOCATE ACCESS>>                                16248000
                                                                        16250000
   << DEVICEPARMS arrays >>                                    <<02524>>16252000
   BUILD'DEVPARMS;                                             <<02524>>16256000
                                                               <<02524>>16258000
   LOGICAL DEV'PARMS'LEN = S - 1;                              <<02524>>16260000
                                                               <<02555>>16262000
   LOGICAL REM'SPOOL'ID;      <<Return from FFILEINFO>>        <<02555>>16264000
                                                               <<02555>>16266000
   DEFINE                                                      <<02555>>16268000
     REMOTE'ACCESS'ERROR =                                     <<02555>>16270000
      BEGIN                                                    <<02555>>16272000
      FINDAFT;               <<Find AFT>>                      <<02555>>16274000
      TOS := 0D;                                               <<02555>>16276000
      DPS2 := TOS;                                             <<02555>>16278000
      DEL;                                                     <<02555>>16280000
      CONDCODE := CCL;                                         <<02555>>16282000
      SETPXFILE;                                               <<02555>>16284000
      PXFFOPEN := DP'REMOTE'ACCESS;                            <<02555>>16286000
      TOS := DP'REMOTE'ACCESS;                                 <<02555>>16288000
      GO BUM;                                                  <<02555>>16290000
      END#;                                                    <<02555>>16292000
DEFINE                                                         <<02555>>16294000
     ERR'SPULAB =                                              <<02555>>16296000
      BEGIN                                                    <<02555>>16298000
      CONDCODE := CCL;                                         <<02555>>16300000
      SETPXFILE;                                               <<02555>>16302000
      PXFFOPEN := DP'ENV'SPULAB'ERR;                           <<02555>>16304000
      TOS := DP'ENV'SPULAB'ERR;                                <<02555>>16306000
      RESULT := 0;      << Reset spool open to fail >>         <<02555>>16308000
      GO BUM;                                                  <<02555>>16310000
      END#;                                                    <<02555>>16312000
                                                               <<02555>>16314000
   <<JIT PARAMETERS>>                                                   16316000
                                                                        16318000
   INTEGER ARRAY JITINFO (0:23) = Q;  <<JIT INFO BUFFER>>               16320000
   INTEGER JID = JITINFO;                                               16322000
   LOGICAL ASEC = JITINFO+3;  <<ACCOUNT SECURITY BIT MAP>>              16324000
   DOUBLE GSEC = JITINFO+4;  <<GROUP SECURITY BIT MAP>>                 16326000
   ARRAY HANAME (*) = JITINFO(6);                                       16328000
   ARRAY HGNAME (*) = JITINFO(10);                                      16330000
   ARRAY LGNAME (*) = JITINFO(14);                                      16332000
   ARRAY USERID (*) = JITINFO(18);                                      16334000
   INTEGER ACCTINXPTR = JITINFO+22;                            <<38.PV>>16336000
   INTEGER GRPINXPTRWD = JITINFO+23;                           <<38.PV>>16338000
   DEFINE                                                      <<38.PV>>16340000
       JITPVF = (0:1) #,                                       <<38.PV>>16342000
       JITMTFFF = (1:1) #, <<INDEX TO APPROPRIATE DOUBLE>>     <<38.PV>>16344000
       GRPINXPTRF = (8:8) #,                                   <<38.PV>>16346000
       HVSPV = GRPINXPTRWD.JITPVF = 1 #,                       <<38.PV>>16348000
       JITMTFF = GRPINXPTRWD.JITMTFFF #,                       <<38.PV>>16350000
       GRPINXPTR = GRPINXPTRWD.GRPINXPTRF #;                   <<38.PV>>16352000
   DOUBLE                                                      <<38.PV>>16354000
       ACCTINDEX,                                              <<38.PV>>16356000
       GRPINDEX;                                               <<38.PV>>16358000
                                                                        16360000
   <<PCBX PARAMETERS>>                                                  16362000
                                                                        16364000
   INTEGER POINTER PCBX;  <<PCBX POINTER>>                              16366000
   INTEGER POINTER PXFILE;  <<PXFILE POINTER>>                          16368000
                                                                        16370000
   <<AFT PARAMETERS>>                                                   16372000
                                                                        16374000
   INTEGER AFTX;  <<AFT ENTRY INDEX>>                                   16376000
   INTEGER FILENUM = AFTX;  <<FILE NR.>>                                16378000
   LOGICAL AFTOPT := 0;  <<1ST WORD OF AFT ENTRY>>                      16380000
                                                                        16382000
   <<ACB PARAMETERS>>                                                   16384000
                                                                        16386000
   INTEGER AFTE; << AFT ENTRY WORD 0 >>                        <<DS.03>>16388000
   INTEGER PACBV := 0;  <<PHYSICAL ACB VECTOR>>                         16390000
   INTEGER LACBV := 0;  <<LOGICAL ACB VECTOR>>                          16392000
   DOUBLE ACBV'S = PACBV;  <<ACB VECTORS>>                              16394000
   LOGICAL LACBF;  <<LOG/PHYS ACB FLAG>>                                16396000
   INTEGER ACBDST;  <<DST NR. BEFORE FGETCB ON ACB>>                    16398000
   INTEGER POINTER ACB;  <<ACB POINTER>>                                16400000
   DOUBLE POINTER ACBDBL = ACB;                                         16402000
   DOUBLE ACBPARMS = ACBDST;  <<DST AND ACB>>                           16404000
   INTEGER FNAMEMQ;   << Q relative location of FNAME.      >> <<04624>>16406000
   LOGICAL STATE := [1/0,1/0,4/OTHERRD,1/0];  <<PARTIAL ACBSTATE>>      16408000
                                                                        16410000
   <<FCB PARAMETERS>>                                                   16412000
                                                                        16414000
   INTEGER POINTER FCB;  <<FCB POINTER>>                                16416000
   DOUBLE POINTER FCBDBL = FCB;                                         16418000
   INTEGER FCBV := 0;  <<FCB VECTOR>>                                   16420000
                                                               <<04624>>16422000
   INTEGER FCBMQ;     << Q relative location of FCB.        >> <<04624>>16424000
   INTEGER FCBSI := 0;  <<FCB SIZE>>                                    16426000
                                                               <<04624>>16428000
                                                                        16430000
   <<FILE LABEL PARAMETERS>>                                            16432000
                                                                        16434000
   INTEGER POINTER FLAB;  <<FILE LABEL POINTER>>                        16436000
   DOUBLE POINTER FLABDBL = FLAB;                                       16438000
   BYTE POINTER BFLAB;                                         <<02571>>16440000
                                                                        16442000
   <<SPOOLFILE USER LABEL 0>>                                  <<SP.11>>16444000
                                                               <<SP.11>>16446000
DEFINE                                                         <<SP.11>>16448000
   SPULAB'LDEV = FLAB       #,  << LDEV of active device >>             16450000
   SPULAB'CURREXT = FLAB(1) #,  << current extent being printed >>      16452000
   SPULAB'LASTBLOCK = FLAB(2)#, << last block actively printing >>      16454000
   SPULAB'LASTREC = FLAB(4)#,   << last record printing >>              16456000
   SPULAB'LASTULAB = FLAB(6).(0:8) #, << last used circular queue >>    16458000
   SPULAB'ULABENTRY = FLAB(6).(8:8)#, << last circ queue entry >>       16460000
   SPULAB'CHNSKIP = FLAB(7).(0:8)#,   << page eject channel >>          16462000
   SPULAB'LINESPERPAGE = FLAB(7).(8:8)#, <<# lines/page>>               16464000
   SPULAB'LASTFOPEN = FLAB(8).(0:8)#, << last FOPEN ulab >>             16466000
   SPULAB'FOPENENTRY = FLAB(8).(8:8)#, << last FOPEN entry >>           16468000
   SPULAB'TOTULAB = FLAB(9)#,    << total user labels alloc >><<SP.ENV>>16470000
   SPULAB'LASTPAGE = FLAB(10)#,  << last page printed >>      <<SP.ENV>>16472000
   SPULAB'LAST'ENV = FLAB(11)#,<<last used environment file>> <<SP.ENV>>16474000
                                 << name (36 bytes)   >>      <<SP.ENV>>16476000
   SPULAB'END      = FLAB(127)#; << end of user label 0>>     <<SP.ENV>>16478000
                                                               <<SP.11>>16480000
EQUATE                                                         <<SP.11>>16482000
   FOPENULABSIZE = 4,   << FOPEN entry size in u-label >>      <<SP.11>>16484000
   NUMSPULABS    = 27,  << number of spooler u-labels >>       <<SP.11>>16486000
   MAXFOPENULAB = 10,   << user labels used for FOPENS >>      <<SP.11>>16488000
   MAXFOPENENTRY = 31;  << nr. of 4-word entries per u-label >><<SP.11>>16490000
                                                               <<SP.11>>16492000
   INTEGER ULAB,ULABENTRY;                                     <<SP.11>>16494000
   DOUBLE SP'ACBBLK;  <<VARIABLE BLOCK COUNT>>                 <<SP.11>>16496000
                                                               <<SP.11>>16498000
   LOGICAL ALLOC'RESULT;                                       <<00635>>16500000
   <<RESOURCE FLAGS>>                                                   16502000
                                                                        16504000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   16506000
   INTEGER A := -1;  <<USED BY GETSIR>>                                 16508000
   INTEGER B:= -1;  <<USED BY FMAVTSIR>>                                16510000
   LOGICAL PACBLOCKED := FALSE;  <<SPECIAL PACB LOCK FLAG>>             16512000
   LOGICAL RESOURCES := FALSE;  <<FOR ERROR RECOVERY>>                  16514000
   DEFINE DISKLOCK = (15:1)#,  <<DISC SPACE ALLOCATED?>>                16516000
          DEVICELOCK = (14:1)#,  <<DEVICE ALLOCATED?>>                  16518000
          ACBLOCK = (13:1)#,  <<ACB CREATED?>>                          16520000
          FCBLOCK  = (12:1)#,  <<FCB CREATED>>                 <<RV.PV>>16522000
          DSLOCK   = (11:1)#,  <<DS LINE OPENED>>              <<RV.PV>>16524000
          DMOUNT   = (10:1) #; <<VOLUME SET WAS MOUNTED>>      <<RV.PV>>16526000
                                                                        16528000
   <<JOB/CI $STDXX ACCESS>>                                             16530000
                                                                        16532000
   LOGICAL JOBF;                                                        16534000
                                                                        16536000
   <<SPOOLFILE ACCESS>>                                                 16538000
                                                                        16540000
   INTEGER XDDX = RECSIZE;                                              16542000
   ARRAY SPINFO(0:13) = Q;                                              16544000
   LOGICAL SPOOLF = SPINFO+0;                                           16546000
   INTEGER POINTER XDDEP = SPINFO+1;                                    16548000
   INTEGER SPDADDR       = SPINFO+2;                                    16550000
   DOUBLE  SPDISKADDR    = SPINFO+3;                                    16552000
   INTEGER SPDISK1 = SPDISKADDR + 0;                                    16554000
   INTEGER SPDISK2 = SPDISKADDR + 1;                                    16556000
   INTEGER SPVDEV  = SPINFO+5;                                          16558000
   INTEGER SPFOPT  = SPINFO+6;                                          16560000
   INTEGER SPAOPT  = SPINFO+7;                                          16562000
   INTEGER SPREC   = SPINFO+8;                                          16564000
   INTEGER SPSTATE= SPINFO+9;                                           16566000
   ARRAY SPFN(*) = SPINFO+10;                                           16568000
   EQUATE SPOOLEDCLASS = -3; <<DEVICE CLASS IS SPOOLED>>       <<00635>>16570000
                                                                        16572000
   << RFA ACCESS >>                                            <<DS.00>>16574000
                                                               <<DS.00>>16576000
   INTEGER POINTER RFAPTR; << STACK APPENDAGE POINTER >>       <<DS.00>>16578000
   INTEGER RFALEN; << APPENDAGE LENGTH >>                      <<DS.00>>16580000
   INTEGER RFALINENUM; << FILE NUMBER OF REMOTE LINE >>        <<DS.00>>16582000
   INTEGER RFAFILENUM; << FILE NUM. OF REMOTE FILE >>          <<DS.00>>16584000
   EQUATE RFAAFTOP = %010000; << RFA AFT(0) ENTRY >>           <<DS.00>>16586000
   INTEGER PIN;   << FOR LOCATING CI PCB >>                    <<DS.06>>16588000
   BYTE ARRAY LOGICAL'DEV(0:3); << MASTER CPU LOGICAL DEV >>   <<DS.04>>16590000
                                                               <<DS.00>>16592000
   << Redirection of $STDIN and $STDLIST declarations >>       <<01425>>16594000
                                                               <<01425>>16596000
   LOGICAL ARRAY REDIRECT'INFO(0:24);                          <<01425>>16598000
                                                               <<01425>>16600000
   DEFINE REDIRECT'FOPTS  = REDIRECT'INFO#,                    <<01425>>16602000
          REDIRECT'AOPTS  = REDIRECT'INFO(1)#,                 <<01425>>16604000
          REDIRECT'DVTYPE = REDIRECT'INFO(2)#,                 <<01425>>16606000
          REDIRECT'LDEV   = REDIRECT'INFO(3)#,                 <<01425>>16608000
          REDIRECT'HDADDR = REDIRECT'INFO(4)#,                 <<01425>>16610000
          REDIRECT'FDESIG = REDIRECT'INFO(5)#,                 <<01425>>16612000
          REDIRECT'ASCDEV = REDIRECT'INFO(23)#;                <<01425>>16614000
          <<       ASCDEV = REDIRECT'INFO(24)  also >>         <<01425>>16616000
                                                               <<01425>>16618000
      INTEGER ERRORCODE;   << FCHECK PARM >>                   <<03091>>16620000
                                                               <<03091>>16622000
   EQUATE STDIN'FOPCODE   = 4,        << $STDIN foption code >><<01425>>16624000
          STDLIST'FOPCODE = 1,        << $STDLIST code >>      <<01425>>16626000
          NULL'FOPCODE    = 6,        << $NULL code >>         <<01490>>16628000
          NEWFILE         = 0,        << New file type >>      <<01425>>16630000
          DEFLT'MODE      = 0,        << Default Access >>     <<01425>>16632000
          EXCL'MODE       = 1,        << Exclusive Access >>   <<01425>>16634000
          READACC         = 0;        << Read Only Access >>   <<01425>>16636000
                                                               <<01425>>16638000
INTEGER CTFLAGS;                                               <<TL.02>>16640000
   DEFINE OUTPRI      = PRICOPBUFS.(0:4)#,                              16642000
          NUMCOPIES   = PRICOPBUFS.(4:7)#,                              16644000
          NUMBUFFERS  = PRICOPBUFS.(11:5)#;                             16646000
                                                                        16648000
   << PRIVATE VOLUME DECLARATIONS >>                           <<RV.PV>>16650000
   EQUATE                                                      <<RV.PV>>16652000
       UNCONDDISMOUNT = 2,                                     <<RV.PV>>16654000
       UNCONDMOUNT = 2,                                        <<RV.PV>>16656000
       CONDMOUNT = -3,                                         <<RV.PV>>16658000
       CONDDISMOUNT = -3;                                      <<RV.PV>>16660000
   INTEGER                                                     <<RV.PV>>16662000
       HVSIND := [8/"*", 8/" "],                               <<RV.PV>>16664000
       REQTYPE := UNCONDMOUNT,                                 <<RV.PV>>16666000
       PVINFO := 0;                                            <<RV.PV>>16668000
   LOGICAL                                                     <<RV.PV>>16670000
       PVOPEN';                                                <<RV.PV>>16672000
   DEFINE                                                      <<RV.PV>>16674000
       CLASSFLG = PVINFO.(0:1) #,                              <<RV.PV>>16676000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>16678000
       VMASK  = PVINFO.(8:8) #;                                <<RV.PV>>16680000
   ARRAY                                                       <<RV.PV>>16682000
       GENTRY (0:GSIZE-1);                                     <<RV.PV>>16684000
                                                               <<HM.00>>16686000
                                                               <<HM.00>>16688000
   << IPC ACCESS >>                                            <<HM.00>>16690000
                                                               <<HM.00>>16692000
   <<*******************************************************>> <<04515>>16694000
   <<  ATTENTION!!!   ATTENTION!!!   ATTENTION!!!           >> <<04515>>16696000
   <<  If any variables are needed to be added, please use  >> <<04515>>16698000
   <<  the storage space in the direct Q relative array     >> <<04515>>16700000
   <<  EXTRA'QSPACE as used below.                          >> <<04515>>16702000
   <<*******************************************************>> <<04515>>16704000
                                                               <<04515>>16706000
  ARRAY EXTRA'QSPACE (0:10) = Q;                               <<04311>>16708000
  ARRAY IPCINFO(*) = EXTRA'QSPACE;                             <<04311>>16710000
  DOUBLE ARRAY IPCINFOD(*) = IPCINFO;                          <<04311>>16712000
   DEFINE  FILELIMIT    =IPCINFOD#,                            <<HM.00>>16714000
           EXTRECORDS   =IPCINFOD(1)#,                         <<HM.00>>16716000
           USERAOPTIONS =IPCINFO(4)#,                          <<HM.00>>16718000
           USERBLKFACTOR=IPCINFO(5)#;                          <<HM.00>>16720000
                                                               <<04515>>16722000
                                                               <<04311>>16724000
  DEFINE                                                       <<04311>>16726000
           REM'FOPT      = EXTRA'QSPACE(9)#,                   <<04311>>16728000
           REM'FCODE     = EXTRA'QSPACE(10)#,                  <<04311>>16730000
           REM'KSAM'FOPT = (REM'FOPT.(2:3) =1)#,               <<04311>>16732000
           REM'KSAM'FCODE= (REM'FCODE = 1080)#;                <<04311>>16734000
                                                               <<RV.PV>>16736000
   INTRINSIC ASCII;                                            <<DS.04>>16738000
                                                               <<DS.04>>16740000
   INTRINSIC WHO;                                              <<RV.PV>>16742000
                                                               <<RV.PV>>16744000
LOGICAL SUBROUTINE DEV'PARMS'LEN';                             <<02524>>16746000
COMMENT                                                        <<02524>>16748000
The DEVPARMS entry for each token contains the length of       <<02524>>16750000
the parameter plus one for a terminator. Also space has        <<02524>>16752000
to be provided for a terminator for the list of parameters.    <<02524>>16754000
;                                                              <<02524>>16756000
   BEGIN                                                       <<02524>>16758000
   DEV'PARMS'LEN := 0;                                         <<02524>>16760000
   IF GET'DEV'PARM(OUTQ'TOKEN, DEVPARMS, DP'INDEX) THEN        <<02524>>16764000
      DEV'PARMS'LEN := DEV'PARMS'LEN + DEVPARMS(DP'INDEX) + 5; <<02524>>16766000
   IF GET'DEV'PARM(DEN'TOKEN, DEVPARMS, DP'INDEX) THEN         <<02524>>16768000
      DEV'PARMS'LEN := DEV'PARMS'LEN + DEVPARMS(DP'INDEX) + 4; <<02524>>16770000
   IF DEV'PARMS'LEN <> 0 THEN                                  <<02524>>16772000
      BEGIN                                                    <<02524>>16774000
      DEV'PARMS'LEN := DEV'PARMS'LEN + 1; << terminator >>     <<02524>>16776000
      IF DEV'PARMS'LEN THEN  << odd count >>                   <<02524>>16778000
         DEV'PARMS'LEN := DEV'PARMS'LEN + 1;                   <<02524>>16780000
      END;                                                     <<02524>>16782000
   END; << subroutine DEV'PARMS'LEN >>                         <<02524>>16784000
                                                               <<00630>>16786000
   LOGICAL SUBROUTINE REDIRECT'IT (STDX'NUM, FOPT'CODE);       <<01425>>16788000
      VALUE STDX'NUM, FOPT'CODE;                               <<01425>>16790000
      INTEGER STDX'NUM, FOPT'CODE;                             <<01425>>16792000
   BEGIN                                                       <<01425>>16794000
      COMMENT:                                                 <<01425>>16796000
         Determines whether an FOPEN of '$STDIN', '$STDINX',   <<01425>>16798000
         or '$STDLIST' other than the original FOPEN (in       <<01425>>16800000
         INITIATE) should be redirected to the non-standard    <<01425>>16802000
         $STDIN or $STDLIST.                                   <<01425>>16804000
                                                               <<01425>>16806000
         Returns TRUE if the FOPEN should be redirected and    <<01425>>16808000
         sets the parameter values appropriately so that the   <<01425>>16810000
         FOPEN can be started over again with the correct      <<01425>>16812000
         parameter values.                                     <<01425>>16814000
      ;                                                        <<01425>>16816000
                                                               <<01425>>16818000
      REDIRECT'INFO := "  ";                                   <<01425>>16820000
      MOVE REDIRECT'INFO(1) := REDIRECT'INFO, (24);            <<01425>>16822000
                                                               <<01425>>16824000
      FFILEINFO (STDX'NUM, 1, REDIRECT'FDESIG,                 <<01425>>16826000
                 2, REDIRECT'FOPTS, 3, REDIRECT'AOPTS,         <<01425>>16828000
                 5, REDIRECT'DVTYPE, 6, REDIRECT'LDEV);        <<01425>>16830000
      FFILEINFO (STDX'NUM, 7, REDIRECT'HDADDR);                <<01425>>16832000
      IF <> THEN      << TOO BIG DRT NUMBER? >>                <<03091>>16834000
         BEGIN                                                 <<03091>>16836000
         FCHECK(STDX'NUM, ERRORCODE);                          <<03091>>16838000
         IF ERRORCODE = TOOBIGDRT THEN                         <<03091>>16840000
            REDIRECT'HDADDR.(0:8) := 255; <<ARBITRARY NON-ZERO><<03091>>16842000
         END;                                                  <<03091>>16844000
                                                               <<04765>>16846000
      IF REDIRECT'FOPTS.(2:3)=1 THEN                           <<04765>>16848000
         BEGIN << KSAM file not allowed for re-direction.   >> <<04765>>16850000
         TOS := KSAMSTD;                                       <<04765>>16852000
         GO ERR;                                               <<04765>>16854000
         END;                                                  <<04765>>16856000
                                                               <<04765>>16858000
                                                               <<01425>>16860000
<< Don't redirect the FOPEN if the file  is  redirected  to >> <<02309>>16862000
<< itself. For the purpose of this test, $STDIN and $STDINX >> <<02309>>16864000
<< are considered to be the same file, that is, REDIRECT'IT >> <<02309>>16866000
<< is returned false if the caller is  trying  to  redirect >> <<02309>>16868000
<< $STDIN to $STDINX or vice versa.                         >> <<02309>>16870000
                                                               <<02309>>16872000
      IF REDIRECT'FOPTS.FOPDESIGNATORF = LOGICAL (FOPT'CODE)   <<02309>>16874000
        OR (REDIRECT'FOPTS.FOPDESIGNATORF LAND 6) =            <<02309>>16876000
             STDIN'FOPCODE                                     <<02309>>16878000
          AND (LOGICAL(FOPT'CODE) LAND 6) = STDIN'FOPCODE THEN <<02309>>16880000
         REDIRECT'IT := FALSE   << Don't redirect the open >>  <<01425>>16882000
      ELSE IF REDIRECT'AOPTS.(8:2) = EXCL'MODE OR              <<01425>>16884000
              (REDIRECT'FOPTS.(14:2) = NEWFILE LAND            <<01425>>16886000
               FOPT'CODE = 4  LAND <<$STDIN>>                  <<04518>>16888000
               REDIRECT'DVTYPE.(8:8) <= FHDISK LAND            <<01490>>16890000
               REDIRECT'FOPTS.(10:3) <> NULL'FOPCODE) THEN     <<01490>>16892000
         BEGIN  << Exclusive Access Violation >>               <<01425>>16894000
         TOS := EXSHERR2;   << Excl. Access Err - FSERR91 >>   <<01425>>16896000
         GO ERR;                                               <<01425>>16898000
         END                                                   <<01425>>16900000
      ELSE                                                     <<01425>>16902000
         BEGIN  << Redirect the file open >>                   <<01425>>16904000
         REDIRECT'IT := TRUE;                                  <<01425>>16906000
         << Set bits in FOPEN's option variable mask to     >> <<01425>>16908000
         << indicate only formal desig, fopts, and aopts.   >> <<01425>>16910000
         PMAP := %16000;                                       <<01425>>16912000
         FOPTIONS := REDIRECT'FOPTS;                           <<01425>>16914000
         AOPTIONS := REDIRECT'AOPTS;                           <<01425>>16916000
         @FORMDESIGNATOR := @REDIRECT'FDESIG & LSL(1);         <<01425>>16918000
         << Reset to do name check if file is not spooled   >> <<01490>>16920000
         << or if file is $NULL.                            >> <<01490>>16922000
         IF REDIRECT'HDADDR.(0:8) <> 0 OR                      <<01490>>16924000
            REDIRECT'FOPTS.(10:3) = NULL'FOPCODE THEN          <<01490>>16926000
            DNTYPE := 0;                                       <<01490>>16928000
                                                               <<01425>>16930000
         IF REDIRECT'DVTYPE.(8:8) <= FHDISK THEN               <<01425>>16932000
            PMAP.(7:1) := 0   << Default to DISC >>            <<01425>>16934000
         ELSE                                                  <<01425>>16936000
            BEGIN  << Non-DISC device >>                       <<01425>>16938000
            X := ASCII (REDIRECT'LDEV, -10, REDIRECT'INFO(24));<<01425>>16940000
            CASE X-1 OF                                        <<01425>>16942000
               BEGIN  << Add ldev leading zeros as needed >>   <<01425>>16944000
               << 1 >>   REDIRECT'ASCDEV := "00";              <<01425>>16946000
               << 2 >>   REDIRECT'ASCDEV.(0:8) := "0";         <<01425>>16948000
               << 3 >>   ;                                     <<01425>>16950000
               END;                                            <<01425>>16952000
            @DEVICE := @REDIRECT'ASCDEV & LSL(1);              <<01425>>16954000
            PMAP.(7:1) := 1;                                   <<01425>>16956000
            END;                                               <<01425>>16958000
         END << Redirect the open >>;                          <<01425>>16960000
      END << REDIRECT'IT >>;                                   <<01425>>16962000
                                                               <<01425>>16964000
                                                               <<00630>>16966000
   SUBROUTINE MASSAGEAOPTIONS;                                 <<HM.01>>16968000
      BEGIN                                                    <<HM.01>>16970000
      IF AOPREAD THEN                                          <<HM.01>>16972000
         BEGIN  <<MINIMUM OF EAR>>                             <<HM.01>>16974000
         IF AOPACMODE <> 1 THEN AOPACMODE:=2;                  <<HM.01>>16976000
         END                                                   <<HM.01>>16978000
      ELSE                                                     <<HM.01>>16980000
         BEGIN                                                 <<HM.01>>16982000
         AOPACTYPE:=1;                                         <<HM.01>>16984000
         AOPACMODE:=1;  <<WRITER GETS EXCLUSIVE ACCESS>>       <<HM.01>>16986000
         END;                                                  <<HM.01>>16988000
      END;  <<MASSAGEAOPTIONS>>                                <<HM.01>>16990000
                                                               <<HM.01>>16992000
                                                               <<HM.01>>16994000
   INTEGER SUBROUTINE ADJUSTMSGPARMS;                          <<HM.00>>16996000
      BEGIN                                                    <<HM.00>>16998000
      FILELIMIT:=FILESIZE;                                     <<HM.00>>17000000
      EXTRECORDS:=0D;                                          <<HM.00>>17002000
      BLOCKFACTOR:=USERBLKFACTOR;                              <<HM.00>>17004000
      ADJUSTMSGPARMS:=-1;                                      <<HM.00>>17006000
      IF AOPCOPY THEN                                          <<HM.00>>17008000
         BEGIN  <<REPLICATE A MSG FILE>>                       <<HM.00>>17010000
         AOPACMODE := 1;  << Exclusive access >>               <<01882>>17012000
         IF NOT AOPREAD THEN AOPACTYPE:=1;  <<only Read/Write>><<03035>>17014000
         FOPFORMAT:=1;                                         <<HM.00>>17016000
         IF AOPWRITE AND NOT AOPINHIBITBUF THEN                <<HM.00>>17018000
            ADJUSTMSGPARMS:=ACCVIOL;                           <<HM.00>>17020000
         END                                                   <<HM.00>>17022000
      ELSE                                                     <<HM.00>>17024000
         BEGIN  <<MSG ACCESS MODE>>                            <<HM.00>>17026000
         AOPTIONS:=USERAOPTIONS;                               <<HM.00>>17028000
         IF AOPACTYPE > 3 THEN                                 <<HM.00>>17030000
            ADJUSTMSGPARMS:=ACCVIOL                            <<HM.00>>17032000
         ELSE                                                  <<HM.00>>17034000
            BEGIN                                              <<HM.00>>17036000
            IF AOPACTYPE = 2 THEN AOPACTYPE:=3;                <<HM.00>>17038000
            IF AOPMULTAC = 0 THEN AOPMULTAC:=2;                <<HM.00>>17040000
            IF AOPACMODE = 0 THEN AOPACMODE:=1;                <<HM.00>>17042000
            AOPINHIBITBUF:=0;                                  <<HM.00>>17044000
            AOPMULTIREC:=0;                                    <<HM.00>>17046000
            FTYPE:=MSG'TYPE;                                   <<HM.00>>17048000
            IF FOPFORMAT > 1 THEN FOPFORMAT:=1;                <<HM.00>>17050000
            END;                                               <<HM.00>>17052000
         END;                                                  <<HM.00>>17054000
      END  <<ADJUSTMSGPARMS>>;                                 <<HM.00>>17056000
                                                               <<HM.00>>17058000
                                                               <<HM.00>>17060000
   INTEGER SUBROUTINE ADJUSTCIRPARMS;                          <<HM.00>>17062000
      BEGIN                                                    <<HM.00>>17064000
      ADJUSTCIRPARMS:=-1;                                      <<HM.00>>17066000
      IF AOPCOPY THEN                                          <<HM.01>>17068000
         MASSAGEAOPTIONS                                       <<HM.01>>17070000
      ELSE IF NOT AOPREAD THEN                                 <<HM.01>>17072000
         AOPINHIBITBUF:=0;                                     <<HM.00>>17074000
      IF NOT AOPINHIBITBUF THEN AOPMULTIREC:=0;                <<HM.00>>17076000
      IF AOPSEMI THEN                                          <<HM.00>>17078000
         AOPACMODE:=IF AOPREAD THEN 3 ELSE 1;                  <<HM.00>>17080000
      IF NOT AOPREAD THEN                                      <<HM.00>>17082000
         BEGIN                                                 <<HM.00>>17084000
         IF AOPMULTAC = 0 THEN AOPMULTAC:=2;                   <<HM.00>>17086000
         IF AOPWRITESAVE THEN                                  <<HM.00>>17088000
            AOPACTYPE:=3  <<SET IT TO APPEND>>                 <<HM.00>>17090000
         ELSE IF AOPACTYPE > 3 THEN                            <<HM.00>>17092000
            ADJUSTCIRPARMS:=ACCVIOL;                           <<HM.00>>17094000
         END;                                                  <<HM.00>>17096000
      END;  <<ADJUSTCIRPARMS>>                                 <<HM.00>>17098000
                                                               <<HM.01>>17100000
   INTEGER SUBROUTINE ADJUSTOPS(ADJTYPE);                      <<00630>>17102000
      VALUE ADJTYPE;                                           <<00630>>17104000
      INTEGER ADJTYPE;                                         <<00630>>17106000
   BEGIN                                                       <<00630>>17108000
      COMMENT:                                                 <<00630>>17110000
         RESOLVE ANY INCONSISTENCIES VIS-A-VIS FOPS AND AOPS.  <<00630>>17112000
         RETURN ERROR CODE (>=0), OR -1 IF NO ERRORS.          <<00630>>17114000
                                                               <<00630>>17116000
         NOTE THAT ADJUSTMENTS TO OLD FILES ARE HANDLED IN     <<00630>>17118000
         "FOPENDA".                                            <<00630>>17120000
         ;                                                     <<00630>>17122000
                                                               <<00630>>17124000
      IF DISABLERIO AND FOPRIO THEN                            <<00630>>17126000
         BEGIN                                                 <<00630>>17128000
         ADJUSTOPS := UNIMPL;                                  <<00630>>17130000
         RETURN;                                               <<00630>>17132000
         END;                                                  <<00630>>17134000
      ADJUSTOPS := -1;                                         <<00630>>17136000
      CASE ADJTYPE OF                                          <<00630>>17138000
         BEGIN                                                 <<00630>>17140000
         <<0>> BEGIN <<NEW FILE,$NEWPASS,$NULL,NO-NAME>>       <<00630>>17142000
               IF FOPMSGFILE THEN                              <<01717>>17144000
                  ADJUSTOPS:=ADJUSTMSGPARMS                    <<HM.00>>17146000
               ELSE IF FOPCIRFILE THEN                         <<HM.00>>17148000
                  BEGIN                                        <<HM.00>>17150000
                  ADJUSTOPS:=ADJUSTCIRPARMS;                   <<HM.00>>17152000
                  TOS:=FILESIZE;  <<ROUND # RECS TO FILL BLK>> <<HM.00>>17154000
                  TOS:=BLOCKFACTOR;                            <<HM.00>>17156000
                  ASSEMBLE(LDIV,ZROB;TEST);                    <<HM.00>>17158000
                  IF <> THEN                                   <<HM.00>>17160000
                     TOS:=-TOS+BLOCKFACTOR; <<ROUND UP TO BLOCK  HM.00>>17162000
                  FILESIZE:=TOS+FILESIZE;                      <<HM.00>>17164000
                  END                                          <<HM.00>>17166000
               ELSE IF FOPRIO THEN                             <<00630>>17168000
                  BEGIN                                        <<00630>>17170000
                  FOPFORMAT := 0;  <<FIXED>>                   <<00630>>17172000
                  AOPCOPY := 0;                                <<HM.00>>17174000
                  IF NOT AOPINHIBITBUF THEN                    <<00630>>17176000
                     BEGIN                                     <<00630>>17178000
                     AOPMULTIREC := 0;                         <<00630>>17180000
                     AOPNOWAIT := 0;                           <<00630>>17182000
                     END;                                      <<00630>>17184000
                  END;                                         <<00630>>17186000
               END; <<0>>                                      <<00630>>17188000
                                                               <<00630>>17190000
          <<1>> BEGIN <<NON-DIRECT DEV,$STDIN(X),$STDLIST>>    <<00630>>17192000
                FOPFILETYPE := 0;                              <<HM.00>>17194000
                END;                                           <<00630>>17196000
          <<2>> ADJUSTOPS:=ADJUSTMSGPARMS;  <<MSG FILE>>       <<HM.00>>17198000
          END; <<CASES>>                                       <<00630>>17200000
   END; <<SUBROUTINE ADJUSTOPS>>                               <<00630>>17202000
                                                               <<00630>>17204000
                                                               <<00630>>17206000
   SUBROUTINE RBSIZE;                                                   17208000
      <<COMPUTES THE RECORD SIZE, BLOCK SIZE AND, IF DEFAULT            17210000
        BLOCKING IS SPECIFIED, THE BLOCKING FACTOR>>                    17212000
      BEGIN                                                             17214000
      IF DTYPE=FDISC THEN <<FOREIGN DISC>>                     <<01115>>17216000
        BEGIN                                                  <<01115>>17218000
        RECSIZE:=128;  <<EXCEPT FOR IBM FLOPPIES>>             <<01115>>17220000
        IF LDEVTOTYPE(DADDR)=2 THEN <<IT'S A FLOPPY>>          <<01115>>17222000
          BEGIN <<CHECK FOR IBM>>                              <<01115>>17224000
          TOS:=REQSTATUS(DADDR);  <<DEVICE STATUS>>            <<01115>>17226000
          ASSEMBLE(XCH; DEL; EXF 3:4); <<TTTT FIELD>>          <<01115>>17228000
          IF TOS=8 THEN RECSIZE:=64; <<IT IS IBM>>             <<01115>>17230000
          END;                                                 <<01115>>17232000
        END;                                                   <<01115>>17234000
      TOS := RECSIZE;  <<REC. SIZE>>                                    17236000
      IF = THEN TOS := TOS+DEFRS;  <<USE DEFAULT RECORD SIZE?>>         17238000
      IF < THEN  <<REC. SIZE IN (NEG.) BYTES?>>                         17240000
         TOS := -TOS  <<POS. BYTES>>                                    17242000
      ELSE  <<REC. SIZE IN (POS.) WORDS>>                               17244000
         BEGIN                                                 <<01.01>>17246000
         TOS := TOS&LSL(1);  <<POS. BYTES>>                             17248000
         IF < THEN        <<OVERSIZE RECORD>>                  <<RV.RV>>17250000
         BEGIN                                                 <<RV.RV>>17252000
             TOS := INVDRECSIZE;                               <<RV.RV>>17254000
             GO TO ERR;                                        <<RV.RV>>17256000
         END;                                                  <<RV.RV>>17258000
         END;                                                  <<01.01>>17260000
      IF NOT SPOOLF THEN                                                17262000
         IF FOPCONTROL THEN TOS := TOS+1;  <<CARRIAGE CONTROL?>>        17264000
      IF NOT FOPASCII THEN TOS := (TOS+1)&LSR(1)&LSL(1);  <<EVEN BYTES>>17266000
      RECSIZE := TOS;  <<REC. SIZE IN BYTES>>                           17268000
      IF NOT AOPINHIBITBUF AND STATE.DEFAULTBF THEN  <<DEFAULT?>>       17270000
         BEGIN                                                          17272000
         BLOCKFACTOR := (DEFRS&LSL(1)/RECSIZE);                <<01968>>17274000
         IF = THEN BLOCKFACTOR := 1                                     17276000
         ELSE IF BLOCKFACTOR > 255 THEN BLOCKFACTOR := 255;    <<01968>>17278000
         END;                                                           17280000
      BSIZE:=GETBLKSIZE(RECSIZE,BLOCKFACTOR,FOPTIONS);         <<00630>>17282000
      IF OVERFLOW THEN                                         <<00630>>17284000
      BEGIN                                                    <<RV.PV>>17286000
          TOS := INVDBLKSIZE;                                  <<RV.PV>>17288000
          GO TO ERR;                                           <<RV.PV>>17290000
      END;                                                     <<RV.PV>>17292000
      END;                                                              17294000
                                                                        17296000
   SUBROUTINE LABELIO (RW,FLAG);                                        17298000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           17300000
                                                                        17302000
        INPUT VARIABLES:                                                17304000
            RW - I/O MODE                                               17306000
               0 - READ                                                 17308000
               1 - WRITE                                                17310000
            FLAG - ERROR RECOVERY STRATEGY                              17312000
               0 - CALL FLABIOERR WITH A ZERO FILE NUMBER               17314000
               1 - CALL FLABIOERR WITH A FILE NAME ARRAY                17316000
               2 - CLEAR $OLDPASS REFERENCE IN JIT                      17318000
                                                                        17320000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE IS   17322000
        CALLED>>                                                        17324000
      VALUE RW,FLAG;                                                    17326000
      INTEGER RW,FLAG;                                                  17328000
      BEGIN                                                             17330000
      X := FLABIO(DADDR,DISKADR,RW,FLAB);  <<R/W LABEL>>                17332000
      IF <> THEN  <<ERROR?>>                                            17334000
         BEGIN                                                          17336000
         IF FLAG = 0 THEN  <<FILE NUMBER NOT AVAILABLE?>>               17338000
            FLABIOERR(X,0)                                              17340000
         ELSE IF FLAG = 1 THEN  <<FILE NAME AVAILABLE?>>                17342000
            FLABIOERR(X,0,@FN)                                          17344000
         ELSE  <<SPECIAL CASE FOR $OLDPASS>>                            17346000
            BEGIN                                                       17348000
            FLABIOERR(X,0);                                             17350000
            FADDR := 0D;  <<TEMP CELL FOR 0D>>                          17352000
            TOS := PXGJITDST; TOS := JITPFP&LSL(1);                     17354000
            TOS := @FADDR;                                              17356000
            TOS := 2;                                                   17358000
            ASSEMBLE(MTDS 4)  <<CLEAR $OLDPASS CELL IN JIT>>            17360000
            END;                                                        17362000
         TOS := LBLIOERR;                                               17364000
         GO ERR                                                         17366000
         END                                                            17368000
      END;                                                              17370000
                                                                        17372000
   SUBROUTINE SPOOLFOPEN;                                               17374000
      <<WRITES FOPEN CONTROL + FORMS MSG IF OUTPUT SPOOLFILE            17376000
        DB MUST BE SET TO STACK >>                                      17378000
      BEGIN                                                             17380000
      IF AOPWRITE AND (JOBF OR (RESULT > 2) OR                 <<01882>>17382000
         GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX)) THEN       <<01882>>17384000
         BEGIN                                                          17386000
                                                               <<04515>>17388000
         <<*************************************************>> <<04515>>17390000
         << If FORMMSG is specified, set up RECSIZE length. >> <<04515>>17392000
         << If the FORMMGS is on an odd byte count, we must >> <<04515>>17394000
         << place a blank in front of the byte pointed to   >> <<04515>>17396000
         << by FORMMSG and start from FORMMSG(-1).          >> <<04515>>17398000
         <<*************************************************>> <<04515>>17400000
                                                               <<04515>>17402000
          SAVECHARS := "  ";     << Initialize save characs.>> <<04515>>17404000
          IF NOT PMAP.(8:1) THEN                               <<04515>>17406000
             RECSIZE := 0   << No forms message             >> <<04515>>17408000
             ELSE                << Forms message specified >> <<04515>>17410000
               BEGIN                                           <<04515>>17412000
               SAVECHARS.(0:8) := FORMMSG(49); << Place "." >> <<04515>>17414000
               FORMMSG(49) := "."; << to insure termination >> <<04515>>17416000
               IF @FORMMSG.(15:1) = 0 THEN                     <<04515>>17418000
                  BEGIN  << Even byte count, easy case.     >> <<04515>>17420000
                  SCAN FORMMSG UNTIL "..",1;                   <<04515>>17422000
                  RECSIZE := - (TOS - @FORMMSG);               <<04515>>17424000
                  END                                          <<04515>>17426000
               ELSE                                            <<04515>>17428000
                  BEGIN  <<Odd byte count, hard case.       >> <<04515>>17430000
                  SAVECHARS.(8:8) := FORMMSG(-1);              <<04515>>17432000
                  FORMMSG(-1) := " ";  << Leading blank     >> <<04515>>17434000
                  SCAN FORMMSG(-1) UNTIL "..",1;               <<04515>>17436000
                  RECSIZE := - (TOS - @FORMMSG(-1));           <<04515>>17438000
                  END;                                         <<04515>>17440000
               FORMMSG(49) := SAVECHARS.(0:8);                 <<04515>>17442000
               END;                                            <<04515>>17444000
                                                               <<04515>>17446000
         << Write special spoolfile FOPEN record.           >> <<04515>>17448000
                                                               <<04515>>17450000
         WRITE'FOPEN'RECORD(RECSIZE,FORMMSG,SP'ACBBLK,AFTX);   <<04515>>17452000
                                                               <<04515>>17454000
         << Place character back in case of odd byte address>> <<04515>>17456000
         IF SAVECHARS.(8:8) <> " "                             <<04515>>17458000
            THEN FORMMSG(-1) := SAVECHARS.(8:8);               <<04515>>17460000
                                                               <<04515>>17462000
         ALLOCFLAB;  << allot stack buffer of 128 words >>     <<SP.11>>17466000
         FREADLABEL(AFTX, FLAB); << read u-label 0 >>          <<SP.11>>17468000
         IF > THEN                                             <<SP.11>>17470000
            BEGIN  << must initialize first u-label to 0. >>   <<SP.11>>17472000
            FLAB := 0;                                         <<SP.11>>17474000
            MOVE FLAB(1) := FLAB, (127); << zero the buffer >> <<SP.11>>17476000
            SPULAB'LASTFOPEN := 1;                             <<SP.11>>17478000
            SPULAB'FOPENENTRY := -1; << initialize >>          <<SP.11>>17480000
            SPULAB'TOTULAB := NUMSPULABS;                      <<SP.11>>17482000
           << Initialize to CR in case there's no env file >>  <<02555>>17484000
           SPULAB'LAST'ENV := %006415;                         <<02555>>17486000
            END;                                               <<SP.11>>17488000
         IF SPULAB'LASTFOPEN = MAXFOPENULAB AND                <<SP.11>>17490000
            SPULAB'FOPENENTRY = MAXFOPENENTRY THEN             <<SP.11>>17492000
   << filled up u-label with > 320 FOPENS >>                   <<SP.11>>17494000
         ELSE                                                  <<SP.11>>17496000
            BEGIN                                              <<SP.11>>17498000
            IF SPULAB'FOPENENTRY = MAXFOPENENTRY THEN          <<SP.11>>17500000
               BEGIN                                           <<SP.11>>17502000
               SPULAB'FOPENENTRY := 0;                         <<SP.11>>17504000
               SPULAB'LASTFOPEN := SPULAB'LASTFOPEN+1;         <<SP.11>>17506000
               END                                             <<SP.11>>17508000
            ELSE                                               <<SP.11>>17510000
               SPULAB'FOPENENTRY := SPULAB'FOPENENTRY+1;       <<SP.11>>17512000
            DP'INDEX := 0;                                    <<SP.ENV>>17514000
            IF DEVPARMS <> 0 THEN                             <<SP.ENV>>17516000
               GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX);      <<02555>>17518000
            FWRITELABEL(AFTX, FLAB);                           <<SP.11>>17522000
            ULAB := SPULAB'LASTFOPEN;                          <<SP.11>>17524000
            ULABENTRY := SPULAB'FOPENENTRY; << save current info >>     17526000
            FREADLABEL(AFTX, FLAB,,ULAB);                      <<SP.11>>17528000
            IF > THEN                                          <<SP.11>>17530000
               BEGIN  << initialize u-label >>                 <<SP.11>>17532000
               FLAB := 0;                                      <<SP.11>>17534000
               MOVE FLAB(1) := FLAB, (127);                    <<SP.11>>17536000
               END;                                            <<SP.11>>17538000
            FLABDBL(ULABENTRY*2) := SP'ACBBLK; << store var blk nr. >>  17540000
            FLABDBL(ULABENTRY*2+1) := 0D; << store FCLOSE dblword >>    17542000
            FWRITELABEL(AFTX, FLAB,,ULAB); << write u-label >> <<SP.11>>17544000
            END;                                               <<SP.11>>17546000
         ASSEMBLE(SUBS 128);   << deallocate stack buffer >>   <<SP.11>>17548000
         END;                                                           17554000
      END;                                                              17556000
                                                                        17558000
                                                               <<04679>>17560000
$PAGE                                                          <<04679>>17562000
SUBROUTINE SPOOLFILE'PURGE(AFTX,ODDX,INDEX,A);                 <<04679>>17564000
VALUE AFTX,ODDX,INDEX,A;                                       <<04679>>17566000
INTEGER AFTX,ODDX,INDEX,A;                                     <<04679>>17568000
                                                               <<04679>>17570000
<<**********************************************************>> <<04679>>17572000
<< This subroutine is used to lock and purge an open spool- >> <<04679>>17574000
<< file when encountering an error reading the environment  >> <<04679>>17576000
<< file.                                                    >> <<04679>>17578000
<<                                                          >> <<04679>>17580000
<< Input variables:                                         >> <<04679>>17582000
<<    AFTX - File number of currently open file.            >> <<04679>>17584000
<<    ODDX - Word index into ODD of the spoolfile. Bit 1 is >> <<04679>>17586000
<<           on to indicate output spoolfile.               >> <<04679>>17588000
<<    INDEX- A zero is passed in to reserve space for a     >> <<04679>>17590000
<<           local variable.  It is the word index into     >> <<04679>>17592000
<<           the ODD without the top bit on.                >> <<04679>>17594000
<<    A    - Also used as a local variable for GETSIR.      >> <<04679>>17596000
<<**********************************************************>> <<04679>>17598000
                                                               <<04679>>17600000
BEGIN                                                          <<04679>>17602000
FCLOSE(AFTX,0,0);          << First, close it out.          >> <<04679>>17604000
INDEX := ODDX.(1:15);      << Word index w/o top bit on.    >> <<04679>>17606000
<< Next  lock the ODD entry so it won't print.              >> <<04679>>17608000
A := GETSIR(ODDSIR);       << First, obtain the ODD SIR.    >> <<04679>>17610000
EXCHANGEDB(ODDDST);        << Get to ODD.                   >> <<04679>>17612000
IF ADB0(INDEX).(2:1) = 0 THEN                                  <<04679>>17614000
   BEGIN                   << Already printed, goodbye!     >> <<04679>>17616000
   EXCHANGEDB(0);          << Back to stack.                >> <<04679>>17618000
   RELSIR(ODDSIR,A)        << elease ODD SIR.               >> <<04679>>17620000
   END                                                         <<04679>>17622000
ELSE                                                           <<04679>>17624000
   BEGIN                   << It didn't print yet.          >> <<04679>>17626000
   ADB0(INDEX).(1:2) := 3; << Lock the ODD entry, 3 is lock.>> <<04679>>17628000
   EXCHANGEDB(0);          << Back to the stack.            >> <<04679>>17630000
   RELSIR(ODDSIR,A);       << Release the ODD SIR now.      >> <<04679>>17632000
   AFTX := FSOPEN(,%305,%400,ODDX); << FOPEN as spoolfle.   >> <<04679>>17634000
   IF = THEN               << If it failed, then forget it! >> <<04679>>17636000
      FSCLOSE(AFTX,4,0);   << Purge it, don't check CC!     >> <<04679>>17638000
   END;                                                        <<04679>>17640000
END;                                                           <<04679>>17642000
$PAGE                                                          <<04679>>17644000
   LOGICAL SUBROUTINE ALLOC (OLD);                                      17646000
      <<ALLOCATES NON-SHARABLE (NON-DISC) DEVICES.                      17648000
                                                                        17650000
        INPUT PARAMETERS:                                               17652000
            OLD - OLD FILE FLAG                                         17654000
               TRUE - OLD FILE                                          17656000
               FALSE - NEW FILE                                         17658000
      >>                                                                17660000
      VALUE OLD;                                                        17662000
      INTEGER OLD;                                                      17664000
      BEGIN                                                             17666000
      IF NOT JOBF THEN  <<ALLOCATE DEVICE?>>                            17668000
         BEGIN                                                          17670000
         @FIDS := @FD&LSR(1);                                           17672000
         MOVE FIDS := USERID,(4),2;  <<USER NAME>>                      17674000
         MOVE * := HANAME,(4),2;  <<HOME ACCOUNT NAME>>                 17676000
         TOS := PXGJITDST; TOS := JITJN;                                17678000
         TOS := 4;                                                      17680000
         ASSEMBLE(MFDS 3);  <<JOB NAME>>                                17682000
         MOVE * := FN,(4);  <<LOCAL FILE NAME>>                         17684000
         TOS := @JNUM;                                                  17686000
         TOS := PXGJITDST; TOS := JITJNUM;                              17688000
         TOS := 1;                                                      17690000
         ASSEMBLE(MFDS 4);  <<GET JOB NUMBER TO STACK>>        <<00300>>17692000
         MOVE NOFORMS := ". ";                                 <<01139>>17694000
         IF NOT PMAP.(8:1) THEN @FORMMSG := @NOFORMS;          <<01139>>17696000
                                                                        17698000
         TOS := IF (X := AOPACTYPE) = 0 THEN 0                          17700000
                   ELSE IF X < 4 THEN 1 ELSE 2;                         17702000
         ACCESSW := TOS LOR (FOPFORMAT&LSL(2))                          17704000
                        LOR (FOPASCII&LSL(4));                          17706000
         CTFLAGS := ACCESSW;                                   <<TL.02>>17708000
         CTFLAGS.(7:1) := FOPLABELLED;                         <<TL.02>>17710000
         X := ALLOCATE(DEVINFO,OLD,OUTPRI,FIDS,JID,FORMMSG,             17712000
            JNUM,NUMCOPIES,DEVINFO,XDDEP,CTFLAGS);             <<TL.02>>17714000
         IF > THEN  <<ERROR?>>                                          17716000
            BEGIN                                                       17718000
            IF X = 3 THEN TOS := NONSHAR                       <<*****>>17720000
            ELSE TOS := NAVAILDEV;                                      17722000
            GO ERR                                                      17724000
            END;                                                        17726000
         ACCESSW.(14:2) := CTFLAGS.(14:2);                     <<01815>>17728000
         ALLOC := ALLOC'RESULT := X;                           <<00635>>17730000
         RESOURCES.DEVICELOCK := TRUE  <<SET ALLOCATION FLAG>>          17732000
         END                                                            17734000
      ELSE  <<DEVICE PRE-ALLOCATED>>                                    17736000
         BEGIN                                                          17738000
         ALLOC'RESULT := 0; << get that initialized >>         <<02381>>17740000
         TOS := @FIDS;                                                  17742000
         TOS := @XDDEP;                                                 17744000
         TOS.(0:1) := 0;                                                17746000
         IF = THEN BEGIN ACCESSW := 0; TOS := IDDDST; END               17748000
              ELSE BEGIN ACCESSW := 1; TOS := ODDDST; END;              17750000
         ASSEMBLE(XCH);                                                 17752000
         TOS := XDDSIZE;                                                17754000
         ASSEMBLE(MFDS 4);  << GET XDD ENTRY >>                         17756000
         TOS := FIDS(20).(8:8);                                         17758000
         TOS := FIDS(21);                                               17760000
         SPDISKADDR := TOS;                                             17762000
         SPDADDR := FIDS(20).(0:8);                                     17764000
         TOS := FIDS(22).(8:8);  <<VDEV>>                               17766000
         IF = THEN TOS := TOS + FIDS(0);                                17768000
         DEVINFO := TOS LAND %377;  << LOG REAL/VIRT DEV # >>           17770000
         TOS := @DEVINFO(1);                                            17772000
         TOS := LPDTDST; TOS := DEVINFO*LPDTENTRY;                      17774000
         TOS := LPDTENTRY;                                              17776000
         ASSEMBLE(MFDS 3);                                              17778000
         TOS := LDT; TOS := DEVINFO*LDTENTRY;                           17780000
         TOS := LDTENTRY;                                               17782000
         ASSEMBLE(MFDS 4)                                               17784000
         END;                                                           17786000
      IF ALLOC'RESULT = SPOOLEDCLASS THEN SPOOLF := 1 ELSE     <<00635>>17788000
         SPOOLF := DEVINFO(1).(0:1);  <<virt. dev - spooled >>          17790000
      AOPTIONS.(13:1) := AOPTIONS.(13:1) LAND ACCESSW.(14:2)=2;         17792000
      IF ACCESSW.(14:2) = 0 THEN AOPTIONS.(14:2) := 0;                  17794000
      USECNT := DEVINFO(3);  <<FILE USE COUNT>>                         17796000
      VDADDR := DEVINFO(4).(0:8);  <<VOLUME TABLE INDEX>>               17798000
      DADDR := DEVINFO;  <<LOGICAL DEVICE NR.>>                         17800000
      DEFRS := DEVINFO(5)&LSR(8);  <<DEFAULT RECORD SIZE>>              17802000
      DTYPE := DEVINFO(5).(10:6);  << Device type >>                    17804000
      END;                                                              17806000
                                                               <<04624>>17808000
   SUBROUTINE UPDATE'FCB(FCBV);                                <<04624>>17810000
   VALUE FCBV;LOGICAL FCBV;                                    <<04624>>17812000
                                                               <<04624>>17814000
      <<****************************************************>> <<04624>>17816000
      << Updates the actual FCB in the control block (where >> <<04624>>17818000
      << ever it may be) by overlaying  it with the updated >> <<04624>>17820000
      << FCB that exists on the stack. Do not copy FCB(0).  >> <<04624>>17822000
      <<****************************************************>> <<04624>>17824000
                                                               <<04624>>17826000
      BEGIN                                                    <<04624>>17828000
      GET'FCB'Q'LOC;                                           <<04624>>17830000
      LOCK'CB(0,0,FCBMQ,FCBV.DSTN,FCBV VTA);                   <<04624>>17832000
      TOS := TOS + 1;   << Copy to FCB(1) in control block. >> <<04624>>17834000
      ASSEMBLE(DXCH);   << Switch source and targer address.>> <<04624>>17836000
      TOS := TOS + 1;   << Copy starting FCB(1) in stack.   >> <<04624>>17838000
      TOS := FCBSI-1;   << Now copy the FCB back to CB table>> <<04624>>17840000
      MOVE'DS'5;                                               <<04624>>17842000
      DEL;              << Delete FLAGS parm. from LOCK'CB. >> <<04624>>17844000
      UNLOCK'CB(0,FCBV.DSTN,FCBV VTA);  << Unlock it.       >> <<04624>>17846000
                                                               <<04624>>17848000
      END;                                                     <<04624>>17850000
                                                               <<04624>>17852000
                                                                        17854000
   <<* * * INITIALIZE PARAMETERS * * *>>                                17856000
                                                                        17858000
   IF (SPOOLF := FALSE) THEN                                            17860000
      BEGIN                                                             17862000
FSOPEN:             <<SPOOLFILE SEC ENTRY POINT>>                       17864000
      SPOOLF := TRUE;                                                   17866000
      END;                                                              17868000
   IF (JOBF := FALSE) THEN                                              17870000
      BEGIN         <<JOB/CI $STDXX SEC ENTRY POINT>>                   17872000
FJOPEN:                                                                 17874000
      JOBF := TRUE;                                                     17876000
      SPOOLF := FALSE;                                                  17878000
      END;                                                              17880000
   IF (KSF:=FALSE) THEN                                        <<KS.00>>17882000
   BEGIN << KSAM SECONDARY ENTRY POINT>>                       <<KS.00>>17884000
KSOPEN:                                                        <<KS.00>>17886000
      KSF:=TRUE;                                               <<KS.00>>17888000
      SPOOLF:=JOBF:=FALSE;                                     <<KS.00>>17890000
   END; <<KSAM SECONDARY ENTRY POINT>>                         <<KS.00>>17892000
   IF (PVOPEN' := FALSE) THEN                                  <<RV.PV>>17894000
   BEGIN  <<ENTRY POINT FOR CONDITIONAL MOUNTS>>               <<RV.PV>>17896000
PVOPEN:                                                        <<RV.PV>>17898000
       PVOPEN' := TRUE;                                        <<RV.PV>>17900000
       KSF := SPOOLF := JOBF := FALSE;                         <<RV.PV>>17902000
   END;                                                        <<RV.PV>>17904000
   IF (MUSTOPEN' := FALSE) THEN                                <<RV.PV>>17906000
   BEGIN  <<ENTRY TO BYPASS LOCKWORD/ACCESS CHECK>>            <<00097>>17908000
MUSTOPEN:                                                      <<RV.PV>>17910000
       MUSTOPEN' := TRUE;                                      <<RV.PV>>17912000
       PVOPEN' := KSF := SPOOLF := JOBF := FALSE;              <<RV.PV>>17914000
   END;                                                        <<RV.PV>>17916000
   IF (DIRACCF:=FALSE) THEN                                    <<00199>>17918000
      BEGIN                                                    <<00199>>17920000
DFOPEN:                                                        <<00199>>17922000
      DIRACCF:=TRUE;                                           <<00199>>17924000
      MUSTOPEN':=PVOPEN':=KSF:=SPOOLF:=JOBF:=FALSE;            <<00199>>17926000
      END;                                                     <<00199>>17928000
                                                                        17930000
$  IF X0 = ON                                                           17932000
   IF MONCALLABLE THEN  <<MONITORING?>>                                 17934000
      BEGIN                                                             17936000
      TOS := "FO"; TOS := "PE"; TOS := "N ";                            17938000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        17940000
      FTITLE(*,*,*,*);                                                  17942000
      DEBUG                                                             17944000
      END;                                                              17946000
$  IF                                                                   17948000
                                                                        17950000
   ERRORON;                                                             17952000
   IPCINFO:=0; MOVE IPCINFO(1):=IPCINFO,(5);                   <<HM.00>>17954000
                                                               <<03509>>17956000
   << Insure that there will be enough stack space while  >>   <<03509>>17958000
   << FOPEN is critical.                                  >>   <<03509>>17960000
                                                               <<03509>>17962000
   TOS := %1130;                                               <<03543>>17964000
   ASSEMBLE (ADDS 0);                                          <<03509>>17966000
   TOS := %1130;                                               <<03543>>17968000
   ASSEMBLE (SUBS 0);                                          <<03509>>17970000
                                                               <<03509>>17972000
   CRIT := SETCRITICAL;  <<GET INTO CRITICAL MODE>>                     17974000
   IF AOPACTYPE=%(2)1111 AND P'AOPS THEN                       <<00107>>17976000
      BEGIN                                                    <<00107>>17978000
      COMMENT:                                                 <<00107>>17980000
        INPUT-ONLY ACCESS WITHOUT SECURITY CHECK.  NOTE        <<00107>>17982000
        THAT LOCKWORD CHECK IS STILL PERFORMED UNLESS          <<00107>>17984000
        "MUSTOPEN" IS CALLED.  ADDED FOR C.I. TO IMPLEMENT     <<00107>>17986000
        :ALTSEC, :RELEASE AND :SECURE COMMANDS;                <<00107>>17988000
                                                               <<00107>>17990000
      IF NOT PRIVMODE THEN                                     <<00107>>17992000
         BEGIN                                                 <<00107>>17994000
         TOS := ILLCAP;                                        <<00107>>17996000
         GOTO ERR;                                             <<00107>>17998000
         END;                                                  <<00107>>18000000
      AOPACTYPE := 0; <<INONLY>>                               <<00107>>18002000
      CHECKSEC := FALSE; <<NO ASEC CHECK>>                     <<00107>>18004000
      END;                                                     <<00107>>18006000
   IF SPOOLF OR JOBF THEN                                               18008000
      BEGIN                                                             18010000
      IF NOT PRIVMODE THEN                                              18012000
         BEGIN                                                          18014000
         TOS := ILLCAP;                                                 18016000
         GO ERR                                                         18018000
         END;                                                           18020000
      IF PMAP <> %7000 THEN                                             18022000
         BEGIN                                                          18024000
         TOS := ILLPARM;                                                18026000
         GO ERR                                                         18028000
         END;                                                           18030000
      @XDDEP := XDDX;                                                   18032000
      PMAP.(6:1) := 0                                                   18034000
      END;                                                              18036000
   CHECKDB;  <<WHERE'S DB?>>                                            18038000
   IF <> THEN  <<DB NOT AT STACK?>>                                     18040000
      BEGIN                                                             18042000
      TOS := EXCHANGEDB(0);  <<SET DB TO STACK>>                        18044000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              18046000
      PXFFOPEN := ILLDB;  <<ERROR NR.>>                                 18048000
      ASSEMBLE(ZERO,XCH);                                               18050000
      EXCHANGEDB(*);  <<RESET DB TO ORIG.>>                             18052000
      TOS := ILLDB;                                                     18054000
      GO ERR                                                            18056000
      END;                                                              18058000
                                                               <<00300>>18060000
   <<* * * ALLOCATE AFT ENTRY * * *>>                          <<00300>>18062000
                                                               <<00300>>18064000
   TOS := FINDANYAFTENT;   << get an AFT entry >>              <<01815>>18066000
   AFTX := TOS;  <<AFT/FILE NR.>>                              <<00300>>18070000
   IF < THEN GO E4'       <<failed PXFILE expansion>>          <<02357>>18072000
   ELSE IF > THEN GO E4;  <<no entry left>>                    <<02357>>18074000
                                                               <<00300>>18076000
   DEVPARMS(0) := 0;      << initialize array >>              <<SP.ENV>>18078000
   IF INTEGER(SPOOLF) > 0 THEN                                          18080000
      BEGIN                                                             18082000
SPOOLL:          <<SPOOLED DEV RESTART>>                                18084000
      SPVDEV := DADDR;                                                  18086000
      SPFOPT := FOPTIONS;                                               18088000
      SPAOPT := AOPTIONS;                                               18090000
      IF RECSIZE > 1012 THEN RECSIZE := 1012;                  <<01.03>>18092000
      SPREC := DTYPE&LSL(10)+RECSIZE;                                   18094000
      SPSTATE := STATE;                                                 18096000
      MOVE SPFN := FN, (4);                                             18098000
      TOS := (FOPTIONS LAND %407) LOR %300;                             18100000
      TOS.(14:1) := 0;                                                  18102000
      IF <> THEN TOS.(15:1) := 1;                                       18104000
      IF (JOBF LAND AOPREAD) OR (NOT JOBF LAND USECNT > 1) THEN         18106000
         TOS.(15:1) := 1;  <<FORCE "OLD" >>                             18108000
      FOPTIONS := TOS;                                                  18110000
      AOPTIONS := (AOPTIONS LAND %3317) LOR %1300;                      18112000
      IF DTYPE = TERMINAL THEN <<IF TERMINAL THEN OUTPUT SPOOLE<<00552>>18114000
         FOPDOMAIN := 0;  <<NEW FILE>>                         <<00552>>18116000
      PMAP := (PMAP LAND %200) LOR %6100;                      <<SP.13>>18118000
      IF FOPDOMAIN = 0 THEN     << is it new file? >>          <<SP.11>>18120000
         USERLABELS := NUMSPULABS;    << 0 is reference >>     <<SP.11>>18122000
        << Labels 1-10 are for FOPEN/FCLOSE pointers. >>       <<SP.11>>18124000
        << Labels 11-27 are for circular queue page ejects. >> <<SP.11>>18126000
      <<STATE : INIT ALREADY>>                                          18128000
      END;                                                              18130000
   SETPCBX;  <<INIT. PCBX POINTER>>                                     18132000
   TOS := @JITINFO;                                                     18134000
   TOS := PXGJITDST; TOS := JITMPN;                                     18136000
   TOS := 24;                                                           18138000
   ASSEMBLE(MFDS 4);  <<COPY JIT INFO>>                                 18140000
   JID := JID.(8:8);  <<MAIN PROCESS PIN>>                              18142000
   SETPXFILE;  <<PXFILE POINTER>>                                       18144000
   TOS := @ACCTINDEX;                                          <<38.PV>>18146000
   TOS := PXGJITDST;                                           <<38.PV>>18148000
   TOS := ACCTINXPTR;                                          <<38.PV>>18150000
   TOS := 2;                                                   <<38.PV>>18152000
   ASSEMBLE (MFDS 4);  <<ACCT INDEX DOUBLE WORD>>              <<38.PV>>18154000
   TOS := @GRPINDEX;                                           <<38.PV>>18156000
   TOS := PXGJITDST;                                           <<38.PV>>18158000
   TOS := GRPINXPTR+(JITMTFF & LSL (1));                       <<38.PV>>18160000
   TOS := 2;                                                   <<38.PV>>18162000
   ASSEMBLE (MFDS 4);  <<GRP INDEX DOUBLE WORD>>               <<38.PV>>18164000
   TOS := @FNAMES&LSL(1); BPS0 := " ";  <<CLEAR FILE NAMES>>            18166000
   ASSEMBLE(DUP,INCB); MOVE * := *,(31);                                18168000
                                                                        18170000
   <<* * * DEFAULT MISSING PARAMETERS * * *>>                           18172000
                                                                        18174000
STARTOVER:   << Restart FOPEN for opens of $STDIN and     >>   <<01425>>18176000
             << $STDLIST other than the initial opens.    >>   <<01425>>18178000
   TOS := PMAP;  <<PARAMETER BIT MAP>>                                  18180000
   IF NOT LS0.(3:1) THEN DNTYPE := 3;                                   18182000
   IF NOT LS0.(4:1) THEN FOPTIONS := 0;                                 18184000
   IF NOT LS0.(5:1) THEN AOPTIONS := 0;                                 18186000
   IF NOT LS0.(6:1) THEN RECSIZE := 0;                                  18188000
   IF NOT LS0.(7:1) OR DEVICE = ";" THEN                      <<SP.ENV>>18190000
      MOVE DEVL := "DISC "                                              18192000
   ELSE                                                                 18194000
      MOVE DEVL := DEVICE, (MAXDEVLEN+1);                      <<02524>>18196000
   IF LS0.(7:1) THEN                                          <<SP.ENV>>18198000
      BEGIN     << Process device parameters, if any >>       <<SP.ENV>>18200000
      DEVPARMFLAG := PARSE'DEV'PARMS(DEVICE,DEVPARMS);        <<SP.ENV>>18202000
DEVPARM'CASE:                                                 <<SP.ENV>>18204000
      CASE DEVPARMFLAG OF                                     <<SP.ENV>>18206000
      BEGIN                                                   <<SP.ENV>>18208000
         ;  <<0 - successful >>                               <<SP.ENV>>18210000
           <<1 - expected "=" after a keyword >>              <<SP.ENV>>18212000
         TOS := DP'EXPECT'EQUAL;                              <<SP.ENV>>18214000
           <<2 - undefined keyword >>                         <<SP.ENV>>18216000
         TOS := DP'UNDEFINED'KEYWORD;                         <<SP.ENV>>18218000
           <<3 - expect semicolon or carriage return >>       <<SP.ENV>>18220000
         TOS := DP'EXPECT'SEMI'CR;                            <<SP.ENV>>18222000
           <<4 - DEVPARMS array overflow     >>               <<SP.ENV>>18224000
         TOS := DP'OVERFLOW;                                  <<SP.ENV>>18226000
           <<5 - DEV array too long or missing CR >>           <<02524>>18228000
         TOS := DP'MISSING'CR;                                 <<02524>>18230000
      END;                                                    <<SP.ENV>>18232000
      IF DEVPARMFLAG <> 0 THEN GO TO ERR;                     <<SP.ENV>>18234000
      END;                                                    <<SP.ENV>>18236000
                                                              <<SP.ENV>>18238000
   IF NOT LS0.(9:1) THEN USERLABELS := 0;                               18240000
   IF NOT LS0.(10:1) OR BLOCKFACTOR <= 0 THEN                           18242000
      BEGIN                                                             18244000
      BLOCKFACTOR := 1;                                                 18246000
      STATE.DEFAULTBF := 1  <<SET DEFAULT BLOCKING FLAG>>               18248000
      END;                                                              18250000
   IF NOT LS0.(11:1) THEN                                               18252000
      PRICOPBUFS := [4/0,7/1,5/DEFBUFFERS]                     <<00.05>>18254000
   ELSE                                                                 18256000
      BEGIN                                                             18258000
      IF NUMBUFFERS = 0 THEN NUMBUFFERS := DEFBUFFERS;         <<00.05>>18260000
      IF NUMCOPIES = 0 THEN NUMCOPIES := 1                              18262000
      END;                                                              18264000
   IF NOT LS0.(12:1) OR FILESIZE <= 0D THEN FILESIZE := 1023D;          18266000
   IF NOT LS0.(13:1) OR NUMEXTENTS <= 0 THEN NUMEXTENTS := 8;           18268000
   IF NOT LS0.(14:1) THEN INITALLOC := 1;                               18270000
   IF NOT TOS THEN FILECODE := 0;                                       18272000
   IF SPOOLF THEN  <<SPOOLFILE ACCESS?>>                                18274000
      BEGIN                                                             18276000
      RECSIZE := SPOOLRSIZE; << words >>                       <<*****>>18278000
      NUMEXTENTS := MAXEXTENTS;                                         18280000
      TOS := NUMEXTENTS;                                                18282000
      TOS := ABS(EXTSSECT); << spoofle extent size (sectors) >><<*****>>18284000
      ASSEMBLE(MPYL);        << total sectors >>               <<*****>>18286000
      X := SPOOLRSECT;       << spoofle sectors/block >>       <<*****>>18288000
      DIVD'DEL;              << get nr. of blocks >>           <<*****>>18290000
<< Correct filesize by sector offset for labels. >>            <<SP.21>>18292000
      FILESIZE := TOS-DOUBLE(NUMSPULABS/SPOOLRSECT)-1D;        <<02055>>18294000
      NUMBUFFERS := 1;                                                  18296000
      MOVE DEVL := "SPOOL "                                             18298000
      END;                                                              18300000
                                                                        18302000
   <<* * * PARSE DESIGNATOR AND DO FILE EQUATION * * *>>                18304000
                                                                        18306000
   IF DNTYPE <> 3 THEN  <<DESIGNATOR SPECIFIED?>>                       18308000
      BEGIN                                                             18310000
      WFMSG(0):=0;                                             <<TL.02>>18312000
      MOVE FD := FORMDESIGNATOR,(36);  <<COPY DESIGNATOR>>              18314000
NFORMAT:                                                                18316000
       SAVFOPNEQ:=FOPNOEQUATE;    <<PRESERVE NO-EQUATE BIT>>   <<KJ.03>>18318000
      IF NOT LOGICAL(FMLNAME(FD,GN,AN,FOPTIONS)) THEN                   18320000
         BEGIN  << DESIGNATOR WAS $STDIN, ETC. >>              <<00117>>18322000
         DNTYPE := 3;                                                   18324000
         FCOMTRIED := TRUE  <<SET FLAG>>                                18326000
         END                                                            18328000
      ELSE                                                              18330000
         BEGIN  << DESIGNATOR WAS NAME >>                      <<00117>>18332000
         DNTYPE := FNFORMAT(FD,FN,GN,AN,LW);                            18334000
         IF DNTYPE = 4 THEN GO E1  <<ILLEGAL NAME?>>                    18336000
         END;                                                           18338000
      IF NOT FOPNOEQUATE AND NOT FCOMTRIED THEN  <<DO FILE EQUATION?>>  18340000
         BEGIN                                                          18342000
         FCOMTRIED := TRUE;  <<SET FLAG>>                               18344000
         DEVPARMFLAG := 0;    << initialize >>                <<SP.ENV>>18346000
         IF FILECOMVALS(FN,GN,AN,FD,DEVL,FOPTIONS,AOPTIONS,             18348000
            PRICOPBUFS,DISP,RECSIZE,NUMEXTENTS,INITALLOC,               18350000
            BLOCKFACTOR,FILESIZE,FILECODE,STATE,PMAP,FMSG,    <<SP.ENV>>18352000
            DEVPARMS,DEVPARMFLAG) THEN                        <<SP.ENV>>18354000
          IF DEVPARMFLAG <> 0 THEN                            <<SP.ENV>>18356000
            GO TO DEVPARM'CASE                                <<SP.ENV>>18358000
          ELSE                                                <<SP.ENV>>18360000
            GO NFORMAT  << USED FILE EQUATION >>               <<00300>>18362000
         END;                                                  <<TL.02>>18364000
      IF WFMSG(0) <> 0 THEN @FORMMSG := @FMSG+2;               <<TL.02>>18366000
      IF WFMSG(0) <> 0 THEN PMAP.(8:1) := 1;                   <<TL.18>>18368000
      END;                                                              18370000
                                                              <<SP.ENV>>18372000
                                                              <<SP.ENV>>18376000
   DEVPARMFLAG := DP'INDEX := 0;                              <<SP.ENV>>18378000
   DP'DEN := DEN'DEFAULT;  << Initialize density >>            <<02568>>18380000
                                                               <<02568>>18382000
   IF DEVPARMS <> 0 THEN                                       <<02555>>18384000
   BEGIN                     <<device parameters present>>     <<02555>>18386000
      IF GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX) THEN        <<02555>>18388000
      BEGIN                                                    <<02555>>18390000
         PCHECKENV(BDEVPARMS((DP'INDEX+1)&LSL(1)),DEVPARMFLAG, <<02555>>18392000
                   ALLOC'RESULT);                              <<02555>>18394000
         SETPCBX;            << Reset PCB pointer >>           <<02555>>18396000
         CASE DEVPARMFLAG OF                                   <<02555>>18398000
         BEGIN                                                 <<02555>>18400000
                                                               <<02555>>18402000
         <<0>>   DP'FLAG := 0;         << Successful >>        <<02555>>18404000
         <<1>>   DP'FLAG := DP'ENV'OPEN'FAIL;                  <<02555>>18406000
         <<2>>   DP'FLAG := DP'ENV'BADFILE;                    <<02555>>18408000
         <<3>>   DP'FLAG := DP'ENV'HDR'FAIL;                   <<02555>>18410000
         <<4>>   DP'FLAG := DP'ENV'NOT'COMPILE;                <<02555>>18412000
         <<5>>   DP'FLAG := 0;         << Warning - recs change<<02555>>18414000
         <<6>>   DP'FLAG := DP'ENV'READ'ERR;                   <<02555>>18416000
         <<7>>   DP'FLAG := DP'ENV'READ'ERR;                   <<02555>>18418000
         <<8>>   DP'FLAG := DP'ENV'FCLOSE;                     <<02555>>18420000
         <<9>>   DP'FLAG := 0;         << Warning-FGETINFO fail<<02555>>18422000
         <<10>>  DP'FLAG := DP'ENV'FDEVICECONTROL;             <<02555>>18424000
         <<11>>  DP'FLAG := DP'ENV'FEQ'ERR;                    <<02555>>18426000
                                                               <<02555>>18428000
         END;             << Case statement >>                 <<02555>>18430000
                                                               <<02555>>18432000
         IF DP'FLAG <> 0 THEN                                  <<02555>>18434000
         BEGIN                                                 <<02555>>18436000
            TOS := DP'FLAG;                                    <<02555>>18438000
            GO ERR;                                            <<02555>>18440000
         END;                                                  <<02555>>18442000
      END;    << of ENVIRONMENT file check >>                  <<02568>>18444000
                                                               <<02568>>18446000
      IF GET'DEV'PARM(DEN'TOKEN,DEVPARMS,DP'INDEX) THEN        <<02568>>18448000
         BEGIN                                                 <<02568>>18450000
         IF NOT PARSE'DENSITY(BDEVPARMS( (DP'INDEX+1)&LSL(1) ),<<02568>>18452000
                              DEVPARMS(DP'INDEX)-1,DP'DEN) THEN<<02568>>18454000
            BEGIN                                              <<02568>>18456000
            TOS := DP'DEN'INVALID;                             <<02568>>18458000
            GOTO ERR;                                          <<02568>>18460000
            END;                                               <<02568>>18462000
         END;    << of density check >>                        <<02568>>18464000
                                                               <<02568>>18466000
   END;    << of device parameters present >>                  <<02568>>18468000
                                                               <<02568>>18470000
   <<* * * ADJUST FOPTIONS AND AOPTIONS * * *>>                         18472000
                                                               <<00.06>>18474000
   USERAOPTIONS:=AOPTIONS;                                     <<HM.00>>18476000
   IF INTEGER(SPOOLF) < 0 THEN                                 <<00.06>>18478000
      BEGIN  <<ARE WE SQUEEZING?>>                             <<00.06>>18480000
      IF AOPACTYPE = %10 AND @XDDEP.(0:1) = 1 THEN             <<00.06>>18482000
         BEGIN                                                 <<00.06>>18484000
         SPOOLF.(14:1) := 0;                                   <<00.06>>18486000
         AOPACMODE := 1;                                       <<00.06>>18488000
         END;                                                  <<00.06>>18490000
      AOPTIONS := AOPTIONS LAND %177761;                       <<00.06>>18492000
      IF @XDDEP.(0:1) = 1 THEN USERLABELS := NUMSPULABS;       <<01863>>18494000
      END;                                                     <<00.06>>18496000
   BLOCKFACTOR := IF BLOCKFACTOR < 255 THEN BLOCKFACTOR        <<01968>>18498000
      ELSE 255;                                                <<01968>>18500000
   IF = THEN  <<DEFAULT BLOCKING WANTED?>>                              18502000
      BEGIN                                                             18504000
      BLOCKFACTOR := 1;                                                 18506000
      STATE.DEFAULTBF := 1  <<SET DEFAULT BLOCKING FLAG>>               18508000
      END;                                                              18510000
   USERBLKFACTOR:=BLOCKFACTOR;                                 <<HM.00>>18512000
   TOS := AOPMULTAC;                                                    18514000
   IF <> THEN  <<MULTI-ACCESS WANTED?>>                                 18516000
      BEGIN  <<CHANGED IF MSG FILE>>                           <<HM.00>>18518000
      IF S0 = 3 THEN                                           <<HM.00>>18520000
         BEGIN  <<UNDEFINED VALUE FOR MULTIACCESS>>            <<HM.00>>18522000
         TOS:=ACCVIOL;                                         <<HM.00>>18524000
         GO ERR;                                               <<HM.00>>18526000
         END;                                                  <<HM.00>>18528000
      CASE AOPACMODE OF                                                 18530000
         BEGIN                                                          18532000
         IF NOT AOPREAD THEN ASSEMBLE(DEL,ZERO);                        18534000
         ASSEMBLE(DEL,ZERO);                                            18536000
         IF AOPWRITEONLY THEN ASSEMBLE(DEL,ZERO);                       18538000
         ;                                                              18540000
         END                                                            18542000
      END;                                                              18544000
   AOPMULTAC := TOS;                                                    18546000
   IF AOPNOWAIT THEN  <<NO-WAIT I/O WANTED?>>                           18548000
      BEGIN  <<CHANGED IF MSG FILE>>                           <<HM.00>>18550000
      AOPINHIBITBUF := 1;  <<NO BUFFERING FOR NOW>>                     18552000
      AOPMULTIREC := 0;  <<DISALLOW MULTI-RECORD MODE>>                 18554000
      BLOCKFACTOR := 1;  <<DISALLOW BLOCKING>>                          18556000
      AOPMULTAC := 0  <<DISALLOW MULTI-ACCESS>>                         18558000
      END;                                                              18560000
   IF AOPMULTIREC THEN AOPINHIBITBUF := 1;                    <<SP.ENV>>18562000
   IF FOPFILETYPE=3 OR FOPFILETYPE=5 OR FOPFILETYPE=7 THEN     <<HM.00>>18564000
      BEGIN  <<UNDEFINED FILE TYPE>>                           <<HM.00>>18566000
      TOS:=FILETYPEVIOL;                                       <<HM.00>>18568000
      GO ERR;                                                  <<HM.00>>18570000
      END;                                                     <<HM.00>>18572000
   IF FOPVARIABLE AND NOT SPOOLF AND NOT PRIVMODE THEN         <<00.04>>18574000
      BEGIN                                                    <<00.04>>18576000
      FOPFORMAT := 1;  <<FORCE NORMAL FORMAT>>                 <<00.04>>18578000
      END;                                                     <<00.04>>18580000
   IF AOPINHIBITBUF THEN  <<NO BUFFERING?>>                             18582000
      BEGIN                                                             18584000
      AOPMULTAC := 0;                                                   18586000
      END;                                                              18588000
   IF FOPUNDEFINED THEN  <<UNDEFINED RECORD FORMAT?>>                   18590000
      BEGIN                                                             18592000
      BLOCKFACTOR := 1;                                                 18594000
      STATE.DEFAULTBF := 0  <<CLEAR DEFAULT BLOCKING FLAG>>             18596000
      END;                                                              18598000
   IF AOPEXECUTE AND NOT PRIVMODE THEN  <<ILLEGAL EXECUTE?>>            18600000
      BEGIN                                                             18602000
      TOS := ACCVIOL;                                                   18604000
      GO ERR                                                            18606000
      END;                                                              18608000
   IF NUMBUFFERS <= 0 THEN NUMBUFFERS := DEFBUFFERS;           <<+0.05>>18610000
                                                                        18612000
   <<* * * PROCESS ACCORDING TO DESIGNATOR * * *>>                      18614000
                                                                        18616000
   TOS := FOPDESIGNATOR;  <<DESIGNATOR>>                                18618000
   X := S0;  <<PLACE COPY IN X>>                                        18620000
   IF TOS > 6 THEN GO E1;  <<INVALID?>>                                 18622000
   CASE * X OF                                                          18624000
      BEGIN                                                             18626000
                                                                        18628000
      <<FORMAL DESIGNATOR>>                                             18630000
                                                                        18632000
      BEGIN                                                             18634000
              IF DEVL = "#" THEN   << BACK REFERENCE >>        <<DS.04>>18636000
                BEGIN              << TO THE REMOTE  >>        <<DS.04>>18638000
                TOS := 0;          << LINE CONNECTED  TO>>     <<DS.04>>18640000
                PIN := GETPROCNUM;                             <<DS.06>>18642000
                WHILE PCBTYPE <> USER'MAIN DO                  <<DS.06>>18644000
                   PIN := PCBFATHER;                           <<DS.06>>18646000
                TOS := PIN;                                    <<DS.06>>18648000
                TOS := SDSLDEVPLABEL;                          <<DS.04>>18650000
                IF = THEN                                      <<DS.04>>18652000
                  BEGIN            << DS NOT IN SYSTEM >>      <<DS.04>>18654000
                  TOS := UNIMPL;                               <<DS.04>>18656000
                  GO TO ERR;                                   <<DS.04>>18658000
                  END;                                         <<DS.04>>18660000
                ASSEMBLE(PCAL 0);  << SDSLDEV >>               <<DS.04>>18662000
                IF S0 = 0 THEN     << NOT A REMOTE >>          <<DS.04>>18664000
                  BEGIN                                        <<DS.04>>18666000
                  TOS := UNDEFDEV;                             <<DS.04>>18668000
                  GO TO ERR;                                   <<DS.04>>18670000
                  END;                                         <<DS.04>>18672000
                TOS := ASCII(LS0,10,LOGICAL'DEV);              <<DS.04>>18674000
                MOVE DEVL(9+S0) := DEVL(9),(-10);              <<02524>>18676000
                    << include terminating byte in move. >>    <<02524>>18678000
                MOVE DEVL := LOGICAL'DEV,(S0); <<INSERT>>      <<DS.04>>18680000
                DDEL;  << LOGICAL DEV AND LENGTH >>            <<DS.04>>18682000
                END;   << BACK FILE REFERENCE >>               <<DS.04>>18684000
      X := GETDEVINFO(DEVL,DEVINFO);  <<GET DEVICE INFO>>               18686000
      IF > THEN  <<ERROR?>>                                             18688000
         BEGIN                                                          18690000
         TOS := UNDEFDEV;                                               18692000
         GO ERR                                                         18694000
         END;                                                           18696000
      IF DEVINFO(6).CS THEN GO E8;  <<CS DEVICE>>              <<00161>>18698000
      DTYPE := DEVINFO(1);  <<DEVICE TYPE>>                             18700000
      IF DTYPE=SDISC AND AOPNOWAIT THEN                        <<SD.00>>18702000
         BEGIN    << Serial disc - no NO-WAIT I/O. >>          <<01992>>18704000
         TOS := ACCVIOL;                                       <<01992>>18706000
         GOTO ERR;                                             <<SD.00>>18708000
         END;                                                  <<SD.00>>18710000
      DEFRS := DEVINFO(6)&LSR(8)  <<DEFAULT RECORD SIZE - POS. WORDS>>  18712000
      END;                                                              18714000
                                                                        18716000
      <<$STDLIST DESIGNATOR>>                                           18718000
                                                                        18720000
      BEGIN                                                             18722000
      IF AFTX = 2 THEN                                         <<01425>>18724000
         BEGIN  << Initial FOPEN of $STDLIST >>                <<01425>>18726000
         DADDR := PXGSTDLIST;                                  <<01425>>18728000
         AOPACTYPE := 1;                                       <<01425>>18730000
         GO GETDEVCHAR;                                        <<01425>>18732000
         END                                                   <<01425>>18734000
      ELSE                                                     <<01425>>18736000
         BEGIN  << A subsequent FOPEN of $STDLIST >>           <<01425>>18738000
         IF REDIRECT'IT (2, STDLIST'FOPCODE) THEN              <<01425>>18740000
            BEGIN                                              <<04133>>18742000
SFLAG:      REOPENSTD := TRUE;                                 <<04133>>18744000
            GOTO STARTOVER;                                    <<04133>>18746000
            END                                                <<04133>>18748000
         ELSE                                                  <<01425>>18750000
            BEGIN  << $STDLIST was not redirected >>           <<01425>>18752000
            DADDR := PXGSTDLIST;                               <<01425>>18754000
            AOPACTYPE := 1;                                    <<01425>>18756000
            GO GETDEVCHAR;                                     <<01425>>18758000
            END;                                               <<01425>>18760000
         END << Subsequent FOPEN >>;                           <<01425>>18762000
      END << $STDLIST case >>;                                 <<01425>>18764000
                                                                        18766000
      <<$NEWPASS DESIGNATOR>>                                           18768000
                                                                        18770000
      BEGIN                                                             18772000
      FOPDOMAIN := 0;  <<MAKE NEW>>                                     18774000
      MOVE DEVL := "DISC ";  <<MAKE DEVICE CLASS "DISC">>               18776000
      X := GETDEVINFO(DEVL,DEVINFO);  <<GET DEVICE INFO>>               18778000
      IF <> THEN  <<ERROR?>>                                            18780000
         BEGIN                                                          18782000
         TOS := UNDEFDEV;                                               18784000
         GO ERR                                                         18786000
         END;                                                           18788000
      @AN := @HANAME;  <<HOME ACCOUNT NAME>>                            18790000
      @GN := @LGNAME;  <<LOGON GROUP NAME>>                             18792000
      TOS := @FN&LSL(1);                                                18794000
      MOVE * := "$NEWPASS";  <<LOCAL FILE NAME>>                        18796000
      DTYPE := DEVINFO(1);  <<DEVICE TYPE>>                             18798000
      DEFRS := DEVINFO(6)&LSR(8);  <<DEFAULT REC. SIZE - POS. WORDS>>   18800000
      END;                                                              18802000
                                                                        18804000
      <<$OLDPASS DESIGNATOR>>                                           18806000
                                                                        18808000
      BEGIN                                                             18810000
      FOPDOMAIN := 0;  <<MAKE NEW>>                                     18812000
      TOS := @FADDR;                                                    18814000
      TOS := PXGJITDST; TOS := JITPFP&LSL(1);                           18816000
      TOS := 2;                                                         18818000
      ASSEMBLE(MFDS 4);  <<GET $OLDPASS LABEL ADR.>>                    18820000
      IF FADDR = 0D THEN  <<NO $OLDPASS?>>                              18822000
         BEGIN                                                          18824000
         TOS := NOPASSD;                                                18826000
         GO ERR                                                         18828000
         END;                                                           18830000
      VDADDR := FADDRW1.(0:8);  <<VTABX>>                      <<RV.PV>>18832000
      FADDRW1.(0:8) := 0;  <<CLEAR VTABX>>                     <<RV.PV>>18834000
      DISKADR := FADDR;  <<FILE LABEL ADR.>>                            18836000
      CASE DNTYPE OF                                           <<RV.PV>>18838000
      BEGIN                                                    <<RV.PV>>18840000
          ;                                                    <<RV.PV>>18842000
          MOVE AN := HANAME, (4);                              <<RV.PV>>18844000
          BEGIN                                                <<RV.PV>>18846000
              MOVE GN := LGNAME, (4);                          <<RV.PV>>18848000
              MOVE AN := HANAME, (4);                          <<RV.PV>>18850000
          END;                                                 <<RV.PV>>18852000
          BEGIN                                                <<RV.PV>>18854000
              MOVE FN := "$OLDPASS";                           <<RV.PV>>18856000
              MOVE GN := LGNAME, (4);                          <<RV.PV>>18858000
              MOVE AN := HANAME, (4);                          <<RV.PV>>18860000
          END;                                                 <<RV.PV>>18862000
      END;<<OF DNTYPE CASE>>                                   <<RV.PV>>18864000
      END;                                                              18866000
                                                                        18868000
      <<$STDIN DESIGNATOR>>                                             18870000
                                                                        18872000
      BEGIN                                                             18874000
      IF AFTX <> 1   << Not first FOPEN of $STDIN.          >> <<02309>>18876000
        AND REDIRECT'IT (1, STDIN'FOPCODE) THEN                <<02309>>18878000
        GO SFLAG;                                              <<04133>>18880000
                                                               <<02309>>18882000
<< First FOPEN of $STDIN or $STDIN not redirected.          >> <<02309>>18884000
                                                               <<02309>>18886000
      STATE.READMODE := STDINRD;                               <<02309>>18888000
      GO STDINXD;                                              <<02309>>18890000
      END << $STDIN case >>;                                   <<01425>>18894000
                                                                        18896000
      <<$STDINX DESIGNATOR>>                                            18898000
                                                                        18900000
   BEGIN                                                       <<01425>>18902000
   IF AFTX <> 1   << Not first FOPEN of $STDINX.            >> <<02309>>18904000
     AND REDIRECT'IT (1, STDIN'FOPCODE) THEN                   <<02309>>18906000
     GO SFLAG                                                  <<04133>>18908000
   ELSE                                                        <<01425>>18910000
      BEGIN                                                             18912000
      STATE.READMODE := STDINXRD;                              <<02309>>18914000
STDINXD:                                                                18916000
      AOPACTYPE := 0;  <<MAKE READ ONLY>>                               18918000
      DADDR := PXGSTDIN;  <<$STDIN LOG. DEV. NR.>>                      18920000
GETDEVCHAR:                                                             18922000
      IF INTEGER(DNTYPE) = 3 THEN  <<ABSENT NAME?>>                     18924000
         BEGIN                                                          18926000
         DTYPE := FOPDESIGNATOR;  <<DESIGNATOR TYPE>>                   18928000
         TOS := @FN&LSL(1);                                             18930000
         IF DTYPE = 1 THEN                                              18932000
            MOVE * := "$STDLIST"                                        18934000
         ELSE IF DTYPE = 4 THEN                                         18936000
            MOVE * := "$STDIN  "                                        18938000
         ELSE IF DTYPE = 5 THEN                                         18940000
            MOVE * := "$STDINX "                                        18942000
         END;                                                           18944000
      DEVINFO := DADDR;  <<LOG. DEV. NR.>>                              18946000
      TOS := @DTYPE;                                                    18948000
      TOS := LDT; TOS := DADDR*LDTENTRY+2;                              18950000
      TOS := 1;                                                         18952000
      ASSEMBLE(MFDS 4);  <<GET DEVICE TYPE WORD FROM LDT>>              18954000
      DTYPE := DTYPE.(10:6);  <<DEVICE TYPE>>                  <<00630>>18956000
      END;                                                              18958000
   END << $STDINX case >>;                                     <<01425>>18960000
                                                                        18962000
      <<$NULL DESIGNATOR>>                                              18964000
                                                                        18966000
      BEGIN                                                             18968000
      AFTOPT := %004000;                                       <<DS.00>>18970000
      TOS := ADJUSTOPS(NEWDIRFILE);                            <<00630>>18972000
      IF S0>=0 THEN GOTO ERR;                                  <<00630>>18974000
      DEL;                                                     <<00630>>18976000
      GO FINISH                                                         18978000
      END                                                               18980000
                                                                        18982000
      END;                                                              18984000
                                                                        18986000
   <<*******************************************************>> <<04624>>18988000
   <<         PROCESS ACCORDING TO DEVICE TYPE              >> <<04624>>18990000
   << The X register will get the access type of the file,  >> <<04624>>18992000
   << based on the top bits of the device type.  If it is   >> <<04624>>18994000
   << zero, than execute the THEN of this huge, disgusing   >> <<04624>>18996000
   << clause, signifying direct access file (disk file).    >> <<04624>>18998000
   <<*******************************************************>> <<04624>>19000000
                                                               <<04624>>19002000
   X := DTYPE&LSR(3);                                                   19004000
   IF = THEN  <<DIRECT ACCESS?>>                                        19006000
      BEGIN                                                             19008000
                                                                        19010000
      <<DIRECT ACCESS DEVICE>>                                          19012000
                                                                        19014000
      IF DTYPE=FDISC THEN GO L; <<FOREIGN DISC>>               <<01115>>19016000
                                                               <<01115>>19018000
      IF FILECODE < 0 AND NOT PRIVMODE AND CHECKSEC THEN       <<00433>>19020000
          GO FCODERR;                                          <<00309>>19022000
      @ANPTR := @AN;  <<ACCOUNT NAME>>                                  19024000
      @GNPTR := @GN;  <<GROUP NAME>>                                    19026000
      CASE DNTYPE OF                                           <<42.PV>>19028000
      BEGIN                                                    <<42.PV>>19030000
          ;       <<FULLY QUALIFIED NAME>>                     <<42.PV>>19032000
          BEGIN   <<ACCT NAME MISSING>>                        <<42.PV>>19034000
              MOVE AN := HANAME, (4); <<HOME ACCT NAME>>       <<42.PV>>19036000
              LINKAGE'INDEXP := ACCTINDEX;                     <<42.PV>>19038000
          END;                                                 <<42.PV>>19040000
          BEGIN   <<GROUP NAME MISSING>>                       <<42.PV>>19042000
              MOVE AN := HANAME, (4);                          <<42.PV>>19044000
              MOVE GN := LGNAME, (4); <<LOG-ON GROUP NAME>>    <<42.PV>>19046000
              IF HVSPV AND LINKAGE = 0 THEN                    <<42.PV>>19048000
              BEGIN <<NOT MOUNTED. START AT ACCT LEVEL>>       <<42.PV>>19050000
                  DNTYPE := 1;                                 <<42.PV>>19052000
                  LINKAGE'INDEXP := ACCTINDEX;                 <<42.PV>>19054000
              END ELSE                                         <<42.PV>>19056000
               LINKAGE'INDEXP := GRPINDEX;                     <<42.PV>>19058000
          END;                                                 <<42.PV>>19060000
          BEGIN   <<NAME MISSING>>                             <<42.PV>>19062000
              MOVE GN := LGNAME, (4);                          <<42.PV>>19064000
              MOVE AN := HANAME, (4);                          <<42.PV>>19066000
          END;                                                 <<42.PV>>19068000
          GO TO E1; <<ILLEGAL NAME>>                           <<42.PV>>19070000
      END;<<OF DNTYPE CASE>>                                   <<42.PV>>19072000
CONT1:                                                         <<42.PV>>19074000
      IF NOT SPOOLF THEN                                       <<RV.PV>>19076000
      BEGIN                                                    <<RV.PV>>19078000
          GENTRY (GLINKAGE).(PVF) := GRPINXPTRWD.JITPVF;       <<38.PV>>19080000
          TOS := @LGNAME & LSL (1);                            <<RV.PV>>19082000
          TOS := @GNPTR & LSL (1);                             <<RV.PV>>19084000
          TOS := @HANAME & LSL (1);                            <<RV.PV>>19086000
          TOS := @ANPTR & LSL (1);                             <<RV.PV>>19088000
          IF BPS3 <> BPS2, (8) OR BPS1 <> BPS0, (8) THEN       <<RV.PV>>19090000
          BEGIN <<NEED GROUP ENTRY TO DETERMINE IF HVS IS PV>> <<RV.PV>>19092000
              TOS := DIRECFIND (%10, 0D, ANPTR,                <<RV.PV>>19094000
                                GNPTR, FN, GENTRY);            <<38.PV>>19096000
              IF <> THEN                                       <<38.PV>>19098000
              BEGIN                                            <<38.PV>>19100000
                  IF < THEN X := DIRIOERR                      <<38.PV>>19102000
                       ELSE IF S0 = 2 THEN X := UNDEFFILESD-S1 <<38.PV>>19104000
                                   ELSE FTROUBLE (404);        <<04138>>19106000
                  DDEL; DDEL; DDEL;                            <<RV.PV>>19108000
                  TOS := X;                                    <<38.PV>>19110000
                  GO TO ERR;                                   <<38.PV>>19112000
              END;                                             <<38.PV>>19114000
              DDEL;                                            <<38.PV>>19116000
          END;                                                 <<38.PV>>19118000
          DDEL; DDEL; <<POINTERS>>                             <<38.PV>>19120000
          IF GENTRY (GLINKAGE).(PVF) = PV THEN                 <<23.PV>>19122000
          BEGIN << HVS IS A "PV" >>                            <<RV.PV>>19124000
              TOS := 0D;                                       <<RV.PV>>19126000
              WHO (, DS1);                                     <<RV.PV>>19128000
              DEL;                                             <<RV.PV>>19130000
              IF LOGICAL (TOS).(7:1) THEN                      <<RV.PV>>19132000
              BEGIN << HAS "UV" CAPABILITY >>                  <<RV.PV>>19134000
                  REQTYPE := IF PVOPEN' OR MUSTOPEN' THEN      <<RV.PV>>19136000
                              CONDMOUNT ELSE UNCONDMOUNT;      <<RV.PV>>19138000
                  MOUNT (HVSIND, GNPTR, ANPTR,                 <<23.PV>>19140000
                         REQTYPE, -1, PVINFO);                 <<rv.PV>>19142000
                  IF < THEN                                    <<23.PV>>19144000
                  BEGIN << SOME KIND OF MOUNT PROBLEM);        <<23.PV>>19146000
                      <<REQTYPE CONTAINS MOUNT ERROR NUMBER>>  <<23.PV>>19148000
                      <<NEED TO MAP TO FILESYS ERROR NUMBER>>  <<23.PV>>19150000
                      TOS := MOUNTPROB;                        <<23.PV>>19152000
                      GO TO ERR;                               <<RV.PV>>19154000
                  END;                                         <<RV.PV>>19156000
                  RESOURCES.DMOUNT := TRUE;                    <<RV.PV>>19158000
                  CLASSFLG := IF NOT PMAP.(7:1) OR             <<00705>>19160000
                              DEVL="DISC" AND DEVL(4)=SPECIAL  <<00705>>19162000
                              THEN 1 ELSE 0;                   <<00705>>19164000
              END ELSE                                         <<RV.PV>>19166000
              BEGIN << USER DOES NOT HAVE "UV" CAPABILITY>>    <<RV.PV>>19168000
                  TOS := UVCAP;                                <<RV.PV>>19170000
                  GO TO ERR;                                   <<RV.PV>>19172000
              END;                                             <<RV.PV>>19174000
          END;                                                 <<RV.PV>>19176000
      END;<< OF NOT SPOOLF >>                                  <<RV.PV>>19178000
      IF FOPOLDPASS THEN                                       <<RV.PV>>19180000
      BEGIN                                                    <<RV.PV>>19182000
          ALLOCFLAB;                                           <<RV.PV>>19184000
          DADDR := LUN (VDADDR,MVTABX);                        <<RV.PV>>19186000
          LABELIO (0,2);  <<READ FLAB>>                        <<RV.PV>>19188000
          MOVE FLLOCNAME := FN, (4);                           <<RV.PV>>19190000
          MOVE FLGRPNAME := GN, (4);                           <<RV.PV>>19192000
          MOVE FLACCTNAME := AN, (4);                          <<RV.PV>>19194000
          MOVE FLLOCKWORD := LW, (4);                          <<RV.PV>>19196000
          LABELIO (1,2);  <<WRITE UPDATED FLAB>>               <<RV.PV>>19198000
          GO TO OPNOLDA;                                       <<RV.PV>>19200000
      END;                                                     <<RV.PV>>19202000
      DOMAIN := FOPDOMAIN;  <<FILE DOMAIN>>                    <<RV.PV>>19204000
      IF DOMAIN = 0 THEN    << New file? >>                             19206000
         BEGIN                                                          19208000
         IF INTEGER(SPOOLF) <= 0 THEN AOPMULTAC := 0;  <<NEW FILE>>     19210000
         GO NFILE                                                       19212000
         END;                                                           19214000
      IF SPOOLF THEN  <<SPOOLFILE ACCESS?>>                             19216000
         BEGIN                                                          19218000
         DADDR := 0;                                                    19220000
         FADDRW1 := 0;                                                  19222000
         FADDRW2 := @SPINFO;                                            19224000
         GO OPNOLDS                                                     19226000
         END;                                                           19228000
                                                                        19230000
      B := GETSIR(FMAVTSIR);                                   <<HM.00>>19232000
      A := GETSIR(FISIR);                                      <<01084>>19234000
                                                                        19236000
      <<* * * SEARCH JOB TEMPORARY DIRECTORY * * *>>                    19238000
                                                                        19240000
      IF DOMAIN > 1 THEN  <<SEARCH JTFD?>>                              19242000
         BEGIN                                                          19244000
         JID := 2;                                                      19246000
         IF RETJTENTRY(FN,GNPTR,ANPTR,JID,FIDS) = 0 THEN  <<FOUND?>>    19248000
            BEGIN                                                       19250000
            TOS := FIDS;                                                19252000
            VDADDR := S0.(0:8);  <<VTABX>>                     <<RV.PV>>19254000
            DADDR := LUN (VDADDR,MVTABX);                      <<RV.PV>>19256000
            TOS := TOS.(8:8);    <<VTABX>>                     <<RV.PV>>19258000
            TOS := FIDS(1);                                             19260000
            FADDR := TOS;  <<FILE LABEL SECTOR NR.>>                    19262000
            GO OPNOLD                                                   19264000
            END                                                         19266000
         END;                                                           19268000
      IF NOT LOGICAL(DOMAIN) THEN  <<NOT FOUND IN JTFD?>>               19270000
         BEGIN                                                          19272000
         TOS := UNDEFFILEJD;                                            19274000
         GO ERR                                                         19276000
         END;                                                           19278000
                                                                        19280000
      <<* * * SEARCH PERMANENT DIRECTORY * * *>>                        19282000
                                                                        19284000
      IF DNTYPE = 3 THEN GO E1;     << No designator >>                 19286000
      TOS := 0D; TOS := GSEC; TOS := ASEC;                              19288000
      DISKADR := DIRECFINDFILE (DNTYPE,LINKAGE'INDEXP,ANPTR,   <<38.PV>>19290000
                                GNPTR,FN,AS4);                 <<38.PV>>19292000
      IF <> THEN                                                        19294000
         BEGIN                                                          19296000
         IF < THEN TOS := DIRIOERR                                      19298000
         ELSE IF P2 = 2 THEN TOS := UNDEFFILESD-P1                      19300000
         ELSE FTROUBLE(484);  <<OTHER ERROR?>>                 <<KJ.03>>19302000
         GO ERR                                                         19304000
         END;                                                           19306000
      IF CARRY THEN  <<FILE FLAGGED - BAD LABEL?>>             <<+1.01>>19308000
         BEGIN                                                          19310000
         TOS := BADFILE;                                                19312000
         GO ERR                                                         19314000
         END;                                                           19316000
      ASEC := TOS; GSEC := TOS; FADDR := TOS;                           19318000
      VDADDR := FADDRW1&LSR(8);  <<VOLUME TABLE INDEX>>                 19320000
      DADDR := LUN (VDADDR,MVTABX);  <<LOGICAL UNIT NR.>>      <<RV.PV>>19322000
      DOMAIN := 1;  <<SET TO PERMANENT FILE>>                           19324000
                                                               <<HM.00>>19326000
      <<****************************************************>> <<04624>>19328000
      <<                                                    >> <<04624>>19330000
      <<                 OLD        FILE                    >> <<04624>>19332000
      <<                                                    >> <<04624>>19334000
      << We have, in our infinite wisdom, determined that   >> <<04624>>19336000
      << this is indeed an old file.  Allocate the FLAB on  >> <<04624>>19338000
      << stack and read it in.  Do checking on the file type>> <<04624>>19340000
      <<****************************************************>> <<04624>>19342000
                                                               <<HM.00>>19344000
OPNOLD:                                                        <<HM.00>>19346000
      ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>               <<HM.00>>19348000
      DISKADR:=FADDR; << LABELIO uses DISKADR; will also zero>><<01901>>19350000
      P1.(0:8):=0;    << out vol no (DISKADR) for consistency>><<01901>>19352000
      LABELIO(0,1);   << Read flab; print name if label error>><<01901>>19354000
      IF FLMSGFILE THEN                                        <<HM.00>>19356000
         BEGIN  <<MSG FILE ACCESS>>                            <<HM.00>>19358000
         IF (TOS:=ADJUSTMSGPARMS) <> -1 THEN GO ERR;           <<HM.00>>19360000
         END                                                   <<HM.00>>19362000
      ELSE IF FLCIRFILE THEN                                   <<HM.00>>19364000
         BEGIN  <<CIRCULAR FILE ACCESS>>                       <<HM.00>>19366000
         IF (TOS:=ADJUSTCIRPARMS) <> -1 THEN GO ERR;           <<HM.00>>19368000
         END;                                                  <<HM.00>>19370000
      IF AOPNOWAIT AND AOPINHIBITBUF AND NOT PRIVMODE THEN     <<HM.00>>19372000
         BEGIN                                                 <<HM.00>>19374000
         TOS := ILLCAP;                                        <<HM.00>>19376000
         GO ERR                                                <<HM.00>>19378000
         END;                                                  <<HM.00>>19380000
                                                                        19382000
      <<****************************************************>> <<04624>>19384000
      << If the file was opened for multi-access, scan the  >> <<04624>>19386000
      << FMAVT.  If an entry exists for the file, then the  >> <<04624>>19388000
      << file was previously opened multi-access and the    >> <<04624>>19390000
      << PACB exists already.  SCANFMAVT will return the    >> <<04624>>19392000
      << PACBV.  Lock the PACB via FGETCB and set the       >> <<04624>>19394000
      << the PACB LOCKED flag.                              >> <<04624>>19396000
      <<****************************************************>> <<04624>>19398000
                                                                        19400000
      IF AOPMULTAC <> 0 THEN  <<NOT LOCKED YET?>>              <<HM.00>>19402000
         BEGIN                                                          19404000
         IF (PACBV := SCANFMAVT(AOPGLOBALMULTAC&LSL(3),        <<HM.00>>19406000
            FADDRW1.(8:8)+DADDR&LSL(8),FADDRW2,0)) <> 0 THEN   <<HM.00>>19408000
            BEGIN                                                       19410000
                                                               <<04624>>19412000
            <<**********************************************>> <<04624>>19414000
            << Send the FMAVT SIR and FISIR to be released  >> <<04624>>19416000
            << before impeding on the ACB so that we do not >> <<04624>>19418000
            << tie up the SIR's for long periods of time.   >> <<04624>>19420000
            <<**********************************************>> <<04624>>19422000
                                                               <<04624>>19424000
            FGETCB(0,0,DUM,PACBV,1,FMAVTSIR,B,FISIR,A);        <<01393>>19426000
            ASSEMBLE(DEL,DDEL);                                         19430000
            PACBLOCKED := TRUE;  <<SET PACB LOCKED FLAG>>               19432000
            EXCHANGEDB(0)  <<RESET DB TO STACK>>                        19434000
            END                                                         19436000
         END;                                                           19438000
                                                                        19440000
       << Must check for Priv File Code Match >>               <<02352>>19442000
       IF FLFILECODE < 0 OR FILECODE < 0 THEN                  <<01175>>19446000
        IF FILECODE <> FLFILECODE THEN GO FCODERR;<<MISMATCH?>><<01175>>19448000
                                                               <<04615>>19450000
      <<* * * CHECK FILE SECURITY * * *>>                      <<04615>>19452000
                                                               <<04615>>19454000
      IF DOMAIN=1 THEN                                         <<04615>>19456000
         BEGIN                                                 <<04615>>19458000
         IF NOT LOGICAL(FLSECURE) OR NOT CHECKSEC THEN         <<04615>>19460000
            ASEC := ASEC LOR %76  <<R,A,W,L,X BUT NO S>>       <<04615>>19462000
         ELSE  <<CHECK SECURITY>>                              <<04615>>19464000
            BEGIN                                              <<04615>>19466000
            ASEC := ACCCHECK(0,ANPTR,ASEC,GNPTR,GSEC,          <<04615>>19468000
                      FLUSERID,FLSECMX);                       <<04615>>19470000
            CASE AOPACTYPE OF  <<CHECK ACCESS>>                <<04615>>19472000
               BEGIN                                           <<04615>>19474000
                                                               <<04615>>19476000
               <<READ ONLY>>                                   <<04615>>19478000
                                                               <<04615>>19480000
               BEGIN                                           <<04615>>19482000
               IF NOT ASEC&LSR(5) THEN GO SECVIOL; <<NO READ?>><<04615>>19484000
               IF FLMSGFILE AND NOT AOPCOPY                    <<04615>>19486000
               AND NOT ASEC&LSR(3) THEN GO SECVIOL;            <<04615>>19488000
               END;                                            <<04615>>19490000
                                                               <<04615>>19492000
               <<WRITE ONLY - DELETE>>                         <<04615>>19494000
                                                               <<04615>>19496000
                             << No Write? >>                   <<04615>>19498000
OUT:           IF NOT ASEC&LSR(3) THEN GO SECVIOL;             <<04615>>19500000
                                                               <<04615>>19502000
               <<WRITE ONLY - SAVE>>                           <<04615>>19504000
                                                               <<04615>>19506000
               GO OUT;                                         <<04615>>19508000
                                                               <<04615>>19510000
               <<APPEND>>                                      <<04615>>19512000
                                                               <<04615>>19514000
                             << No A,W? >>                     <<04615>>19516000
               IF INTEGER(ASEC.(11:2)) = 0 THEN GO SECVIOL;    <<04615>>19518000
                                                               <<04615>>19520000
               <<READ OR WRITE>>                               <<04615>>19522000
                                                               <<04615>>19524000
               BEGIN                                           <<04615>>19526000
                             << R,W? >>                        <<04615>>19528000
INOUT:         IF INTEGER(ASEC LAND %50) = 0 THEN GO SECVIOL;  <<04615>>19530000
               IF NOT ASEC&LSR(5) THEN  <<NO R => W ONLY?>>    <<04615>>19532000
                  AOPACTYPE := 2                               <<04615>>19534000
               ELSE IF NOT ASEC&LSR(3) THEN <<NO W=>R ONLY?>>  <<04615>>19536000
                  AOPACTYPE := 0                               <<04615>>19538000
               END;                                            <<04615>>19540000
                                                               <<04615>>19542000
               <<UPDATE>>                                      <<04615>>19544000
                                                               <<04615>>19546000
               GO INOUT;                                       <<04615>>19548000
                                                               <<04615>>19550000
               <<MODIFY SL OR PROGRAM FILE>>                   <<04615>>19552000
                                                               <<04615>>19554000
               BEGIN                                           <<04615>>19556000
               << No Execute? >>                               <<04615>>19558000
EXECUTE:       IF NOT ASEC&LSR(1) THEN GO SECVIOL;             <<04615>>19560000
               ASEC := ASEC LOR 4  <<INCLUDE LOCKING>>         <<04615>>19562000
               END;                                            <<04615>>19564000
                                                               <<04615>>19566000
               <<LOAD A PROGRAM FILE>>                         <<04615>>19568000
                                                               <<04615>>19570000
               GO EXECUTE                                      <<04615>>19572000
                                                               <<04615>>19574000
               END;                                            <<04615>>19576000
            IF INTEGER(ASEC.(11:2)) <> 0                       <<04615>>19578000
               THEN ASEC := ASEC LOR 4;                        <<04615>>19580000
            IF AOPLOCKING OR AOPEXCLUSIVE OR AOPSEMI OR        <<04615>>19582000
                       <<  Exclusive Request? >>               <<04615>>19584000
               AOPDEFAULT AND NOT AOPREAD THEN                 <<04615>>19586000
                  IF NOT ASEC&LSR(2) THEN GO SECVIOL           <<04615>>19588000
            END                                                <<04615>>19590000
         END;                                                  <<04615>>19592000
                                                               <<04615>>19594000
      <<* * * CHECK LOCK WORD * * *>>                          <<04615>>19596000
                                                               <<04615>>19598000
      IF MUSTOPEN' AND PRIVMODE THEN ELSE                      <<04615>>19600000
      BEGIN                                                    <<04615>>19602000
      MOVE FIDS := LW,(4);  <<COPY LOCKWORD>>                  <<04615>>19604000
      TOS := FLOCKWORD(FD,FLAB,A,B,IF PACBLOCKED THEN PACBV    <<04615>>19606000
                     ELSE 0);                                  <<04615>>19608000
      ASSEMBLE(TEST);                                          <<04615>>19610000
      IF = THEN  <<MISMATCH OR ERROR?>>                        <<04615>>19612000
         BEGIN                                                 <<04615>>19614000
         A := -1;  <<SIR WAS RELEASED>>                        <<04615>>19616000
         B := -1;  <<SIR WAS RELEASED>>                        <<04615>>19618000
         TOS := @FLLOCKWORD; PS0 := "  ";                      <<04615>>19620000
         ASSEMBLE (DUP,INCB);                                  <<04615>>19622000
         TOS := 3;                                             <<04615>>19624000
         ASSEMBLE (MOVE 3); <<CLEAR OUT PASSWORD>>             <<04615>>19626000
         PACBLOCKED := FALSE;  <<PACB WAS RELEASED>>           <<04615>>19628000
         TOS := LWVIOL;                                        <<04615>>19630000
         GO ERR                                                <<04615>>19632000
         END;                                                  <<04615>>19634000
      IF TOS = 2 THEN  <<PROMPTED LOCKWORD MATCH?>>            <<04615>>19636000
         BEGIN                                                 <<04615>>19638000
         MOVE LW := FIDS,(4);  <<MAKE LOCKWORD LOOK SUPPLIED>> <<04615>>19640000
         A := -1;  <<SIR WAS RELEASED>>                        <<04615>>19642000
         B := -1;  <<SIR WAS RELEASED>>                        <<04615>>19644000
         PACBLOCKED := FALSE;  <<PACB WAS RELEASED>>           <<04615>>19646000
         GO CONT1                                              <<04615>>19648000
         END;                                                  <<04615>>19650000
      END;                                                     <<04615>>19652000
$PAGE                                                          <<04624>>19654000
      <<****************************************************>> <<04624>>19656000
      << Now call FOPENDA to open the disk file.  Turn bit  >> <<04624>>19658000
      << zero of the DADDR parameter on if the PACB has al- >> <<04624>>19660000
      << ready been locked.  FOPENDA will check this bit    >> <<04624>>19662000
      << upon entrance.                                     >> <<04624>>19664000
      <<****************************************************>> <<04624>>19666000
                                                               <<04624>>19668000
OPNOLDA:                                                                19670000
      ASSEMBLE(SUBS 128);  <<DEALLOCATE FILE LABEL BUFFER>>             19672000
OPNOLDS:                                                                19674000
      DISP.(0:8) := DNTYPE;                                             19676000
      DADDR.(0:1) := PACBLOCKED;                                        19678000
      FOPEN := FOPENDA(DADDR,FADDR,AOPTIONS,NUMBUFFERS,FILECODE,        19680000
         ASEC,DISP,FOPTIONS,PVINFO,IPCINFO);                   <<HM.00>>19682000
                        <<NOTE: LOCAL AOPS MAY BE INVALID>>    <<00630>>19684000
                        <<USE ACBAOPS (FGETINFO) INSTEAD >>    <<00630>>19686000
      PUSH(STATUS);                                                     19688000
      TOS := TOS.(6:2);                                                 19690000
      CONDCODE := TOS;  <<SET CONDITION CODE>>                          19692000
      DADDR.(0:1) := 0;                                                 19694000
      PACBLOCKED := FALSE;                                              19696000
      IF RESULT <> 0 THEN  <<OK?>>                                      19698000
         BEGIN                                                          19700000
         IF SPOOLF THEN DADDR := SPDADDR;                               19702000
         TOS := ATTACHIO(DADDR,0,0,0,2,0,0,0,BSFLAGS); <<O.F.>><<+0.05>>19704000
                                                               <<04624>>19706000
         IF S1.(8:8)<>1 THEN GO E0;          <<ERROR?>>        <<04624>>19708000
                                                               <<04624>>19710000
         END                                                            19712000
      ELSE  <<ERROR>>                                                   19714000
         IF INTEGER(SPOOLF) > 0 THEN DEALLOCATE(SPVDEV);                19716000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              19718000
      TOS := PXFFOPEN;  <<ERROR NR.>>                                   19720000
      GO XIT;                                                           19722000
$PAGE                                                          <<04624>>19724000
      <<****************************************************>> <<04624>>19726000
      <<                                                    >> <<04624>>19728000
      <<                 NEW   DISC  FILE                   >> <<04624>>19730000
      <<                                                    >> <<04624>>19732000
      <<****************************************************>> <<04624>>19734000
                                                                        19736000
NFILE:                                                                  19738000
      IF LWB="/" THEN <<null format>> LWB:=" ";                <<02350>>19740000
      TOS := ADJUSTOPS(NEWDIRFILE);                            <<00630>>19742000
      IF S0>=0 THEN GOTO ERR;                                  <<00630>>19744000
      DEL;                                                     <<00630>>19746000
      IF FOPCONTROL AND NOT FOPASCII THEN  <<INCONSISTENT?>>            19748000
         BEGIN                                                          19750000
         TOS := ACCVIOL;                                                19752000
         GO ERR                                                         19754000
         END;                                                           19756000
      IF AOPNOWAIT AND AOPINHIBITBUF AND NOT PRIVMODE THEN     <<HM.00>>19758000
         BEGIN                                                 <<HM.00>>19760000
         TOS := ILLCAP;                                        <<HM.00>>19762000
         GO ERR                                                <<HM.00>>19764000
         END;                                                  <<HM.00>>19766000
      STATE.CARRIAGEF := FOPCONTROL;  <<CARRIAGE CONTROL?>>             19768000
      RBSIZE;  <<GET RECORD AND BLOCK SIZES>>                           19770000
                                                                        19772000
      <<****************************************************>> <<04624>>19774000
      <<             ALLOCATE LOCAL FCB BUFFER              >> <<04624>>19776000
      << Allocate the FCB buffer on stack and check for     >> <<04624>>19778000
      << proper block and record size for variable files.   >> <<04624>>19780000
      <<****************************************************>> <<04624>>19782000
                                                                        19784000
      ALLOCFCB;  <<ALLOCATE FCB BUFFER>>                                19786000
                                                               <<04624>>19788000
      FCBFOPTIONS := FOPTIONS;  <<COPY FOPTIONS>>                       19790000
      IF FOPVARIABLE AND NOT FOPMSGFILE THEN  <<VAR RECS?>>    <<HM.00>>19792000
         BEGIN                                                          19794000
         IF FOPKSAM THEN <<KSAM FILE>>                         <<HM.00>>19796000
            BEGIN  <<KSAM HANDLE ITS OWN RECSIZE AND BSIZE>>   <<HM.00>>19798000
              <<BLOCKFACTOR NO CHANGE>>                        <<HM.00>>19800000
              BSIZE:=(RECSIZE+1)/2*BLOCKFACTOR;                <<HM.00>>19802000
              <<RECSIZE NO CHANGE EITHER>>                     <<HM.00>>19804000
            END                                                <<HM.00>>19806000
         ELSE                                                  <<HM.00>>19808000
            BEGIN  <<NOT KSAM FILE>>                           <<HM.00>>19810000
            TOS := BLOCKFACTOR;  << FOR SIZE WORDS >>          <<HM.00>>19812000
            IF NOT FOPNORMVAR THEN TOS := TOS*5; <<SPOOL INFO   *HM.00>>19814000
            BSIZE := TOS+BSIZE+1; <<ONE MORE FOR TERMINATOR>>  <<HM.00>>19816000
         IF BSIZE <= 0 THEN    <<BLOCK SIZE MUST BE A>>        <<01052>>19818000
            BEGIN              <<POSITIVE INTEGER    >>        <<01052>>19820000
            TOS:=BADVARBLK;    <<FOR VARIABLE LENGTH >>        <<01052>>19822000
            GO ERR             <<RECORDS             >>        <<01052>>19824000
            END;                                               <<01052>>19826000
            RECSIZE := BSIZE&LSL(1);                           <<HM.00>>19828000
         IF RECSIZE <= 0 THEN   <<RECORD SIZE MUST BE>>        <<01052>>19830000
            BEGIN               <<POSITIVE BYTES     >>        <<01052>>19832000
            TOS:=INVDRECSIZE;   <<FOR VARIABLE LENGTH>>        <<01052>>19834000
            GO ERR              <<RECORD             >>        <<01052>>19836000
            END;                                               <<01052>>19838000
            BLOCKFACTOR := 1;                                  <<HM.00>>19840000
            END;                                               <<HM.00>>19842000
         END;                                                  <<KS.00>>19844000
                                                                        19846000
      <<*****************************************************>><<04624>>19848000
      << Now, call FCREATE to allocate the extents and init- >><<04624>>19850000
      << ialize the FCB.  FCREATE will initialize most of the>><<04624>>19852000
      << FCB variables, including the extent map.  Finish    >><<04624>>19854000
      << initalizing what FCREATE did not.                   >><<04624>>19856000
      <<*****************************************************>><<04624>>19858000
                                                                        19860000
      X := FCREATE(DEVINFO,FCB,FOPTIONS,RECSIZE,BLOCKFACTOR,USERLABELS, 19862000
         NUMEXTENTS,FILESIZE,INITALLOC,SPOOLF,@XDDEP,PVINFO);  <<RV.PV>>19864000
      IF > THEN GO E3;  <<ERROR?>>                                      19866000
      FILELIMIT:=FCBFLIM;                                      <<HM.00>>19868000
      RESOURCES.DISKLOCK := TRUE;  <<SET DISC SPACE FLAG>>              19870000
      TOS := 0;  <<FOR LDEV>>                                           19872000
      TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                         19874000
      TOS := TOS&TASL(8)&DLSR(8);  <<SEPARATE LDEV>>                    19876000
      DISKADR := TOS;  <<FILE LABEL SECTOR NR.>>                        19878000
      DADDR := TOS;  <<FILE LABEL LDEV>>                                19880000
      VDADDR := VTABINX (DADDR,MVTABX<>0); <<VTABX>>           <<RV.PV>>19882000
      FCBUSERLBL := USERLABELS;  <<NR. USER LABELS>>                    19884000
      FCBEXCLSTAT := IF SPOOLF THEN 0 ELSE -1;                          19886000
      FCBOCNT := 1;  <<INIT. OPEN COUNT>>                               19888000
      IF NOT AOPREAD THEN FCBOCNTOUT := 1;  <<INIT. OUTPUT COUNT>>      19890000
      IF NOT AOPWRITEONLY THEN FCBOCNTIN := 1;  <<INIT. INPUT COUNT>>   19892000
      FCBSI := SIZEBFCB+(FCBNUMEXTS+1)&LSL(1)  <<FCB SIZE>>             19894000
      END                                                               19896000
$PAGE                                                          <<04624>>19898000
      <<****************************************************>> <<04624>>19900000
      <<                                                    >> <<04624>>19902000
      <<             NON   DIRECT  ACCESS  FILE             >> <<04624>>19904000
      <<                                                    >> <<04624>>19906000
      << Believe it or not, the X register contains the     >> <<04624>>19908000
      << access type (what a kludge).  Below is the ELSE of >> <<04624>>19910000
      << the HUGE IF DIRECT ACCESS clause.                  >> <<04624>>19912000
      <<****************************************************>> <<04624>>19914000
                                                               <<04624>>19916000
   ELSE                                                                 19918000
      BEGIN        << Non-direct access. >>                             19920000
                                                                        19922000
      IF LWB="/" THEN <<null format disc only>> LWB:=" ";      <<02350>>19924000
                                                               <<00199>>19926000
      IF DIRACCF AND X<>5 THEN GO E8; <<ONLY DA FILES OK>>     <<00469>>19928000
                                                               <<03035>>19930000
      IF AOPNOWAIT AND AOPINHIBITBUF AND NOT PRIVMODE THEN     <<03035>>19932000
         BEGIN                                                 <<03035>>19934000
         TOS := ILLCAP;                                        <<03035>>19936000
         GO ERR                                                <<03035>>19938000
         END;                                                  <<03035>>19940000
                                                               <<00199>>19942000
      <<****************************************************>> <<04624>>19944000
      << Do a case on the access type.  It will be one of   >> <<04624>>19946000
      << the following:  Serial Input, Parrallel Input/     >> <<04624>>19948000
      << Output, Serial Input/Output, Serial Output or DS.  >> <<04624>>19950000
      <<****************************************************>> <<04624>>19952000
                                                                        19954000
      CASE X-1 OF                                                       19956000
         BEGIN                                                          19958000
                                                                        19960000
         <<SERIAL INPUT DEVICE>>                                        19962000
                                                                        19964000
         BEGIN                                                          19966000
         IF (CARDR <= DTYPE <= PTREAD) THEN  <<CARD OR PAPER TAPE?>>    19968000
            BEGIN                                                       19970000
            FOPCONTROL := 0;  <<MAKE NO CARRIAGE CONTROL>>              19972000
            FOPFORMAT := 2;  <<MAKE UNDEFINED REC. FORMAT>>             19974000
            STATE.DEFAULTBF := 1;  <<SET DEFAULT BLOCKING FLAG>>        19976000
            BLOCKFACTOR := 1;                                           19978000
            FOPDOMAIN := 1;  <<MAKE OLD PERMANENT>>                     19980000
            IF NOT FOPASCII THEN AOPINHIBITBUF := 1  <<NO BUFFERING?>>  19982000
            END;                                                        19984000
         IF AOPWRITEONLY THEN  <<FORM OF WRITE ONLY?>>                  19986000
            BEGIN                                                       19988000
            TOS := ACCVIOL;                                             19990000
            GO ERR                                                      19992000
            END;                                                        19994000
         AOPACTYPE := 0;  <<MAKE INPUT ONLY>>                  <<00630>>19996000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>19998000
         IF S0>=0 THEN GOTO ERR;                               <<00630>>20000000
         DEL;                                                  <<00630>>20002000
         END;                                                           20004000
                                                                        20006000
         <<PARALLEL INPUT/OUTPUT DEVICE>>                               20008000
                                                                        20010000
         BEGIN                                                          20012000
         IF DTYPE = TERMINAL OR DTYPE = READERPUNCH THEN  <<T OR R/P?>> 20014000
            BEGIN                                                       20016000
            IF DTYPE = TERMINAL THEN FOPASCII := 1;  <<FORCE?>><<00.04>>20018000
            IF DTYPE = TERMINAL THEN AOPINHIBITBUF := 1;  <<MAKE NOBUF>>20020000
            IF DTYPE = READERPUNCH THEN  <<READER/PUNCH?>>              20022000
               BEGIN                                                    20024000
               FOPCONTROL := 0;  <<DISALLOW CCTL>>                      20026000
               IF AOPREADWRITE THEN AOPINHIBITBUF := 1;                 20028000
               IF AOPREAD THEN FOPDOMAIN := OLD'PERM'FILE;     <<04189>>20030000
               IF AOPWRITEONLY THEN                            <<04189>>20032000
                  BEGIN   << Write new, wrt save or append. >> <<04189>>20034000
                  AOPACTYPE := WRITE'NEW;   << Allow formsg >> <<04189>>20036000
                  FOPDOMAIN := NEW'FILE;                       <<04189>>20038000
                  END;                                         <<04189>>20040000
               END;                                                     20042000
            FOPFORMAT := 2;  <<MAKE UNDEFINED REC. FORMAT>>             20044000
            BLOCKFACTOR := 1;                                           20046000
            STATE.DEFAULTBF := 0  <<CLEAR DEFAULT BLOCKING FLAG>>       20048000
            END;                                               <<00630>>20050000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>20052000
         IF S0>=0 THEN GOTO ERR;                               <<00630>>20054000
         DEL;                                                  <<00630>>20056000
         END;                                                           20058000
                                                                        20060000
         <<SERIAL INPUT/OUTPUT DEVICE>>                                 20062000
                                                                        20064000
         BEGIN                                                          20066000
         IF AOPWRITEONLY THEN FOPDOMAIN := 0   <<NEW>>         <<01.03>>20068000
         ELSE IF AOPREAD THEN FOPDOMAIN := 1;  <<OLD>>         <<01.03>>20070000
         IF ABSOLUTE(AVR) <> 1 THEN FOPTIONS.FOPLABELLEDF := 0;<<02549>>20072000
         IF DACCCL = SERIALIO AND FOPLABELLED THEN             <<03578>>20074000
            BEGIN                                              <<01863>>20076000
            TOS := CREATETLTENT(FORMMSG,FNAMES,FILENUM,        <<02549>>20080000
               AOPACTYPE,DP'DEN);                              <<02568>>20082000
            IF S0 <> 0 THEN GO ERR                             <<01863>>20084000
            ELSE DEL;                                          <<01863>>20086000
            END;                                               <<01863>>20088000
         STATE.CARRIAGEF := FOPCONTROL;  <<CARRIAGE CONTROL?>> <<00630>>20090000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>20092000
         IF S0 >= 0 THEN GOTO ERR;                             <<00630>>20094000
         DEL;                                                  <<00630>>20096000
         END;                                                           20098000
                                                                        20100000
         <<SERIAL OUTPUT DEVICE>>                                       20102000
                                                                        20104000
         BEGIN                                                          20106000
                                                               <<01.03>>20108000
                                                               <<01.03>>20110000
         IF DTYPE = LPTR THEN FOPASCII := 1;   <<MAKE ASCII?>> <<01.03>>20112000
         FOPFORMAT := 2;  <<MAKE RECORD FORMAT UNDEFINED>>     <<01.03>>20114000
         BLOCKFACTOR := 1;                                     <<01.03>>20116000
         STATE.DEFAULTBF := 0;  <<CLEAR DEFAULT BLOCKING FLAG>><<01.03>>20118000
         FOPDOMAIN := 0;   <<MAKE NEW>>                        <<01.03>>20120000
                                                               <<01.03>>20122000
         IF AOPREAD AND PMAP.(5:1) THEN  <<READ ONLY SPECIFIED?>>       20124000
            BEGIN                                                       20126000
            TOS := ACCVIOL;                                             20128000
            GO ERR                                                      20130000
            END;                                                        20132000
         AOPACTYPE := 1;  <<MAKE WRITE ONLY - DELETE>>         <<00630>>20134000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>20138000
         IF S0>=0 THEN GOTO ERR;                               <<00630>>20140000
         DEL;                                                  <<00630>>20142000
         END;                                                  <<DS.00>>20144000
                                                               <<DS.00>>20146000
         << DS TYPE DEVICE >>                                  <<DS.00>>20148000
                                                               <<DS.00>>20150000
         BEGIN                                                 <<DS.00>>20152000
            REMOTE:=TRUE;                                      <<KS.00>>20154000
            IF DTYPE = DSDUMMYDEV THEN                         <<DS.00>>20156000
            BEGIN << RFA FOPEN >>                              <<DS.00>>20158000
               FINDAFT; << HOLD AFT FOR FILESYS >>             <<DS.00>>20160000
               TOS := -1;                                      <<DS.00>>20162000
               TOS := -1;                                      <<DS.00>>20164000
               DPS2 := TOS;                                    <<DS.00>>20166000
               DEL;                                            <<DS.00>>20168000
               TOS := 0;                                       <<DS.00>>20170000
               TOS := @DEVL;                                   <<DS.00>>20172000
               TOS := 0D;    TOS := 0D;                        <<DS.00>>20174000
               TOS := %20;  << PMAP >>                         <<DS.00>>20176000
               TOS := DSOPENPLABEL;                            <<DS.00>>20178000
               IF = THEN SUDDENDEATH(52);                      <<DS.00>>20180000
               ASMB(PCAL 0); << DS OPEN LINE >>                <<DS.00>>20182000
               RFALINENUM := TOS;                              <<DS.00>>20184000
               IF <> THEN                                      <<DS.00>>20186000
               BEGIN << DS OPEN FAILURE >>                     <<DS.00>>20188000
                  TOS := 0;                                    <<DS.00>>20190000
                  TOS := RFALINENUM;                           <<DS.00>>20192000
                  TOS := DSCHKPLABEL;                          <<DS.00>>20194000
                  IF = THEN SUDDENDEATH(52);                   <<DS.00>>20196000
                  ASMB(PCAL 0);                                <<DS.00>>20198000
$                 IF X1 = ON                                   <<DS.00>>20200000
                  IF <> THEN FTROUBLE(486);                    <<KJ.03>>20202000
$                 IF                                           <<DS.00>>20204000
RELAFT:                                                        <<DS.00>>20206000
                  FINDAFT; << RELEASE AFT >>                   <<DS.00>>20208000
                  TOS := 0D;                                   <<DS.00>>20210000
                  DPS2 := TOS;                                 <<DS.00>>20212000
                  DEL;                                         <<DS.00>>20214000
                  GO ERR;                                      <<DS.00>>20216000
               END;                                            <<DS.00>>20218000
               RESOURCES.DSLOCK := 1;                          <<DS.00>>20220000
               ALLOCRFABUF; << BUILD AND SEND REMOTE FOPEN >>  <<DS.00>>20222000
               RFALEN := 41;                                   <<02524>>20224000
               TOS := "RFA ";                                  <<DS.00>>20226000
               TOS := 1; << FOPEN TYPE >>                      <<DS.00>>20228000
               TOS := 36; << FORMAL DESIGNATOR >>              <<DS.00>>20230000
               TOS := FOPTIONS;                                <<DS.00>>20232000
               TOS := AOPTIONS;                                <<DS.00>>20234000
               IF S0.AOPACTYPEF > 5 THEN                       <<DS.03>>20236000
               BEGIN << EXECUTE ACCESS NOT ALLOWED >>          <<DS.03>>20238000
                  TOS := ACCVIOL;                              <<DS.03>>20240000
                  GO RELAFT;                                   <<DS.03>>20242000
               END;                                            <<DS.03>>20244000
               TOS.(4:1) := 0; << DISALLOW NO-WAIT I/O >>      <<DS.00>>20246000
               TOS := RECSIZE;                                 <<DS.00>>20248000
               TOS := 72; << DEVICE TYPE >>                    <<DS.00>>20250000
               TOS := DEVPARMFLAG := DEV'PARMS'LEN';           <<02524>>20252000
               RFALEN:=RFALEN+INTEGER(DEVPARMFLAG&LSR(1));     <<02524>>20254000
               TOS := TOS + 82;                                <<02524>>20258000
               TOS := USERLABELS;                              <<DS.00>>20260000
               TOS := BLOCKFACTOR;                             <<DS.00>>20262000
               TOS := PRICOPBUFS;                              <<DS.00>>20264000
               TOS := FILESIZE;                                <<DS.00>>20266000
               TOS := NUMEXTENTS;                              <<DS.00>>20268000
               TOS := INITALLOC;                               <<DS.00>>20270000
               TOS := FILECODE;                                <<DS.00>>20272000
               TOS := PMAP LOR %007577;    << PMAP >>          <<DS.00>>20274000
               LS0.(0:1) := STATUS.(0:1); << PRIV CODE BIT>>   <<DS.04>>20276000
               LS0.(1:1) := KSF.(15:1); << KSAM ENRT POINT >>  <<DS.06>>20278000
               IF LS0.(3:1) AND LWB <> " " THEN                <<DS.00>>20280000
               BEGIN << CHECK FOR LOCKWORD INSERTION IN FD >>  <<DS.00>>20282000
                  MOVE FD := FD WHILE AN,1;                    <<DS.00>>20284000
                  IF BPS0 <> "/" THEN                          <<DS.00>>20286000
                  BEGIN << INSERTION REQUIRED >>               <<DS.00>>20288000
                     X := 0;                                   <<DS.00>>20290000
                     DO                                        <<DS.00>>20292000
                     BEGIN << DETERMINE LOCKWORD LENGTH >>     <<DS.00>>20294000
                        TOS := LWB(X);                         <<DS.00>>20296000
                        DEL;                                   <<DS.00>>20298000
                     END UNTIL < OR (X:=X+1) >= 8;             <<DS.00>>20300000
                     TOS := @FD+35;                            <<DS.00>>20302000
                     TOS := @FD+34-X;                          <<DS.00>>20304000
                     MOVE * := *,(S2 - @FD - 35 + X);          <<DS.00>>20306000
                     BPS0 := "/";                              <<DS.00>>20308000
                     TOS := TOS + 1;                           <<DS.00>>20310000
                     MOVE * := LWB,(X),2;                      <<DS.00>>20312000
                  END;                                         <<DS.00>>20314000
                  DEL;                                         <<DS.00>>20316000
               END;                                            <<DS.00>>20318000
               ALLOCBUF; << PUT ON FORMAL DESIGNATOR >>        <<DS.00>>20320000
               ASSEMBLE(ADDS 18);                              <<DS.00>>20322000
               TOS := X; << BUF PTR >>                         <<DS.00>>20324000
               MOVE * := FD,(36);                              <<DS.00>>20326000
               ALLOCBUF; << PUT ON DEVICE SPEC. >>             <<DS.00>>20328000
               ALLOC'RESULT := X;                              <<01882>>20330000
               TOS := DEVPARMFLAG&LSR(1) + 5;                  <<02524>>20332000
               ASSEMBLE(ADDS 0);                               <<01882>>20336000
               X := ALLOC'RESULT;                              <<01882>>20338000
               TOS := X;                                       <<DS.00>>20340000
               DEVL(MAXDEVLEN) := " ";                         <<02555>>20342000
               SCAN DEVL UNTIL " #",1; << LOCATE REMOTE DEV >> <<DS.00>>20344000
               IF CARRY THEN                                   <<DS.00>>20346000
               BEGIN << NO REMOTE DEVICE TYPE SPECIFIED >>     <<DS.00>>20348000
                  TOS := UNDEFDEV;                             <<DS.00>>20350000
                  GO RELAFT;                                   <<DS.00>>20352000
               END;                                            <<DS.00>>20354000
               TOS := TOS + 1; << SKIP OVER # >>               <<DS.00>>20356000
               TOS := BPS0;                                    <<DS.00>>20358000
               DEL;                                            <<DS.00>>20360000
               IF < THEN                                       <<DS.00>>20362000
               BEGIN << DEFAULT DEVICE CLASS >>                <<DS.00>>20364000
                  DEL; << DEVL POINTER >>                      <<DS.00>>20366000
                  MOVE * := "DISC ";                           <<DS.00>>20368000
               END ELSE                                        <<DS.00>>20370000
                  BEGIN                                        <<01882>>20372000
                  MOVE * := *,(8),2;   << insert dev spec >>   <<01882>>20374000
                  BPS0 := " ";                                 <<02524>>20376000
                  DEL;                                         <<02524>>20378000
                  END;                                         <<02524>>20380000
                  STUFF'DEV'PARMS(DEVPARMS,ALLOC'RESULT);      <<02524>>20384000
               IF PMAP.(8:1) THEN                              <<DS.00>>20388000
               BEGIN << FORMS MESSAGE INCLUDED >>              <<DS.00>>20390000
                  ALLOCBUF;                                    <<DS.00>>20392000
                  ASSEMBLE (ADDS 81); <<ALLOW 81 WORDS>>       <<DS.RW>>20394000
                  TOS := X;                                    <<DS.00>>20396000
                  MOVE * := FORMMSG,(162);                     <<DS.RW>>20398000
                  RFALEN:=RFALEN+81;                           <<DS.RW>>20400000
               END;                                            <<DS.00>>20402000
               TOS := 0;                                       <<DS.00>>20404000
               TOS := RFALINENUM;                              <<DS.00>>20406000
               TOS := RFAMSG;                                  <<DS.00>>20408000
               TOS := RFASTREAM;                               <<DS.00>>20410000
               TOS := RFASUBSTR;                               <<DS.00>>20412000
               TOS := @RFAPTR;                                 <<DS.00>>20414000
               TOS := RFALEN;                                  <<DS.00>>20416000
               TOS := 0D;  TOS := 0D;                          <<DS.00>>20418000
               TOS := MWCPLABEL;                               <<DS.00>>20420000
               IF = THEN SUDDENDEATH(52);                      <<DS.00>>20422000
               ASMB(PCAL 0); << SEND FOPEN ACROSS LINE >>      <<DS.00>>20424000
               DEL;                                            <<DS.00>>20426000
               IF <> THEN                                      <<DS.00>>20428000
               BEGIN << TRANSMISSION FAILURE >>                <<DS.00>>20430000
                  TOS := 0;                                             20432000
                  TOS := RFALINENUM;                                    20434000
                  TOS := DSCHKPLABEL;                                   20436000
                  IF = THEN SUDDENDEATH(52);                            20438000
                  ASMB(PCAL 0);                                         20440000
$                 IF X1 = ON                                   <<DS.00>>20442000
                   IF <> THEN FTROUBLE(486);                   <<KJ.03>>20444000
$                 IF                                           <<DS.00>>20446000
                  GO RELAFT;                                   <<DS.00>>20448000
               END;                                            <<DS.00>>20450000
               DELAPPENDAGE;                                   <<DS.00>>20452000
               RFAFILENUM := S0.(8:8); << REMOTE FILE NUM >>   <<DS.00>>20454000
               IF TOS.CC <> CCE THEN                           <<DS.00>>20456000
               BEGIN << REMOTE FOPEN FAILED ON SLAVE >>        <<DS.00>>20458000
                  ALLOCRFABUF; << DO FCHECK FOR ERR NR. >>     <<DS.00>>20460000
                  TOS := "RFA ";                               <<DS.00>>20462000
                  TOS := %16;  << FCHECK INDEX >>              <<DS.04>>20464000
                  TOS := RFAFILENUM;                           <<DS.00>>20466000
                  TOS := %30; << PARAMETER MASK >>             <<DS.00>>20468000
                  TOS := 0D; << FILL OUT BUFFER >>             <<DS.00>>20470000
                  RFALEN := 5;                                 <<DS.00>>20472000
                  TOS := 0;                                    <<DS.00>>20474000
                  TOS := RFALINENUM;                           <<DS.00>>20476000
                  TOS := RFAMSG;                               <<DS.00>>20478000
                  TOS := RFASTREAM;                            <<DS.00>>20480000
                  TOS := RFASUBSTR;                            <<DS.00>>20482000
                  TOS := @RFAPTR;                              <<DS.00>>20484000
                  TOS := RFALEN;                               <<DS.00>>20486000
                  TOS := 0D;  TOS := 0D;                       <<DS.00>>20488000
                  TOS := MWCPLABEL;                            <<DS.00>>20490000
                  IF = THEN SUDDENDEATH(52);                   <<DS.00>>20492000
                  ASMB(PCAL 0);                                <<DS.00>>20494000
                  DEL;                                         <<DS.00>>20496000
                  IF <> THEN                                   <<DS.00>>20498000
                  BEGIN << TRANSMISSION FAILURE >>             <<DS.00>>20500000
                     TOS := 0;                                 <<DS.00>>20502000
                     TOS := RFALINENUM;                        <<DS.00>>20504000
                     TOS := DSCHKPLABEL;                       <<DS.00>>20506000
                     IF = THEN SUDDENDEATH(52);                <<DS.00>>20508000
                     ASMB(PCAL 0);                             <<DS.00>>20510000
$                    IF X1 = ON                                <<DS.00>>20512000
                     IF <> THEN FTROUBLE(486);                 <<KJ.03>>20514000
$                    IF                                        <<DS.00>>20516000
                     GO RELAFT;                                <<DS.00>>20518000
                  END;                                         <<DS.00>>20520000
                  ASSEMBLE(SUBS 5);                            <<DS.00>>20522000
                   GO TO RELAFT;                               <<DS.04>>20524000
               END;                                            <<DS.00>>20526000
               FINDAFT;                                        <<DS.00>>20528000
               TOS := RFAAFTOP;                                <<DS.00>>20530000
               IF AOPMULTIREC THEN TOS := TOS + 1;             <<DS.03>>20532000
               TOS := RFAFILENUM&LSL(8) + RFALINENUM;          <<DS.00>>20534000
               DPS2 := TOS; << INITIALIZE AFT >>               <<DS.00>>20536000
               ASMB(INCA,INCA);                                <<DS.03>>20538000
               TOS := DISP.(13:3);                             <<DS.03>>20540000
               PS1 := TOS; << SAVE PENDING DISP IN AFT >>      <<DS.03>>20542000
               FOPEN := AFTX;                                  <<DS.00>>20544000
               CONDCODE := CCE;                                <<DS.00>>20546000
               TOS := 0;                                       <<DS.00>>20548000
               GO EXIT;                                        <<DS.00>>20550000
            END;                                               <<DS.00>>20552000
         END;                                                  <<DS.00>>20554000
         END;                                                  <<DS.00>>20556000
                                                               <<DS.00>>20558000
      <<UNDEFINED DEVICE>>                                              20560000
                                                                        20562000
L:    IF FOPCONTROL AND NOT FOPASCII THEN  <<INCONSISTENT?>>   <<01115>>20564000
         BEGIN                                                          20566000
         TOS := ACCVIOL;                                                20568000
         GO ERR                                                         20570000
         END;                                                           20572000
      SAVAOPS := AOPTIONS;   << ALLOC may alter AOPTIONS >>    <<01882>>20574000
      TOS := ALLOC(NOT FOPNEW);    << allocate device >>                20576000
      IF AOPREAD AND (1 <= SAVAOPS.(12:4) <= 3) THEN           <<01882>>20578000
         GO ACCVIOLBL;                                         <<01882>>20580000
                                                               <<01882>>20582000
      IF DTYPE=FDISC THEN                                      <<01882>>20584000
         BEGIN    << fudge foreign disc stuff >>               <<01882>>20586000
         FOPFORMAT := FOPFIXEDFMT;                             <<01882>>20588000
         FOPASCII := 0;                                        <<01882>>20590000
         FOPCONTROL := 0;                                      <<01882>>20592000
         IF AOPAPPEND OR AOPEXECUTE OR (SAVAOPS.(12:4)=3) THEN <<01882>>20594000
            BEGIN                                              <<01882>>20596000
ACCVIOLBL:  TOS := ACCVIOL;                                    <<01882>>20598000
            GO ERR;                                            <<01882>>20600000
            END;                                               <<01882>>20602000
         END;                                                  <<01882>>20604000
      IF FOPLABELLED AND DACCCL = SERIALIO THEN                <<03578>>20608000
         BEGIN      << Labelled serial device >>               <<03578>>20610000
         TOS := POSITION(DADDR,FILENUM,BLOCKFACTOR,            <<02549>>20614000
            RECSIZE,FOPTIONS,AOPACTYPE);                       <<02549>>20616000
         IF S0 <> 0 THEN GO ERR;                               <<02549>>20618000
         DEL;                                                  <<02549>>20620000
         IF BLOCKFACTOR <> 0 THEN STATE.DEFAULTBF := 0;        <<02549>>20622000
         END          << Labelled mag tape >>                  <<02568>>20624000
      ELSE IF DTYPE = MTAPE THEN                               <<03578>>20626000
         BEGIN        << Unlabelled tape >>                    <<02568>>20628000
                                                               <<02568>>20630000
         << If tape is on variable density drive and user >>   <<02568>>20632000
         << has some sort of write access, post density.  >>   <<02568>>20634000
                                                               <<02568>>20636000
         IF (VARIABLE'DENSITY) AND (NOT AOPREAD) THEN          <<02568>>20638000
            STORE'DENSITY(DADDR,DP'DEN,0);                     <<02568>>20640000
                                                               <<04308>>20642000
         << If write access requested check for write ring >>  <<04308>>20644000
                                                               <<04308>>20646000
         << Note. This code is not implemented (SR #11434) >>  <<04308>>20648000
         << because of problem with FORTRAN.Files opened in>>  <<04308>>20650000
         << FORTRAN programs always have read/write access >>  <<04308>>20652000
         << and this code will force write ring even if    >>  <<04308>>20654000
         << program reads only from tape.                  >>  <<04308>>20656000
                                                               <<04308>>20658000
      << IF AOPACTYPE <> 0 THEN   << write rec with size = 0 >><<04308>>20660000
      <<    ATTACHIO (DADDR,0,0,0,1,0,0,4,%11); >>             <<04308>>20662000
                                                               <<04308>>20664000
         END;                                                  <<02568>>20666000
                                                               <<02568>>20668000
      RBSIZE;     << Get record and block sizes >>                      20670000
      TOS := STATE.READCODE;  <<EOF CHECKING MODE>>                     20672000
      ASSEMBLE(XCH);                                                    20674000
      SETPCBX;                                                          20676000
      IF DADDR = PXGSTDIN THEN  <<$STDIN?>>                             20678000
         BEGIN                                                          20680000
         DEL;                                                           20682000
         TOS := PXGJOBTYPE;                                             20684000
         IF <> THEN TOS := -(TOS-3);                                    20686000
         TOS.(12:2) := TOS;  <<JOB/SESSION>>                            20688000
         IF JOBF THEN  <<CI READ CODE>>                                 20690000
               TOS.(14:2) := STDINCIRD;  <<CI>>                         20692000
         END                                                            20694000
      ELSE                                                              20696000
         BEGIN                                                          20698000
         IF TOS = -2 THEN    <<:DATA ALLOC RETURN>>                     20700000
            BEGIN DEL; TOS := COLONRD; END                              20702000
         ELSE                                                           20704000
            IF DACCCL = SERIALIO THEN <<other data>>           <<03578>>20706000
               BEGIN DEL; TOS := MAGTRD; END                            20708000
         END;                                                           20710000
      IF NOT AOPREAD AND                                       <<00.04>>20712000
         (DTYPE <> TERMINAL OR AOPACTYPE <> 4) THEN            <<00.04>>20714000
         ASSEMBLE(DEL,ZERO);                                   <<00.04>>20716000
      STATE.READCODE := TOS;  <<EOF CHECKING MODE>>                     20718000
      IF (DADDR = PXGSTDIN) OR (DADDR = PXGSTDLIST) THEN                20720000
         BEGIN    <<$STDXX ACCESS>>                                     20722000
         AOPMULTAC := 1;  <<SET MULTI-ACCESS>>                          20724000
         <<AOPNOWAIT := 0;  <<SHOULD DISALLOW NO-WAIT I/O>>    <<00.05>>20726000
         AOPINHIBITBUF := (DTYPE=TERMINAL);  <<BUFFERING?>>             20728000
         FOPFORMAT := 2  <<FORCE UNDEFINED>>                            20730000
         END;                                                           20732000
      IF SPOOLF THEN GO SPOOLL;  <<VIRTUAL DEVICE ALLOC>>               20734000
      IF FOPVARIABLE THEN  <<VARIABLE RECORDS?>>                        20736000
         BEGIN                                                          20738000
         TOS := BLOCKFACTOR;  << FOR SIZE WORDS >>             <<00157>>20740000
         IF NOT FOPNORMVAR THEN TOS := TOS*5; <<SPOOL INFO>>   <<00157>>20742000
         BSIZE := TOS+BSIZE+1; <<ONE MORE FOR TERMINATOR>>     <<00157>>20744000
         RECSIZE := BSIZE&LSL(1);                              <<00157>>20746000
         BLOCKFACTOR := 1;                                     <<00157>>20748000
         END;                                                           20750000
<<*** KLUDGY CHECK FOR WRITE RING***>>                         <<00623>>20752000
                                                               <<00623>>20754000
      IF (DTYPE=MTAPE) AND AOPAPPEND THEN                      <<01882>>20756000
         ATTACHIO(DADDR,0,0,0,1,0,0,0,USFLAGS+%13); <<no PCB>> <<01882>>20758000
                                                               <<00623>>20760000
     IF DACCCL = SERIALIO AND AOPAPPEND                        <<03578>>20762000
     AND NOT FOPLABELLED THEN                                  <<00157>>20764000
         BEGIN  <<TAPE APPEND>>                                <<00.SD>>20766000
                                                                        20768000
                                                                        20770000
         <<* * * POSITION TAPE FOR APPENDING * * *>>                    20772000
                                                                        20774000
         TOS := ATTACHIO(DADDR,0,0,0,7,0,0,0,BFLAGS);  <<FSF>> <<+0.05>>20776000
         IF S1STAT = 1 OR S1STAT = EOFSTAT THEN  << TM found >><<03579>>20778000
            BEGIN                                              <<00.06>>20780000
            DDEL;                                              <<00.06>>20782000
            IF DTYPE = MTAPE THEN                              <<02568>>20784000
               SET'LPDT'BOT(DADDR,0);  << No longer at BOT >>  <<02568>>20786000
            TOS := ATTACHIO(DADDR,0,0,0,12,0,0,0,BFLAGS);      <<00.06>>20788000
            IF S1.(8:8) <> %12 THEN GO E0;  <<ATTACHIO error?>><<02568>>20790000
            END                                                <<00.06>>20792000
         ELSE IF S1.(8:8) = %103 THEN  <<RUNAWAY => NEW TAPE?>><<00.06>>20794000
            BEGIN                                              <<00.06>>20796000
            DDEL;                                              <<00.06>>20798000
            ATTACHIO(DADDR,0,0,0,5,0,0,0,USFLAGS+%13);<<Rewnd>><<02568>>20800000
            IF DTYPE = MTAPE THEN                              <<02568>>20802000
               SET'LPDT'BOT(DADDR,1);  << Tape back at BOT >>  <<02568>>20804000
            END                                                <<00.06>>20806000
         ELSE GO E0;  <<ATTACHIO ERROR?>>                      <<00.06>>20808000
         DDEL                                                  <<00.06>>20810000
         END                                                            20812000
      END;                                                              20814000
$PAGE                                                          <<04624>>20816000
   <<*******************************************************>> <<04624>>20818000
   <<              CREATE   AN    ACB                       >> <<04624>>20820000
   << Create an ACB via SETACB.  SETACB will initialize     >> <<04624>>20822000
   << most of the ACB variables and then returns with DB    >> <<04624>>20824000
   << set to the data segment containing the ACB.           >> <<04624>>20826000
   <<*******************************************************>> <<04624>>20828000
                                                                        20830000
   IF INTEGER(SPOOLF) > 0                                      <<04624>>20832000
      THEN FNAMEMQ := @SPFN - @Q0                              <<04624>>20834000
      ELSE FNAMEMQ := @FN   - @Q0;                             <<04624>>20836000
   IF DTYPE=SDISC AND AOPTIONS.(4:1)=1 THEN                    <<00188>>20838000
      GOTO E9;                                                 <<00188>>20840000
   SETACB(0,DUM,0,0,0,AFTX,AOPTIONS,FOPTIONS,DTYPE,RECSIZE,    <<01.02>>20842000
      BSIZE,NUMBUFFERS,BLOCKFACTOR,DADDR,FCBSI,SPINFO,         <<01.02>>20844000
      INTEGER(DNTYPE&LSL(8))+DISP,DISKADR,0D,0D,IPCINFO);      <<HM.00>>20846000
   LACBF := TOS;                                                        20848000
   ACBV'S := TOS; ACBPARMS := TOS;  <<ACB PARM'S>>                      20850000
   IF < THEN GO E5;  <<ERROR?>>                                         20852000
   IF > THEN GO NOFMAVT;    << Out of FMAVT entries.        >> <<04519>>20854000
   RESOURCES.ACBLOCK := TRUE;  <<SET ACB CREATED FLAG>>                 20856000
                                                               <<04624>>20858000
   <<*******************************************************>> <<04624>>20860000
   << Copy the file name from either FN or SPFN.  LOCK'CB is>> <<04624>>20862000
   << a tricky way to set up the parameters for an MDS to   >> <<04624>>20864000
   << copy the name from the stack to the ACB.  FNAMEMQ is  >> <<04624>>20866000
   << the Q-relative location of the name to copy.          >> <<04624>>20868000
   <<*******************************************************>> <<04624>>20870000
                                                               <<04624>>20872000
   LOCK'CB(0,0,FNAMEMQ,PACBV.DSTN,PACBV VTA);                  <<04624>>20874000
   TOS := TOS + ACBNAME'DISP;<< @ACBNAME                    >> <<04624>>20876000
   ASSEMBLE(DXCH);  << Exchange source and target addresses.>> <<04624>>20878000
   TOS := 4;                 << Move 8 characters, 4 words. >> <<04624>>20880000
   MOVE'DS'5;                << Copy name to ACB.           >> <<04624>>20882000
   DEL;                      << Delete FLAGS parameter.     >> <<04624>>20884000
   UNLOCK'CB(0,PACBV.DSTN,PACBV VTA);                          <<04624>>20886000
                                                               <<04624>>20888000
   ACBVDADDR := VDADDR;                                                 20890000
    ACBACCESS := %76; <<ALL EXCEPT STORE ACC>>                 <<00685>>20892000
   ACBLSTATE := LOGICAL(ACBLSTATE) LOR STATE;  <<INSERT STATE BITS>>    20894000
   ACBPRIV := FILECODE.(0:1);  <<PRIV. FILE BIT>>                       20896000
                                                               <<04624>>20898000
   <<*******************************************************>> <<04624>>20900000
   <<                                                       >> <<04624>>20902000
   <<               NON    DISK    FILE                     >> <<04624>>20904000
   <<                                                       >> <<04624>>20906000
   << Non disk files do not need an FCB.  Therefore, enter  >> <<04624>>20908000
   << here to update the LACB (if one exists), do some      >> <<04624>>20910000
   << checking and GO TO FINISH to initialize the AFT.      >> <<04624>>20912000
   <<*******************************************************>> <<04624>>20914000
                                                               <<04624>>20916000
   IF ((LOGICAL(DTYPE) LAND %70) <> DIRACC)   <<NON-DISC?>>    <<01115>>20918000
      OR (DTYPE=FDISC) THEN                   <<OR FOREIGN DISC>><<FDF>>20920000
      BEGIN                                                             20922000
      IF (DTYPE=MTAPE OR DTYPE=SDISC)                          <<02356>>20924000
         AND NOT FOPLABELLED                                   <<02356>>20926000
         AND AOPWRITE THEN ACBNEWEOF:=1;                       <<02356>>20928000
                                                               <<04514>>20930000
      <<****************************************************>> <<04514>>20932000
      << Copy the PACB to the LACB and unlock the ACB via   >> <<04514>>20934000
      << UNLOCACB.                                          >> <<04514>>20936000
      <<****************************************************>> <<04514>>20938000
                                                               <<04514>>20940000
      TOS := 0; TOS := ACBPARMS; TOS := ACBV'S;                <<DS.00>>20942000
      UNLOCACB(*,*,*,*,*,0); << RELEASE ACB >>                 <<DS.00>>20944000
      << Perform ATTACHIO setup for device allocation for >>   <<04136>>20946000
      << all devices except redirection or reopenning     >>   <<04136>>20948000
      << (by son) $STDLIST for output devices like e.g LP.>>   <<04136>>20950000
      << The extra call for setup will cause on LP extra  >>   <<04136>>20952000
      << page ejection.                                   >>   <<04136>>20954000
      IF ( JOBF << $STDIN/$STDINX >> OR                        <<04136>>20956000
           (AFTX > 2) << non $STDIN/$STDINX/$STDLIST >> OR     <<04136>>20958000
           (LDEVTOTYPE(DADDR) >= TERMINAL LAND  <<terminal>>   <<04136>>20960000
            LDEVTOTYPE(DADDR) < MTAPE)) AND                    <<04136>>20962000
         (DTYPE <> FDISC << it is not a foreign disc >>) THEN  <<04136>>20964000
         IF NOT PRIMEDEVICE(DADDR,XDDEP,PMAP.(8:1))            <<01027>>20966000
         THEN                                                  <<01027>>20968000
         BEGIN                                                 <<01027>>20970000
         TOS := IOERRHDR;     << header I/O err >>             <<01863>>20972000
         GO TO ERR;                                            <<01863>>20974000
         END;                                                  <<01027>>20976000
      GO FINISH                                                         20978000
      END;                                                              20980000
$PAGE                                                          <<04624>>20982000
   <<*******************************************************>> <<04624>>20984000
   <<                                                       >> <<04624>>20986000
   <<           DISK   FILE   COMPLETION                    >> <<04624>>20988000
   <<                                                       >> <<04624>>20990000
   << Set DB back from PACB extra data segment to stack.    >> <<04624>>20992000
   <<*******************************************************>> <<04624>>20994000
                                                               <<04624>>20996000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                20998000
                                                                        21000000
   <<*******************************************************>> <<04624>>21002000
   <<              CREATE    AN    FCB                      >> <<04624>>21004000
   << Create an FCB via FCREATECB.  If the file was opened  >> <<04624>>21006000
   << exclusively, then attempt to put the FCB in the stack.>> <<04624>>21008000
   << For files opened shared, the FCB ALWAYS goes in an ex->> <<04624>>21010000
   << tra data segment (shared FCB data segment).  Shared   >> <<04624>>21012000
   << FCB's are NEVER put in a processes stack.             >> <<04624>>21014000
   <<*******************************************************>> <<04624>>21016000
                                                                        21018000
   MOVE FCBGN := GN,(4);  <<GROUP NAME>>                                21020000
   MOVE FCBAN := AN,(4);  <<ACCOUNT NAME>>                              21022000
   FCBACB := PACBV;  <<INSERT PACB VECTOR>>                             21024000
                                                               <<04624>>21026000
   <<*******************************************************>> <<04624>>21028000
   << Now create the FCB and copy the local FCB array to the>> <<04624>>21030000
   << control block via UPDATE'FCB.  Most of the FCB was    >> <<04624>>21032000
   << initialized in FCREATE.  The rest of it was initial-  >> <<04624>>21034000
   << ized throughout FOPEN.                                >> <<04624>>21036000
   <<*******************************************************>> <<04624>>21038000
                                                               <<04624>>21040000
   FCREATECB(DUM,0,IF AOPMULTAC <> 0 THEN -2 ELSE -4,          <<01625>>21042000
      FCBSI,CBFCB);                                            <<01625>>21044000
   IF < THEN GO E6;  <<ERROR?>>                                         21046000
   FCBV := TOS;   << FCREATECB returns the new FCBV on TOS. >> <<04624>>21048000
   DEL;           << Don't need the @FCB. No split stack.   >> <<04624>>21050000
   EXCHANGEDB(0);          << Back to the stack.            >> <<04624>>21052000
   UPDATE'FCB(FCBV);       << Copy local FCB to control blk.>> <<04624>>21054000
   << Now unlock the FCB.  Was locked by FCREATECB.         >> <<04624>>21056000
   UNLOCK'CB(0,FCBV.DSTN,FCBV VTA);                            <<04624>>21058000
   RESOURCES.FCBLOCK := TRUE;  <<SET FCB CREATED FLAG>>                 21060000
                                                               <<04624>>21062000
                                                               <<04624>>21064000
   <<*******************************************************>> <<04624>>21066000
   << Complete update of ACB.  Call FGETCB to reset the DB  >> <<04624>>21068000
   << at the PACB data segment.  UNLOCACB will reset the    >> <<04624>>21070000
   << DB to the stack.                                      >> <<04624>>21072000
   <<*******************************************************>> <<04624>>21074000
                                                                        21076000
   FGETCB(0,0,DUM,PACBV,0);  <<RE-FIND ACB>>                   <<01.02>>21078000
   ACBPARMS := TOS;  <<DST AND ACB>>                                    21080000
   DEL;  <<DISCARD NEW VECTOR>>                                         21082000
   ACBFCB := FCBV;  <<INSERT FCB VECTOR>>                               21084000
                                                               <<04514>>21086000
   <<*******************************************************>> <<04514>>21088000
   << Copy the PACB to the LACB and unlock the ACB via the  >> <<04514>>21090000
   << procedure UNLOCACB.                                   >> <<04514>>21092000
   <<*******************************************************>> <<04514>>21094000
                                                               <<04514>>21096000
   TOS := 0; TOS := ACBPARMS; TOS := ACBV'S;                   <<DS.00>>21098000
   UNLOCACB(*,*,*,*,*,0); << RELEASE ACB >>                    <<DS.00>>21100000
                                                                        21102000
   <<*******************************************************>> <<04624>>21104000
   <<               CREATE     FILE     LABEL               >> <<04624>>21106000
   << Allocate the FLAB buffer on stack and initialize the  >> <<04624>>21108000
   << FLAB buffer and write it to disk.                     >> <<04624>>21110000
   <<*******************************************************>> <<04624>>21112000
                                                                        21114000
   ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>                           21116000
   TOS := @FLAB; PS0 := 0;  <<CLEAR BUFFER>>                            21118000
   ASSEMBLE(DUP,INCB); TOS := 127; ASSEMBLE(MOVE 3);                    21120000
   MOVE FLLOCNAME := FN,(4);  <<LOCAL FILE NAME>>                       21122000
   MOVE FLGRPNAME := GN,(4);  <<GROUP NAME>>                            21124000
   MOVE FLACCTNAME := AN,(4);  <<ACCOUNT NAME>>                         21126000
   MOVE FLUSERID := USERID,(4);  <<USER NAME>>                          21128000
   MOVE FLLOCKWORD := LW,(4);  <<LOCK WORD>>                            21130000
   FLSECMX:=[6/32,6/32,6/32,6/32,6/32]D;<<Def: R,A,W,L,X:ANY>> <<01175>>21132000
   FLSECURE:=1;                         << Secure file >>      <<01175>>21134000
   FLFILECODE := FILECODE;                                              21136000
   FLFCBVECT := FCBV;                                                   21138000
   FLFLIM := FCBFLIM;                                                   21140000
   FLPVINFO := PVINFO;                                         <<00188>>21142000
   FLUSERLBL := USERLABELS;                                             21144000
   IF SPOOLF THEN FLCLID := ABSOLUTE(CLOADID);                          21146000
   FLFOPTIONS := FOPTIONS;                                              21148000
   IF FOPMSGFILE THEN FLFORMAT:=1;  <<MSG FILE USES VAR LEN REC  HM.00>>21150000
   FLRECSIZE := -RECSIZE;                                               21152000
   FLBLKSIZE := BSIZE;                                                  21154000
   FLSECTOFF := FCBSECTOFF;                                             21156000
   FLNUMEXTS := FCBNUMEXTS;                                             21158000
   FLEXTSIZE := FCBEXTSIZE;                                             21160000
   FLLASTEXTSIZE := FCBLASTEXTSIZE;                                     21162000
   TOS := CALENDAR;  <<DAY AND YEAR>>                                   21164000
   ASSEMBLE(DUP,DUP);                                                   21166000
   FLCREATE := TOS;                                                     21168000
   FLLASTACC := TOS;                                                    21170000
   FLLASTMOD := TOS;                                                    21172000
   LDEVTOVTAB (FLEXTMAP,FCBEXTMAP,FCBNUMEXTS+1,PVINFO<>0);     <<RV.PV>>21174000
   FLALLOCDATE := CALENDAR;  <<SET RESTORE DATE>>              <<00630>>21176000
   FLALLOCTIME := CLOCK;                                       <<00630>>21178000
   TOS := @FLDEVNAME&LSL(1);                                            21180000
   MOVE * := DEVL,(8);  <<DEVICE CLASS NAME>>                           21182000
   TOS := 0;  <<FOR LDEV>>                                              21184000
   TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                            21186000
   TOS := TOS&TASL(8)&DLSR(8);  <<SEPARATE LDEV>>                       21188000
   DISKADR := TOS;  <<FILE LABEL SECTOR NR.>>                           21190000
   DADDR := TOS;  <<FILE LABEL LDEV>>                                   21192000
   A := GETSIR(FISIR);  <<GET FILE SIR - FLABIO CHECK!>>       <<+0.06>>21194000
   LABELIO(1,1);  <<WRITE FILE LABEL>>                                  21196000
   IF INTEGER(SPOOLF) < 0 THEN   <<SPOOLFILE ACCESSED AS A FILE  +1.03>>21198000
      BEGIN                                                             21200000
      TOS := 0D;                                                        21202000
      TOS := P1;                                                        21204000
      TOS.(0:8) := DADDR;                                               21206000
      TOS := P2;                                                        21208000
      XDDSPOOLINFO(*,%3,XDDEP)   <<PUT LABEL ADDR IN XDD>>     <<+1.03>>21210000
      END;                                                              21212000
   IF SPOOLF THEN  <<SPOOLFILE ACCESSED AS A DEVICE>>          <<+1.03>>21214000
      BEGIN                                                             21216000
      TOS := 0D;                                                        21218000
      TOS := 1;                                                         21220000
      TOS := FCBEXTSIZE;                                                21222000
      XDDSPOOLINFO(*,%41,XDDEP)  <<PUT FILE SIZE IN XDD>>      <<+1.03>>21224000
      END;                                                              21226000
                                                                        21228000
   <<* * * OPEN FILE * * *>>                                            21230000
                                                                        21232000
   TOS := ATTACHIO(DADDR,0,0,0,2,0,0,0,BSFLAGS);  <<OPEN FILE>><<+0.05>>21234000
   IF S1.(8:8) <> 1 THEN GO E0;  <<ATTACHIO ERROR?>>                    21236000
                                                               <<+0.04>>21238000
   <<* * * MEASUREMENT DATA ON NEW DISC FILE OPEN * * *>>      <<+0.04>>21240000
                                                               <<+0.04>>21242000
$  IF X3 = ON                                                  <<+0.04>>21244000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>21246000
   TOS := EFOPEN;  <<EVENT NR.>>                               <<+0.04>>21248000
   TOS := FILENUM;  <<FILE NR.>>                               <<+0.04>>21250000
   TOS := SPOOLF;  <<SPOOLING FLAG>>                           <<+0.04>>21252000
   IF < THEN  <<SPOOLER ACCESS?>>                              <<+0.04>>21254000
      BEGIN                                                    <<+0.04>>21256000
      DEL;                                                     <<+0.04>>21258000
      TOS := 2                                                 <<+0.04>>21260000
      END;                                                     <<+0.04>>21262000
   TOS.(0:2) := TOS;  <<INSERT ACCESSOR CODE>>                 <<+0.04>>21264000
   MMSTAT(*,*,AOPTIONS,FOPTIONS);  <<MEASURE EVENT>>           <<+0.05>>21266000
   MMSTAT(EFOPEN',RECSIZE,BSIZE,                               <<+0.05>>21268000
      IF NUMBUFFERS > 16 THEN 16 ELSE NUMBUFFERS);             <<+0.04>>21270000
   TOS := EFOPEN';  <<EVENT CODE>>                             <<+0.04>>21272000
   TOS := FCBFLIM;  <<FILE LIMIT>>                             <<+0.04>>21274000
   TOS := FCBNUMEXTS+1;  <<NR. EXTENTS>>                       <<+0.04>>21276000
   TOS.(0:8) := INITALLOC;  <<NR. EXTENTS ALLOCATED>>          <<+0.04>>21278000
   MMSTAT(*,*,*,*);  <<MEASURE EVENT>>                         <<+0.05>>21280000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>21282000
$  IF                                                          <<+0.04>>21284000
                                                                        21286000
   <<* * * INITIALIZE AFT ENTRY * * *>>                                 21288000
                                                                        21290000
FINISH:                                                                 21292000
   FINDAFT;  <<AFT ENTRY POINTER>>                                      21294000
   TOS := (IF FOPMSGFILE AND NOT AOPCOPY THEN MSG'TYPE&LSL(12) <<HM.00>>21296000
      ELSE 0) + AFTOPT;                                        <<HM.00>>21298000
   TOS := PACBV;                                               <<HM.00>>21300000
   DPS2 := TOS;  <<INIT. FIRST HALF>>                                   21302000
   TOS := TOS+2;                                                        21304000
   TOS := LACBV; TOS := 0;                                              21306000
   DPS2 := TOS;  <<INIT. SECOND HALF>>                                  21308000
   FOPEN := AFTX;  <<FILE NR.>>                                         21310000
   CONDCODE := CCE;  <<OK CONDITION CODE>>                              21312000
   TOS := 0;  <<NO ERROR>>                                              21314000
   GO EXIT;                                                             21316000
                                                                        21318000
   <<* * * ERROR RECOVERY * * *>>                                       21320000
                                                                        21322000
E0:  << ATTACHIO ERROR >>                                               21324000
   ASSEMBLE(XCH,ZROB);                                                  21326000
   TOS := IOSTAT(*);                                                    21328000
   GO ERR;                                                              21330000
     HELP  <<FOR DUMMY CALL>>;                                 <<00117>>21332000
                                                                        21334000
E1:  << INVALID FORMAL DESIGNATOR >>                                    21336000
   TOS := INVFREF;                                                      21338000
   GO ERR;                                                              21340000
                                                                        21342000
E3:  << FCREATE ERROR >>                                                21344000
   X := X-1;                                                            21346000
   IF SPOOLF                                                            21348000
      THEN TOS := SPCREATEERR(X)                                        21350000
      ELSE TOS := FCREATEERR(X);                                        21352000
   GO ERR;                                                              21354000
                                                                        21356000
E4:  << TOO MANY FILES >>                                               21358000
   TOS := TMFP;                                                         21360000
   GO ERR;                                                              21362000
                                                                        21364000
E4': << No room left for PXFILE expansion   >>                 <<02357>>21366000
   TOS := NOROOMLEFT;                                          <<02357>>21368000
   GO ERR;                                                     <<02357>>21370000
                                                               <<02357>>21372000
E5:  << NO MEMORY FOR ACB >>                                            21374000
                                                                        21376000
E6:  << NO MEMORY FOR FCB >>                                            21378000
   TOS := MEMPROB;                                                      21380000
   GO ERR;                                                              21382000
                                                                        21384000
E9:  << ILL PARM >>                                                     21386000
    TOS := ILLPARM; GO ERR;                                    <<01.01>>21388000
                                                               <<+1.01>>21390000
E8:  << NOT FS DEVICE >>                                       <<00117>>21392000
    TOS := DEVVIOL; GO ERR;                                    <<00117>>21394000
                                                               <<00117>>21396000
SECVIOL:                                                                21398000
   TOS := SEXVIOL;                                                      21400000
   GO ERR;                                                              21402000
                                                                        21404000
NOFMAVT:                                                       <<04519>>21406000
   TOS := OUTFMAVT;                                            <<04519>>21408000
   GO ERR;                                                     <<04519>>21410000
                                                               <<04519>>21412000
FCODERR:   << FILE CODE ERROR >>                                        21414000
   TOS := PRIVVIOL;                                                     21416000
                                                                        21418000
ERR:                                                                    21420000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                21422000
   IF PACBLOCKED THEN  <<UNLOCK PACB?>>                                 21424000
      BEGIN                                                             21426000
      FGETCB(0,0,DUM,PACBV,0);  <<RE-FIND PACB>>               <<01.02>>21428000
      ASSEMBLE(DEL,XCH);                                                21430000
      FRELCB(*,*,1)  <<RELEASE PACB>>                                   21432000
      END;                                                              21434000
   TOS := RESOURCES;  <<RESOURCE FLAGS>>                                21436000
   IF LS0.ACBLOCK THEN DELACB(PACBV,LACBV);  <<ACB CREATED?>>           21438000
   IF LS0.FCBLOCK THEN FDELETECB(FCBV);  <<FCB CREATED?>>               21440000
   IF A <> -1 THEN RELSIR (FISIR, A);                          <<01708>>21442000
   IF B <> -1 THEN RELSIR (FMAVTSIR, B);                       <<01708>>21444000
   A := -1;   B := -1;                                         <<01708>>21446000
   IF LS0.DEVICELOCK THEN DEALLOCATE(DADDR);  <<DEVICE ALLOCATED?>>     21448000
   IF LS0.DISKLOCK THEN   <<DISC SPACE ALLOCATION>>            <<DS.00>>21450000
      BEGIN                                                             21452000
      TOS := FCBNUMEXTS+1;                                              21454000
      IF SPOOLF THEN TOS.(8:1) := 1;                                    21456000
      X := DISKDEALLOC(FCBEXTSIZE,FCBLASTEXTSIZE,S0,FCBEXTMAP);         21458000
      DEL;                                                              21460000
$     IF X1 = ON                                                        21462000
      IF <> THEN FTROUBLE(470);  <<ERROR?>>                    <<KJ.03>>21464000
$     IF                                                                21466000
      END;                                                              21468000
   IF LS0.DSLOCK THEN                                          <<RV.PV>>21470000
   BEGIN << RELEASE DS LINE >>                                 <<DS.00>>21472000
      TOS := RFALINENUM;                                       <<DS.00>>21474000
      TOS := DSCLOSEPLABEL;                                    <<DS.00>>21476000
      IF = THEN SUDDENDEATH(52);                               <<DS.00>>21478000
      ASMB(PCAL 0);                                            <<DS.00>>21480000
   END;                                                        <<DS.00>>21482000
   IF TOS.DMOUNT THEN                                          <<RV.PV>>21484000
   BEGIN <<NEED TO DISMOUNT A JUST MOUNTED VOLUME SET>>        <<RV.PV>>21486000
       REQTYPE := IF PVOPEN' THEN CONDDISMOUNT                 <<RV.PV>>21488000
                             ELSE UNCONDDISMOUNT;              <<RV.PV>>21490000
       DISMOUNT (HVSIND, GNPTR, ANPTR,                         <<26.PV>>21492000
                 REQTYPE, PVINFO);                             <<23.PV>>21494000
       IF <> THEN                                              <<RV.PV>>21496000
       BEGIN <<SOME FAILURE>>                                  <<RV.PV>>21498000
           S0 := DISMOUNTPROB; <<HIGHER PRIORITY PROBLEM?>>    <<RV.PV>>21500000
       END ELSE RESOURCES.DMOUNT := FALSE;                     <<RV.PV>>21502000
   END;                                                        <<RV.PV>>21504000
                                                                        21506000
   CONDCODE := CCL;  <<ERROR CONDITION CODE>>                           21508000
   SETPXFILE;  <<INIT. PXFILE POINTER>>                                 21510000
                                                                        21512000
XIT:                                                                    21514000
   SPOOLERRCODE;                                                        21516000
   PXFFOPEN := S0;  <<ERROR NR.>>                                       21518000
                                                                        21520000
EXIT:                                                                   21522000
   IF A <> -1 THEN RELSIR(FISIR,A);  <<RELEASE FILE INTEGRITY SIR?>>    21524000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);                                  21526000
   DP'INDEX := 0;                                              <<02555>>21530000
   DEVPARMFLAG := 0;                                           <<02555>>21532000
   IF  INTEGER(SPOOLF) > 0  AND  RESULT <> 0                   <<02555>>21534000
      THEN  SPOOLFOPEN                                         <<02555>>21536000
   ELSE                                                        <<02555>>21538000
      IF CONDCODE = CCE  AND  REMOTE  THEN                     <<02555>>21540000
         BEGIN                                                 <<02555>>21542000
            << Before we check if we're spooled, must not be >><<04311>>21544000
            << KSAM. (FFILEINFO not supported on KSAM files. >><<04311>>21546000
                                                               <<04311>>21548000
            FGETINFO(AFTX,,REM'FOPT,,,,,,REM'FCODE);           <<04311>>21550000
            IF REM'KSAM'FOPT  OR  REM'KSAM'FCODE               <<04311>>21552000
               THEN REM'SPOOL'ID := 0                          <<04311>>21554000
            ELSE                                               <<04311>>21556000
            BEGIN                                              <<04311>>21558000
            <<Check if spooled>>                               <<02555>>21560000
            FFILEINFO(AFTX,38,REM'SPOOL'ID);                   <<02555>>21562000
            IF <> THEN  REMOTE'ACCESS'ERROR;                   <<04311>>21564000
            END;                                               <<04158>>21568000
                                                               <<04311>>21570000
                                                               <<04311>>21572000
                                                               <<02555>>21574000
            IF REM'SPOOL'ID <> 0 THEN   <<It's spooled>>       <<02555>>21576000
               GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX);      <<02555>>21578000
                                                               <<02555>>21580000
         END            << Remote file >>                      <<04383>>21582000
   ELSE IF CONDCODE = CCE THEN   << ENV on 2608x hot prntr? >> <<04383>>21584000
           GET'DEV'PARM (ENV'TOKEN, DEVPARMS, DP'INDEX);       <<04383>>21586000
                                                               <<02555>>21588000
   IF DP'INDEX <> 0 THEN                                       <<02555>>21590000
      BEGIN             <<Call PLOADENV for downloadable >>    <<02555>>21592000
                        <<environment file               >>    <<02555>>21594000
      PLOADENV(RESULT,BDEVPARMS((DP'INDEX+1)&LSL(1)),          <<02555>>21596000
               DEVPARMFLAG,ALLOC'RESULT);                      <<02555>>21598000
      SETPCBX;          <<Reset PCB pointer after env open>>   <<02555>>21600000
                                                               <<02555>>21602000
      CASE DEVPARMFLAG OF                                      <<02555>>21604000
        BEGIN                                                  <<02555>>21606000
        <<0>>   DP'FLAG := 0;          <<Successful>>          <<02555>>21608000
        <<1>>   DP'FLAG := DP'ENV'OPEN'FAIL;                   <<02555>>21610000
        <<2>>   DP'FLAG := DP'ENV'BADFILE;                     <<02555>>21612000
        <<3>>   DP'FLAG := DP'ENV'HDR'FAIL;                    <<02555>>21614000
        <<4>>   DP'FLAG := DP'ENV'NOT'COMPILE;                 <<02555>>21616000
        <<5>>   DP'FLAG := 0;          <<Warning-recs changed>><<02555>>21618000
        <<6>>   DP'FLAG := DP'ENV'READ'ERR;                    <<02555>>21620000
        <<7>>   DP'FLAG := DP'ENV'READ'ERR;                    <<02555>>21622000
        <<8>>   DP'FLAG := DP'ENV'FCLOSE;                      <<02555>>21624000
        <<9>>   DP'FLAG := 0;          <<Warning-FGETINFO fail><<02555>>21626000
        <<10>>  DP'FLAG := DP'ENV'FDEVICECONTROL;              <<02555>>21628000
        END;            <<Case>>                               <<02555>>21630000
                                                               <<02555>>21632000
      IF DP'FLAG <> 0 THEN                                     <<02555>>21634000
        BEGIN                                                  <<02555>>21636000
        SPOOLFILE'PURGE(AFTX,@XDDEP,0,0);<<Purge the spoofle>> <<04679>>21638000
        CONDCODE := CCL;                                       <<02555>>21640000
        SETPXFILE;                                             <<02555>>21642000
        PXFFOPEN := DP'FLAG;                                   <<02555>>21644000
        TOS := DP'FLAG;                                        <<02555>>21646000
        RESULT := 0;         <<Reset spool open to fail>>      <<02555>>21648000
        GO BUM;                                                <<02555>>21650000
        END                                                    <<02555>>21652000
      ELSE IF INTEGER (SPOOLF) > 0 THEN                        <<04481>>21654000
                                                               <<04481>>21656000
<< Now that environment files are supported on hot devices, >> <<04481>>21658000
<< we must be careful not to do the user label stuff  below >> <<04481>>21660000
<< unless the device or class is spooled.                   >> <<04481>>21662000
                                                               <<04481>>21664000
         BEGIN           << No errors from PLOADENV >>         <<02555>>21666000
         ALLOCFLAB;     << allot stack buffer of 128 words >>  <<02555>>21668000
         FREADLABEL(AFTX,FLAB);   << read u-label 0 >>         <<02555>>21670000
         IF <  THEN ERR'SPULAB;                                <<02555>>21672000
                                                               <<02555>>21674000
         SPULAB'LAST'ENV := " ";                               <<02555>>21676000
         MOVE FLAB(12) := FLAB(11), (17);                      <<02555>>21678000
         MOVE SPULAB'LAST'ENV := DEVPARMS(DP'INDEX+1),         <<02555>>21680000
                            ((DEVPARMS(DP'INDEX)+1)&ASR(1));   <<02555>>21682000
         << Make sure ENV file name is terminated by a CR >>   <<02555>>21684000
         @BFLAB := @FLAB & LSL(1);                             <<02571>>21686000
         BFLAB( 22 + (DEVPARMS(DP'INDEX)-1) ) := %15;          <<02555>>21688000
         FWRITELABEL(AFTX,FLAB);                               <<02555>>21690000
         IF <> THEN ERR'SPULAB;                                <<02555>>21692000
         ASSEMBLE (SUBS 128);     << deallocate stack buffer >><<02555>>21694000
         END;                                                  <<02555>>21696000
                                                               <<02555>>21698000
      END;         << Take care of ENV file >>                 <<02555>>21700000
                                                               <<02555>>21702000
   <<THE FOLLOWING IS A KLUDGE TO AVOID A COMPILER ERROR>>     <<00199>>21704000
   IF CONDCODE=CCE AND                                         <<00199>>21706000
     NOT (REMOTE LOR KSF LOR JOBF LOR SPOOLF) THEN             <<00199>>21708000
   BEGIN <<POSSIBLE KSAM FILE>>                                <<KS.00>>21710000
     FOPTIONS:=0;                                           <<KS.01.06>>21712000
      FGETINFO(RESULT,,FOPTIONS);                              <<KS.00>>21714000
      IF FOPKSAM THEN                                          <<HM.00>>21716000
      BEGIN <<KSAM FILE TO BE OPENED>>                         <<KS.00>>21718000
         IF FOPTIONS.FOPDOMAINF=0 THEN                         <<KS.00>>21720000
         BEGIN <<NEW FILE>>                                    <<KS.00>>21722000
            KFCLOSE(RESULT,0,0);                               <<KS.00>>21724000
            IF PMAP.(3:1)=0 <<FORMALDES ABSENT>>               <<KS.00>>21726000
            OR PMAP.(8:1)=0 <<KSAMPARAM=FORMSMSG ABSENT>> THEN <<KS.00>>21728000
               BEGIN  <<CAN NOT OPEN>>                         <<KS.00>>21730000
               CONDCODE:=CCL; <<ERROR CONDITION CODE>>         <<KS.00>>21732000
               SETPXFILE;                                   <<KS.01.06>>21734000
               PXFFOPEN:=ILLPARM;<<"ILLEGAL PARAMETER">>       <<KS.00>>21736000
               RESULT:=0; <<FOPEN:=0>>                         <<KS.00>>21738000
               GO BUM;                                         <<KS.00>>21740000
               END;  <<CAN NOT OPEN>>                          <<KS.00>>21742000
            TOS:=KOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,       <<KS.00>>21744000
           -RECSIZE,DEVL <<NB>>,FORMMSG,USERLABELS,            <<KS.00>>21746000
            BLOCKFACTOR,PRICOPBUFS,FILESIZE,NUMEXTENTS,        <<KS.00>>21748000
            INITALLOC,FILECODE);                               <<KS.00>>21750000
            PUSH(STATUS);                                      <<KS.00>>21752000
            TOS:=TOS.(6:2);                                    <<KS.00>>21754000
            CONDCODE:=TOS;                                     <<KS.00>>21756000
            RESULT:=TOS;                                       <<KS.00>>21758000
         END <<NEW FILE>>                                      <<KS.00>>21760000
      ELSE                                                     <<KS.00>>21762000
         BEGIN <<OLD FILE>>                                    <<KS.00>>21764000
            IF AOPCOPY THEN                                    <<HM.00>>21766000
            <<DO NOTHING. NOT KSAM ACCESS>>                    <<KS.00>>21768000
         ELSE                                                  <<KS.00>>21770000
            BEGIN<<STANDARD OLD KSAM>>                         <<KS.00>>21772000
               KFCLOSE(RESULT,0,0);                            <<KS.00>>21774000
              IF NOT DIRACCF THEN                              <<01264>>21776000
              BEGIN       << disallow Run KSAM files >>        <<01264>>21778000
               FOPNOEQUATE:=SAVFOPNEQ; <<RESTORE NOEQUATE BIT    KJ.03>>21780000
               TOS:=KOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,    <<KS.00>>21782000
              -RECSIZE,DEVL <<NB>>,FORMMSG,USERLABELS,         <<KS.00>>21784000
               BLOCKFACTOR,PRICOPBUFS,FILESIZE,NUMEXTENTS,     <<KS.00>>21786000
               INITALLOC,FILECODE);                            <<KS.00>>21788000
               PUSH(STATUS);                                   <<KS.00>>21790000
               TOS:=TOS.(6:2);                                 <<KS.00>>21792000
               CONDCODE:=TOS;                                  <<KS.00>>21794000
               RESULT:=TOS;                                    <<KS.00>>21796000
              END;                                             <<01264>>21798000
            END;<<STANDARD OLD KSAM>>                          <<KS.00>>21800000
         END; <<OLD FILE>>                                     <<KS.00>>21802000
      END;<<KSAM FILE>>                                        <<KS.00>>21804000
   END;<<POSSIBLE KSAM FILE>>                                  <<KS.00>>21806000
BUM:                                                           <<KS.00>>21808000
   IF CONDCODE<>CCE THEN FOPEN := 0;                           <<00107>>21810000
   RESETCRITICAL(CRIT);                                                 21812000
   ERROREXIT(15,S0,0)                                                   21814000
   END;     << procedure FOPEN >>                                       21816000
$ PAGE " FRENAME "                                                      21822000
$ CONTROL SEGMENT = FILESYS4                                            21824000
PROCEDURE FRENAME(FILENUM,NEWFREF);                            <<KS.00>>21826000
   <<MUST BE CALLED WITH DB SET TO THE STACK>>                          21828000
   VALUE FILENUM;                                                       21830000
   INTEGER FILENUM;                                                     21832000
   BYTE ARRAY NEWFREF;                                                  21834000
   OPTION PRIVILEGED;                                                   21836000
   BEGIN                                                                21838000
                                                               <<04514>>21840000
   <<*******************************************************>> <<04514>>21842000
   <<  Error condition        ACBERROR      Condition Code  >> <<04514>>21844000
   <<                                                       >> <<04514>>21846000
   << PCBXFSECT not initialized             ***H A N G ***  >> <<04514>>21848000
   << 1 > FILENUM > FXMAXNUM                ***H A N G ***  >> <<04514>>21850000
   << Privileged file code and caller not   ***H A N G ***  >> <<04514>>21852000
   << FILNUM is $NULL                            CCE        >> <<04514>>21854000
   << DTYPE <> "DISC"         DEVVIOL            CCL        >> <<04514>>21856000
   << FILENUM <> EXCLUSIVE    MULITACCERR        CCL        >> <<04514>>21858000
   << R/W Label Error         LBLIOERR           CCL        >> <<04514>>21860000
   << NEWFREF Invalid         INVFREF            CCL        >> <<04514>>21862000
   << FILENUM Rename to $NULL INVFNAME           CCL        >> <<04514>>21864000
   << RENAME accross HVS's    HVSIOL             CCL        >> <<04514>>21866000
   << ****N O R M A L****                        CCE        >> <<04514>>21868000
   <<                                                       >> <<04514>>21870000
   <<*******************************************************>> <<04514>>21872000
                                                               <<04514>>21874000
   ARRAY ERRORMAP (1:8)=PB := DUPNSD,UNDEFFILESD,SEXVIOL,               21876000
      DIROVFLO,DIROVFLO,DIROVFLO,DIRIOERR,NORIN;                        21878000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   21880000
   INTEGER POINTER PCBX;  <<PCBX POINTER>>                              21882000
   INTEGER A;  <<USED BY GETSIR>>                                       21884000
   INTEGER B := -1;  <<USED BY GETSIR>>                                 21886000
   INTEGER DBFLAG := 0;  <<DB SET TO STACK FLAG>>                       21888000
   INTEGER NTYPE;                                                       21890000
   INTEGER OLDNTYPE;                                                    21892000
   INTEGER DOMAIN;                                                      21894000
   INTEGER DADDR;                                                       21896000
   INTEGER NEWNTYPE;                                                    21898000
   LOGICAL NEWFOPTIONS := 0;                                            21900000
   BYTE ARRAY TNEWFREF(0:35);  << TEMP. FILE NAME >>           <<04132>>21902000
   ARRAY FN (0:3);  <<LOCAL FILE NAME>>                                 21904000
   ARRAY GN (0:3);  <<GROUP NAME>>                                      21906000
   ARRAY AN (0:3);  <<ACCT. NAME>>                                      21908000
   ARRAY LW (0:3);  <<LOCK WORD>>                                       21910000
   BYTE ARRAY BFN(*) = FN, BGN(*) = GN, BAN(*) = AN;           <<01849>>21912000
   INTEGER POINTER FNPTR,GNPTR,ANPTR;                                   21914000
   BYTE POINTER BFNPTR, BGNPTR, BANPTR;                        <<01849>>21916000
   DOUBLE DRCODE;                                                       21918000
   INTEGER RCB = DRCODE;                                                21920000
   INTEGER RCA = DRCODE+1;                                              21922000
   DOUBLE FADDR;                                                        21924000
                                                                        21926000
   <<ACB PARAMETERS>>                                                   21928000
                                                                        21930000
                                                                        21934000
   <<FCB PARAMETERS>>                                                   21936000
                                                                        21938000
   LOGICAL FCBV;  <<FCB VECTOR>>                                        21940000
   INTEGER FCBDST;  <<FCB DST NR.>>                                     21942000
   INTEGER DSTX;    << Original Stack number >>                <<04514>>21944000
   INTEGER POINTER FCB;  <<FCB POINTER>>                                21946000
   DOUBLE POINTER FCBDBL = FCB;                                         21948000
   DOUBLE FCBPARMS = DSTX;    <<DST & FCB>>                    <<04514>>21950000
                                                                        21952000
   <<FILE LABEL PARAMETERS>>                                            21954000
                                                                        21956000
   DOUBLE LABADR;  <<FILE LABEL SECTOR NR.>>                            21958000
   INTEGER P1 = LABADR;                                                 21960000
   INTEGER P2 = LABADR+1;                                               21962000
   ARRAY LABADRA (*) = LABADR;                                          21964000
   INTEGER ARRAY FLAB (0:127);  <<FILE LABEL BUFFER>>                   21966000
   ARRAY FTAB(0:120);  << :FILE COMMAND PARM. BUFFER >>        <<04132>>21968000
                                                                        21970000
   <<JIT INFO>>                                                         21972000
                                                                        21974000
   INTEGER ARRAY JITINFO(0:26) = Q;                                     21976000
   ARRAY HANAME (*) = JITINFO(3);  <<HOME ACCT. NAME>>                  21978000
   ARRAY LGNAME (*) = JITINFO(11);  <<LOGON GROUP NAME>>                21980000
   ARRAY USERID (*) = JITINFO(15);  <<USER NAME>>                       21982000
   DOUBLE UCAP = JITINFO+25;  <<USER CAPABILITIES>>                     21984000
   LOGICAL SFCAP = UCAP;  <<SAVE FILE CAPABILITY?>>                     21986000
                                                                        21988000
                                                               <<DS.00>>21990000
   << REMOTE FILE ACCESS (RFA) VARIABLES >>                    <<DS.00>>21992000
                                                               <<DS.00>>21994000
   INTEGER POINTER RFAPTR; << APPENDAGE POINTER >>             <<DS.00>>21996000
   INTEGER RFALEN; << APPENDAGE LENGTH >>                      <<DS.00>>21998000
   INTEGER USERDB; <<U/B KSAM>>                                <<KS.00>>22000000
   INTEGER POINTER AFT; <<U/B KSAM>>                           <<KS.00>>22002000
                                                               <<DS.00>>22004000
                                                                        22006000
   << PRIVATE VOLUMES DECLARATIONS >>                          <<RV.PV>>22008000
                                                               <<RV.PV>>22010000
   INTEGER                                                     <<RV.PV>>22012000
       PVINFO := 0;                                            <<RV.PV>>22014000
   DEFINE                                                      <<RV.PV>>22016000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>22018000
       VMASK  = PVINFO.(8:8) #;                                <<RV.PV>>22020000
   ARRAY                                                       <<RV.PV>>22022000
       GENTRY (*),                                             <<RV.PV>>22024000
       SHVSNAME (*);                                           <<RV.PV>>22026000
                                                               <<RV.PV>>22028000
                                                               <<RV.PV>>22030000
   LOGICAL ACB'FLAGS;         << Flags sent to LOC'ACB      >> <<04514>>22032000
                                                               <<04514>>22034000
   <<*******************************************************>> <<04514>>22036000
   << ACB'POINTERS - Below are the declarations and equates >> <<04514>>22038000
   << for the PACB and AFT arrays.  LOC'ACB places the AFT  >> <<04514>>22040000
   << at ACB(-4) to ACB(-1) and the PACB follows.           >> <<04514>>22042000
                                                               <<04514>>22044000
   INTEGER ACBMQ;          << Q-relative ACB loc for LOC'ACB>> <<04514>>22046000
   INTEGER AFTE;    <<AFT entry word 0, type and $NULL bit. >> <<04514>>22048000
   INTEGER PACBV;   << Physical ACB Vector                  >> <<04514>>22050000
   INTEGER LACBV;   << Logical  ACB Vector                  >> <<04514>>22052000
   INTEGER IOQX;    << No-wait I/O pending Queue index.     >> <<04514>>22054000
                                                               <<04514>>22056000
   << The order of the above declarationa cannot be changed >> <<04514>>22058000
   << in any way.  Also, the ACB declaration must immed-    >> <<04514>>22060000
   << iately follow.                                        >> <<04514>>22062000
                                                               <<04514>>22064000
   INTEGER ARRAY ACB(0:SIZEXACB-1) = Q;                        <<04514>>22066000
   DOUBLE ARRAY ACBDBL(*)=ACB;                                 <<04514>>22068000
                                                               <<04514>>22070000
   <<*******************************************************>> <<04514>>22072000
                                                               <<04514>>22074000
   SUBROUTINE LABELIO (RW);                                             22076000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           22078000
                                                                        22080000
        INPUT VARIABLES:                                                22082000
            RW - I/O MODE                                               22084000
               0 - READ                                                 22086000
               1 - WRITE                                                22088000
                                                                        22090000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE      22092000
        IS CALLED>>                                                     22094000
      VALUE RW;                                                         22096000
      INTEGER RW;                                                       22098000
      BEGIN                                                             22100000
      X := FLABIO(DADDR,LABADR,RW,FLAB);  <<R/W LABEL>>                 22102000
      IF <> THEN  <<ERROR?>>                                            22104000
         BEGIN                                                          22106000
         FLABIOERR(X,FILENUM);  <<HANDLE ERROR>>                        22108000
         TOS := LBLIOERR;                                               22110000
         TOS := CCL;                                                    22112000
         GO STACKERR                                                    22114000
         END                                                            22116000
      END;                                                              22118000
   SUBROUTINE CHKHVSBOUNDS;                                    <<RV.PV>>22120000
       BEGIN                                                   <<RV.PV>>22122000
           TOS := @AN & LSL (1);                               <<RV.PV>>22124000
           TOS := @ANPTR & LSL (1);                            <<RV.PV>>22126000
           TOS := @GN & LSL (1);                               <<RV.PV>>22128000
           TOS := @GNPTR & LSL (1);                            <<RV.PV>>22130000
           IF BPS3 <> BPS2, (8) OR BPS1 <> BPS0, (8) THEN      <<RV.PV>>22132000
           BEGIN  <<POSSIBLE DIFFERENT HVS'S>>                 <<RV.PV>>22134000
               <<ALLOCATE SPACE FOR NEEDED ARRAYS>>            <<RV.PV>>22136000
               DDEL; DDEL;  <<POINTERS>>                       <<RV.PV>>22138000
               TOS := GSIZE+(NAMESIZE*3);                      <<RV.PV>>22140000
               PUSH (S);                                       <<RV.PV>>22142000
               @SHVSNAME := (@GENTRY := TOS) + GSIZE;          <<RV.PV>>22144000
               ASSEMBLE (ADDS 0);                              <<RV.PV>>22146000
               IF PVINFO = 0 THEN                              <<RV.PV>>22148000
               BEGIN <<SOURCE HVS IS SYSTEM VOLUME SET>>       <<RV.PV>>22150000
                   SHVSNAME := "  ";                           <<RV.PV>>22152000
                   MOVE SHVSNAME (1) :=                        <<RV.PV>>22154000
                        SHVSNAME, ((NAMESIZE*3)-1);            <<RV.PV>>22156000
               END ELSE                                        <<RV.PV>>22158000
               BEGIN  <<NEED SOURCE HVS NAME>>                 <<RV.PV>>22160000
                   DRCODE := DIRECFIND (%10,0D,AN,GN,          <<RV.PV>>22162000
                                        FN,GENTRY);            <<RV.PV>>22164000
                   IF <> THEN                                  <<RV.PV>>22166000
                   BEGIN                                       <<RV.PV>>22168000
                       IF < THEN TOS := DIRIOERR ELSE                   22170000
                         BEGIN  << convert directory err nr. >>         22172000
                         TOS := ERRORMAP(RCA);                          22174000
                         IF RCA=2 THEN TOS := TOS-RCB                   22176000
                         ELSE IF RCA=8 THEN TOS := TOS+RCB;             22178000
                         END;                                           22180000
                       TOS := CCL;                             <<RV.PV>>22182000
                       GO TO STACKERR;                         <<RV.PV>>22184000
                   END;                                        <<RV.PV>>22186000
                   MOVE SHVSNAME :=                            <<RV.PV>>22188000
                        GENTRY (GHVSNAME), (NAMESIZE*3);       <<RV.PV>>22190000
               END;                                            <<RV.PV>>22192000
               <<GET TARGET HVS NAME>>                         <<RV.PV>>22194000
               DRCODE := DIRECFIND (%10,0D,ANPTR,GNPTR,        <<RV.PV>>22196000
                                    FNPTR,GENTRY);             <<RV.PV>>22198000
               IF <> THEN                                      <<RV.PV>>22200000
               BEGIN                                           <<RV.PV>>22202000
                       IF < THEN TOS := DIRIOERR ELSE                   22204000
                         BEGIN  << convert directory err nr. >>         22206000
                         TOS := ERRORMAP(RCA);                          22208000
                         IF RCA=2 THEN TOS := TOS-RCB                   22210000
                         ELSE IF RCA=8 THEN TOS := TOS+RCB;             22212000
                         END;                                           22214000
                   TOS := CCL;                                 <<RV.PV>>22216000
                   GO TO STACKERR;                             <<RV.PV>>22218000
               END;                                            <<RV.PV>>22220000
               TOS := @SHVSNAME & LSL (1);                     <<RV.PV>>22222000
               TOS := @GENTRY (GHVSNAME) & LSL (1);            <<RV.PV>>22224000
               IF * <> *, (24) THEN                            <<RV.PV>>22226000
               BEGIN <<SOURCE AND TARGET HVS'S DIFFERENT>>     <<RV.PV>>22228000
                   TOS := HVSVIOL;                             <<RV.PV>>22230000
                   TOS := CCL;                                 <<RV.PV>>22232000
                   GO TO STACKERR;                             <<RV.PV>>22234000
               END;                                            <<RV.PV>>22236000
               TOS := GSIZE+(NAMESIZE*3);                      <<RV.PV>>22238000
               ASSEMBLE (SUBS 0);                              <<RV.PV>>22240000
           END ELSE ASSEMBLE (DDEL, DDEL);                     <<RV.PV>>22242000
       END;<<OF CHKHVSBOUNDS>>                                 <<RV.PV>>22244000
                                                                        22246000
$  IF X0 = ON                                                           22248000
   IF MONCALLABLE THEN  <<MONITORING?>>                                 22250000
      BEGIN                                                             22252000
      TOS := "FR"; TOS := "EN"; TOS := "AM"; TOS := "E ";               22254000
      ASSEMBLE(DZRO,DZRO);                                              22256000
      FTITLE(*,*,*,*);                                                  22258000
      DEBUG                                                             22260000
      END;                                                              22262000
$  IF                                                                   22264000
                                                                        22266000
   ERRORON;                                                             22268000
   CRIT := SETCRITICAL;                                                 22270000
   CHECKDB;  <<WHERE'S DB?>>                                            22272000
   IF <> THEN DBFLAG := DBFLAG+1;  <<NOT SET TO STACK?>>                22274000
   PUSH(STATUS);      << FLAG.(0:1) set to privmode         >> <<04514>>22276000
   ACB'FLAGS := TOS;  << bit of STATUS register             >> <<04514>>22278000
   ACB'FLAGS.(1:15):=0;  <<  Privmode check only            >> <<04514>>22280000
   GET'ACB'Q'LOC;                                              <<04514>>22282000
   LOC'ACB(DSTX, ACBMQ, FILENUM, ACB'FLAGS);                   <<04514>>22284000
   DSTX := TOS;  <<LOC'ACB returns DST on TOS               >> <<04514>>22286000
   IF < THEN  <<INVALID FILE NR.?>>                                     22288000
      BEGIN                                                             22290000
      TOS := INVFN;                                                     22292000
      TOS := CCL;                                                       22294000
      GO EXIT                                                           22296000
      END;                                                              22298000
   IF > THEN  <<$NULL?>>                                                22300000
      BEGIN                                                             22302000
      TOS := 0;  <<NO ERROR>>                                           22304000
      TOS := CCE;                                                       22306000
      GO EXIT                                                           22308000
      END;                                                              22310000
   IF LOGICAL(DBFLAG) THEN  <<DB WAS NOT AT STACK?>>                    22312000
      BEGIN                                                             22314000
      TOS := ILLDB;                                                     22316000
      TOS := CCL;                                                       22318000
      GO ACBERR                                                         22320000
      END;                                                              22322000
   CASE FTYPE OF                                               <<DS.00>>22324000
   BEGIN                                                       <<DS.00>>22326000
                                                               <<DS.00>>22328000
   BEGIN << CONVENTIONAL FILE >>                               <<DS.00>>22330000
CONVENTIONAL:                                                  <<HM.00>>22332000
   IF ACBACCCL<>DIRACC OR ACBSPOOLED OR ACBDTYPE=FDISC THEN    <<01115>>22334000
      BEGIN                                                             22336000
      TOS := DEVVIOL;                                                   22338000
      TOS := CCL;                                                       22340000
      GO ACBERR                                                         22342000
      END;                                                              22344000
   OLDNTYPE := ACBDNTYPE;                                               22346000
   B := GETSIR(FISIR);  <<GET FILE SIR NOW!>>                           22348000
                                                                        22350000
   <<* * * LOCATE FCB * * *>>                                           22352000
                                                                        22354000
   FGETCB(0,0,DUM,ACBFCB,1);  <<GET FCB>>                      <<01.02>>22356000
   FCBPARMS := TOS; FCBV := TOS;  <<DST, FCB AND FCBV>>                 22358000
   IF FCBEXCLSTAT <> -1 THEN  <<NOT OPENED EXCLUSIVELY?>>               22360000
      BEGIN                                                             22362000
      TOS := MLTIACCERR;                                                22364000
      TOS := CCL;                                                       22366000
      GO FCBERR                                                         22368000
      END;                                                              22370000
   TOS := 0;  <<FOR LDEV>>                                              22372000
   TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                            22374000
   TOS := TOS&TASL(8)&DLSR(8);  <<SEPARATE LDEV>>                       22376000
   LABADR := TOS;  <<FILE LABEL SECTOR NR.>>                            22378000
   DADDR := TOS;  <<FILE LABEL LDEV>>                                   22380000
   PVINFO := FCBPVINFO;                                        <<RV.PV>>22382000
                                                                        22384000
   <<* * * READ FILE LABEL * * *>>                                      22386000
                                                                        22388000
   FCBDST := EXCHANGEDB(0);  <<SET DB TO STACK>>                        22390000
   LABELIO(0);  <<READ FILE LABEL>>                                     22392000
   @FNPTR := @FLLOCNAME;                                                22394000
   @GNPTR := @FLGRPNAME;                                                22396000
   @ANPTR := @FLACCTNAME;                                               22398000
   MOVE FN := FNPTR,(4);                                                22400000
   MOVE GN := GNPTR,(4);                                                22402000
   MOVE AN := ANPTR,(4);                                                22404000
   LW := "  "; MOVE LW(1) := LW,(3);                                    22406000
   MOVE TNEWFREF := NEWFREF,(36);  <<COPY FILE REF.>>          <<04132>>22408000
   NTYPE := FNFORMAT(TNEWFREF,FNPTR,GNPTR,ANPTR,LW);           <<04132>>22410000
   IF NTYPE > 2 THEN  << FILE EQ. OR ERROR >>                  <<04132>>22412000
      IF NTYPE = 3 THEN  << CHECK FILE EQ >>                   <<04132>>22414000
         BEGIN                                                 <<04132>>22416000
         NTYPE := FQFORMAT(TNEWFREF,FNPTR,GNPTR,ANPTR,LW);     <<04132>>22418000
         IF NTYPE = 4 THEN GOTO E1;                            <<04132>>22420000
         END                                                   <<04132>>22422000
      ELSE                                                     <<04132>>22424000
      BEGIN                                                             22426000
E1:   TOS := INVFREF;                                                   22428000
      TOS := CCL;                                                       22430000
      GO STACKERR                                                       22432000
      END;                                                              22434000
   DOMAIN := FLDOMAIN;  <<FILE DOMAIN>>                                 22436000
   NEWNTYPE := NTYPE;                                          <<04132>>22438000
                                                                        22440000
   <<* * * GET INFORMATION IN JIT * * *>>                               22442000
                                                                        22444000
   SETPCBX;  <<INIT. PCBX POINTER>>                                     22446000
   TOS := @JITINFO;  <<STACK ADR.>>                                     22448000
   TOS := PXGJITDST; TOS := JITASEC;  <<JIT LOC.>>                      22450000
   TOS := 27;                                                           22452000
   ASSEMBLE(MFDS 4);                                                    22454000
   IF NTYPE = 2 THEN  << GROUP & ACCT ABSENT? >>               <<+1.01>>22456000
      BEGIN                                                             22458000
      MOVE FLGRPNAME := LGNAME,(4);                                     22460000
      MOVE FLACCTNAME := HANAME,(4)                                     22462000
      END                                                               22464000
   ELSE IF NTYPE = 1 THEN  << ACCT NAME ABSENT? >>             <<+1.01>>22466000
      MOVE FLACCTNAME := HANAME,(4);                                    22468000
                                                                        22470000
   <<* * * Rename a permanent file * * *>>                     <<01849>>22472000
                                                                        22474000
   CHKHVSBOUNDS;                                               <<01882>>22476000
   IF DOMAIN = 1 THEN                                                   22478000
      BEGIN     << insert name in system directory >>                   22480000
      IF NOT SFCAP THEN                                        <<01849>>22482000
         BEGIN   << No Save File capability.                >> <<01849>>22484000
         TOS := SFERR;                                         <<01849>>22486000
         TOS := CCL;                                           <<01849>>22488000
         GO STACKERR;                                          <<01849>>22490000
         END;                                                  <<01849>>22492000
      TOS := @USERID&LSL(1);                                   <<00088>>22494000
      TOS := @FLUSERID&LSL(1);                                          22496000
      TOS := @HANAME&LSL(1);                                   <<00706>>22498000
      TOS := @AN&LSL(1); <<ACCT OF FILE BEING RENAMED>>        <<00706>>22500000
      IF BPS3 <> BPS2,(8)  OR  BPS1 <> BPS0,(8) THEN           <<00706>>22502000
         BEGIN <<CREATOR VIOLATION>>                           <<00706>>22504000
         TOS := USERIDVIOL;                                             22506000
         TOS := CCL;                                                    22508000
         GO STACKERR                                                    22510000
         END;                                                           22512000
      A := GETSIR(DSSIR);  <<GET DIRECTORY SIR(?)>>                     22514000
      DRCODE := DIRECPURGEFILE (-FSECTORS(FLAB),0,AN,          <<38.PV>>22516000
                                GN,FN,MVTABX);                 <<RV.PV>>22518000
      IF <> THEN  <<ERROR?>>                                            22520000
         BEGIN                                                          22522000
         RELSIR(DSSIR,A);                                               22524000
         TOS := DIRIOERR;                                               22526000
         TOS := CCL;                                                    22528000
         GO STACKERR                                                    22530000
         END;                                                           22532000
      P1.(0:8) := VTABINX (DADDR,MVTABX<>0);                   <<RV.PV>>22534000
      DRCODE := DIRECINSERTFILE (FSECTORS(FLAB),0,ANPTR,GNPTR, <<38.PV>>22536000
                                 FNPTR,LABADR,MVTABX);         <<RV.PV>>22538000
      IF <> THEN  <<ERROR?>>                                            22540000
         BEGIN                                                          22542000
         IF < THEN TOS := DIRIOERR                                      22544000
         ELSE IF RCA = 1 THEN TOS := DUPNSD                             22546000
         ELSE IF RCA = 2 THEN TOS := UNDEFFILESD-RCB                    22548000
         ELSE IF RCA = 3 THEN TOS := SEXVIOL                            22550000
         ELSE IF (4 <= RCA <= 6) THEN TOS := DIROVFLO          <<00088>>22552000
         ELSE IF RCA = 8 THEN TOS := NORIN+RCB                          22554000
         ELSE TOS := DIRIOERR;                                          22556000
         DRCODE := DIRECRESETFILE  (FSECTORS(FLAB),0,AN,       <<00088>>22558000
                                    GN,FN,LABADR,MVTABX);      <<RV.PV>>22560000
         IF <> THEN TOS := DIRIOERR;                                    22562000
         RELSIR(DSSIR,A);                                               22564000
         TOS := CCL;                                                    22566000
         GO STACKERR                                                    22568000
         END;                                                           22570000
      RELSIR(DSSIR,A);                                                  22572000
      P1.(0:8) := 0  <<CLEAR VOLUME TABLE INDEX>>                       22574000
      END;                                                              22576000
                                                               <<01849>>22578000
   <<* * * Rename a temp file (incl $NEWPASS/$OLDPASS) * * *>> <<01849>>22580000
                                                               <<01849>>22582000
   IF DOMAIN = 2 OR FLOLDPASS THEN  <<INSERT NAME IN JTFD?>>            22584000
      BEGIN                                                             22586000
      P1.(0:8) := VTABINX (DADDR,MVTABX<>0);                   <<RV.PV>>22588000
      TOS := ADDJTENTRY(FLLOCNAME,GNPTR,ANPTR,2,2,LABADRA);             22590000
      ASSEMBLE(TEST);                                                   22592000
      RCA := TOS;                                                       22594000
      IF <>                                                    <<01849>>22596000
        THEN                                                   <<01849>>22598000
         BEGIN   << Dup temp file name or JTFD overflow.    >> <<01849>>22600000
         @BFNPTR := @FNPTR & LSL(1);                           <<01849>>22602000
         @BGNPTR := @GNPTR & LSL(1);                           <<01849>>22604000
         @BANPTR := @ANPTR & LSL(1);                           <<01849>>22606000
         IF RCA = 2   << Duplicate name...                  >> <<01849>>22608000
           AND BFN = BFNPTR, (4)   << ...O.K. if we're...   >> <<01849>>22610000
           AND BGN = BGNPTR, (4)   << ...renaming the file..>> <<01849>>22612000
           AND BAN = BANPTR, (4)   << ...to itself.         >> <<01849>>22614000
           THEN   << Do nothing, skip REMJTENTRY below.     >> <<01849>>22616000
           ELSE                                                <<01849>>22618000
              BEGIN   << Real error, choose one and scram.  >> <<01849>>22620000
              TOS := IF RCA = 2 THEN DUPNJD ELSE JTFDIROFL;    <<01849>>22622000
              TOS := CCL;                                      <<01849>>22624000
              GO STACKERR;                                     <<01849>>22626000
              END;                                             <<01849>>22628000
         END                                                   <<01849>>22630000
        ELSE                                                   <<01849>>22632000
         BEGIN   << Delete the old temp file name here.     >> <<01849>>22634000
         NTYPE := OLDNTYPE;                                    <<01849>>22636000
         @FNPTR := @FN;                                        <<01849>>22638000
         @GNPTR := @GN;                                        <<01849>>22640000
         @ANPTR := @AN;                                        <<01849>>22642000
         IF NOT FLACTUAL THEN  <<$NEWPASS/$OLDPASS?>>          <<01849>>22644000
            BEGIN                                              <<01849>>22646000
            P1.(0:8):=VTABINX (DADDR,MVTABX<>0);  <<VTABX>>    <<01849>>22648000
            EXCHANGEDB(PXGJITDST);  <<SET DB TO JIT DST>>      <<01849>>22650000
            TOS := ADB0(JCELLS);                               <<01849>>22652000
            IF DPS0(JPASS) = LABADR THEN DPS0(JPASS) := 0D;    <<01849>>22654000
            EXCHANGEDB(0);  <<RESET DB TO STACK>>              <<01849>>22656000
            IF FLOLDPASS THEN FLDOMAIN := 2;   << Oldtemp.  >> <<01849>>22658000
            FLDESIGNATOR := 0;  <<MAKE DESIGNATOR ACTUAL>>     <<01849>>22660000
            P1.(0:8) := 0;  <<CLEAR LOGICAL DEVICE NR.>>       <<01849>>22662000
            NEWFOPTIONS := FLFOPTIONS  <<SAVE FOPTIONS>>       <<01849>>22664000
            END;                                               <<01849>>22666000
         IF DOMAIN = 2 THEN  <<TEMPORARY FILE?>>               <<01849>>22668000
            BEGIN   << Delete JTFD entry.                   >> <<01849>>22670000
           X := REMJTENTRY(FNPTR,GNPTR,ANPTR,2,0).(8:8);       <<04574>>22672000
<< THE UPPER 8 BITS (0:8) ARE USED FOR THE OLD FILE REFERENCE>><<04574>>22674000
<< COUNT SO IT CAN BE PRESERVED WHEN REPLACING FILE EQU'S    >><<04574>>22676000
               IF <> THEN FTROUBLE(488);                       <<01849>>22678000
            END;                                               <<01849>>22680000
         END;                                                  <<01849>>22682000
      END;                                                     <<01849>>22684000
                                                                        22686000
   <<* * * WRITE UPDATED FILE LABEL * * *>>                             22688000
                                                                        22690000
   FLLASTMOD := CALENDAR;  <<UPDATE MODIFICATION DATE>>                 22692000
   MOVE FLLOCKWORD := LW,(4);  <<UPDATE LOCKWORD>>                      22694000
   LABELIO(1);  <<WRITE FILE LABEL>>                                    22696000
                                                                        22698000
   <<* * * UPDATE FCB AND ACB * * *>>                                   22700000
                                                                        22702000
   EXCHANGEDB(FCBDST);  <<RESET DB TO FCB DST>>                         22704000
   IF NEWFOPTIONS <> 0 THEN FCBFOPTIONS := NEWFOPTIONS;                 22706000
   FRELCB(DSTX,FCBV,1);   << Release FCB - Back to DSTX >>     <<04514>>22708000
   ACBDNTYPE := NEWNTYPE;                                               22710000
   IF NEWFOPTIONS <> 0 THEN ACBFOPTIONS := NEWFOPTIONS;                 22712000
                                                               <<+0.04>>22714000
   <<* * * MEASUREMENT DATA ON FRENAME * * *>>                 <<+0.05>>22716000
                                                               <<+0.05>>22718000
$  IF X3 = ON                                                  <<+0.05>>22720000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>22722000
   MMSTAT(EFRENAME,FILENUM,0,0);  <<MEASURE EVENT>>            <<+0.05>>22724000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>22726000
$  IF                                                          <<+0.05>>22728000
                                                               <<+0.05>>22730000
   TOS := 0;  <<NO ERROR>>                                              22732000
   TOS := CCE;                                                          22734000
   GO ACBERR;                                                           22736000
   HELP  <<FOR DUMMY CALL>>;                                   <<00117>>22738000
                                                                        22740000
STACKERR:                                                               22742000
   EXCHANGEDB(FCBDST);  <<RESET DB TO FCB DST>>                         22744000
                                                                        22746000
FCBERR:                                                                 22748000
   FRELCB(DSTX,FCBV,1);    <<RELEASE FCB - BACK TO DSTX>>      <<04514>>22750000
                                                                        22752000
ACBERR:                                                                 22754000
   IF FSTYPE THEN                                              <<DS.00>>22756000
   ACBERROR := S1;  <<ERROR NR.>>                                       22758000
                                                               <<04514>>22760000
   UNLOC'ACB(ACBMQ,0);  << Release ACB               >>        <<04514>>22762000
   IF B <> -1 THEN RELSIR(FISIR,B);  <<RELEASE FILE SIR>>               22764000
   END; << CONVENTIONAL FILE;                                  <<DS.00>>22766000
                                                               <<DS.00>>22768000
   BEGIN << REMOTE FILE >>                                     <<DS.00>>22770000
      ALLOCRFABUF;                                             <<DS.00>>22772000
      RFALEN := 18;                                            <<DS.00>>22774000
      TOS := "RFA ";                                           <<DS.00>>22776000
      TOS := 17;                                               <<DS.00>>22778000
      TOS := RFAFILE;                                          <<DS.00>>22780000
      ALLOCBUF; << FOR NAME ARRAY >>                           <<DS.00>>22782000
      ASSEMBLE(ADDS 14);                                       <<DS.00>>22784000
      TOS := X;                                                <<DS.00>>22786000
      MOVE * := TNEWFREF,(28);                                 <<04132>>22788000
      MWCNOBUF;                                                <<DS.00>>22790000
      CHECKXFER;                                               <<DS.00>>22792000
      DELAPPENDAGE;                                            <<DS.00>>22794000
      PREPRETURN;                                              <<DS.00>>22796000
      IF LS0.CC <> CCE THEN                                    <<D1.01>>22798000
         BEGIN                                                 <<D1.01>>22800000
         FCHECK(FILENUM,S1);                                   <<D1.01>>22802000
         IF <> THEN S1 := NAVAILDEV;                           <<D1.01>>22804000
         END;                                                  <<D1.01>>22806000
   END; << REMOTE FILE >>                                      <<DS.00>>22808000
                                                               <<DS.00>>22810000
      <<DUMMY 2>>;                                             <<KS.00>>22812000
      <<DUMMY 3>>;                                             <<KS.00>>22814000
      <<DUMMY 4>>;                                             <<KS.00>>22816000
      <<DUMMY 5>>;                                             <<KS.00>>22818000
      BEGIN <<KSAM FILE>>                                      <<KS.00>>22820000
         USERDB:=EXCHANGEDB(0);                                <<KS.00>>22822000
         SETAFT;                                               <<KS.00>>22824000
         AFTFLAG:=3;<<KSAM ERROR>>                             <<KS.00>>22826000
         AFTERRNUM:=UNIMPL;<<"UNIMPLEMENTED">>                 <<KS.00>>22828000
         TOS:=UNIMPL;<<"UNIMPLEMENTED">>                       <<KS.00>>22830000
         TOS:=CCL;                                             <<KS.00>>22832000
         EXCHANGEDB(USERDB);                                   <<KS.00>>22834000
      END;<<KSAM FILE>>                                        <<KS.00>>22836000
      <<DUMMY 7>>;                                             <<HM.00>>22838000
      GO CONVENTIONAL;  <<MSG FILE>>                           <<HM.00>>22840000
   END; << FTYPE CASE >>                                       <<DS.00>>22842000
EXIT:                                                                   22844000
   CONDCODE := TOS;  <<SET CONDITION CODE>>                             22846000
   RESETCRITICAL(CRIT);                                                 22848000
   ERROREXIT(2,S0,0)                                                    22850000
   END;                                                                 22852000
PROCEDURE SPECIAL'SPOOL'CLOSE(FILENUM,DISP,SECCODE);                    22854000
VALUE FILENUM,DISP,SECCODE;                                             22856000
INTEGER FILENUM,DISP,SECCODE;                                           22858000
OPTION FORWARD;                                                         22860000
OPTION PRIVILEGED,UNCALLABLE;                                           22862000
                                                                        22864000
                                                                        22866000
$ PAGE " FCLOSE "                                                       22868000
$ CONTROL SEGMENT = FILESYS7                                            22872000
PROCEDURE FCLOSE(FILENUM,DISP,SECCODE);                        <<KS.00>>22874000
                                                               <<04517>>22876000
   <<*******************************************************>> <<04517>>22878000
   << Closes the specified file (Really!!!)                 >> <<04517>>22880000
   <<                                                       >> <<04517>>22882000
   << Entry Points:                                         >> <<04517>>22884000
   <<    FCLOSE - User callabel entry point                 >> <<04517>>22886000
   <<    FSCLOSE- System spoolfile entry point              >> <<04517>>22888000
   <<    FJCLOSE- System CI $STDXX entry point              >> <<04517>>22890000
   <<    KFCLOSE- KSAM file entry point                     >> <<04517>>22892000
   <<                                                       >> <<04517>>22894000
   << Input variables:                                      >> <<04517>>22896000
   <<    FILENUM - File number of the file                  >> <<04517>>22898000
   <<    DISP    - File disposition                         >> <<04517>>22900000
   <<       (12:1) - Return disc space beyond file limit    >> <<04517>>22902000
   <<       (13:3) - Domain disposition                     >> <<04517>>22904000
   <<          0 - No change                                >> <<04517>>22906000
   <<          1 - Save permanent                           >> <<04517>>22908000
   <<          2 - Save temporary and rewind                >> <<04517>>22910000
   <<          3 - Save temporary and no rewind             >> <<04517>>22912000
   <<          4 - Release (purge file)                     >> <<04517>>22914000
   <<     SECCODE- File security                            >> <<04517>>22916000
   <<          0 - Unrestricted access                      >> <<04517>>22918000
   <<          1 - Creator - restricted access              >> <<04517>>22920000
   <<                                                       >> <<04517>>22922000
   << Condition Code:                                       >> <<04517>>22924000
   <<    CCE - OK                                           >> <<04517>>22926000
   <<    CCL - ERROR                                        >> <<04517>>22928000
   <<                                                       >> <<04517>>22930000
   << Note that DB may be set to any data segement when     >> <<04517>>22932000
   << this procedure is called.                             >> <<04517>>22934000
   <<*******************************************************>> <<04517>>22936000
                                                               <<04517>>22938000
   VALUE FILENUM,DISP,SECCODE;                                          22940000
   INTEGER FILENUM,DISP,SECCODE;                                        22942000
   OPTION PRIVILEGED;                                                   22944000
   BEGIN                                                                22946000
   << >>                                                                22948000
   ENTRY FSCLOSE;       <<SPOOLFILE SEC ENTRY POINT>>                   22950000
   ENTRY FJCLOSE;       <<CI $STDXX SEC ENTRY POINT>>                   22952000
   ENTRY KFCLOSE; <<SECONDARY ENTRY POINT FOR KSAM>>           <<KS.00>>22954000
   ENTRY PVCLOSE;       <<CONDITIONAL DISMOUNT ENTRY POINT>>   <<RV.PV>>22956000
   ENTRY FCLOSEDA;      <<SHOULD BE PAIRED WITH FOPENDA>>      <<RV.PV>>22958000
   << >>                                                                22960000
   ARRAY ERRORMAP (1:8)=PB := DUPNSD,UNDEFFILESD,SEXVIOL,               22962000
      DIROVFLO,DIROVFLO,DIROVFLO,DIRIOERR,NORIN;                        22964000
   LOGICAL MUSTCLOSE := FALSE;  <<IGNORE ERRORS WHILE CLOSING?>>        22966000
   DOUBLE DRCODE;  <<NR. SECTORS DEALLOCATED>>                          22968000
   INTEGER RCB = DRCODE;  <<FIRST HALF OF DRCODE>>                      22970000
   INTEGER RCA = DRCODE+1;  <<SECOND HALF OF DRCODE>>                   22972000
   LOGICAL ORIG'DST;  <<Original DST upon entry             >> <<04517>>22974000
                                                               <<04517>>22976000
   INTEGER I;  <<UTILITY INTEGER>>                                      22978000
   INTEGER J;  <<UTILITY INTEGER>>                                      22980000
   INTEGER ARRAY LOG'BUF(0:14)=Q; << Sys. logging, must be Q>> <<04713>>22982000
   DOUBLE FADDR;                                                        22984000
   INTEGER FADDRW1 = FADDR, FADDRW2 = FADDRW1+1;               <<RV.PV>>22986000
   DOUBLE POINTER EXTENTRY;                                             22988000
   DOUBLE NSECTORS := 0D;                                               22990000
                                                                        22992000
   <<MISC. FILE PARAMETERS>>                                            22994000
                                                                        22996000
   DEFINE                                                      <<04513>>22998000
      DISP'CRUNCH  = DISP.(12:1)#,   << Crunch bit          >> <<04513>>23000000
      DISP'DOMAIN  = DISP.(13:3)#;   << Domain bits         >> <<04513>>23002000
   INTEGER DOMAIN;  <<FOP'S FILE DOMAIN>>                               23004000
   INTEGER ATYPE;  <<ACCESS TYPE>>                                      23006000
   INTEGER PDISP;  <<PENDING DISPOSITION>>                              23008000
   LOGICAL PURGE := FALSE;  <<DEALLOCATE DISC SPACE FLAG>>              23010000
   LOGICAL CRUNCH := FALSE;  <<DEALLOCATE DISC SPACE PAST EOF?>>        23012000
                                                                        23016000
   <<MISC. DEVICE PARAMETERS>>                                          23018000
                                                                        23020000
   LOGICAL DADDR;  <<LOGICAL DEVICE NR.>>                               23022000
   INTEGER VDADDR;  <<VOLUME TABLE INDEX>>                              23024000
   DOUBLE IO'STATUS;  << Return parm from ATTACHIO.         >> <<04814>>23026000
   INTEGER WAITIO'STATUS = IO'STATUS + 0;  << Statu of ATIO.>> <<04814>>23028000
   DEFINE ERR'STAT = WAITIO'STATUS.(8:8)#; << Error bits.   >> <<04814>>23030000
                                                                        23032000
   <<PCBX PARAMETERS>>                                                  23034000
                                                                        23036000
   INTEGER POINTER PCBX;  <<PCBX POINTER>>                              23038000
   INTEGER POINTER PXFILE;  <<PCBX FILE SECTION>>                       23040000
                                                                        23042000
   <<AFT PARAMETERS>>                                                   23044000
                                                                        23046000
   INTEGER POINTER AFT;  <<AFT ENTRY POINTER>>                          23048000
   DOUBLE POINTER AFTDBL = AFT;                                         23050000
                                                                        23052000
   <<ACB PARAMETERS>>                                                   23054000
                                                                        23056000
   LOGICAL FLAGS;    <<Flags for call to LOC'ACB.          >>  <<04517>>23058000
                                                                        23062000
   <<FCB PARAMETERS>>                                                   23064000
                                                                        23066000
   INTEGER FCBMQ;  << Used for LOCK'CB for Q value.         >> <<04624>>23068000
   LOGICAL FCBV;  <<FCB VECTOR>>                                        23070000
   INTEGER FCBDST;  <<ORIG. DST BEFORE SET TO FCB>>                     23072000
   INTEGER POINTER FCB;  <<FCB POINTER>>                                23074000
   DOUBLE POINTER FCBDBL = FCB;                                         23076000
   DOUBLE FCBPARMS = FCBDST;  <<DST AND FCB>>                           23078000
   DOUBLE FCB'VARS;                << Word 0 and 1 of FCB.  >> <<04624>>23080000
   INTEGER FCB'0    = FCB'VARS;    << Word 0 of FCB.        >> <<04624>>23082000
   INTEGER FCBSI;                  << Extract bits for size >> <<04624>>23084000
   LOGICAL RELFCB := FALSE;  <<DELETE FCB?>>                            23086000
                                                                        23088000
   <<FILE LABEL PARAMETERS>>                                            23090000
                                                                        23092000
   DOUBLE DISKADR;  <<FILE LABEL SECTOR NR.>>                           23094000
   INTEGER POINTER FLAB;  <<FILE LABEL POINTER>>                        23096000
   DOUBLE POINTER FLABDBL = FLAB;                                       23098000
   LOGICAL LABELERROR := FALSE;  <<BAD FILE LABEL?>>                    23100000
                                                                        23102000
   << JIT Parameters >>                                        <<02349>>23104000
   DOUBLE UCAP;                                                <<02349>>23106000
   LOGICAL SFCAP=UCAP;                                         <<02349>>23108000
   <<RESOURCE PARAMETERS>>                                              23110000
                                                                        23112000
   LOGICAL A;  <<FOR GETSIR>>                                           23114000
LOGICAL B:=-1; << FOR FMAVTSIR >>                              <<00157>>23116000
   LOGICAL CRIT;  <<FOR SETCRITICAL>>                                   23118000
   LOGICAL RESOURCES := FALSE;  <<FOR ERROR RECOVERY>>                  23120000
   DEFINE SIRLOCK = (15:1)#,  <<FILE SIR LOCKED?>>                      23122000
          FCBLOCK = (14:1)#,  <<FCB LOCKED?>>                  <<RV.PV>>23124000
          DMOUNT  = (13:1)#;  <<NEED TO DISMOUNT VOL SET?>>    <<RV.PV>>23126000
                                                                        23128000
   <<JOB/CI $STDXX ACCESS >>                                            23130000
                                                                        23132000
   LOGICAL JOBF;                                                        23134000
   LOGICAL PRIMED;                                                      23136000
   LOGICAL CI;                                                          23138000
   LOGICAL CLOSEIT;                                                     23140000
                                                                        23142000
   <<SPOOLFILE ACCESS>>                                                 23144000
                                                                        23146000
   LOGICAL SPOOLF;                                                      23148000
   INTEGER POINTER XDDEP;                                               23150000
   LOGICAL SPVDEV;                                                      23152000
   INTEGER Z;  <<UTILITY VARIABLE>>                            <<00.06>>23154000
   DOUBLE POINTER XMAP;  <<EXT MAP TEMP PTR>>                  <<00.06>>23156000
                                                               <<DS.00>>23158000
   << REMOTE FILE ACCESS (RFA) VARIABLES >>                    <<DS.00>>23160000
                                                               <<DS.00>>23162000
   INTEGER POINTER RFAPTR; << APPENDAGE POINTER >>             <<DS.00>>23164000
   INTEGER RFALEN; << APPENDAGE LENGTH >>                      <<DS.00>>23166000
   LOGICAL KSC; <<ONLY TRUE IF ENTRY KFCLOSE USED>>            <<KS.00>>23168000
                                                               <<DS.00>>23170000
   << PRIVATE VOLUME DECLARATIONS >>                           <<RV.PV>>23172000
   EQUATE                                                      <<RV.PV>>23174000
       UNCONDDISMOUNT = 2,                                     <<RV.PV>>23176000
       CONDDISMOUNT = -3;                                      <<RV.PV>>23178000
   INTEGER                                                     <<RV.PV>>23180000
       HVSIND := [8/"*", 8/" "],                               <<RV.PV>>23182000
       XDSDST,                                                 <<RV.PV>>23184000
       REQTYPE := UNCONDDISMOUNT,                              <<RV.PV>>23186000
       PVINFO := 0;                                            <<RV.PV>>23188000
   LOGICAL                                                     <<RV.PV>>23190000
        FCLOSEDA',                                             <<RV.PV>>23192000
       PVCLOSE';                                               <<RV.PV>>23194000
   DEFINE                                                      <<RV.PV>>23196000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>23198000
       VMASK  = PVINFO.(8:8) #;                                <<RV.PV>>23200000
                                                               <<HM.00>>23202000
   << COMMUNICATION FILE DECLARATIONS >>                       <<HM.00>>23204000
   LOGICAL MSGFILE:=FALSE;                                     <<HM.00>>23206000
                                                               <<03509>>23208000
   << These variables are part of a kludge to fix crunch- >>   <<03509>>23210000
   << ing of files so that the disc space is returned     >>   <<03509>>23212000
   << AFTER the file label is updated.                    >>   <<03509>>23214000
                                                               <<03509>>23216000
   DOUBLE POINTER extent'list;  << For a list of extents >>    <<03509>>23218000
   INTEGER extent'list'size;    << Num of entries in list>>    <<03509>>23220000
   INTEGER extent'list'last'size;  << Size of last entry >>    <<03509>>23222000
   INTEGER extsize;                                            <<04307>>23224000
                                                               <<03509>>23226000
   INTEGER partial'ext'ldev;  << ldev of partial extent >>     <<03509>>23228000
   DOUBLE partial'ext'len;    << length of extent.      >>     <<03509>>23230000
   DOUBLE partial'ext'addr;   << address of extent.     >>     <<03509>>23232000
   INTEGER count;                                              <<03509>>23234000
   POINTER TARGET;                                             <<04517>>23236000
                                                               <<03509>>23238000
                                                               <<RV.PV>>23240000
                                                               <<04517>>23242000
<<**********************************************************>> <<04517>>23244000
<<                                                          >> <<04517>>23246000
<<  ############### ACB POINTERS #################          >> <<04517>>23248000
<<                                                          >> <<04517>>23250000
<<  Below are the declarations and equates for the PACB and >> <<04517>>23252000
<<  AFT arrays.  They cannot be changed in any way and they >> <<04517>>23254000
<<  MUST BE THE LAST DECLARATIONS !!!!!!  LOC'ACB places    >> <<04517>>23256000
<<  the AFT at ACB(-4) to ACB(-1) and the PACB follows.     >> <<04517>>23258000
                                                               <<04517>>23260000
INTEGER ACBMQ;                                                 <<04517>>23262000
INTEGER AFTE;      << AFT entry word 0, type and $NULL bit  >> <<04517>>23264000
INTEGER PACBV;     << Physical ACB Vector                   >> <<04517>>23266000
INTEGER LACBV;     << Logical  ACB Vector                   >> <<04517>>23268000
INTEGER IOQX;      << No-Wait I/O pending Queue Index       >> <<04517>>23270000
                                                               <<04517>>23272000
<< SIZEXACB = %70, 0-%67 used by LOC'ACB and the last word  >> <<04517>>23274000
<< used for the DSTX define, since a declaration past the   >> <<04517>>23276000
<< ACB declaration will cause a Primary Q overflow.         >> <<04517>>23278000
                                                               <<04517>>23280000
INTEGER ARRAY ACB(0:SIZEXACB) = Q;                             <<04517>>23282000
DOUBLE ARRAY ACBDBL(*)=ACB;                                    <<04517>>23284000
DEFINE DSTX = ACB(SIZEXACB)#; << Returned by LOC'ACB        >> <<04517>>23286000
                                                               <<04517>>23288000
<<  Do not place any declarations after this point!!!  Just >> <<04517>>23290000
<<  as important, do no stack any data before the call to   >> <<04517>>23292000
<<  IOMOVE or FQUIESCIO.  Both procedures expect the ACB    >> <<04517>>23294000
<<  and DSTX to be directly below the procedure calls.      >> <<04517>>23296000
<<  FQUIESC'IO finds the ACB at Q-62 and IOMOVE at Q-63.    >> <<04517>>23298000
<<  (IOMOVE has 3 parms, FQUIESCE'IO one parm and one word  >> <<04517>>23300000
<<  for Integer function return value.                      >> <<04517>>23302000
<<**********************************************************>> <<04517>>23304000
                                                               <<04517>>23306000
$PAGE                                                          <<04517>>23308000
   SUBROUTINE LABELIO (RW);                                             23310000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           23312000
                                                                        23314000
        INPUT VARIABLES:                                                23316000
            RW - I/O MODE                                               23318000
               0 - READ                                                 23320000
               1 - WRITE                                                23322000
                                                                        23324000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE IS   23326000
        CALLED>>                                                        23328000
      VALUE RW;                                                         23330000
      INTEGER RW;                                                       23332000
      BEGIN                                                             23334000
      X := FLABIO(DADDR,DISKADR,RW,FLAB);  <<R/W LABEL>>                23336000
      IF <> THEN  <<ERROR?>>                                            23338000
         BEGIN                                                          23340000
         FLABIOERR(X,FILENUM);  <<HANDLE ERROR>>                        23342000
         TOS := LBLIOERR;                                               23344000
         GO ERR                                                         23346000
         END                                                            23348000
      END;                                                              23350000
                                                                        23352000
   SUBROUTINE RELEASEDISK (FIRST,LAST);                                 23354000
      <<DEALLOCATES THE DISC SPACE FOR THE SPECIFIED EXTENTS OF THE     23356000
        FILE BEING CLOSED.                                              23358000
                                                                        23360000
        INPUT PARAMETERS:                                               23362000
            FIRST - THE FIRST EXTENT INDEX TO BE DEALLOCATED            23364000
            LAST - THE LAST EXTENT INDEX TO BE DEALLOCATED              23366000
                                                                        23368000
        THE TOTAL NUMBER OF SECTORS RELEASED IS ADDED TO DRCODE.  ALSO, 23370000
        THE DEALLOCATED EXTENT DESCRIPTORS ARE CLEARED IN THE FCB       23372000
        AND FILE LABEL EXTENT MAPS>>                                    23374000
      VALUE FIRST,LAST;                                                 23376000
      INTEGER FIRST,LAST;                                               23378000
      BEGIN                                                             23380000
      extent'list'size := 0;                                   <<03509>>23382000
      count := last - first + 1;  << Number of extents >>      <<03509>>23384000
      IF FIRST <= LAST THEN  <<EXTENTS TO BE DEALLOCATED?>>             23386000
         BEGIN                                                          23388000
         << Remember size of last extent in list >>            <<03509>>23390000
                                                               <<03509>>23392000
         extent'list'last'size := IF last=fcbnumexts THEN      <<03509>>23394000
                          fcblastextsize ELSE fcbextsize;      <<03509>>23396000
                                                               <<03509>>23398000
         TOS := @FCBEXTMAP+FIRST&LSL(1);  <<FCB EXTENT MAP POINTER>>    23400000
         TOS := @FLEXTMAP+S3&LSL(1);  <<FILE LABEL EXTENT MAP POINTER>> 23402000
                                                                        23404000
         << Add extents to list of extents to purge >>         <<03509>>23406000
                                                               <<03509>>23408000
         WHILE count > 0 DO                                    <<03509>>23410000
            BEGIN  << Add extents to list >>                   <<03509>>23412000
                                                               <<03509>>23414000
               extent'list (extent'list'size) :=               <<03509>>23416000
                     DPS1 (extent'list'size);                  <<03509>>23418000
               extent'list'size := extent'list'size + 1;       <<03509>>23420000
               count := count - 1;                             <<03509>>23422000
                                                               <<03509>>23424000
            END;   << Add extents to list >>                   <<03509>>23426000
                                                               <<03509>>23428000
                                                                        23432000
         <<* * * COMPUTE SECTORS DEALLOCATED * * *>>                    23434000
                                                                        23436000
         DO BEGIN                                                       23438000
            TOS := DPS1;  <<FCB EXTENT DESCRIPTOR>>                     23440000
            IF <> THEN  <<EXTENT ALLOCATED?>>                           23442000
               BEGIN                                                    23444000
               TOS := 0; << LEFT HALF OF DOUBLE EXT SIZE >>    <<00300>>23446000
               IF S7 = FCBNUMEXTS THEN  <<LAST EXTENT?>>                23448000
                  TOS := FCBLASTEXTSIZE                                 23450000
               ELSE  <<NOT LAST EXTENT>>                                23452000
                  TOS := FCBEXTSIZE;                                    23454000
               DRCODE := DRCODE+TOS  <<ADD TO TOTAL>>                   23456000
               END;                                                     23458000
            ASSEMBLE(DDEL,DZRO; DZRO);                                  23460000
            DPS5 := TOS;  <<CLEAR FCB EXTENT DESCRIPTOR>>               23462000
            DPS2 := TOS;  <<CLEAR FILE LABEL EXTENT DESCRIPTOR>>        23464000
            ASSEMBLE(INCB,INCB);  <<NEXT FCB EXTENT>>                   23466000
            ASSEMBLE(INCA,INCA);  <<NEXT FILE LABEL EXTENT>>            23468000
            S4 := S4+1  <<BUMP FIRST EXTENT INDEX>>                     23470000
            END UNTIL S4 > S3;                                          23472000
         DDEL                                                           23474000
         END                                                            23476000
      END;                                                              23478000
$PAGE                                                          <<04814>>23480000
SUBROUTINE BACK'SPACE'RECORDS;                                 <<04814>>23482000
                                                               <<04814>>23484000
<<**********************************************************>> <<04814>>23486000
<< This subroutine performs a BSR function for each pre-read>> <<04814>>23488000
<< performed to properly position the tape, mispositioned   >> <<04814>>23490000
<< due to pre-reads.  ACBTAPEDISP contains the number of    >> <<04814>>23492000
<< pre-reads, obtained from FQUIESCE'IO.                    >> <<04814>>23494000
<<**********************************************************>> <<04814>>23496000
                                                               <<04814>>23498000
BEGIN                                                          <<04814>>23500000
IF LOG(ACBNEWEOF) THEN  << No pre-reads were performed, any >> <<04814>>23502000
   ACBTAPEDISP := 0     << outstanding I/O's were writes.   >> <<04814>>23504000
ELSE                                                           <<04814>>23506000
   WHILE ACBTAPEDISP > 0 DO                                    <<04814>>23508000
     BEGIN                                                     <<04814>>23510000
     IO'STATUS := ATTACHIO(DADDR,0,0,0,12,0,0,4,BFLAGS);       <<04814>>23512000
     IF ERR'STAT <> 1 THEN                                     <<04814>>23514000
        BEGIN           << Error of some kind, ignore some. >> <<04814>>23516000
        ACBERROR := IOSTAT(ERR'STAT);                          <<04814>>23518000
        IF ACBERROR <> EOF AND ACBERROR <> EOT AND             <<04814>>23520000
           ACBERROR <> TAPERREC THEN                           <<04814>>23522000
           BEGIN        << Report error condition.  Place   >> <<04814>>23524000
           TOS := ACBERROR;  << error on TOS and GO TO ERR. >> <<04814>>23526000
           GO TO ERR;        << I hate GO TO's!!!!!!!!!!!!! >> <<04814>>23528000
           END;                                                <<04814>>23530000
        END;                                                   <<04814>>23532000
     ACBTAPEDISP := ACBTAPEDISP - 1;                           <<04814>>23534000
     END;                                                      <<04814>>23536000
END; << Subroutine BACK'SPACE'RECORDS.                      >> <<04814>>23538000
$PAGE                                                          <<04814>>23540000
                                                                        23542000
   SUBROUTINE UPDATEFCB;                                                23544000
                                                               <<04624>>23546000
      <<****************************************************>> <<04624>>23548000
      << Updates the actual FCB in the control block (where >> <<04624>>23550000
      << ever it may be) by overlaying  it with the updated >> <<04624>>23552000
      << FCB that exists on the stack.                      >> <<04624>>23554000
      <<****************************************************>> <<04624>>23556000
                                                               <<04624>>23558000
      BEGIN                                                             23560000
                                                               <<04624>>23562000
      LOCK'CB(0,0,FCBMQ,FCBV.DSTN,FCBV VTA);                   <<04624>>23564000
      ASSEMBLE(DXCH);   << Switch source and targer address.>> <<04624>>23566000
      TOS := FCBSI;     << Now copy the FCB back to CB table>> <<04624>>23568000
      MOVE'DS'5;                                               <<04624>>23570000
      DEL;              << Delete FLAGS parm. from LOCK'CB. >> <<04624>>23572000
      UNLOCK'CB(0,FCBV.DSTN,FCBV VTA);  << Unlock it.       >> <<04624>>23574000
                                                               <<04517>>23576000
      END;                                                              23578000
                                                                        23580000
   INTEGER SUBROUTINE DISMOUNT';                               <<RV.PV>>23582000
       BEGIN                                                   <<RV.PV>>23584000
           IF FCLOSEDA' THEN RETURN;                           <<RV.PV>>23586000
           REQTYPE := IF PVCLOSE' THEN CONDDISMOUNT            <<RV.PV>>23588000
                                  ELSE UNCONDDISMOUNT;         <<RV.PV>>23590000
           IF (XDSDST := PCB'XDS) <> 0 THEN                    <<RV.PV>>23592000
            EXCHANGEDB (0); <<TO STACK>>                       <<RV.PV>>23594000
           DISMOUNT (HVSIND, FCBGN, FCBAN,                     <<RV.PV>>23596000
                     REQTYPE, PVINFO);                         <<23.PV>>23598000
           IF <> THEN                                          <<RV.PV>>23600000
           BEGIN <<SOME FAILURE>>                              <<RV.PV>>23602000
               <<REQTYPE CONTAINS DISMOUNT ERROR NUMBER>>      <<23.PV>>23604000
               <<CALLER OF DISMOUNT' NEEDS TO MAP IT>>         <<23.PV>>23606000
               <<INTO A FILESYS ERROR NUMBER>>                 <<23.PV>>23608000
               DISMOUNT' := DISMOUNTPROB;                      <<RV.PV>>23610000
           END;                                                <<RV.PV>>23612000
           RESOURCES.DMOUNT := FALSE; <<ONLY TRY ONCE>>        <<RV.PV>>23614000
           IF XDSDST <> 0 THEN EXCHANGEDB (XDSDST);            <<RV.PV>>23616000
       END;<<OF DISMOUNT'>>                                    <<RV.PV>>23618000
                                                               <<RV.PV>>23620000
   <<* * * INITIALIZE PARAMETERS * * *>>                                23622000
                                                                        23624000
   IF (SPOOLF := FALSE) THEN                                            23626000
      BEGIN                                                             23628000
FSCLOSE:                                                                23630000
      SPOOLF := TRUE;                                                   23632000
      END;                                                              23634000
   IF (JOBF := FALSE) THEN                                              23636000
      BEGIN                                                             23638000
FJCLOSE:                                                                23640000
      JOBF := TRUE;                                                     23642000
      SPOOLF := FALSE;                                                  23644000
      END;                                                              23646000
   IF (KSC:=FALSE) THEN                                        <<KS.00>>23648000
   BEGIN <<KSAM SECONDARY ENTRY POINT BEGINS>>                 <<KS.00>>23650000
KFCLOSE:                                                       <<KS.00>>23652000
      KSC:=TRUE;                                               <<KS.00>>23654000
      SPOOLF:=JOBF:=FALSE;                                     <<KS.00>>23656000
   END; <<KSAM SECONDARY ENTRY POINT BEGINS>>                  <<KS.00>>23658000
   IF (PVCLOSE' := FALSE) THEN                                 <<RV.PV>>23660000
   BEGIN <<CONDITIONAL DISMOUNT ENTRY POINT>>                  <<RV.PV>>23662000
PVCLOSE:                                                       <<RV.PV>>23664000
       PVCLOSE' := TRUE;                                       <<RV.PV>>23666000
       KSC := SPOOLF := JOBF := FALSE;                         <<RV.PV>>23668000
   END;                                                        <<RV.PV>>23670000
   IF (FCLOSEDA' := FALSE) THEN                                <<RV.PV>>23672000
   BEGIN                                                       <<RV.PV>>23674000
FCLOSEDA:                                                      <<RV.PV>>23676000
       FCLOSEDA' := TRUE;                                      <<RV.PV>>23678000
       PVCLOSE' := KSC := SPOOLF := JOBF := FALSE;             <<RV.PV>>23680000
   END;                                                        <<RV.PV>>23682000
                                                                        23684000
$  IF X0 = ON                                                           23686000
   IF MONCALLABLE THEN  <<MONITORING?>>                                 23688000
      BEGIN                                                             23690000
      TOS := "FC"; TOS := "LO"; TOS := "SE";                            23692000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        23694000
      FTITLE(*,*,*,*);                                                  23696000
      DEBUG                                                             23698000
      END;                                                              23700000
$  IF                                                                   23702000
                                                                        23704000
   ERRORON;                                                             23706000
                                                               <<03509>>23708000
   << Insure that there will be enough stack space while  >>   <<03509>>23710000
   << FCLOSE is critical.                                 >>   <<03509>>23712000
                                                               <<03509>>23714000
   TOS := %1400;                                               <<03509>>23716000
   ASSEMBLE (ADDS 0);                                          <<03509>>23718000
   TOS := %1400;                                               <<03509>>23720000
   ASSEMBLE (SUBS 0);                                          <<03509>>23722000
                                                               <<03509>>23724000
   CRIT := SETCRITICAL;                                                 23726000
   ORIG'DST := EXCHANGEDB(0);  << Save original DST number     <<04517>>23728000
   MUSTCLOSE := (DISP = -1) LAND PRIVMODE;                     <<RV.PV>>23730000
   IF SPOOLF OR JOBF THEN  <<SPECIAL CLOSE?>>                           23732000
      BEGIN                                                             23734000
      IF NOT PRIVMODE THEN  <<NOT PRIVILEGED?>>                         23736000
         BEGIN                                                          23738000
         TOS := ILLCAP;                                                 23740000
         TOS := CCL;                                                    23742000
         GO EXIT                                                        23744000
        ; HELP  <<FOR DUMMY CALL>>;                            <<00117>>23746000
         END                                                            23748000
      END;                                                              23750000
   CI := PCB'PTYPE = 1;  <<CI?>>                                        23752000
   IF NOT JOBF AND CI AND (1 <= FILENUM <= 2) AND DISP <> 4             23754000
      THEN CLOSEIT := FALSE                                             23756000
      ELSE CLOSEIT := TRUE;                                             23758000
   IF NOT CI AND FILENUM <= 2                                  <<01863>>23760000
      THEN PRIMED := FALSE                                     <<01863>>23762000
      ELSE PRIMED := TRUE;                                     <<01863>>23764000
   IF JOBF AND DISP = 4 AND FILENUM = 2 THEN                            23766000
     BEGIN  << Deletion of Output spoolfile on close.   >>              23768000
     SPECIAL'SPOOL'CLOSE(FILENUM,DISP,SECCODE);                         23770000
     TOS := IF = THEN CCE ELSE CCL;                                     23772000
     GOTO EXIT;                                                         23774000
     END;                                                               23776000
   SETPCBX;  <<INIT. PCBX POINTER>>                                     23778000
   TOS:=@UCAP;           << Address of user cap variable >>    <<02349>>23780000
   TOS:=PXGJITDST;       << Pick JIT DST from PXGLOBAL area >> <<02349>>23782000
   TOS:=JITUCAP;         << Location in JIT of user cap >>     <<02349>>23784000
   TOS:=2;               << Number of words to move >>         <<02349>>23786000
   ASSEMBLE(MFDS 4);     << Get user cap from JIT >>           <<02349>>23788000
   SETPXFILE;  <<INIT. PXFILE POINTER>>                                 23790000
                                                                        23792000
   <<* * *       Obtain the FMAVT SIR NOW!!!        * * *>>    <<04517>>23794000
                                                                        23796000
   B := GETSIR(FMAVTSIR);                                      <<01863>>23798000
                                                               <<04517>>23802000
   <<*******************************************************>> <<04517>>23804000
   <<  Next, copy our AFT entry and ACB's onto the stack    >> <<04517>>23806000
   << into out Q relative array ACB.                        >> <<04517>>23808000
   <<*******************************************************>> <<04517>>23810000
                                                               <<04517>>23812000
   PUSH(STATUS);         << FLAG.(0:1) set to privmode bit  >> <<04517>>23814000
   FLAGS := TOS;         << of STATUS registar.             >> <<04517>>23816000
   FLAGS.(1:15) := 0;    << Privmode check only.            >> <<04517>>23818000
   GET'ACB'Q'LOC;                                              <<04517>>23820000
   LOC'ACB(DSTX,ACBMQ,FILENUM,FLAGS,FMAVTSIR,B);               <<04517>>23822000
   DSTX := TOS;      <<LOC'ACB returns current DST number   >> <<04517>>23824000
                                                               <<04517>>23826000
   IF < THEN GO E1;  <<INVALID FILE NR.?>>                              23828000
   IF > THEN GO RELAFTENT;  <<$NULL?>>                                  23830000
                                                               <<04517>>23832000
   <<*******************************************************>> <<04517>>23834000
   << If we try to close the file with I/O pending, return  >> <<04517>>23836000
   << I/O pending error unless we are in a "MUST CLOSE"     >> <<04517>>23838000
   << situation.                                            >> <<04517>>23840000
   <<*******************************************************>> <<04517>>23842000
                                                               <<04517>>23844000
   IF IOQX <> 0 THEN                                           <<04517>>23846000
      BEGIN   << No-Wait I/O pending                        >> <<04517>>23848000
      IF NOT MUSTCLOSE THEN  <<RETURN ERROR?>>                          23850000
         BEGIN                                                          23852000
         TOS := IOPENDING;                                              23854000
         GO ERR                                                         23856000
         END;                                                           23858000
                                                               <<04517>>23860000
      <<****************************************************>> <<04517>>23862000
      << If the IOQX is non-zero, signifying that there is  >> <<04517>>23864000
      << a No-Wait I/O pending than delete this request via >> <<04517>>23866000
      << ABORTIOX, except for a message file.               >> <<04517>>23868000
      <<****************************************************>> <<04517>>23870000
                                                               <<04517>>23872000
      IF FTYPE <> MSG'TYPE AND IOQX > 0         <<ABORT I/O>>  <<04517>>23874000
         THEN ABORTIOX(IOQX);                                  <<04517>>23876000
      IOQX := 0;  << Clear out IOQX word in AFT             >> <<04517>>23878000
      END;                                                              23880000
   IF FTYPE<>0 AND FTYPE<>MSG'TYPE OR ACBACCCL<>0 THEN         <<01882>>23882000
     IF B <> -1 THEN RELSIR(FMAVTSIR,B);                       <<01882>>23884000
   CASE FTYPE OF                                               <<DS.00>>23886000
   BEGIN                                                       <<DS.00>>23888000
                                                               <<DS.00>>23890000
   BEGIN << CONVENTIONAL FILE >>                               <<DS.00>>23892000
CONV: <<USED FOR KSAM>>                                        <<KS.00>>23894000
   IF ACBDTYPE=FDISC THEN DISP := SECCODE := 0;                <<01882>>23896000
   IF ACBMSGFILE AND (NOT ACBCOPY OR ACBWRITE) THEN            <<01882>>23898000
      MSGFILE := TRUE;                                         <<01882>>23900000
   IF ACBACCCL = DIRACC AND LOGICAL(ACBPRIV) AND NOT PRIVMODE THEN      23902000
      GO E1;  <<COULDN'T HAVE OPENED IT?>>                              23904000
                                                                        23906000
   <<* * * HANDLE SPECIAL SITUATIONS FOR SPOOLING * * *>>               23908000
                                                                        23910000
   IF CLOSEIT AND LOGICAL(ACBSPOOL) THEN  <<VIRTUAL>>                   23912000
      BEGIN                                                             23914000
      SPOOLF := 1;                                                      23916000
      IF LOGICAL(ACBSPOOLIO) AND PRIMED THEN  <<WRITE FCLOSE CONTROL?>> 23918000
         BEGIN                                                          23920000
         ACBCTL := 0;                                                   23922000
         ACBNEWEOF := 1;                                                23924000
         @TARGET := 0;       << Initialize dummy pointer.   >> <<04865>>23926000
         IOMOVE(4,TARGET,0); << Write file close record     >> <<04517>>23928000
         END;                                                           23930000
      END;                                                              23932000
   IF NOT MSGFILE AND NOT ACBINHIBITBUF                        <<HM.00>>23934000
     AND ((CLOSEIT LAND ACBSHCNT <= 1) LOR                     <<HM.00>>23936000
      (NOT CLOSEIT LAND NOT LOGICAL(ACBSPOOL))) THEN                    23938000
      BEGIN                                                             23940000
                                                               <<04517>>23942000
      <<****************************************************>> <<04517>>23944000
      << FQUIESCIO also needs the ACB and DSTX directly     >> <<04517>>23946000
      << above the procedure call. Obtain the number of pre->> <<04814>>23948000
      << reads from FQUIESCE'IO.  For serial devices, we    >> <<04814>>23950000
      << will do a BSR for each pre-read.                   >> <<04814>>23952000
      <<****************************************************>> <<04517>>23954000
                                                               <<04517>>23956000
      TOS := FQUIESCE'IO(FALSE);  << Must use TOS to insure >> <<04814>>23958000
      ACBTAPEDISP := TOS;         << the ACB at Q-62!!!!!!  >> <<04814>>23960000
      IF NOT LOGICAL(ACBEOF) THEN  <<NO EOF YET?>>                      23962000
         ACBEOF := FCHECKEOF(PACBV);                           <<04517>>23964000
      END;                                                              23966000
   IF NOT CLOSEIT THEN                                                  23968000
      BEGIN                                                             23970000
      TOS := 0;                                                         23972000
      TOS := CCE;                                                       23974000
      GO XIT;                                                           23976000
      END;                                                              23978000
   IF ACBREADTYPE <> 0 THEN  <<$STDIN(X) - UPDATE EOF?>>                23980000
      BEGIN                                                             23982000
      IF ACBREADMODE <> STDINCIRD THEN  <<NON-CI?>>                     23984000
         BEGIN                                                          23986000
         IF (LOGICAL(ACBREADMODE+1) LAND LOGICAL(ACBEOFS)) <> 0 THEN    23988000
            ACBEOF := 1;                                                23990000
         IF CI OR ACBSHCNTIN <= 2 THEN  <<RESET EOF FLAGS IN PACB?>>    23992000
            ACBEOFS := 0                                                23994000
         END                                                            23996000
      END;                                                              23998000
   IF NOT SPOOLF AND NOT MSGFILE THEN                          <<HM.00>>24000000
      IF (SPOOLF := ACBSPXDDX <> 0) THEN DISP := 0;                     24002000
                                                               <<04517>>24004000
   <<*******************************************************>> <<04517>>24006000
   <<  Copy the FCB onto the stack.  Because of space prob- >> <<04517>>24008000
   << lems in out Q-relative locations.  We expand SREG by  >> <<04517>>24010000
   << FCBSIZE and move the Control Block onto stack.        >> <<04517>>24012000
   <<*******************************************************>> <<04517>>24014000
                                                               <<04517>>24016000
   IF ACBACCCL = DIRACC AND ACBDTYPE <> FDISC THEN  <<DISC FILE?><<FDF>>24018000
      BEGIN                                                             24020000
      A := GETSIR(FISIR);  <<GET FILE SIR NOW!>>                        24022000
      RESOURCES.SIRLOCK := TRUE;  <<SET SIR FLAG>>                      24024000
      FCBV := ACBFCB;                                          <<04624>>24028000
      FCB'VARS := GETFCB'INFO(FCBV,0);  << Get FCB size.    >> <<04624>>24030000
      FCBSI := FCB'0.SIZEF;     << Extract bits of FCB size.>> <<04624>>24032000
      PUSH(S);               << Allocate local FCB array    >> <<04624>>24034000
      @FCB := TOS + 1;       << on Top Of Stack.            >> <<04624>>24036000
      TOS := FCBSI;          << Expand S by FCB size.       >> <<04624>>24038000
      ASSEMBLE(ADDS 0);                                        <<04624>>24040000
      GET'FCB'Q'LOC;                                           <<04624>>24042000
      LOCK'CB(0,0,FCBMQ,FCBV.DSTN,FCBV VTA);                   <<04624>>24044000
      TOS := FCBSI;                                            <<04624>>24046000
      MOVE'DS'5;             << Copy the FCB onto stack.    >> <<04624>>24048000
      DEL;                   << Delete FLAG parameter.      >> <<04624>>24050000
      RESOURCES.FCBLOCK := TRUE; << FCB is locked.          >> <<04624>>24052000
                                                               <<04624>>24054000
      IF FCBDISP = HARDFLABERR                                 <<04624>>24056000
         THEN LABELERROR := TRUE;                              <<04624>>24058000
      IF MUSTCLOSE THEN                                        <<04624>>24060000
         BEGIN                                                 <<04624>>24062000
         FCBDISP := 0;                                         <<04624>>24064000
         FCBCRUNCH := 0;                                       <<04624>>24066000
         END;                                                  <<04624>>24068000
      END; << Disc file.                                    >> <<04624>>24070000
                                                               <<04624>>24072000
   IF MUSTCLOSE OR LABELERROR THEN ACBDISP := DISP := 0;                24074000
   ATYPE := ACBACTYPE;  <<ACCESS TYPE>>                                 24076000
   DADDR := ACBDADDR;  <<LOG. DEV. NR.>>                                24078000
   VDADDR := ACBVDADDR;  <<VOLUME TABLE INDEX>>                         24080000
   IF (TOS:=ACBDISP) <> 0 THEN DISP.(13:3):=TOS ELSE DEL;      <<02351>>24082000
                                                                        24084000
   <<* * * PROCESS ACCORDING TO DEVICE TYPE * * *>>                     24086000
                                                                        24088000
   IF ACBDTYPE<>FDISC THEN TOS:=ACBACCCL                       <<01115>>24090000
                      ELSE TOS:=3;                             <<01115>>24092000
   IF = THEN  <<DIRECT ACCESS DEVICE?>>                                 24094000
      BEGIN                                                             24096000
                                                                        24098000
      <<DIRECT ACCESS DEVICE>>                                          24100000
                                                                        24102000
      PVINFO := FCBPVINFO;                                     <<RV.PV>>24104000
      TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                         24106000
      BS1 := 0;  <<CLEAR LDEV>>                                         24108000
      DISKADR := TOS;  <<FILE LABEL SECTOR NR.>>                        24110000
      << SET PENDING DISPOSITION >>                                     24112000
      IF SPOOLF THEN  <<SPOOLFILE?>>                                    24114000
         BEGIN                                                          24116000
         @XDDEP := ACBSPXDDX;   <<XDD TABLE INDEX>>            <<+1.03>>24118000
         IF INTEGER(SPOOLF) > 0 THEN   <<ACCESSED AS DEVICE?>> <<+1.03>>24120000
            BEGIN                                                       24122000
            SPVDEV := ACBSPVDEV;   <<VIRTUAL DEVICE NR.>>      <<+1.03>>24124000
            DISP := IF LOGICAL(ACBSPOOLIO)                     <<+1.03>>24126000
              THEN 0   <<OUTPUT: SAVE FILE>>                   <<+1.03>>24128000
              ELSE 4   <<INPUT: DELETE>>                       <<+1.03>>24130000
            END                                                         24132000
         ELSE   << SPOOLFILE ACCESSED AS A FILE >>             <<+1.03>>24134000
            IF DISP = 1 THEN                                   <<+1.03>>24136000
               BEGIN  <<REDUCE NR. OF COPIES, TERMINATE IF 0>> <<+1.03>>24138000
               TOS := XDDSPOOLINFO(0D,%4,XDDEP);                        24140000
               DISP := IF TOS = 0                              <<+1.03>>24142000
                  THEN 4   <<LAST COPY PRINTED: DELETE>>       <<+1.03>>24144000
                  ELSE 0   <<MORE COPIES TO PRINT: KEEP>>      <<+1.03>>24146000
               END;                                                     24148000
         IF DISP <> 0 THEN DISP := 4;  <<DEFAULT: DELETE>>     <<+1.03>>24150000
         TOS := 0;  <<FOR DOMAIN>>                                      24152000
         IF DISP = 0 THEN   << SAVE? >>                        <<+1.03>>24154000
            BEGIN   <<SAVE FILE IN IDD OR ODD>>                <<+1.03>>24156000
            TOS := TOS+1;  <<DOMAIN := 1: SAVE FILE>>          <<+1.03>>24158000
            IF FCBOCNTOUT = 1   << LAST COPY? >>               <<+1.03>>24160000
               THEN DISP := %10   << CRUNCH FILE >>            <<+1.03>>24162000
            END;                                                        24164000
         IF ACBSPSQZ=1   << ALREADY CRUNCHED? >>               <<+1.03>>24166000
            THEN DISP := DISP'DOMAIN;   <<Don't crunch again>> <<04513>>24168000
         DOMAIN := TOS                                                  24170000
         END                                                            24172000
      ELSE  <<NORMAL FILE>>                                             24174000
         BEGIN                                                          24176000
         DOMAIN := FCBDOMAIN;  <<SET DOMAIN>>                           24178000
         IF DISP'DOMAIN = 3 THEN DISP'DOMAIN := 2;<<job temp>> <<04513>>24180000
         IF DISP'DOMAIN = 2 THEN                               <<04513>>24182000
            IF DOMAIN=1 THEN GO E3  << sys file >>                      24184000
            ELSE IF DOMAIN=2 THEN DISP'DOMAIN := 0; << temp >> <<04513>>24186000
         END;                                                           24188000
      IF LABELERROR THEN  <<BAD LABEL?>>                                24190000
         BEGIN                                                          24192000
         IF NOT MUSTCLOSE THEN  <<RETURN ERROR?>>                       24194000
            BEGIN                                                       24196000
            TOS := LBLIOERR;                                            24198000
            GO ERR                                                      24200000
            END;                                                        24202000
         IF DOMAIN = 2 THEN REMJTENTRY(ACBNAME,FCBGN,FCBAN,2,0);        24204000
         DOMAIN := PURGE := 1;                                          24206000
         GO FCBACBMGT                                                   24208000
         END;                                                           24210000
      ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>                        24212000
      LABELIO(0);  <<READ LABEL>>                                       24214000
      RESOURCES.DMOUNT := MVTABX <> 0;<<DISMOUNT REQUIRED?>>   <<RV.PV>>24216000
      LDEVTOVTAB(FLEXTMAP,FCBEXTMAP,FCBNUMEXTS+1,FCBMVTABX<>0);<<RV.PV>>24218000
                                                               <<04513>>24220000
     <<*****************************************************>> <<04513>>24222000
     << Determine if we should crunch the file, now, or     >> <<04513>>24224000
     << possible in the future.                             >> <<04513>>24226000
     <<*****************************************************>> <<04513>>24228000
                                                               <<04513>>24230000
     IF FCBOCNT > 1 THEN                                       <<04513>>24232000
        BEGIN               << Not the last accessor.       >> <<04513>>24234000
        IF DISP'CRUNCH = 1 THEN                                <<04513>>24236000
           BEGIN                                               <<04513>>24238000
           IF FCBDISP = 0                                      <<04513>>24240000
              THEN FCBCRUNCH := 1;  << Will crunch.    >>      <<04513>>24242000
           DISP'CRUNCH := 0;   << Won't crunch this pass!   >> <<04513>>24244000
           END                                                 <<04513>>24246000
        ELSE                                                   <<04513>>24248000
           IF DISP'DOMAIN <> 0                                 <<04513>>24250000
              THEN FCBCRUNCH := 0;  << Won't crunch.   >>      <<04513>>24252000
        END                                                    <<04513>>24254000
     ELSE                                                      <<04513>>24256000
        BEGIN               << Last accessor, do we crunch? >> <<04513>>24258000
        IF DISP'CRUNCH = 1 THEN                                <<04513>>24260000
           BEGIN                                               <<04513>>24262000
           IF 1 <= FCBDISP <= 4 AND FCBCRUNCH = 0              <<04513>>24264000
              THEN DISP'CRUNCH := 0;     << Can't crunch.   >> <<04513>>24266000
           END                                                 <<04513>>24268000
        ELSE                                                   <<04513>>24270000
           IF DISP'DOMAIN = 0 AND FCBCRUNCH = 1                <<04513>>24272000
              THEN DISP'CRUNCH := 1;     << Let's crunch.   >> <<04513>>24274000
        END;                                                   <<04513>>24276000
                                                                        24278000
      <<* * * CRUNCH FILE * * *>>                                       24280000
                                                                        24282000
      IF (%10 <= DISP <= %13) AND NOT ACBCIRFILE               <<04549>>24284000
                              AND NOT MSGFILE THEN             <<04549>>24286000
         BEGIN                                                          24288000
         IF ATYPE=0 THEN     <<READ ONLY ACCESS>>              <<01052>>24290000
            BEGIN                                              <<01882>>24292000
            TOS := ACCVIOL;     << can't crunch file >>        <<01882>>24294000
            DISP := DISP'DOMAIN;  << Remove Crunch bit      >> <<04513>>24296000
            GO ERR                                             <<01882>>24298000
            END;                                               <<01882>>24300000
         CRUNCH := TRUE;  <<SET FLAG>>                                  24302000
                                                               <<04549>>24304000
         <<*************************************************>> <<04549>>24306000
         << Obtain block number of EOF.  For fixed length   >> <<04549>>24308000
         << and undefined, divide EOF record number by      >> <<04549>>24310000
         << blocking factor.  For normal variable, FCBEND   >> <<04549>>24312000
         << contains the block number of the last data blk,  > <<04549>>24314000
         << which is the number of blocks -1.  For spoofles,>> <<04549>>24316000
         << the block number is retrieved from the ACB Block>> <<04549>>24318000
         << Transfer Count.                                 >> <<04549>>24320000
         <<*************************************************>> <<04549>>24322000
                                                               <<04549>>24324000
         IF SPOOLF THEN       << Spoolfile variable length. >> <<04549>>24326000
            TOS := ACBBTFRCT  << # of spoolfile blocks.     >> <<04549>>24328000
         ELSE IF ACBNORMVAR THEN << Normal variable length. >> <<04549>>24330000
            BEGIN                                              <<04549>>24332000
            IF FCBEOF = 0D                                     <<04549>>24334000
               THEN TOS := 0D           << Empty file       >> <<04549>>24336000
               ELSE << Kludge to protect pre-MPEIV files.   >> <<04768>>24338000
                  IF FCBEND = 0D                               <<04768>>24340000
                     THEN GO TO NO'CRUNCH                      <<04768>>24342000
                     ELSE TOS := FCBEND + 1D;                  <<04768>>24344000
            END                                                <<04549>>24346000
         ELSE                                                  <<04549>>24348000
            BEGIN             << Fixed  or undefined length >> <<04549>>24350000
            TOS := FCBEOF/DOUBLE(FCBBLKFACT);                  <<04549>>24352000
            IF FCBEOF MOD DOUBLE(FCBBLKFACT) <> 0D             <<04549>>24354000
               THEN TOS := TOS + 1D; << Partial Block       >> <<04549>>24356000
            END;                                               <<04549>>24358000
                                                               <<04549>>24360000
         <<*************************************************>> <<04549>>24362000
         << TOS contains EOF block number.  Calculate EOF   >> <<04549>>24364000
         << EXTENT and sector displacement into that extent.>> <<04549>>24366000
         <<*************************************************>> <<04549>>24368000
                                                               <<04549>>24370000
         X := FCBSECTPBLK;                                              24372000
         MPYD;                                                          24374000
         TOS := TOS+DOUBLE(LOGICAL(FCBSECTOFF));                        24376000
         X := FCBEXTSIZE;                                               24378000
         DIVD;                                                          24380000
         I := TOS;  <<REM: EOF EXTENT SECTOR DISP.>>           <<+1.03>>24382000
         J := TOS;  <<QUOT: EOF EXTENT INDEX>>                 <<+1.03>>24384000
         DEL;                                                           24386000
         DRCODE := 0D;  <<INIT. NR. SECTORS DEALLOCATED>>               24388000
                                                                        24390000
         <<* * * RELEASE UNUSED PART OF EOF EXTENT * * *>>              24392000
                                                                        24394000
         << The following code has been altered to     >>      <<03509>>24396000
         << prevent problems when the system crashs    >>      <<03509>>24398000
         << after space has been returned but before   >>      <<03509>>24400000
         << the file label has been updated.  This fix >>      <<03509>>24402000
         << is a kludge, but the code is shit and      >>      <<03509>>24404000
         << needs to be re-written.                    >>      <<03509>>24406000
                                                               <<03509>>24408000
         partial'ext'len := 0D;                                <<03509>>24410000
         extsize := fcbextsize;                                <<04307>>24412000
         IF I <> 0 THEN  <<RELEASE PARTIAL EXTENT?>>                    24414000
            BEGIN                                                       24416000
            @EXTENTRY := @FCBEXTMAP+J&LSL(1);  <<EOF EXTENT DESCRIPTOR>>24418000
            IF J = FCBNUMEXTS THEN  <<LAST EXTENT?>>                    24420000
               TOS := FCBLASTEXTSIZE  <<EXTENT SIZE>>                   24422000
            ELSE  <<NOT LAST EXTENT>>                                   24424000
               TOS := FCBEXTSIZE;  <<EXTENT SIZE>>                      24426000
                                                               <<03509>>24428000
            partial'ext'len := DOUBLE(LOGICAL(TOS-I));         <<03509>>24430000
            drcode := partial'ext'len;                         <<03509>>24432000
            TOS := EXTENTRY;  <<SAVE EOF EXTENT DESCRIPTOR>>            24434000
            ASSEMBLE(DDUP,ZERO);                                        24436000
            BS2 := TOS;  <<CLEAR LDEV>>                                 24438000
            partial'ext'addr := TOS+DOUBLE(LOGICAL(i));        <<03509>>24440000
            IF BS1 = 0  THEN GO SKIPIT; << NOT ALLOCATED. >>   <<00117>>24442000
            partial'ext'ldev := bs1;                           <<03509>>24444000
                                                               <<03509>>24446000
SKIPIT:                                                        <<00117>>24452000
            EXTENTRY := TOS;  <<RESTORE EOF EXTENT DESCRIPTOR>>         24454000
            J := J+1;                                                   24456000
            IF SPOOLF THEN                                              24458000
               BEGIN                                                    24460000
               DISABLE;  <<UPD CUR SPFILE SECT CNT>>                    24462000
               TOS := ABS(NUMSSECT);                                    24464000
               TOS := ABS(X := X+1);                                    24466000
            TOS:=DOUBLE(LOGICAL(TOS)) - DRCODE;                <<SZ.00>>24468000
               ABS(X) := TOS;                                           24470000
               ABS(X := X-1) := TOS;                                    24472000
               ENABLE;                                                  24474000
               END;                                                     24476000
            END;                                                        24478000
                                                                        24480000
         <<* * * DEALLOCATE REMAINING EXTENTS * * *>>                   24482000
         << Allocate a buffer for a list of extents    >>      <<03509>>24484000
         << to purge, Releasedisk will then fill it.   >>      <<03509>>24486000
                                                               <<03509>>24488000
         PUSH (S);                                             <<03509>>24490000
         @extent'list := TOS + 1;                              <<03509>>24492000
         TOS := (fcbnumexts*2) + 1;                            <<03509>>24494000
         ASSEMBLE (ADDS 0);   << Allocate the buffer >>        <<03509>>24496000
                                                               <<03509>>24498000
         RELEASEDISK(J,FCBNUMEXTS);  <<RELEASE OTHER EXTENTS>>          24500000
         IF NOT SPOOLF AND DOMAIN = 1 AND (%10 <= DISP <= %11) <<00157>>24502000
            THEN << RE-SAVE OLD PERM FILE >>                   <<00117>>24504000
            DIRECADJUST (-DRCODE,0,FLACCTNAME,                 <<39.PV>>24506000
                         FLGRPNAME,MVTABX);                    <<39.PV>>24508000
                                                                        24510000
         <<*************************************************>> <<04549>>24512000
         << UPDATE FCB AND FILE LABEL - File limit for var- >> <<04549>>24514000
         << iable length is in blocks.                      >> <<04549>>24516000
         <<*************************************************>> <<04549>>24518000
                                                                        24520000
         IF ACBNORMVAR THEN                                    <<04549>>24522000
            BEGIN                                              <<04549>>24524000
            IF FCBEOF = 0D                                     <<04549>>24526000
               THEN FCBFLIM := FLFLIM := 0D                    <<04549>>24528000
               ELSE FCBFLIM := FLFLIM := FCBEND + 1D;          <<04549>>24530000
            END                                                <<04549>>24532000
         ELSE                                                  <<04549>>24534000
             FCBFLIM := FLFLIM := FCBEOF;                      <<04549>>24536000
         FCBNUMEXTS := J-1;  <<UPDATE NR. EXTENTS>>                     24538000
         FLNUMEXTS := J-1;  <<UPDATE NR. EXTENTS>>                      24540000
         TOS := I;  <<EOF SECTOR DISP.>>                                24542000
         IF = THEN TOS := TOS+FCBEXTSIZE;  <<BEGINNING OF EXTENT?>>     24544000
         I := TOS;  <<LAST EXTENT SIZE>>                                24546000
         IF J = 1 THEN  <<SINGLE EXTENT FILE?>>                         24548000
            BEGIN                                                       24550000
            FCBEXTSIZE := I;  <<UPDATE EXTENT SIZE>>                    24552000
            FLEXTSIZE := I  <<UPDATE EXTENT SIZE>>                      24554000
            END;                                                        24556000
         FCBLASTEXTSIZE := I;  <<UPDATE LAST EXTENT SIZE>>              24558000
         FLLASTEXTSIZE := I;  <<UPDATE LAST EXTENT SIZE>>               24560000
         UPDATEFCB;  <<UPDATE FCB>>                                     24562000
         Labelio (1);  << Write file label >>                  <<03509>>24564000
                                                               <<03509>>24566000
         << Now we can safely deallocate the extents >>        <<03509>>24568000
                                                               <<03509>>24570000
         << First release partial extent >>                    <<03509>>24572000
                                                               <<03509>>24574000
         IF partial'ext'len > 0D THEN                          <<03509>>24576000
            Return'Disc'Space (partial'ext'ldev,               <<03509>>24578000
              partial'ext'addr, partial'ext'len);              <<03509>>24580000
                                                               <<03509>>24582000
         IF spoolf THEN                                        <<03509>>24584000
            extent'list'size.(8:1) := 1;                       <<03509>>24586000
         x := Diskdealloc (extsize, extent'list'last'size,     <<04307>>24588000
                           extent'list'size, extent'list);     <<03509>>24590000
                                                               <<03509>>24592000
$IF X1=ON                                                      <<03509>>24594000
         IF <> THEN Ftrouble (471);                            <<03509>>24596000
$IF                                                            <<03509>>24598000
                                                               <<03509>>24600000
                                                               <<03509>>24602000
         END;                                                           24604000
                                                               <<04768>>24606000
NO'CRUNCH:                                                     <<04768>>24608000
                                                               <<04768>>24610000
      DISP := DISP'DOMAIN;      << Remove crunch bit        >> <<04513>>24612000
                                                                        24614000
      <<* * * SAVE $NEWPASS FILE * * *>>                                24616000
                                                                        24618000
      IF FLNEWPASS THEN  <<$NEWPASS FILE?>>                             24620000
         BEGIN                                                          24622000
         TOS := FLLABEL;  <<$NEWPASS VTABX AND SECTOR NR.>>    <<RV.PV>>24624000
         EXCHANGEDB(PXGJITDST);  <<SET DB TO JIT DST>>                  24626000
         FADDR := DADB0(JITPFP);  <<$OLDPASS LDEV AND SECTOR NR.>>      24628000
         DADB0(JITPFP) := TOS;  <<MAKE $NEWPASS $OLDPASS>>              24630000
         EXCHANGEDB(0);  <<RESET DB TO STACK>>                          24632000
         IF FADDR <> 0D THEN  <<DELETE OLD $OLDPASS?>>                  24634000
            BEGIN                                                       24636000
            LABELIO(1);  <<WRITE LABEL>>                                24638000
            ASSEMBLE(SUBS 128);  <<DEALLOCATE FILE LABEL BUFFER>>       24640000
            TOS := 0D;  <<FOR RESULT OF FDELETE>>                       24642000
            TOS := LUN (FADDRW1.(0:8),MVTABX);<<VTABX TO LDEV>><<RV.PV>>24644000
            TOS := FADDRW1.(8:8); <<SECTOR # (HIGH ORDER)>>    <<RV.PV>>24646000
            TOS := FADDRW2;       <<SECTOR # (LOW ORDER)>>     <<RV.PV>>24648000
            IF FRELSPACE(*,*,MVTABX) = 0D THEN FTROUBLE(489);  <<00300>>24650000
            ASSEMBLE(ADDS 128);  <<RE-ALLOCATE FILE LABEL BUFFER>>      24652000
            LABELIO(0)  <<RE-READ LABEL>>                               24654000
            END;                                                        24656000
         FLDESIGNATOR := 3;  <<MAKE $OLDPASS>>                          24658000
         DISP := 0                                                      24660000
         END;                                                           24662000
                                                                        24664000
      <<* * * RECONCILE PENDING DISPOSITION * * *>>                     24666000
                                                                        24668000
FCBACBMGT:                                                              24670000
      PDISP := FCBDISP;                                                 24672000
      IF PDISP = 1 AND DISP = 4 AND DOMAIN = 1 THEN                     24674000
         DISP := PDISP := 0;                                            24676000
      IF DISP <> 0 THEN                                                 24678000
         IF (PDISP = 0) OR (DISP < PDISP) THEN PDISP := DISP;           24680000
      IF INTEGER(SPOOLF) < 0 THEN                              <<+1.01>>24682000
        IF (DISP := PDISP) <> 0 THEN DOMAIN := 0;              <<+1.01>>24684000
                                                                        24686000
      <<* * * UNLOCK FILE RIN * * *>>                                   24688000
                                                                        24690000
      IF FCBRIN <> 0 THEN  <<FILE HAS RIN?>>                            24692000
         BEGIN                                                          24694000
         RUNLOCK(FCBRIN);                                               24696000
         IF = THEN MRCAPOK(FALSE)  << WAS POSSIBLE >>                   24698000
         END;                                                           24700000
                                                                        24702000
      <<* * * CHECK FOR SINGLE/LAST ACCESSOR * * *>>                    24704000
                                                                        24706000
      FCBOCNT := FCBOCNT-1;  <<DECREMENT OPEN COUNT>>                   24708000
      IF FCBOCNT = 0 THEN  <<ZERO OPEN COUNT?>>                         24710000
         BEGIN                                                          24712000
         ASSEMBLE(DZRO,ZERO);                                           24714000
         FCBOCNTIN := TOS;  <<CLEAR INPUT COUNT>>                       24716000
         FCBOCNTOUT := TOS;  <<CLEAR OUTPUT COUNT>>                     24718000
         FCBDISP := TOS;                                                24720000
         RELFCB := TRUE;  <<SET DELETE FCB FLAG>>                       24722000
                                                                        24724000
         <<* * * PROCESS ACCORDING TO DISPOSITION * * *>>               24726000
                                                                        24728000
         TOS := PDISP;                                                  24730000
         X := S0;  <<PLACE COPY IN X>>                                  24732000
         IF TOS > 4 THEN  <<INVLAID?>>                                  24734000
            BEGIN                                                       24736000
            TOS := UNIMPL;                                              24738000
            GO ERR                                                      24740000
            END;                                                        24742000
         CASE * X OF                                                    24744000
            BEGIN                                                       24746000
                                                                        24748000
            <<0: LEAVE DISPOSITION>>                           <<+1.03>>24750000
                                                                        24752000
            IF NOT FLOLDPASS AND DOMAIN = 0 THEN GO REL;                24754000
                                                                        24756000
            <<1: SAVE PERMANENT DISPOSITION>>                  <<+1.03>>24758000
                                                                        24760000
            BEGIN                                                       24762000
            IF ACBDNTYPE = 3 THEN GO E2;  <<NULL NAME?>>                24764000
            IF DOMAIN <> 1 THEN  <<NOT PERMANENT FILE?>>                24766000
               BEGIN                                           <<02349>>24768000
               IF NOT SFCAP THEN  << No save file cap >>       <<02349>>24770000
                  BEGIN                                        <<02349>>24772000
                  TOS:=SFERR;                                  <<02349>>24774000
                  GO ERR;                                      <<02349>>24776000
                  END;                                         <<02349>>24778000
               DRCODE := DIRECINSERTFILE (FSECTORS(FLAB),0,    <<38.PV>>24780000
               FLACCTNAME,FLGRPNAME,FLLOCNAME,FLLABEL,MVTABX); <<43.PV>>24782000
               IF < THEN GO E4;  <<I/O ERROR?>>                         24784000
               IF > THEN  <<OTHER ERROR?>>                              24786000
                  BEGIN                                                 24788000
                  TOS := ERRORMAP(RCA);  <<RAW ERROR NR.>>              24790000
                  IF RCA = 2 THEN TOS := TOS-RCB;                       24792000
                  IF RCA = 8 AND RCB <> 0 THEN                          24794000
                     BEGIN                                              24796000
                     ASSEMBLE(ADDS 5);  <<DIRECFINDFILE WORKSPACE>>     24798000
                     DIRECFINDFILE (0,0D,FLACCTNAME,           <<38.PV>>24800000
                              FLGRPNAME,FLLOCNAME,AS5,MVTABX); <<43.PV>>24802000
                     TOS := IF = THEN DUPNSD ELSE NORIN+RCB             24804000
                     END;                                               24806000
                  GO ERR                                                24808000
                  END;                                                  24810000
               IF SECCODE=1 <<set matrix to R,A,W,L,X:CR and >><<01175>>24812000
               THEN BEGIN    << secure the file. >>            <<01175>>24814000
                   FLSECMX:=[6/1,6/1,6/1,6/1,6/1]D; <<CR ONLY>><<01175>>24816000
                   FLSECURE:=1;                     <<SECURE IT<<01175>>24818000
                   END;                                        <<01175>>24820000
               END;                                                     24822000
            IF DOMAIN = 2 THEN  <<JOB TEMPORARY FILE?>>                 24824000
               BEGIN                                                    24826000
                X:=REMJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME,  <<04574>>24828000
                              2,0).(8:8);                      <<04574>>24830000
<< THE UPPER 8 BITS (0:8) ARE USED FOR THE OLD FILE REFERENCE>><<04574>>24832000
<< COUNT SO IT CAN BE PRESERVED WHEN REPLACING FILE EQU'S    >><<04574>>24834000
               IF <> THEN GO E4  <<ERROR?>>                             24836000
               END;                                                     24838000
            DOMAIN := 1  <<MAKE DOMAIN PERMANENT>>                      24840000
            END;                                                        24842000
                                                                        24844000
            <<2: SAVE TEMPORARY DISPOSITION>>                  <<+1.03>>24846000
                                                                        24848000
            BEGIN                                                       24850000
SAVET:      IF DISP = 0 THEN GO CLEANUP;                                24852000
            IF ACBDNTYPE = 3 THEN GO E2;  <<NULL NAME?>>                24854000
            IF DOMAIN <> 2 THEN  <<NOT JOB TEMPORARY?>>                 24856000
               BEGIN                                                    24858000
               TOS := ADDJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME,2,2,    24860000
                  FLLABEL);  <<ADD TO JOB DIRECTORY>>          <<RV.PV>>24862000
               ASSEMBLE(TEST);                                          24864000
               RCA := TOS;                                              24866000
               IF <> THEN  <<ERROR?>>                                   24868000
                  BEGIN                                                 24870000
                  TOS := IF RCA = 2 THEN DUPNJD ELSE JTFDIROFL;         24872000
                  GO ERR                                                24874000
                  END                                                   24876000
               END;                                                     24878000
            DOMAIN := 2  <<MAKE DOMAIN TEMPORARY>>                      24880000
            END;                                                        24882000
                                                                        24884000
            <<3: SAVE TEMPORARY DISPOSITION>>                  <<+1.03>>24886000
                                                                        24888000
            GO SAVET;                                                   24890000
                                                                        24892000
            <<4: RELEASE DISPOSITION>>                         <<+1.03>>24894000
                                                                        24896000
            BEGIN                                                       24898000
REL:        IF FLLOCK&LSR(13) <> 0 OR FCBLKST <> 0 THEN                 24900000
               BEGIN                                                    24902000
               TOS := MLTIACCERR;                                       24904000
               GO ERR                                                   24906000
               END;                                                     24908000
                                                                        24910000
            <<* * * DELETE DIRECTORY ENTRY * * *>>                      24912000
                                                                        24914000
            IF DOMAIN = 1 THEN  <<PERMANENT FILE?>>                     24916000
               BEGIN                                                    24918000
               IF NOT LOGICAL(ACBACCESS.(12:1)) THEN                    24920000
                  BEGIN                                                 24922000
                  TOS := LOGICAL(ACBACCESS&LSL(8)) LOR SEXVIOL;         24924000
                  GO ERR                                                24926000
                  END;                                                  24928000
               DRCODE := DIRECPURGEFILE (-FSECTORS(FLAB),0,    <<38.PV>>24930000
                  FLACCTNAME,FLGRPNAME,FLLOCNAME,MVTABX);      <<43.PV>>24932000
               IF < THEN GO E4;  <<I/O ERROR?>>                         24934000
              IF > THEN FTROUBLE(490);<< OTHER ERROR?>>        <<KJ.03>>24936000
               END                                                      24938000
            ELSE IF DOMAIN = 2 THEN  <<JOB TEMPORARY FILE?>>            24940000
               BEGIN                                                    24942000
                X:=REMJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME,  <<04574>>24944000
                              2,0).(8:8);                      <<04574>>24946000
<< THE UPPER 8 BITS (0:8) ARE USED FOR THE OLD FILE REFERENCE>><<04574>>24948000
<< COUNT SO IT CAN BE PRESERVED WHEN REPLACING FILE EQU'S    >><<04574>>24950000
               IF <> THEN GO E4  <<ERROR?>>                             24952000
               END;                                                     24954000
            PURGE := TRUE  <<SET DEALLOCATE DISC SPACE FLAG>>           24956000
            END                                                         24958000
                                                                        24960000
            END;                                               <<HM.00>>24962000
         IF MSGFILE THEN FCCLOSE(FILENUM,FCB,FLAB);            <<HM.00>>24964000
         END                                                            24966000
      ELSE  <<NON-ZERO OPEN COUNT>>                                     24968000
         BEGIN                                                          24970000
                                                                        24972000
         <<* * * DE-LINK SHARED FILE ACCESSOR * * *>>                   24974000
                                                                        24976000
         IF ATYPE <> 0 THEN FCBOCNTOUT := FCBOCNTOUT-1;                 24978000
         IF ATYPE = 0 OR ATYPE > 3 THEN FCBOCNTIN := FCBOCNTIN-1;       24980000
         IF ACBSEMI THEN FCBEXCLSTAT := FCBEXCLSTAT-1;  <<SEMI-EXCL?>>  24982000
         FCBDISP := IF LABELERROR THEN HARDFLABERR ELSE PDISP;          24984000
         PDISP := 0;                                                    24986000
         IF MSGFILE THEN FCCLOSE(FILENUM,FCB,FLAB);            <<HM.00>>24988000
         UPDATEFCB  <<UPDATE FCB>>                                      24990000
         END;                                                           24992000
                                                                        24994000
      <<* * * UPDATE PASSED FILE POINTER IN JIT * * *>>                 24996000
                                                                        24998000
CLEANUP:                                                                25000000
      IF FLOLDPASS AND (PDISP <> 0) THEN  <<NEW $OLDPASS?>>             25002000
         BEGIN                                                          25004000
         FADDR := FLLABEL;  <<LDEV AND SECTOR NR.>>            <<RV.PV>>25006000
         EXCHANGEDB(PXGJITDST);  <<SET DB TO JIT DST>>                  25008000
         IF DADB0(JITPFP) = FADDR THEN DADB0(JITPFP) := 0D;             25010000
         EXCHANGEDB(0)  <<RESET DB TO STACK>>                           25012000
         END;                                                           25014000
                                                                        25016000
      <<* * * UPDATE FILE LABEL * * *>>                                 25018000
                                                                        25020000
      IF NOT PURGE THEN  <<WRITE UPDATED FILE LABEL?>>                  25022000
         BEGIN                                                          25024000
         FLDOMAIN := DOMAIN;                                            25026000
         IF DOMAIN <> 0 THEN FLDESIGNATOR := 0;  <<MAKE ACTUAL DESIG.?>>25028000
         IF FCBOCNTIN = 0 THEN FLSTATUS := LOGICAL(FLSTATUS) LAND 2;    25030000
         IF FCBOCNTOUT = 0 THEN FLSTATUS := LOGICAL(FLSTATUS) LAND 1;   25032000
         IF FCBOCNT = 0 THEN  <<LAST ACCESSOR?>>                        25034000
            BEGIN                                                       25036000
            FLFCBVECT := 0;  <<CLEAR FCB VECTOR>>                       25038000
            FLPVINFO := 0;                                     <<00188>>25040000
            FLSTATUS := FCBLKST;                                        25042000
            FLEXCL := 0                                                 25044000
            END;                                                        25046000
         FLUSERLBL := FCBUSERLBL;  <<UPDATE USER LABEL EOF>>            25048000
         FLEOF := FCBEOF;  <<UPDATE FILE EOF>>                          25050000
         FLSTART:=FCBSTART;                                    <<HM.00>>25052000
         FLEND:=FCBEND;                                        <<HM.00>>25054000
         FLDTYPE := FCBDTYPE;                                           25056000
         FLSUBTYPE := FCBSUBTYPE;                                       25058000
         TOS := CALENDAR;  <<DAY AND YEAR>>                             25060000
         FLLASTACC := S0;  <<UPDATE LAST ACCESS DATE>>                  25062000
         IF (1 <= ATYPE <= 6) THEN FLLASTMOD := TOS ELSE DEL;           25064000
         LABELIO(1)  <<WRITE LABEL>>                                    25066000
         END;                                                           25068000
      END                                                               25070000
   ELSE  <<NON-DIRECT ACCESS DEVICE>>                                   25072000
      BEGIN                                                             25074000
                                                               <<02723>>25076000
      PDISP := DISP;                                           <<02723>>25078000
                                                                        25080000
      <<SERIAL INPUT/OUTPUT DEVICE>>                                    25082000
                                                                        25084000
      IF TOS = 3 THEN  <<SERIAL I/O?>>                                  25086000
        IF LABELDEVICE THEN                                    <<03578>>25088000
           BEGIN                                               <<02688>>25090000
           TOS := CHECKUL(FILENUM,4,IF MUSTCLOSE THEN -1       <<02688>>25092000
                                                 ELSE DISP);   <<02688>>25094000
           IF < THEN GO ERR;                                   <<02688>>25096000
                                                               <<02723>>25098000
   << CHECKUL returns NAVAILDEV and CCE when the tape      >>  <<02723>>25100000
   << drive has already been released because of a         >>  <<02723>>25102000
   << =REPLY 0.  DISP is changed to ensure that FREEDEVICE >>  <<02723>>25104000
   << will not DCLOSE the drive since a new tape may have  >>  <<02723>>25106000
   << already been mounted on the drive. >>                    <<02723>>25108000
                                                               <<02723>>25110000
           IF TOS = NAVAILDEV THEN DISP := 2;                  <<02723>>25112000
           END   << of labeled tape >>                         <<02723>>25114000
        ELSE                                                   <<02549>>25116000
         BEGIN                                                          25120000
                                                               <<04814>>25122000
         <<*************************************************>> <<04814>>25124000
         << Back Space Record for each pre-read performed   >> <<04814>>25126000
         << for serial devices to properly position the tape>> <<04814>>25128000
         << mispositioned due to pre-reads.  We do this for >> <<04814>>25130000
         << buffered files with no-rewind disposition.      >> <<04814>>25132000
         <<*************************************************>> <<04814>>25134000
                                                               <<04814>>25136000
         IF DISP = 3 AND NOT ACBINHIBITBUF                     <<04814>>25138000
            THEN BACK'SPACE'RECORDS;                           <<04814>>25140000
                                                               <<04589>>25142000
         <<*************************************************>> <<04589>>25144000
         << For all other dispositions excepy No Rewind, we >> <<04589>>25146000
         << do the following.  Write EOF if a new EOF has   >> <<04589>>25148000
         << been established.  Then, depending of the disp- >> <<04589>>25150000
         << osition, rewind and maybe unload the device.    >> <<04589>>25152000
         <<*************************************************>> <<04589>>25154000
                                                               <<04589>>25156000
         IF ACBACTUAL AND DISP <> 3 THEN                                25158000
            BEGIN                                                       25160000
            IF LOGICAL(ACBNEWEOF) THEN                         <<01086>>25162000
               BEGIN          << Write End-of-File >>          <<01086>>25164000
               TOS := ATTACHIO(DADDR,0,0,0,6,0,0,4,BFLAGS);    <<02688>>25166000
               IF S1.(13:3) <> 1 AND NOT MUSTCLOSE THEN GO E0;          25168000
               DDEL;                                           <<04589>>25170000
               ACBNEWEOF := 0; << Turn off new EOF bit.     >> <<04589>>25172000
               END;                                                     25174000
            << REWIND & MAYBE UNLOAD >>                                 25176000
            ATTACHIO(DADDR,0,0,0,IF DISP = 1 THEN 9 ELSE 5,0,  <<+0.04>>25178000
               0,0,UBPFLAGS);  <<REWIND NO PCB>>               <<+0.05>>25180000
            IF ACBDTYPE = MTAPE THEN                           <<02568>>25182000
               SET'LPDT'BOT(DADDR,1);  << Tape at load pt >>   <<02568>>25184000
            IF ACBDTYPE = MTAPE OR ACBDTYPE = SDISC THEN       <<03671>>25186000
              CLEANLDEV (DADDR);                               <<02577>>25188000
            END                                                         25190000
         END;                                                           25192000
      END;                                                              25196000
                                                                        25198000
   <<* * * UPDATE EOF BIT IN JIT * * *>>                                25200000
                                                                        25202000
   IF ACBREADTYPE <> 0 THEN  <<$STDIN(X)?>>                             25204000
      BEGIN                                                             25206000
      TOS := ACBEOF = 0;                                                25208000
      TOS := ACBREADMODE;                                               25210000
      ASSEMBLE(TBC 14);                                                 25212000
      IF = THEN    << Not Command Interpreter. >>                       25214000
         IF NOT (CI LOR (1 <= FILENUM <= 2)) THEN  <<NOT CI?>>          25216000
           BEGIN                                                        25218000
           ASSEMBLE(DDUP);                                              25220000
           EXCHANGEDB(PXGJITDST);  <<SET DB TO JIT DST>>                25222000
           IF TOS                                                       25224000
              THEN ADB0(JITEOF).(1:1) := TOS                            25226000
              ELSE ADB0(JITEOF).(0:1) := TOS;                           25228000
           EXCHANGEDB(0)  <<RESET DB TO STACK>>                         25230000
           END;                                                         25232000
      DDEL                                                              25234000
      END;                                                              25236000
                                                                        25238000
   <<* * * DEALLOCATE DEVICE * * *>>                                    25240000
                                                                        25242000
   IF ACBACCCL=DIRACC AND ACBDTYPE<>FDISC THEN  <<DISC FILE?>> <<01115>>25244000
      BEGIN                                                             25246000
      IF RESOURCES.SIRLOCK THEN RELSIR (FISIR,A);              <<RV.PV>>25248000
      ATTACHIO(DADDR,0,0,0,3,0,0,0,USFLAGS+%13);  <<C.F.>>     <<+0.05>>25250000
      IF RELFCB THEN  <<LAST ACCESSOR?>>                                25252000
         BEGIN                                                          25254000
         IF FCBRIN <> 0 THEN DEALLORIN (FCBRIN.(1:15));        <<RV.PV>>25256000
         FDELETECB (FCBV); <<DELETE FCB>>                      <<RV.PV>>25258000
         IF INTEGER(SPOOLF) > 0 AND PURGE THEN DEALLOCATE(SPVDEV);      25260000
         IF INTEGER(SPOOLF) < 0 AND PURGE THEN SREMOVEXDD(XDDEP);       25262000
         TOS := 0;  <<FOR RESULT OF DISKDEALLOC>>                       25264000
         TOS := FCBEXTSIZE;  <<EXTENT SIZE>>                            25266000
         TOS := FCBLASTEXTSIZE;  <<LAST EXTENT SIZE>>                   25268000
         TOS := FCBNUMEXTS+1;  <<NR. EXTENTS>>                          25270000
         IF SPOOLF AND PURGE THEN TOS.(8:1) := 1;                       25272000
         IF NOT PURGE THEN TOS := -TOS;  <<DECREMENT USE COUNTS ONLY?>> 25274000
         X := DISKDEALLOC(*,*,*,FCBEXTMAP);  <<DEALLOCATE EXTENTS>>     25276000
$        IF X1 = ON                                                     25278000
         IF <> THEN FTROUBLE(471); <<ERROR?>>                  <<KJ.03>>25280000
$        IF                                                             25282000
         IF SPOOLF AND NOT PURGE THEN                                   25284000
            BEGIN                                                       25286000
            TOS := 0D;                                                  25288000
            TOS := FCBNUMEXTS+1;                                        25290000
            IF INTEGER(SPOOLF)<0 AND ACBSPSQZ=1 THEN           <<00.06>>25292000
               BEGIN                                           <<00.06>>25294000
               Z := 0;                                         <<00.06>>25296000
               @XMAP := @FCBEXTMAP;                            <<00.06>>25298000
               WHILE (Z:=Z+1) <= FCBNUMEXTS DO                 <<00.06>>25300000
                  IF XMAP(Z)=0D THEN TOS := TOS-1;             <<00.06>>25302000
               END;                                            <<00.06>>25304000
            TOS := FCBLASTEXTSIZE;                                      25306000
            XDDSPOOLINFO(*,%41,XDDEP);   <<POST FILE SIZE>>    <<+1.03>>25308000
            XDDSPOOLINFO(FCBEOF,%21,XDDEP)   <<POST NR. RECORDS  +1.03>>25310000
            END                                                         25312000
         END ELSE                                              <<RV.PV>>25314000
         BEGIN  <<UNLOCK FCB>>                                 <<RV.PV>>25316000
                                                               <<04624>>25318000
          UNLOCK'CB(0,FCBV.DSTN,FCBV VTA);                     <<04624>>25320000
                                                               <<04624>>25322000
         END;                                                  <<RV.PV>>25324000
      IF INTEGER(SPOOLF) > 0 AND NOT PURGE THEN DEALLOCATE(SPVDEV)      25326000
      END                                                               25328000
   ELSE  <<NON-DISC FILE>>                                              25330000
      BEGIN                                                             25332000
      TOS := DADDR;                                                     25334000
      TOS.(4:1) := 1;  <<LAST ACCESSOR ABORT>>                          25336000
      IF NOT PRIMED THEN TOS.(7:1) := 1;                                25338000
      IF ACBLABELLED=1 AND DISP > 1 THEN                       <<02549>>25340000
         TOS.(3:1) := 1;  <<DON'T REWIND>>                     <<TL.02>>25342000
      DEALLOCATE(*)  <<DE-ALLOCATE DEVICE>>                             25344000
                                                               <<TL.02>>25346000
      END;                                                              25348000
                                                                        25350000
   <<* * * LOG FILE CLOSE * * *>>                                       25352000
                                                                        25354000
   IF LABELERROR THEN PDISP := -1;  <<SPECIAL DISPOSITION>>             25356000
   I := PDISP&LSL(8)+ACBDOMAIN;  << DISP/DOMAIN >>                      25358000
   J := IF INTEGER(SPOOLF) > 0                                          25360000
           THEN ACBSPTYPE&LSL(8)                                        25362000
           ELSE ACBDTYPE&LSL(8)+INTEGER(DADDR);                         25364000
   MOVE LOG'BUF := ACBNAME,(4);  << FILE NAME >>               <<04713>>25368000
   IF ACBACCCL = 0 AND ACBDTYPE<>FDISC THEN  <<DISC FILE?>>    <<01115>>25370000
      BEGIN                                                             25372000
      TOS := @LOG'BUF(4)&LSL(1)+1;                             <<04713>>25374000
      TOS := @FCBGN&LSL(1);                                             25376000
      MOVE * := *,(8);  <<GROUP NAME>>                                  25378000
      MOVE LOG'BUF(9) := FCBAN,(4);  <<ACCOUNT NAME>>          <<04713>>25380000
      TOS := FSECTORS(FLAB)                                             25382000
      END                                                               25384000
   ELSE  <<NON-DISC FILE>>                                              25386000
      BEGIN                                                             25388000
      TOS := @LOG'BUF(4); PS0 := "  ";  <<CLEAR REMAINDER>>    <<04713>>25390000
      ASSEMBLE(DUP,INCB); TOS := 8; ASSEMBLE(MOVE 3);                   25392000
      TOS := 0D                                                         25394000
      END;                                                              25396000
   FADDR := TOS;                                                        25398000
   LOG'BUF(4).(0:8) := ".";                                    <<04713>>25400000
   LOG'BUF(8).(8:8) := ".";                                    <<04713>>25402000
                                                               <<+0.04>>25404000
   <<* * * MEASUREMENT DATA ON FCLOSE * * *>>                  <<+0.04>>25406000
                                                               <<+0.04>>25408000
$  IF X3 = ON                                                  <<+0.04>>25410000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>25412000
   IF ACBACCCL = DIRACC THEN  <<MEASURE?>>                     <<+0.04>>25414000
      MMSTAT(EFCLOSE,FILENUM,DISP,SECCODE);  <<MEASURE EVENT>> <<+0.05>>25416000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>25418000
$  IF                                                          <<+0.04>>25420000
                                                                        25422000
   <<*******************************************************>> <<04589>>25424000
   << If we are not the last accessors to the ACB, then     >> <<04589>>25426000
   << copy the possible changed ACB back to the control blk.>> <<04589>>25428000
   << via UNLOC'ACB.  Next, delete the LACB for the file    >> <<04589>>25430000
   << and, only if this is the last accessor, the PACB via  >> <<04589>>25432000
   << DELACB.                                               >> <<04589>>25434000
   <<*******************************************************>> <<04589>>25436000
                                                               <<04589>>25438000
   IF ACBSHCNT > 1                                             <<04589>>25440000
      THEN UNLOC'ACB(ACBMQ,0);                                 <<04589>>25442000
                                                                        25444000
   DELACB(PACBV,LACBV,ACBACTYPE);  <<DELETE LOG/PHYS ACB>>     <<04796>>25446000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);                         <<00218>>25448000
   LOG5(LOG'BUF,I,FADDR,J,ACBRTFRCT,ACBBTFRCT,5);              <<04713>>25450000
                                                                        25452000
   <<* * * FREE AFT ENTRY * * *>>                                       25454000
                                                                        25456000
RELAFTENT:                                                              25458000
   SETAFT;  <<INIT. AFT ENTRY POINTER>>                                 25460000
   ASSEMBLE(DZRO,DZRO);                                                 25462000
   AFTDBL := TOS; AFTDBL(1) := TOS;  <<ZERO ENTRY>>                     25464000
   TOS := 0;  <<NO ERROR NR.>>                                          25466000
   TOS := CCE;  <<OK CONDITION CODE>>                                   25468000
   IF INTEGER(SPOOLF) < 0 AND RELFCB THEN                               25470000
      IF DISP = 0 THEN                                                  25472000
         BEGIN                                                          25474000
         XDDSPOOLINFO(0D,%10,XDDEP);  <<READY BIT SET>>        <<+1.03>>25476000
         END                                                            25478000
      ELSE                                                              25480000
         BEGIN                                                          25482000
         DEL;                                                           25484000
         TOS := CCG;                                                    25486000
         END;                                                           25488000
   GO EXIT;                                                             25490000
                                                                        25492000
   <<* * * ERROR RECOVERY - RELEASE RESOURCES * * *>>                   25494000
                                                                        25496000
E0:                                                                     25498000
   ASSEMBLE(XCH,ZROB);                                                  25500000
   TOS := IOSTAT(*);  <<CONVERT ERROR NR.>>                             25502000
   GO ERR;                                                              25504000
                                                                        25506000
E1:  << INVALID FILE NUMBER >>                                          25508000
   TOS := INVFN;                                                        25510000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                25512000
   GO EXIT;                                                             25514000
                                                                        25516000
E2:  << INVALID FILE REFERENCE >>                                       25518000
   TOS := INVFREF;                                                      25520000
   GO ERR;                                                              25522000
                                                                        25524000
E3:  << TRYING TO SAVE A SYSTEM FILE IN JTFD >>                         25526000
   TOS := INVSAVE;                                                      25528000
   GO ERR;                                                              25530000
                                                                        25532000
E4:  << DIRECTORY I/O ERROR >>                                          25534000
   TOS := DIRIOERR;                                                     25536000
                                                                        25538000
ERR:                                                                    25540000
   TOS := RESOURCES;                                                    25542000
   IF LS0.FCBLOCK THEN  <<RELEASE FCB?>>                                25544000
      BEGIN                                                             25546000
                                                               <<04624>>25548000
      UNLOCK'CB(0,FCBV.DSTN,FCBV VTA);                         <<04624>>25550000
                                                               <<04624>>25552000
      END;                                                              25554000
   IF TOS.SIRLOCK THEN RELSIR(FISIR,A);  <<RELEASE SIR?>>               25556000
    IF NOT MUSTCLOSE THEN RESOURCES.DMOUNT := FALSE;           <<00208>>25560000
   ACBERROR := S0;  <<INSERT ERROR CODE IN ACB>>                        25562000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                25564000
                                                                        25566000
XIT:                                                                    25568000
                                                               <<04517>>25570000
   UNLOC'ACB(ACBMQ,0);          <<  Release that ACB!!!!!   >> <<04517>>25572000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);                         <<00201>>25574000
   END; << CONVENTIONAL FILE >>                                <<DS.00>>25576000
                                                               <<DS.00>>25578000
   BEGIN << REMOTE FILE >>                                     <<DS.00>>25580000
      PDISP := LACBV; << PENDING DISPOSITION >>                <<DS.03>>25582000
      IF <> AND (DISP.(13:3) = 0 OR DISP.(13:3) > PDISP)       <<DS.03>>25584000
      THEN DISP := PDISP; << USE PENDING DISP >>               <<DS.03>>25586000
      ALLOCRFABUF;                                             <<04517>>25588000
      RFALEN := 6;                                             <<DS.00>>25590000
      TOS := "RFA ";                                           <<DS.00>>25592000
      TOS := 2;                                                <<DS.00>>25594000
      TOS := RFAFILE;                                          <<DS.00>>25596000
      LS0.(0:1) := KSC.(15:1); << KSAM KFCLOSE >>              <<DS.06>>25598000
      TOS := DISP;                                             <<DS.00>>25600000
      TOS := SECCODE;                                          <<DS.00>>25602000
      MWCNOBUF;                                                <<DS.00>>25604000
      CHECKXFER;                                               <<DS.00>>25606000
      DELAPPENDAGE;                                            <<DS.00>>25608000
      TOS := TOS.CC;                                           <<DS.00>>25610000
      IF S0 = CCE THEN                                         <<DS.00>>25612000
      BEGIN << FILE CLOSED, CLOSE LINE >>                      <<DS.00>>25614000
         TOS := RFALINE;                                       <<DS.00>>25616000
         TOS := DSCLOSEPLABEL;                                 <<DS.00>>25618000
         ASMB(PCAL 0);                                         <<DS.00>>25620000
         SETAFT;                                               <<DS.00>>25622000
         ASSEMBLE(DZRO,DZRO);                                  <<DS.00>>25624000
         AFTDBL := TOS; AFTDBL(1) := TOS;                      <<DS.00>>25626000
          ASSEMBLE(ZERO,XCH); << SEND GOOD CLOSE >>            <<DS.04>>25628000
       END                                                     <<DS.04>>25630000
       ELSE                                                    <<DS.04>>25632000
          BEGIN     << FCLOSE FAILURE >>                       <<DS.04>>25634000
          FCHECK(RFAFILE,I);                                   <<DS.04>>25636000
          IF < THEN                                            <<DS.04>>25638000
             TOS:=NAVAILDEV                                    <<DS.04>>25640000
          ELSE                                                 <<DS.04>>25642000
             TOS:=I;                                           <<DS.04>>25644000
          ASSEMBLE(XCH);                                       <<DS.04>>25646000
          END;                                                 <<DS.04>>25648000
   END; << REMOTE FILE >>                                      <<DS.00>>25650000
         <<DUMMY FOR 2>>;                                      <<KS.00>>25652000
         <<DUMMY FOR 3>>;                                      <<KS.00>>25654000
         <<DUMMY FOR 4>>;                                      <<KS.00>>25656000
         <<DUMMY FOR 5>>;                                      <<KS.00>>25658000
         BEGIN <<KSAM FILE>>                                   <<KS.00>>25660000
            IF KSC THEN                                        <<KS.00>>25662000
            GO CONV <<SECONDARY ENTRY USED>>                   <<KS.00>>25664000
         ELSE                                                  <<KS.00>>25666000
            BEGIN <<FILE PAIR TO BE CLOSED>>                   <<KS.00>>25668000
               KCLOSE(FILENUM,DISP,SECCODE);                   <<KS.00>>25670000
               PUSH(STATUS);                                   <<KS.00>>25672000
               TOS:=TOS.CC;                                    <<KS.00>>25674000
               ASSEMBLE(ZERO,XCH);                             <<KS.00>>25676000
            END; <<FILE PAIR TO BE CLOSED>>                    <<KS.00>>25678000
         END; <<KSAM FILE>>                                    <<KS.00>>25680000
   <<DUMMY 7>>;                                                <<HM.00>>25682000
   BEGIN     << Message file >>                                <<01882>>25684000
   FTYPE := 0;                                                 <<01882>>25686000
   GO CONV;                                                    <<01882>>25688000
   END;                                                        <<01882>>25690000
                                                               <<DS.00>>25692000
   END; << FTYPE CASE >>                                       <<DS.00>>25694000
                                                                        25696000
EXIT:                                                                   25698000
       IF B <> -1 THEN RELSIR(FMAVTSIR,B);                     <<00157>>25700000
   IF RESOURCES.DMOUNT THEN                                    <<00208>>25702000
   BEGIN                                                       <<00208>>25704000
       IF (X := DISMOUNT') <> 0 THEN                           <<00208>>25706000
       BEGIN <<OVERRIDE ORIGINAL ERROR. LESS CRITICAL>>        <<00208>>25708000
           S0 := CCL; <<ERROR CONDITION CODE>>                 <<00208>>25710000
       END;                                                    <<00208>>25712000
   END;                                                        <<00208>>25714000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           25716000
   EXCHANGEDB(ORIG'DST);  <<RESET DB TO ORIG.>>                <<04517>>25718000
   RESETCRITICAL(CRIT);                                                 25720000
   ERROREXIT(3,S0,0)                                                    25722000
   END;                                                                 25724000
$ PAGE "SPECIAL'SPOOL'CLOSE"                                            25728000
PROCEDURE SPECIAL'SPOOL'CLOSE(FILENUM,DISP,SECCODE);                    25730000
VALUE FILENUM,DISP,SECCODE;                                             25732000
INTEGER FILENUM,DISP,SECCODE;                                           25734000
OPTION PRIVILEGED,UNCALLABLE;                                           25736000
COMMENT                                                                 25738000
                                                                        25740000
   This is a procedure that will cause the deletion of                  25742000
a output spool file on FCLOSE of that file.  This is a                  25744000
KLUDGE for the CI until we figure out what we really                    25746000
want to do.                                                             25748000
                                                                        25750000
Alorithm                                                                25752000
                                                                        25754000
  Find offset in ODD                                                    25756000
  Set OUTPRI to 0                                                       25758000
  FJCLOSE file                                                          25760000
  FSOPEN file                                                           25762000
  FSCLOSE file                                                          25764000
                                                                        25766000
;                                                                       25768000
BEGIN                                                                   25770000
INTEGER ARRAY BASE(*)=DB+0;                                             25772000
LOGICAL STATUS=Q-1;                                                     25774000
INTEGER DEV'FILE'ID;                                                    25776000
INTEGER ODD'OFFSET;                                                     25778000
DEFINE ODD'OUT'PRI = BASE(ODD'OFFSET).(3:4)#,                           25780000
       ODD'LDEV    = BASE(ODD'OFFSET + 20)#,                            25782000
       ODD'SIZE    = BASE(1).(8:8)#,                                    25784000
       ODD'START   = BASE(2)#,                                          25786000
       ODD'FLAGS   = BASE(ODD'OFFSET)#,                                 25788000
       ODD'FILE'ID = BASE(ODD'OFFSET + 18)#;                            25790000
                                                                        25792000
LOGICAL FOUND := FALSE;                                                 25794000
                                                                        25796000
  << get the device file id using ffileinfo #38 >>                      25798000
STATUS.CC := CCE;                                                       25800000
FFILEINFO (FILENUM,38,DEV'FILE'ID);                                     25802000
IF < THEN                                                               25804000
  STATUS.CC := CCL                                                      25806000
ELSE BEGIN  <<Got the dev file id ok >>                                 25808000
  EXCHANGEDB(ODDDST);                                                   25810000
  ODD'OFFSET := ODD'START;                                              25812000
  WHILE NOT FOUND DO                                                    25814000
    BEGIN                                                               25816000
    IF ODD'LDEV <> 0 LAND ODD'FLAGS <> 0                                25818000
      LAND ODD'FILE'ID = DEV'FILE'ID THEN                               25820000
      FOUND := TRUE                                                     25822000
    ELSE ODD'OFFSET := ODD'OFFSET + ODD'SIZE;                           25824000
    END;                                                                25826000
  IF NOT FOUND THEN                                                     25828000
    BEGIN                                                               25830000
    EXCHANGEDB (0);                                                     25832000
    STATUS.CC := CCL;                                                   25834000
    END;                                                                25836000
  ELSE BEGIN                                                            25838000
    ODD'OUT'PRI := 0;                                                   25840000
    EXCHANGEDB (0);                                                     25842000
    FJCLOSE(FILENUM,0,0);                                               25844000
    IF < THEN                                                           25846000
      STATUS.CC := CCL                                                  25848000
    ELSE BEGIN                                                          25850000
      ODD'OFFSET.(0:1) := 1;  << Let it be the ODD >>                   25852000
      FILENUM := FSOPEN(,%305,%400,ODD'OFFSET);                         25854000
      IF <> THEN                                                        25856000
        STATUS.CC := CCG                                                25858000
      ELSE BEGIN                                                        25860000
        FSCLOSE (FILENUM,DISP,SECCODE);                                 25862000
        IF < THEN                                                       25864000
          STATUS.CC := CCL;                                             25866000
        END                                                             25868000
      END                                                               25870000
    END                                                                 25872000
  END;                                                                  25874000
END;                                                                    25876000
$TITLE "FERRMSG"                                               <<09.EB>>25878000
$CONTROL SEGMENT = FILESYS7    << FERRMSG >>                            25880000
PROCEDURE FERRMSG(ERRORCODE,MSGBUFF',MSGLENGTH);               <<09.EB>>25882000
   INTEGER ERRORCODE,MSGLENGTH;                                <<09.EB>>25884000
   ARRAY MSGBUFF';                                             <<09.EB>>25886000
COMMENT                                                        <<09.EB>>25888000
                                                               <<09.EB>>25890000
RETURNS STRING FOR FILE SYSTEM MESSAGE NUMBER. PARAMETERS:     <<09.EB>>25892000
                                                               <<09.EB>>25894000
ERRORCODE - FILE SYSTEM ERROR NUMBER (GOTTEN FROM FCHECK).     <<09.EB>>25896000
MSGBUFF   - BUFFER IN WHICH THE ERROR MESSAGE WILL BE PLACED.  <<09.EB>>25898000
            MUST BE AT LEAST 72 BYTES LONG.                    <<09.EB>>25900000
MSGLENGTH - THE LENGTH OF THE STRING PLACED IN MSGBUFF.        <<09.EB>>25902000
                                                               <<09.EB>>25904000
CONDITION CODES:                                               <<09.EB>>25906000
                                                               <<09.EB>>25908000
CCE - EVERYTHING OK.                                           <<09.EB>>25910000
CCL - NO ERROR MESSAGE EXISTS FOR THIS ERRORCODE.              <<09.EB>>25912000
      (OR MAY BE MESSAGE SYSTEM ERROR.  SEE GENMESSAGE         <<09.EB>>25914000
       INTRINSIC)                                              <<09.EB>>25916000
CCG - SOMETHING WRONG WITH CALL:                               <<09.EB>>25918000
         - MSGBUFF ADDRESS MAY BE OUT OF BOUNDS.               <<09.EB>>25920000
         - MSGBUFF MAY NOT BE LARGE ENOUGH.                    <<09.EB>>25922000
         - MSGLENGTH ADDRESS IS OUT OF BOUNDS.                 <<09.EB>>25924000
;                                                              <<09.EB>>25926000
BEGIN                                                          <<09.EB>>25928000
                                                               <<09.EB>>25930000
                                                               <<09.EB>>25932000
EQUATE                                                         <<09.EB>>25934000
   FILESYSSET      = 8,                                        <<09.EB>>25936000
   MSGBUFFSIZE     = 72,                                       <<09.EB>>25938000
   MSGBUFFSIZEWM1  = 35,                                       <<03060>>25940000
   UBND            = -7;                                       <<03060>>25942000
                                                               <<09.EB>>25944000
LOGICAL                                                        <<09.EB>>25946000
   INTRINDESCRIP := [10/307, 6/3],                             <<09.EB>>25950000
   P1 = INTRINDESCRIP,                                         <<09.EB>>25952000
   P2 = P1,                                                    <<09.EB>>25954000
   P3 = P1,                                                    <<09.EB>>25956000
   P4 = P1,                                                    <<09.EB>>25958000
   P5 = P1;                                                    <<09.EB>>25960000
                                                               <<09.EB>>25962000
BYTE ARRAY MSGBUFF(*) = MSGBUFF';                              <<09.EB>>25964000
BYTE ARRAY INBUFF(0:MSGBUFFSIZE);                              <<09.EB>>25966000
                                                               <<09.EB>>25968000
                                                               <<09.EB>>25970000
ERRORON;                                                       <<09.EB>>25972000
IF FBNDCHK(@MSGLENGTH,1,UBND) AND FBNDCHK(@MSGBUFF',           <<03060>>25974000
   MSGBUFFSIZE/2,UBND) AND FBNDCHK(@ERRORCODE,                 <<03060>>25976000
   1,UBND) THEN                                                <<03060>>25978000
BEGIN                                                          <<09.EB>>25980000
   MSGLENGTH := 0;                                             <<09.EB>>25982000
   FORMSG(INBUFF,FILESYSSET,ERRORCODE,%100000,P1,P2,P3,P4,P5,  <<09.EB>>25984000
      MSGBUFF,MSGBUFFSIZE,MSGLENGTH,-1,0);                     <<09.EB>>25986000
   IF = THEN CONDCODE := CCE                                   <<13.EB>>25988000
   ELSE                                                        <<13.EB>>25990000
   BEGIN                                                       <<13.EB>>25992000
      MOVE MSGBUFF' := "UNDEFINED FILE SYSTEM ERROR ";         <<13.EB>>25994000
      MSGLENGTH := 27;                                         <<13.EB>>25996000
      CONDCODE := CCL;                                         <<13.EB>>25998000
   END;                                                        <<13.EB>>26000000
END                                                            <<13.EB>>26002000
ELSE CONDCODE := CCG;                                          <<13.EB>>26004000
                                                               <<13.EB>>26006000
ERROREXIT(INTRINDESCRIP,0,0);                                  <<13.EB>>26008000
                                                               <<13.EB>>26010000
END; << PROCEDURE FERRMSG >>                                   <<13.EB>>26012000
$PAGE "MPE-IV FILE SYSTEM - OUTER BLOCK "                      <<KS.00>>26014000
$CONTROL SEGMENT=FILEACCESS, MAP                                        26016000
END. <<END OF FILE SYSTEM>>                                    <<KS.00>>26018000
