$CONTROL USLINIT,CODE,MAP,DEFINE,LINES=120                     <<07273>>00005000
<< FILEACC - File System Access Control - Module 50 >>                  00010000
<< HP32002C source C.00.00 >>                                           00015000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00020000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00025000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00030000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00035000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00040000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00045000
$SET X9=ON  << Signifies Module 50 in INCLACB.              >> <<06514>>00050000
$SET X0=OFF,X1=ON, X2=ON, X3=OFF, X8=ON                        <<06514>>00055000
$ TITLE " MPE-IV FILE SYSTEM - BASELINE OPEN-CLOSE "                    00060000
$ THIRTY                                                                00065000
$ CONTROL MAIN = FILEACCESS                                             00070000
BEGIN                                                                   00075000
                                                                        00080000
<<----------------------------------------------------------------------00085000
*                                                                      *00090000
*              MPE-IV Baseline File System                            * 00095000
*                                                                      *00100000
*  TOGGLES:                                                            *00105000
*     X0   ENABLES CODE THAT PRINTS THE PROCEDURE NAME AND CALLS       *00110000
*          DEBUG UPON ENTRY TO MOST FILE SYSTEM INTRINSICS.            *00115000
*                                                                      *00120000
*     X1   ENABLES CODE THAT CALLS SUDDENDEATH(50) WHEN IRRECOVERABLE  *00125000
*          ERRORS ARE DETECTED.  THESE ERRORS SHOULD NEVER OCCUR AND   *00130000
*          WOULD OTHERWISE GO UNDETECTED.                              *00135000
*                                                                      *00140000
*     X2   ENABLES CODE THAT CALLS SUDDENDEATH(50) WHEN DATA FAILS     *00145000
*          CREDIBLITY CHECKS.                                          *00150000
*                                                             *  +0.04  00155000
*     X3   ENABLES CODE THAT CALLS THE MMSTAT MEASUREMENT     *  +0.04  00160000
*          FACILITY FOR EACH INTRINSIC CALLED WHEN ACCESSING  *  +0.04  00165000
*          A DISC FILE.                                       *  +0.04  00170000
*                                                             *((00630))00175000
*     X8   Enables listing of long descriptions and pictures  *((FMAVT))00180000
*          of the various tables to be listed                 *((FMAVT))00185000
*                                                             *((FMAVT))00190000
*     X9   Signifies Module 50 in INCLACB.                    *((*MPEV))00195000
*                                                                      *00200000
---------------------------------------------------------------------->>00205000
                                                                        00210000
$PAGE                                                          <<04516>>00215000
<< Correct problem in attempted write beyond FLIM >>           <<00532>>00220000
<< Add Relative I/O features >>                                <<00630>>00225000
<< Allow tape FOPEN without write ring. >>                     <<00685>>00230000
<< Fix EOT on unbuffered labeled tapes. >>                     <<00722>>00235000
<< Partially remove System Buffer code >>                      <<00822>>00240000
<< Add Tape Label info to FFILEINFO, etc. >>                   <<00828>>00245000
<< Change for 3270. >>                                         <<00838>>00250000
<< Labeled tape record and block size override FOPEN, FEQ. >>  <<00841>>00255000
<< FGETINFO can return "$NULL". >>                             <<00899>>00260000
<< FCONTROL write EOF to read-only tape rejected. >>           <<00900>>00265000
<< Correct FSPACE to labeled tape. >>                          <<00901>>00270000
<< Put all FCB's in system shared DST's. Fix SIR bug >>        <<01084>>00275000
<< Change test on initial extent alloc to <=0 >>               <<01084>>00280000
<< Initialize DX in FCONVBLK in case of error in LABELIOSQ. >> <<01085>>00285000
<< TEMPORARY fix for FCONTROL (2) and (6).                  >> <<01083>>00290000
<< Fix FGETINFO; chg FCLOSE to write EOF on mult.vol unlbl tp>><<01086>>00295000
<< NOSYSBUF, initial PXFILE, and FLOCK fixes  >>               <<*****>>00300000
<< Fix FMAVT SIR/LOCK PACB deadlock                          >><<HM.00>>00305000
<< Changes for Process Level Redirection of $STDIN/$STDLIST >> <<01425>>00310000
<< Reverse order of sirs passed to FOPEN (re:1393)           >><<01480>>00315000
<< Correct call to FGETCB in FOPENDA                         >><<01480>>00320000
<< Change to FFILEINFO for $NULL                             >><<01480>>00325000
<< FCB strategy to use stack FCB's >>                          <<01863>>00330000
<< Fix open of bad environment file >>                         <<01863>>00335000
<< Add global multiaccess for message files >>                 <<01863>>00340000
<< change FINDAFTENT for redirection of $STDIN >>              <<01863>>00345000
<< message file fix >>                                         <<01863>>00350000
<< Add FGETLOCKWORD for CI   >>                                <<04867>>00355000
<< change FCLOSE for SPOOK >>                                  <<01863>>00360000
<< Change FCLOSE for spooling >>                               <<01863>>00365000
<< FRENAME: Allow FRENAME A,A,TEMP, SF check for perm files >> <<01863>>00370000
<< Fix excess page ejects; spoofle u-labels >>                 <<01863>>00375000
<< fix remote Environment file Open >>                         <<01882>>00380000
<<>>                                                           <<01901>>00385000
<< FLABIO: checks that 1st extent addr of FLAB equals SECTOR >><<01901>>00390000
<< FOPEN: remove direct call to FLABIO; go thru LABELIO      >><<01901>>00395000
<< Turn X2 on to restore error checking for CBT, VT addresses>><<01901>>00400000
<< FCLOSE logging fix >>                                       <<01937>>00405000
<< Add 1 to INITALLOC in JDT (:FILE) in FILECOMVALS (SR14822)>><<01968>>00410000
<< FCLEAR: allow initialization > 33023 sectors     (SR15613)>><<01968>>00415000
<< Correct bf calc for 1B/rec case (RBSIZE in FOPEN)(SR11529)>><<01968>>00420000
<< Correct file size calculations in FCREATE                 >><<01968>>00425000
<< Fix FCREATECB SIR problem >>                                <<01992>>00430000
<< Fix spoolfile overflow >>                                   <<02055>>00435000
<< Changes for new disc free space management, also fix >>     <<03509>>00440000
<< Eliminate redirect of $STDIN to $STDINX and vice versa.  >> <<02309>>00445000
<< returned before updating the file label.             >>     <<03509>>00450000
<< New Tape Labels code >>                                     <<02549>>00455000
<< If ACC=OUT, write EOF to tape even if no FWRITE (SR15066) >><<02356>>00460000
<< Define NOTLOCKED for consistency with module 97 (FUNLOCK) >><<02355>>00465000
<< FCLOSE: Preserve release space bits in DISP parm          >><<02351>>00470000
<< FCLOSE: check for SF cap in JIT ucap; return 111 if no SF >><<02349>>00475000
<< New error number 12: record out of range                  >><<02307>>00480000
<< New error no.: 74: no room left in stk seg for another file <<02357>>00485000
<< Enhancement to suppress prompt of lockword                >><<02350>>00490000
<< a problem in fclose - crunch where the space was     >>     <<03509>>00495000
<< Add FSERR 6 and 7 for LINUS, chng NAVLSTAT for reel swt  >> <<03561>>00500000
<< Add SF 404 and recomment a SF 0 that is commented out    >> <<04138>>00505000
<< SR24941:  forms msg now allowed on spooled card punch.   >> <<04189>>00510000
<< Allow ENV files for 2608A/2608S unspooled printers.      >> <<04383>>00515000
<< Don't post ENV info to non-existing UL's on hot printers.>> <<04481>>00520000
<< FCLOSE now properly handles crunch w/mulit-acc.>>           <<04513>>00525000
<< FCLOSE now crunches variable length files.               >> <<04549>>00530000
                                                               <<01084>>00535000
<< FOPEN no longer fail if open remote KSAM file.            >><<04311>>00540000
<< Fix ptrs in FALTPXFILE - QMIT pre-release fix.            >><<04958>>00545000
<< LYNX2 kludge - another entry point into FCLOSE (FTCLOSE).>> <<6029>> 00550000
<< Changed IOSTAT to add general status 5 for error returns >> <<6029>> 00555000
<< from ATTACHIO related to FDEVICECONTROL code 192 (LYNXII)>> <<6029>> 00560000
DEFINE INT = INTEGER#,                                                  00565000
       DBL = DOUBLE#,                                          <<HM.00>>00570000
       LOG = LOGICAL#,                                                  00575000
       ABS = ABSOLUTE#,                                                 00580000
       ASMB = ASSEMBLE#;                                                00585000
INTEGER DB0 = DB+0;                                                     00590000
INTEGER DB1 = DB+1;                                                     00595000
INTEGER POINTER PDB0 = DB+0;                                            00600000
INTEGER ARRAY ADB0 (*) = DB+0;                                          00605000
INTEGER ARRAY DUM (*) = DB+0;  <<DUMMY REFERENCE PARAM>>       <<01.02>>00610000
DOUBLE ARRAY DADB0 (*) = DB+0;                                          00615000
INTEGER ARRAY AQM2 (*) = Q-2;                                  <<06514>>00620000
INTEGER ARRAY AQM3 (*) = Q-3;                                  <<06514>>00625000
INTEGER ARRAY AQM4 (*) = Q-4;                                  <<06514>>00630000
INTEGER ARRAY AQM1 (*) = Q-1;                                           00635000
INTEGER ARRAY AQ0 (*) = Q-0;                                            00640000
INTEGER ARRAY QARRAY(*) = AQ0;                                 <<06272>>00645000
BYTE BS0 = S-0;                                                         00650000
BYTE BS1 = S-1;                                                         00655000
BYTE BS2 = S-2;                                                         00660000
BYTE BS3 = S-3;                                                         00665000
INTEGER Q0 = Q-0;                                              <<00630>>00670000
INTEGER S0 = S-0;                                                       00675000
INTEGER S1 = S-1;                                                       00680000
INTEGER S2 = S-2;                                                       00685000
INTEGER S3 = S-3;                                                       00690000
INTEGER S4 = S-4;                                                       00695000
INTEGER S5 = S-5;                                                       00700000
INTEGER S6 = S-6;                                                       00705000
INTEGER S7 = S-7;                                                       00710000
LOGICAL LS0 = S-0;                                                      00715000
LOGICAL LS1 = S-1;                                                      00720000
LOGICAL LS2 = S-2;                                                      00725000
DOUBLE DS1 = S-1;                                                       00730000
DOUBLE DS2 = S-2;                                                       00735000
DOUBLE DS3 = S-3;                                                       00740000
DOUBLE DS4 = S-4;                                                       00745000
DOUBLE DS5 = S-5;                                                       00750000
DOUBLE DS6 = S-6;                                                       00755000
BYTE POINTER BPS0 = S-0;                                                00760000
BYTE POINTER BPS1 = S-1;                                                00765000
BYTE POINTER BPS2 = S-2;                                                00770000
BYTE POINTER BPS3 = S-3;                                       <<RV.PV>>00775000
INTEGER POINTER PS0 = S-0;                                              00780000
INTEGER POINTER PS1 = S-1;                                              00785000
INTEGER POINTER PS2 = S-2;                                              00790000
LOGICAL POINTER LPS0 = S-0;                                             00795000
LOGICAL POINTER LPS1 = S-1;                                             00800000
DOUBLE POINTER DPS0 = S-0;                                              00805000
DOUBLE POINTER DPS1 = S-1;                                              00810000
DOUBLE POINTER DPS2 = S-2;                                              00815000
DOUBLE POINTER DPS3 = S-3;                                              00820000
DOUBLE POINTER DPS4 = S-4;                                              00825000
<<  On FCLOSE of a unlabeled serial disc the TLT is cleaned >> <<03671>>00830000
DOUBLE POINTER DPS5 = S-5;                                              00835000
DOUBLE POINTER DPS6 = S-6;                                              00840000
DOUBLE POINTER DPS7 = S-7;                                              00845000
INTEGER ARRAY AS0 (*) = S-0;                                            00850000
INTEGER ARRAY AS1 (*) = S-1;                                            00855000
INTEGER ARRAY AS2 (*) = S-2;                                            00860000
INTEGER ARRAY AS3 (*) = S-3;                                            00865000
INTEGER ARRAY AS4 (*) = S-4;                                            00870000
                                                               <<04624>>00875000
DEFINE                                                         <<04624>>00880000
   MOVE'DS'1  =  ASSEMBLE(MDS 1)#,                             <<04624>>00885000
   MOVE'DS'2  =  ASSEMBLE(MDS 2)#,                             <<04624>>00890000
   MOVE'DS'3  =  ASSEMBLE(MDS 3)#,                             <<04624>>00895000
   MOVE'DS'4  =  ASSEMBLE(MDS 4)#,                             <<04624>>00900000
   MOVE'DS'5  =  ASSEMBLE(MDS 5)#;                             <<04624>>00905000
                                                               <<04624>>00910000
INTEGER ARRAY AS5 (*) = S-5;                                   <<43.PV>>00915000
INTEGER DELTAQ =Q-0;                                                    00920000
LOGICAL STATUS =Q-1;                                                    00925000
INTEGER X = X;                                                          00930000
EQUATE CCE=2,CCG=0,CCL=1;                                               00935000
                                                                        00940000
DEFINE PRIVMODE = STATUS.(0:1)#,                                        00945000
       CARRYCODE = STATUS.(5:1)#,                                       00950000
       CONDCODE = STATUS.(6:2)#;                                        00955000
DEFINE SETCARRY=CARRYCODE:=1#,                                 <<01393>>00960000
       SETNOCARRY=CARRYCODE:=0#;                               <<01393>>00965000
                                                               <<01393>>00970000
DEFINE MIN2 = ASSEMBLE(DDUP,CMP); IF > THEN ASSEMBLE(XCH); DEL#;        00975000
DEFINE MIN3 = MIN2; MIN2#;                                              00980000
DEFINE MAX2 = ASSEMBLE(DDUP,CMP); IF < THEN ASSEMBLE(XCH); DEL#;        00985000
DEFINE ENABLE = ASSEMBLE(SED 1)#;                                       00990000
DEFINE DISABLE = ASSEMBLE(SED 0)#;                                      00995000
DEFINE PSEUDODISABLE = ASSEMBLE(PSDB)#;                                 01000000
DEFINE PSEUDOENABLE = ASSEMBLE(PSEB)#;                                  01005000
                                                               <<00822>>01010000
comment CHECKDB: If DB is at the stack, then DBBANK=SBANK.       00822  01015000
STACKDB and SBANK for the current process are obtained           00822  01020000
from the two words preceding the dispatcher marker on            00822  01025000
the interrupt control stack.  ;                                <<00822>>01030000
DEFINE CHECKDB =                                                        01035000
   DISABLE;                                                             01040000
   PUSH(DB);                                                            01045000
   X := ABSOLUTE(QI)-5;                                                 01050000
   TOS := ABSOLUTE(X);                                                  01055000
   X := X+1;                                                            01060000
   TOS := ABSOLUTE(X);                                                  01065000
   ENABLE;                                                              01070000
   ASSEMBLE(DCMP)#;                                                     01075000
DEFINE CURRENTDB = CHECKDB; TOS := IF = THEN 0 ELSE FSDSTX#;            01080000
DEFINE MPYD = ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD)#,              01085000
       DIVD = ASSEMBLE(ZERO,CAB;LDXA,LDIV;CAB,LDXA;LDIV)#,              01090000
       DIVD'DEL = ASSEMBLE(ZERO,CAB;LDXA,LDIV;CAB,LDXA;LDIV,DEL)#;      01095000
                                                                        01100000
<<----------------------------------------------------------------------01105000
*                                                                      *01110000
*  FILE SYSTEM PARAMETERS                                              *01115000
*                                                                      *01120000
---------------------------------------------------------------------->>01125000
                                                                        01130000
EQUATE                                                                  01135000
                                                               <<06514>>01140000
DEFEXTSIZE  =  256,   << DEFAULT EXTENT SIZE >>                         01145000
DEFFSIZE    = 1024,   << DEFAULT FILE SIZE - IN RECORDS >>              01150000
DEFNUMEXTS  =    8,   << DEFAULT NUMBER OF EXTENTS >>                   01155000
DEFBUFFERS  =    2,   << DEFAULT NUMBER OF BUFFERS >>          <<00.05>>01160000
MAXBUFFERS  =14000,   << Max. words of buffer data >>          <<02549>>01165000
SPOOLRSIZE  =  506,   << DEFAULT SPOOLFILE REC SIZE >>                  01170000
SPOOLRSECT  =    4,   << #SECTORS/SPOOLFILE REC >>                      01175000
FISIR       =   37,   << FILE INTEGRITY SIR NUMBER >>                   01180000
DSSIR       =    8;   << DIRECTORY SIR >>                               01185000
                                                                        01190000
$INCLUDE INCLFERR                                              <<06514>>01195000
                                                                        01200000
<<----------------------------------------------------------------------01205000
*                                                                      *01210000
*  FILE SYSTEM MONITORING DEFINITIONS                                  *01215000
*                                                                      *01220000
---------------------------------------------------------------------->>01225000
                                                                        01230000
DEFINE                                                                  01235000
CURPRC'NUM    = (CURPRC/PCBSIZE)#,                             <<06863>>01240000
MYPIN'MON     = (ABS(MONITOR).(0:12) = 0 OR                    <<06863>>01245000
                 ABS(MONITOR).(0:12) = CURPRC'MON)#,           <<06863>>01250000
                                                                        01255000
MONOTHER      = INTEGER(ABSOLUTE(MONITOR)) <> 0 AND            <<+1.C3>>01260000
                ABS(MONITOR).(13:1) AND MYPIN'MON#,            <<06863>>01265000
MONUNCALLABLE = INTEGER(ABSOLUTE(MONITOR)) <> 0 AND            <<+1.C3>>01270000
                ABS(MONITOR).(14:1) AND MYPIN'MON#,            <<06863>>01275000
MONCALLABLE   = INTEGER(ABSOLUTE(MONITOR)) <>0 AND             <<+1.C3>>01280000
                ABS(MONITOR).(15:1) AND MYPIN'MON#;            <<06863>>01285000
                                                               <<+0.04>>01290000
<<-------------------------------------------------------------  +0.04  01295000
*                                                             *  +0.04  01300000
*  MMSTAT MEASUREMENT DEFINITIONS                             *  +0.04  01305000
*                                                             *  +0.04  01310000
---------------------------------------------------------------  +0.04>>01315000
                                                               <<+0.04>>01320000
DEFINE MEAS'TAPE'ON =LOGICAL(ABSOLUTE(MEASMSK1))#;             <<+1.C3>>01325000
EQUATE                                                         <<+0.04>>01330000
EFOPEN          = -60,  << FOPEN/FOPENDA INITIAL >>            <<+0.04>>01335000
EFOPEN'         = -61,  << FOPEN/FOPENDA CONTINUATION >>       <<+0.04>>01340000
EFREAD          = -62,  << FREAD >>                            <<+0.04>>01345000
EFWRITE         = -63,  << FWRITE >>                           <<+0.04>>01350000
EFREADDIR       = -64,  << FREADDIR INITIAL >>                 <<+0.04>>01355000
EFREADDIR'      = -64,  << FREADDIR CONTINUATION >>            <<+0.04>>01360000
EFWRITEDIR      = -65,  << FWRITEDIR INITIAL >>                <<+0.04>>01365000
EFWRITEDIR'     = -65,  << FWRITEDIR CONTINUATION >>           <<+0.04>>01370000
EFUPDATE        = -66,  << FUPDATE >>                          <<+0.04>>01375000
EIOWAIT         = -67,  << IOWAIT >>                           <<+0.04>>01380000
EFREADSEEK      = -68,  << FREADSEEK >>                        <<+0.04>>01385000
EFSPACE         = -69,  << FSPACE >>                           <<+0.04>>01390000
EFPOINT         = -70,  << FPOINT >>                           <<+0.04>>01395000
EFCONTROL       = -71,  << FCONTROL >>                         <<+0.04>>01400000
EFSETMODE       = -72,  << FSETMODE >>                         <<+0.04>>01405000
EFRELATE        = -73,  << FRELATE >>                          <<+0.04>>01410000
EFCHECK         = -74,  << FCHECK >>                           <<+0.04>>01415000
EFGETINFO       = -75,  << FGETINFO >>                         <<+0.04>>01420000
EFREADLABEL     = -76,  << FREADLABEL >>                       <<+0.04>>01425000
EFWRITELABEL    = -77,  << FWRITELABEL >>                      <<+0.04>>01430000
EFLOCK          = -78,  << FLOCK >>                            <<+0.04>>01435000
EFUNLOCK        = -79,  << FUNLOCK >>                          <<+0.04>>01440000
EFRENAME        = -80,  << FRENAME >>                          <<+0.04>>01445000
EFCLOSE         = -81,  << FCLOSE >>                           <<+0.04>>01450000
EFALTSEC        = -82;  << FALTSEC >>                          <<01175>>01455000
                                                                        01460000
<<----------------------------------------------------------------------01465000
*                                                                      *01470000
*  SYSGLOB DEFINITIONS                                                 *01475000
*                                                                      *01480000
---------------------------------------------------------------------->>01485000
                                                                        01490000
EQUATE                                                                  01495000
DSTP         =   2,         << DST base >>                              01500000
QI           =   5,                                                     01505000
SYSDB        = 512,         << System DB base >>                        01510000
CLOADID      = SYSDB+%75,   << Cold Load count >>                       01515000
SHFCBDST     = SYSDB+%76,   << Shared FCB DST nr. >>                    01520000
MONITOR      = SYSDB+%77,   << monitoring flag word >>                  01525000
MAXSSECT     = SYSDB+%100,  << max # spoolfile sectors >>               01530000
NUMSSECT     = SYSDB+%102,  << current # ...........   >>               01535000
EXTSSECT     = SYSDB+%104,  << # sectors/spoolfile extent >>            01540000
SPOOLINDEX   = SYSDB+%132,  << class spool index >>                     01545000
CSIOWAIT     = SYSDB+%135,  << CSIOWAIT P-label >>                      01550000
CCLOSEPLABL  = SYSDB+%140,  << CS CCLOSE Plabel - FPROCTERM >>          01555000
MEASMSK1     = SYSDB+%267,                                     <<+1.C3>>01560000
DSCHKPLABL   = SYSDB+%335,  << DSCHECK Plabel >>               <<DS.00>>01565000
DSOPENPLABL  = SYSDB+%336,  << DSOPEN Plabel >>                <<DS.00>>01570000
DSCLOSEPLABL = SYSDB+%337,  << DSCLOSE Plabel >>               <<DS.00>>01575000
SDSLDEVLABEL = SYSDB+%323,  << Plabel for SDSLDEV >>           <<DS.04>>01580000
EXTLAB3270   = %73,         << SYSGLOBEXT index >>             <<01165>>01585000
SYSEXTPTR    = %377,  << PTR TO SYSEXT OF SYSGLOB >>           <<01165>>01590000
MANWCPLABL   = SYSDB+%340,  << MANAGEWRITECONV PLABEL >>       <<DS.00>>01595000
AVR          = SYSDB+%346;  << auto volume recognition, labeled tape >> 01600000
POINTER SYSGLOBEXT = SYSEXTPTR;                                <<01165>>01605000
DEFINE                                                         <<01165>>01610000
  PLABEL3270 = SYSGLOBEXT(EXTLAB3270)#;                        <<01165>>01615000
                                                                        01620000
<<----------------------------------------------------------------------01625000
*                                                                      *01630000
*  JOB INFO TABLE (JIT) DEFINITIONS                                    *01635000
*                                                                      *01640000
---------------------------------------------------------------------->>01645000
                                                                        01650000
EQUATE                                                         <<06868>>01655000
   JITJNUM   = 7,  ! Job number, single word at present.       <<06868>>01660000
   JITEOF    = 10, ! Contains EOF flush flags in (8:2).        <<06868>>01665000
   JITASEC   = 13, ! Account security, single word.            <<06868>>01670000
   JITPFP    = 18, ! Dbl word offset to passed file address.   <<06868>>01675000
   JITUCAP   = 38, ! User capabilities, double word.           <<06868>>01680000
   JITJN     = 44; ! Job name, 8 bytes.                        <<06868>>01685000
                                                                        01690000
<<----------------------------------------------------------------------01695000
*                                                                      *01700000
*  I/O SYSTEM DEFINITIONS                                              *01705000
*                                                                      *01710000
---------------------------------------------------------------------->>01715000
                                                                        01720000
EQUATE   << Device type (subtype) & subclass >>                <<02568>>01725000
MHDISK       =  0,    DIRACC     =  0,                                  01730000
FHDISK       =  1,                                                      01735000
FDISC        =  7,                                             <<01115>>01740000
CARDR        =  8,    SERIALIN   =  1,                                  01745000
PTREAD       =  9,                                                      01750000
TERMINAL     = 16,    PARALELL   =  2,                                  01755000
READERPUNCH  = 20,                                                      01760000
NRJETYPE     = 22,                                             <<06866>>01765000
PROGCONT     = 23,                                                      01770000
MTAPE        = 24,    SERIALIO   =  3,                                  01775000
HPODIE       = 42,    << ODIE device >>                        <<*8877>>01780000
   HP7970    =  0,    << subtype.(13:3) = 0 >>                 <<02568>>01785000
   HP7976    =  1,    << subtype.(13:3) = 1 >>                 <<02568>>01790000
   HP7978    =  2,    << Subtype of Buckhorn>>                 <<07271>>01795000
   HP7974    =  3,    <<   "     "  Antelope>>                 <<07271>>01800000
SDISC        = 31,                                             <<00.SD>>01805000
LPTR         = 32,    SERIALOUT  =  4,                                  01810000
CPNCH        = 33,                                                      01815000
PTPNCH       = 34,                                                      01820000
CALCOMP500   = 35,                                                      01825000
CALCOMP600   = 36,                                                      01830000
CALCOMP700   = 37,                                                      01835000
CALCOMP836   = 38,                                                      01840000
NULL         = 63;                                                      01845000
                                                                        01850000
DEFINE S1STAT =S1.(8:8)#;                                      <<*****>>01855000
EQUATE   << IOCODE VALUES >>                                            01860000
EOFSTAT     = %12,                                             <<*****>>01865000
EOTSTAT     = %31,                                             <<*****>>01870000
BREAKSTAT   =%173,   << BREAK hit on terminal >>               <<*****>>01875000
NAVLSTAT    =%204,   << Labeled dev unavail after reelswtch >> <<03561>>01880000
EOFCODE     =  2;                                                       01885000
                                                               <<*7839>>01890000
DEFINE                                                         <<*7839>>01895000
  STREAMING'DEVICE = ((ACBDTYPE = MTAPE) LAND                  <<*7839>>01900000
                ((SUBTYPE = HP7974) LOR (SUBTYPE = HP7978)))#; <<*7839>>01905000
                                                               <<*7839>>01910000
                                                               <<+0.05>>01915000
DEFINE  << ATTACHIO FLAGS >>                                   <<+0.05>>01920000
UFLAGS    = %010000#,  << UNBLOCKED >>                         <<+0.05>>01925000
BFLAGS    = %010001#,  << BLOCKED >>                           <<+0.05>>01930000
BBFLAGS   = %010011#,  << BLOCKED W/SBUF'S >>                  <<+0.05>>01935000
UBPFLAGS  = %010013#,  << UNBLOCKED W/SBUF'S NO PCB >>         <<+0.05>>01940000
USFLAGS   = ((SPOOLF.(14:2)+1)&LSL(12))#,                      <<+0.05>>01945000
BSFLAGS   = ((SPOOLF.(14:2)+1)&LSL(12)+1)#;                    <<00822>>01950000
                                                                        01955000
<<*--------------------------------------------------------*>> <<06040>>01960000
<<*                                                        *>> <<06040>>01965000
<<*            ATTACHIO FUNCTIONS                          *>> <<06040>>01970000
<<*                                                        *>> <<06040>>01975000
<<*--------------------------------------------------------*>> <<06040>>01980000
                                                               <<06040>>01985000
EQUATE                                                         <<06040>>01990000
                                                               <<06040>>01995000
READ         =  0,                                             <<06040>>02000000
WRITE        =  1,                                             <<06040>>02005000
OPEN'FILE    =  2,                                             <<06040>>02010000
CLOSE'FILE   =  3,                                             <<06040>>02015000
CHECK'STATUS =  30,                                            <<*7839>>02020000
CLOSE'DEV    =  4,                                             <<06040>>02025000
REWIND       =  5,                                             <<06040>>02030000
WRITE'EOF    =  6,                                             <<06040>>02035000
FSF          =  7,                                             <<06040>>02040000
BSF          =  8,                                             <<06040>>02045000
REW'UNLOAD   =  9,                                             <<06040>>02050000
GAP          = 10,                                             <<06040>>02055000
FSR          = 11,                                             <<06040>>02060000
BSR          = 12;                                             <<06040>>02065000
                                                               <<06040>>02070000
<<----------------------------------------------------------------------02075000
*                                                                      *02080000
*  IOQ TABLE DEFINITIONS                                               *02085000
*                                                                      *02090000
---------------------------------------------------------------------->>02095000
                                                                        02100000
INTEGER POINTER IOQ = 5;  <<IOQ SYSTEM TABLE NR.>>                      02105000
                                                                        02110000
<<----------------------------------------------------------------------02115000
*                                                                      *02120000
*  LOGICAL PHYSICAL DEVICE TABLE (LPDT) DEFINITIONS                    *02125000
*                                                                      *02130000
---------------------------------------------------------------------->>02135000
                                                                        02140000
EQUATE                                                                  02145000
LPDTDST     = %15,  << LOG PHYS DEV TABLE DST >>                        02150000
LPDTENTRY   =   4;  ! LPDT entry size.                         <<06515>>02155000
                                                                        02160000
DEFINE                                                         <<02568>>02165000
   T'SUBTYPE        = (13:3)#,  << Subtype for mag tapes >>    <<02568>>02170000
   LPDT'SUBTYPE     = LPDT(DADDR*LPDTENTRY+1).T'SUBTYPE#,      <<07271>>02175000
   VARIABLE'DENSITY =                                          <<02568>>02180000
      LPDT'SUBTYPE = HP7974 OR LPDT'SUBTYPE = HP7976 OR        <<07271>>02185000
      LPDT'SUBTYPE = HP7978#;                                  <<07271>>02190000
                                                               <<02568>>02195000
INTEGER POINTER LPDT = 8;  <<LPDT SYSTEM TABLE>>                        02200000
                                                                        02205000
<<----------------------------------------------------------------------02210000
*                                                                      *02215000
*  VOLUME TABLE DEFINITIONS                                            *02220000
*                                                                      *02225000
---------------------------------------------------------------------->>02230000
                                                                        02235000
EQUATE                                                                  02240000
VTAB        = %35,  << VOLUME TABLE DST >>                              02245000
VTABSIR     =  22,  << VOLUME TABLE SIR >>                              02250000
VTABENTRY   =  14;  << ENTRY SIZE >>                                    02255000
                                                                        02260000
<<----------------------------------------------------------------------02265000
*                                                                      *02270000
*  LOGICAL DEVICE TABLE (LDT) DEFINITIONS                              *02275000
*                                                                      *02280000
---------------------------------------------------------------------->>02285000
                                                                        02290000
EQUATE                                                                  02295000
LDTDST      = %16,  ! LDT data segment number.                 <<06515>>02300000
LDTENTRY    =   7;  ! LDT entry size.                          <<06515>>02305000
                                                               <<06515>>02310000
DEFINE                                                         <<06515>>02315000
   LDT'FILE'USE'CNT      = LDT(0)#,                            <<06515>>02320000
   LDT'VOLUME'TBL'INDEX  = LDT(1)#,                            <<06515>>02325000
   LDT'RECORD'WIDTH      = LDT(2).(0:8)#,                      <<06515>>02330000
   LDT'DEVICE'TYPE       = LDT(2).(10:6)#,                     <<06515>>02335000
   LDT'CS'DEVICE         = LDT(2).(8:1)#;                      <<06515>>02340000
                                                               <<06515>>02345000
DEFINE ! Defines for DEVINFO coming from GETDEVINFO.           <<06515>>02350000
   DEVINFO'LDEV          = DEVINFO#,                           <<06515>>02355000
   DEVINFO'DEVTYPE       = DEVINFO(1)#,                        <<06515>>02360000
       ! Defines for DEVINFO coming from ALLOCATE.             <<06515>>02365000
   DEVINFO'VIRTUAL'DEVICE= DEVINFO(1).(0:1)#;                  <<06515>>02370000
                                                                        02375000
<<----------------------------------------------------------------------02380000
*                                                                      *02385000
*  INPUT/OUTPUT DEVICE DIRECTORY (XDD) DEFINITIONS                     *02390000
*                                                                      *02395000
---------------------------------------------------------------------->>02400000
                                                                        02405000
EQUATE                                                                  02410000
ODDSIR      =  4,    << ODD SIR >>                             <<04679>>02415000
SIZE'OF'XDD'SUBENTRY = 32,                                     <<06862>>02420000
IDDDST      = 45,   << INPUT XDD >>                                     02425000
ODDDST      = 46;   << OUTPUT XDD >>                                    02430000
                                                                        02435000
DEFINE                                                         <<06862>>02440000
   XDDS'DEVICE           = XDD'SUBENTRY(20)       #,           <<06862>>02445000
   XDDS'OUTPUT'PRIORITY  = XDD'SUBENTRY(0).(3:4)  #,           <<06862>>02450000
   XDDS'SPOOFLE'VT'INDEX = XDD'SUBENTRY(22).(0:8) #,           <<06862>>02455000
   XDDS'SPOOL'STATE      = XDD'SUBENTRY(0).(1:2)  #,           <<S8492>>02460000
        XDDS'ACTIVE      = 0                      #,           <<S8492>>02465000
        XDDS'READY       = 1                      #,           <<S8492>>02470000
        XDDS'OPEN        = 2                      #,           <<S8492>>02475000
        XDDS'LOCKED      = 3                      #,           <<S8492>>02480000
   XDDS'UNUSED'SUBENTRY  = 0                      #,           <<S8492>>02485000
   XDDS'VIRTUAL'LDEV     = XDD'SUBENTRY(21)       #,           <<06862>>02490000
   XDDSD'DISC'LABEL      = XDD'DSUBENTRY(11)      #;           <<06862>>02495000
                                                                        02500000
                                                                        02505000
$INCLUDE INCLPCB5                                              <<06514>>02510000
                                                               <<06514>>02515000
!------------------------------------------------------------- <<06514>>02520000
! Misc PCB definitions                                         <<06514>>02525000
!------------------------------------------------------------- <<06514>>02530000
                                                               <<06514>>02535000
LOGICAL POINTER PCB = SYSPCBINDEX;                             <<06514>>02540000
                                                               <<06514>>02545000
EQUATE                                                         <<06514>>02550000
   USER'MAIN = 1;         ! PCB type of CI process.            <<06514>>02555000
                                                                        02560000
<<-------------------------------------------------------------  RV.PV  02565000
*                                                             *  RV.PV  02570000
*  MOUNTED VOLUME TABLE DEFINITIONS                           *  RV.PV  02575000
*                                                             *  RV.PV  02580000
---------------------------------------------------------------  RV.PV  02585000
                                                                 RV.PV>>02590000
EQUATE                                                         <<RV.PV>>02595000
MVTABDST    = 53,   << MOUNTED VOLUME TABLE DST NR. >>         <<RV.PV>>02600000
MVTABENTRY  = 21;   << MVTAB ENTRY SIZE >>                     <<RV.PV>>02605000
INTEGER ARRAY MVTAB (*) = ADB0;                                <<RV.PV>>02610000
DEFINE                                                         <<RV.PV>>02615000
MVTABSZ     = MVTAB.(0:8) #;  << ENTRY SIZE >>                 <<RV.PV>>02620000
                                                               <<RV.PV>>02625000
<<----------------------------------------------------------------------02630000
*                                                                      *02635000
*  AOPTIONS DEFINITIONS                                                *02640000
*                                                                      *02645000
---------------------------------------------------------------------->>02650000
                                                               <<04189>>02655000
<< Access mode equates.                                     >> <<06056>>02660000
EQUATE                                                         <<06056>>02665000
   DEFAULT'ACCESS   =  0,                                      <<06056>>02670000
   EXCL'ACCESS      =  1,                                      <<06056>>02675000
   EAR'ACCESS       =  2,                                      <<06056>>02680000
   SHARED'ACCESS    =  3;                                      <<06056>>02685000
EQUATE                                                         <<04189>>02690000
   WRITE'NEW    = 1,                                           <<04189>>02695000
   WRITE'SAVE   = 2,                                           <<04189>>02700000
   WRITE'APPEND = 3;                                           <<04189>>02705000
                                                                        02710000
DEFINE  <<AOPTION FIELDS>>                                              02715000
AOPGLOBALAFTF   = (2:1)#,                << Global AFT.     >> <<06514>>02720000
AOPCOPYF        = (3:1)#,                << COPY MODE >>       <<HM.00>>02725000
AOPNOWAITF      = (4:1)#,                << NO-WAIT I/O MODE >>         02730000
AOPMULTACF      = (5:2)#,                << MULTI ACCESS MODE >>        02735000
AOPINHIBITBUFF  = (7:1)#,                << INHIBIT BUFFERING >>        02740000
AOPACMODEF      = (8:2)#,                << ACCESS MODE >>              02745000
AOPLOCKINGF     = (10:1)#,               << DYNAMIC LOCKING >>          02750000
AOPMULTIRECF    = (11:1)#,               << MULTI-RECORD >>             02755000
AOPACTYPEF      = (12:4)#;               << ACCESS TYPE >>              02760000
                                                                        02765000
DEFINE                                                                  02770000
AOPGLOBALAFT    = AOPTIONS.(2:1)#,       << Global AFT.     >> <<06514>>02775000
AOPCOPY         = AOPTIONS.(3:1)#,       << FILE TO BE COPIED>><<HM.00>>02780000
AOPNOWAIT       = AOPTIONS.(4:1)#,       << NO-WAIT I/O MODE >>         02785000
AOPMULTAC       = AOPTIONS.(5:2)#,       << MULTI ACCESS MODE >>        02790000
AOPGLOBALMULTAC = AOPTIONS.(5:1)#,       << INTER JOB MULTI>>  <<HM.00>>02795000
AOPINHIBITBUF   = AOPTIONS.(7:1)#,       << INHIBIT BUFFERING >>        02800000
AOPACMODE       = AOPTIONS.(8:2)#,       << ACCESS MODE >>              02805000
AOPDEFAULT      = (INT(AOPACMODE) = 0)#, << DEFAULT >>                  02810000
AOPEXCLUSIVE    = (INT(AOPACMODE) = 1)#, << EXCLUSIVE >>                02815000
AOPSEMI         = (INT(AOPACMODE) = 2)#, << SEMI-EXCLUSIVE >>           02820000
AOPSHARE        = (INT(AOPACMODE) = 3)#, << SHARE >>                    02825000
AOPLOCKING      = AOPTIONS.(10:1)#,      << DYNAMIC LOCKING >>          02830000
AOPMULTIREC     = AOPTIONS.(11:1)#,      << MULTI-RECORD >>             02835000
AOPACTYPE       = AOPTIONS.(12:4)#,      << ACCESS TYPE >>              02840000
AOPREAD         = (INT(AOPACTYPE) = 0)#, << READ ONLY >>                02845000
AOPWRITE        = (INT(AOPACTYPE) = 1)#, << WRITE ONLY - DELETE >>      02850000
AOPWRITESAVE    = (INT(AOPACTYPE) = 2)#, << WRITE ONLY - SAVE >>        02855000
AOPAPPEND       = (INT(AOPACTYPE) = 3)#, << APPEND ONLY >>              02860000
AOPREADWRITE    = (INT(AOPACTYPE) = 4)#, << READ OR WRITE >>            02865000
AOPUPDATE       = (INT(AOPACTYPE) = 5)#, << UPDATE ONLY >>              02870000
AOPEXECUTE      = (INT(AOPACTYPE) = 6)#, << EXECUTE ONLY >>             02875000
AOPWRITEONLY    = (1 <= INT(AOPACTYPE) <= 3)#;  << FORM OF WRITE >>     02880000
                                                                        02885000
<<----------------------------------------------------------------------02890000
*                                                                      *02895000
*  FOPTIONS DEFINITIONS                                                *02900000
*                                                                      *02905000
---------------------------------------------------------------------->>02910000
                                                               <<04189>>02915000
EQUATE                                                         <<04189>>02920000
   NEW'FILE      = 0,                                          <<04189>>02925000
   OLD'PERM'FILE = 1,                                          <<04189>>02930000
   OLD'TEMP'FILE = 2,                                          <<04189>>02935000
   OLD'FILE      = 3;                    << Perm or temp.   >> <<04189>>02940000
                                                                        02945000
DEFINE  <<FOPTIONS FIELDS>>                                             02950000
FILETYPE        = (2:3)#,                << TYPE OF FILE >>    <<HM.00>>02955000
FOPNOEQUATEF    = (5:1)#,                << NO FILE EQUATION >>         02960000
FOPLABELLEDF    = (6:1)#,                << LABELLED TAPE >>  <<TL.02>> 02965000
FOPCONTROLF     = (7:1)#,                << CARRIAGE CONTROL >>         02970000
FOPFORMATF      = (8:2)#,                << RECORD FORMAT >>            02975000
FOPDESIGNATORF  = (10:3)#,               << DESIGNATOR TYPE >>          02980000
FOPASCIIF       = (13:1)#,               << ASCII/BINARY FORMAT >>      02985000
FOPDOMAINF      = (14:2)#;               << FILE DOMAIN >>              02990000
                                                                        02995000
DEFINE                                                                  03000000
FOPFILETYPE     = FOPTIONS.(2:3)#,       << TYPE OF FILE >>    <<HM.00>>03005000
FOPKSAM         = (FOPFILETYPE=1)#,      << RESERVED FOR KSAM    HM.00>>03010000
FOPRIO          = (FOPFILETYPE=2)#,      << RIO FILE >>        <<HM.00>>03015000
FOPCIRFILE      = (FOPFILETYPE=4)#,      << CIRCULAR FILE >>   <<HM.00>>03020000
FOPMSGFILE      = (FOPFILETYPE=6)#,      << IPC FILE >>        <<HM.00>>03025000
FOPNOEQUATE     = FOPTIONS.(5:1)#,       << NO FILE EQUATION >>         03030000
FOPLABELLED     = LOG(FOPTIONS.(6:1))#,                        <<TL.02>>03035000
FOPCONTROL      = FOPTIONS.(7:1)#,       << CARRIAGE CONTROL >>         03040000
FOPFORMAT       = FOPTIONS.(8:2)#,       << RECORD FORMAT >>            03045000
FOPVARFLD       = FOPTIONS.(9:1)#,       << VARIABLE BIT >>             03050000
FOPFIXED        = (INT(FOPFORMAT) = 0)#, << FIXED >>                    03055000
FOPVARIABLE     = (INT(FOPVARFLD) = 1)#, << VARIABLE >>                 03060000
FOPNORMVAR      = (INT(FOPFORMAT) = 1)#, << NORMAL VARIABLE >>          03065000
FOPSPECVAR      = (INT(FOPFORMAT) = 3)#, << SPECIAL VARIABLE >>         03070000
FOPUNDEFINED    = (INT(FOPFORMAT) = 2)#, << UNDEFINED >>                03075000
FOPFIXEDFMT     = 0  #,                                        <<01115>>03080000
FOPDESIGNATOR   = FOPTIONS.(10:3)#,      << DESIGNATOR TYPE >>          03085000
FOPACTUAL       = (INT(FOPDESIGNATOR) = 0)#,<< ACTUAL >>                03090000
FOPSTDLIST      = (INT(FOPDESIGNATOR) = 1)#,<< $STDLIST >>              03095000
FOPNEWPASS      = (INT(FOPDESIGNATOR) = 2)#,<< $NEWPASS >>              03100000
FOPOLDPASS      = (INT(FOPDESIGNATOR) = 3)#,<< $OLDPASS >>              03105000
FOPSTDIN        = (INT(FOPDESIGNATOR) = 4)#,<< $STDIN >>                03110000
FOPSTDINX       = (INT(FOPDESIGNATOR) = 5)#,<< $STDINX >>               03115000
FOPNULL         = (INT(FOPDESIGNATOR) = 6)#,<< $NULL >>                 03120000
FOPASCII        = FOPTIONS.(13:1)#,      << ASCII/BINARY FORMAT >>      03125000
FOPDOMAIN       = FOPTIONS.(14:2)#,      << FILE DOMAIN >>              03130000
FOPNEW          = (INT(FOPDOMAIN) = 0)#, << NEW >>                      03135000
FOPPERMANENT    = (INT(FOPDOMAIN) = 1)#, << OLD - PERMANENT >>          03140000
FOPTEMPORARY    = (INT(FOPDOMAIN) = 2)#, << OLD - TEMPORARY >>          03145000
FOPOLD          = (INT(FOPDOMAIN) = 3)#; << OLD - EITHER >>             03150000
                                                                        03155000
DEFINE                                                                  03160000
NOLABEL         = FALSE#;                << FUTURE HOOK >>              03165000
                                                                        03170000
COMMENT                                                        <<02524>>03175000
<<-------------------------------------------------------------<<02524>>03180000
*                                                             *<<02524>>03185000
*  DEVICE parameter/DEVPARMS array definitions                *<<02524>>03190000
*                                                             *<<02524>>03195000
------------------------------------------------------------->><<02524>>03200000
;  << end of header >>                                         <<02524>>03205000
                                                               <<02524>>03210000
EQUATE                                                         <<02524>>03215000
   DEVPARM'SIZE = %101,    << size of formatted area >>        <<02524>>03220000
   DEVPARM'END  = DEVPARM'SIZE-1,                              <<02524>>03225000
         << index for end of formatted area >>                 <<02524>>03230000
   BDEVPARM'END = DEVPARM'END*2 + 1,                           <<02524>>03235000
         << byte index for end of formatted area >>            <<02524>>03240000
   NUM'EXTRA'VARS = 5,     << overhead at end of DEVPARMS >>   <<02524>>03245000
   DEV'ARRAY'END  = DEVPARM'END + NUM'EXTRA'VARS,              <<02524>>03250000
         << DEVPARMS array bounds >>                           <<02524>>03255000
   MAXDEVLEN = %100,         <<max. size of DEVL array>>       <<06073>>03260000
                                                               <<02524>>03265000
   << index definitions for overhead region >>                 <<02524>>03270000
                                                               <<02524>>03275000
   DP'INDEX'IND = DEVPARM'END+1,                               <<02524>>03280000
   DP'FLAG'IND  = DP'INDEX'IND+1,                              <<02524>>03285000
   DP'ENV'FNUM'IND = DP'FLAG'IND+1,                            <<02524>>03290000
   DEVPARMFLAG'IND = DP'ENV'FNUM'IND+1,                        <<02524>>03295000
   DP'DEN'IND   = DEVPARMFLAG'IND+1,                           <<02524>>03300000
                                                               <<02524>>03305000
   NUM'DP'TOKENS   = 3,                                        <<02524>>03310000
   AVAIL'PTR'IND   = NUM'DP'TOKENS*2 + 1;                      <<02524>>03315000
         << index of free ptr in formatted region >>           <<02524>>03320000
                                                               <<02524>>03325000
DEFINE                                                         <<02524>>03330000
   BUILD'DEVPARMS =                                            <<02524>>03335000
      ARRAY DEVPARMS(0:DEV'ARRAY'END);                         <<02524>>03340000
      BYTE ARRAY BDEVPARMS(*) = DEVPARMS#,                     <<02524>>03345000
   NEXT'AVAIL'PTR =                                            <<02524>>03350000
      DEVPARMS(AVAIL'PTR'IND)#,                                <<02524>>03355000
                                                               <<02524>>03360000
   << overhead area defines >>                                 <<02524>>03365000
                                                               <<02524>>03370000
   DP'INDEX = DEVPARMS(DP'INDEX'IND)#,                         <<02524>>03375000
   DP'FLAG  = DEVPARMS(DP'FLAG'IND)#,                          <<02524>>03380000
   DP'ENV'FNUM = DEVPARMS(DP'ENV'FNUM'IND)#,                   <<02524>>03385000
   DEVPARMFLAG = DEVPARMS(DEVPARMFLAG'IND)#,                   <<02524>>03390000
   DP'DEN   = DEVPARMS(DP'DEN'IND)#,                           <<02524>>03395000
                                                               <<02524>>03400000
   << token defines >>                                         <<02524>>03405000
                                                               <<02524>>03410000
   OUTQ'DEFN     = "OQ"#,                                      <<02524>>03415000
   ENV'DEFN      = "EN"#,                                      <<02524>>03420000
   DEN'DEFN      = "DN"#;                                      <<02524>>03425000
                                                               <<02524>>03430000
EQUATE                                                         <<02524>>03435000
   << density equates >>                                       <<02524>>03440000
                                                               <<02524>>03445000
   DEN'1600      = 1,                                          <<02524>>03450000
   DEN'6250      = 2,                                          <<02524>>03455000
   DEN'800       = 3,                                          <<07271>>03460000
   DEN'DEFAULT   = 0,                                          <<02568>>03465000
                                                               <<02524>>03470000
   << token equates >>                                         <<02524>>03475000
                                                               <<02524>>03480000
   OUTQ'TOKEN    = OUTQ'DEFN,                                  <<02524>>03485000
   ENV'TOKEN     = ENV'DEFN,                                   <<02524>>03490000
   DEN'TOKEN     = DEN'DEFN;                                   <<02524>>03495000
                                                               <<02524>>03500000
<<----------------------------------------------------------------------03505000
*                                                                      *03510000
*  FOPEN STATE WORD (STATE) DEFINITIONS                                *03515000
*                                                                      *03520000
---------------------------------------------------------------------->>03525000
                                                                        03530000
DEFINE                                                                  03535000
CARRIAGEF   = (9:1)#,         << CARRIAGE CONTROL FLAG >>               03540000
DEFAULTBF   = (10:1)#,        << DEFAULT BLOCKING FLAG >>               03545000
READCODE    = (11:4)#,        << INPUT EOF CHECK >>                     03550000
READTYPE    = (11:2)#,        << 00 DATA,01 JOB,10 SESS >>              03555000
READMODE    = (13:2)#;        << SEE BELOW >>                           03560000
                                                                        03565000
EQUATE                                                                  03570000
STDINRD     = 0,    << TYPE=JOB/SESSION >>                              03575000
STDINXRD    = 1,                                                        03580000
STDINCIRD   = 2,                                                        03585000
MAGTRD      = 0,    << TYPE=DATA >>                                     03590000
OTHERRD     = 1,                                                        03595000
COLONRD     = 2;                                                        03600000
$INCLUDE INCLPXFL                                              <<06514>>03605000
$INCLUDE INCLACB                                               <<06514>>03610000
$INCLUDE INCLFCB                                               <<06514>>03615000
$INCLUDE INCLFLAB                                              <<06514>>03620000
$INCLUDE INCFMAVT                                              <<06272>>03625000
$PAGE "MPE-V TABLES DECLARTIONS - DIRECTORY "                  <<06272>>03630000
$INCLUDE INCLPXG                                               <<06272>>03635000
<<-------------------------------------------------------------  DS.00  03640000
*                                                             *  DS.00  03645000
*   REMOTE FILE ACCESS DEFINITIONS                            *  DS.00  03650000
*                                                             *  DS.00  03655000
---------------------------------------------------------------  DS.00>>03660000
                                                                        03665000
EQUATE                                                         <<DS.00>>03670000
DSDUMMYDEV     = 41, << DEVICE TYPE OF DS DUMMY >>             <<DS.00>>03675000
RFAMSG         = 7,  << MESSAGE TYPE >>                        <<DS.00>>03680000
RFASTREAM      = %20,<< STREAM TYPE >>                         <<DS.00>>03685000
RFASUBSTR      = 0;  << SUBSTREAM TYPE >>                      <<DS.00>>03690000
                                                               <<DS.00>>03695000
DEFINE                                                         <<DS.00>>03700000
ALLOCBUF       = PUSH(S); X := (TOS+1)&LSL(1)#,                <<DS.00>>03705000
ALLOCRFABUF    = PUSH(S); @RFAPTR := TOS+1#,                   <<DS.00>>03710000
CC             = (6:2)#, << COND. CODE BITS OF STATUS >>       <<DS.00>>03715000
CHECKXFER      = IF <> THEN                                    <<DS.00>>03720000
                 BEGIN                                         <<DS.00>>03725000
                    TOS := 0;                                  <<DS.00>>03730000
                    TOS := RFALINE;                            <<DS.00>>03735000
                    TOS := DSCHKPLABEL;                        <<DS.00>>03740000
                    ASMB(PCAL 0);                              <<DS.00>>03745000
$                   IF X1 = ON                                 <<DS.00>>03750000
                    IF <> THEN FTROUBLE(486);                  <<KJ.03>>03755000
$                   IF                                         <<DS.00>>03760000
                    TOS := CCL;                                <<DS.00>>03765000
                    GO EXIT;                                   <<DS.00>>03770000
                 END#,                                         <<DS.00>>03775000
DELAPPENDAGE   = TOS := RFALEN-1; ASSEMBLE(SUBS 0)#,           <<DS.00>>03780000
GETMWCPARMS    = TOS := 0;  TOS := RFALINE;  TOS := RFAMSG;    <<DS.00>>03785000
                 TOS := RFASTREAM;  TOS := RFASUBSTR;          <<DS.00>>03790000
                 TOS := @RFAPTR;  TOS := RFALEN#,              <<DS.00>>03795000
LOAD'ERROR    = TOS := TOS LOR LOCAL'FAILURE&LSL(8)#,          <<DS.04>>03800000
MWCNOBUF       = GETMWCPARMS;  TOS := 0D;  TOS := 0D;          <<DS.00>>03805000
                 TOS := MWCPLABEL;  ASMB(PCAL 0); DEL#,        <<DS.00>>03810000
DSCHKPLABEL    = ABS(DSCHKPLABL)#,                             <<DS.00>>03815000
DSOPENPLABEL   = ABS(DSOPENPLABL)#,                            <<DS.00>>03820000
DSCLOSEPLABEL  = ABS(DSCLOSEPLABL)#,                           <<DS.00>>03825000
MWCPLABEL      = ABS(MANWCPLABL)#,                             <<DS.00>>03830000
SDSLDEVPLABEL = ABS(SDSLDEVLABEL)#,                            <<DS.04>>03835000
PREPRETURN     = TOS := TOS.CC; ASSEMBLE(ZERO,XCH)#,           <<DS.00>>03840000
RFAMREC        = LOGICAL(AFTE)#, << RFA MULTI-REC FILE >>      <<DS.03>>03845000
SETRFAPTR      = DSTX := EXCHANGEDB(0);                        <<DS.00>>03850000
                 ALLOCRFABUF;                                  <<DS.00>>03855000
                 DSTX := EXCHANGEDB(DSTX)#;                    <<DS.00>>03860000
$PAGE "MPE-V TABLES DECLARTIONS - PXGLOBAL "                   <<06272>>03865000
<<-------------------------------------------------------------  RV.PV  03870000
*                                                             *  RV.PV  03875000
*  DIRECTORY ENTRY DEFINITIONS                                *  RV.PV  03880000
*                                                             *  RV.PV  03885000
---------------------------------------------------------------  RV.PV>>03890000
                                                               <<RV.PV>>03895000
EQUATE                                                         <<RV.PV>>03900000
                                                               <<RV.PV>>03905000
   NAMESIZE        = 4,                                        <<RV.PV>>03910000
                                                               <<RV.PV>>03915000
<<GROUP ENTRY>>                                                <<RV.PV>>03920000
   GNAME           = 0,                  <<NAME>>              <<RV.PV>>03925000
   GFIPNTR         = GNAME+NAMESIZE,     <<FILE INDEX>>        <<RV.PV>>03930000
   GPASS           = GFIPNTR+1,          <<PASSWORD>>          <<RV.PV>>03935000
   GDFSCOUNT       = GPASS+NAMESIZE,     <<DISC FILE SPACE>>   <<RV.PV>>03940000
   GDFSLIMIT       = GDFSCOUNT+2,                              <<RV.PV>>03945000
   GCPUCOUNT       = GDFSLIMIT+2,        <<CPU TIME>>          <<RV.PV>>03950000
   GCPULIMIT       = GCPUCOUNT+2,                              <<RV.PV>>03955000
   GCONTIMECOUNT   = GCPULIMIT+2,                              <<RV.PV>>03960000
   GCONTIMELIMIT   = GCONTIMECOUNT+2,                          <<RV.PV>>03965000
   GSEC            = GCONTIMELIMIT+2,                          <<RV.PV>>03970000
   GPURGEFLAGW     = GSEC,                                     <<RV.PV>>03975000
   GCAP            = GSEC +2,                                  <<RV.PV>>03980000
   GLINKAGE        = GCAP+1,                                   <<RV.PV>>03985000
   GVSDIPNTR       = GLINKAGE+1,         <<VS DEF INDEX PNTR>> <<RV.PV>>03990000
   GHVSNAME        = GVSDIPNTR+1,        <<HOME VS NAME>>      <<RV.PV>>03995000
   GHVSANAME       = GHVSNAME,           << "   "  ACCT NAME>> <<RV.PV>>04000000
   GHVSGNAME       = GHVSANAME+NAMESIZE, << "   "  GRP  NAME>> <<RV.PV>>04005000
   GHVSVSNAME      = GHVSGNAME+NAMESIZE, << "   "  VS   NAME>> <<RV.PV>>04010000
   GSAVEFIPNTR     = GHVSVSNAME+NAMESIZE,<<SAVES GFIPNTR>>     <<RV.PV>>04015000
   GMOUNTREFCNTR   = GSAVEFIPNTR+1,      <<MOUNT USE COUNTER>> <<RV.PV>>04020000
   GSPARE          = GMOUNTREFCNTR+1,                          <<RV.PV>>04025000
   GSIZE           = GSPARE+1;                                 <<RV.PV>>04030000
<<GLINKAGE DEFINITIONS>>                                       <<RV.PV>>04035000
DEFINE                                                         <<RV.PV>>04040000
   PVF             = 0:1 #,                                    <<RV.PV>>04045000
   MVTABXF         = 8:8 #;                                    <<RV.PV>>04050000
EQUATE                                                         <<RV.PV>>04055000
   PV              = 1;                                        <<RV.PV>>04060000
$PAGE "MPE-V DECLARTIONS - FORWARD PROCEDURES "                <<06272>>04065000
<<----------------------------------------------------------------------04070000
*                                                                      *04075000
*  FORWARD PROCEDURE DECLARATIONS                                      *04080000
*                                                                      *04085000
---------------------------------------------------------------------->>04090000
                                                                        04095000
PROCEDURE DELACB (PACBV,LACBV,ACCESS'TYPE);                    <<04796>>04100000
   VALUE PACBV,LACBV,ACCESS'TYPE;                              <<04796>>04105000
   INTEGER ACCESS'TYPE;                                        <<06514>>04110000
   DOUBLE PACBV,LACBV;                                         <<06514>>04115000
   OPTION FORWARD,VARIABLE;                                    <<04796>>04120000
DOUBLE PROCEDURE DISCSIZE(LDEV);                               <<01115>>04125000
   VALUE LDEV;                                                 <<01115>>04130000
   INTEGER LDEV;                                               <<01115>>04135000
   OPTION FORWARD;                                             <<01115>>04140000
INTEGER PROCEDURE FCLEAR (ASCII,DADDR,SECTADDR,NUM);                    04145000
   VALUE ASCII,DADDR,SECTADDR,NUM;                                      04150000
   LOGICAL ASCII,DADDR,NUM;                                             04155000
   DOUBLE SECTADDR;                                                     04160000
   OPTION FORWARD;                                                      04165000
PROCEDURE FCLOSE (FILENUM,DISP,SECCODE);                                04170000
   VALUE FILENUM,DISP,SECCODE;                                          04175000
   INTEGER FILENUM,DISP,SECCODE;                                        04180000
   OPTION FORWARD;                                                      04185000
PROCEDURE FDELETECB (VECTOR);                                           04190000
   VALUE VECTOR;                                                        04195000
   DOUBLE  VECTOR;                                             <<06514>>04200000
   OPTION FORWARD;                                                      04205000
LOGICAL PROCEDURE FREPLY (MESSAGE,LENGTH);                              04210000
   VALUE LENGTH;                                                        04215000
   BYTE ARRAY MESSAGE;                                                  04220000
   INTEGER LENGTH;                                                      04225000
   OPTION FORWARD;                                                      04230000
PROCEDURE FTITLE (T1,T2,T3,T4);                                         04235000
   VALUE T1,T2,T3,T4;                                                   04240000
   DOUBLE T1,T2,T3,T4;                                                  04245000
   OPTION FORWARD;                                                      04250000
PROCEDURE FTROUBLE (CODE);                                              04255000
   VALUE CODE;                                                          04260000
   INTEGER CODE;                                                        04265000
   OPTION FORWARD;                                                      04270000
INTEGER PROCEDURE FLABIO(LDEV,SECT,FUNC,FLAB);                 <<00.06>>04275000
   VALUE   LDEV,SECT,FUNC;                                     <<00.06>>04280000
   INTEGER LDEV,FUNC;                                          <<00.06>>04285000
   DOUBLE  SECT;                                               <<00.06>>04290000
   INTEGER ARRAY FLAB;                                         <<00.06>>04295000
   OPTION  FORWARD;                                            <<00.06>>04300000
PROCEDURE FLABIOERR(FLAG,FN,FGA);                              <<00.06>>04305000
   VALUE   FLAG,FN,FGA;                                        <<00.06>>04310000
   LOGICAL FLAG;                                               <<00.06>>04315000
   INTEGER FN,FGA;                                             <<00.06>>04320000
   OPTION  FORWARD,VARIABLE;                                   <<00.06>>04325000
INTEGER PROCEDURE GETBLKSIZE(RECSIZE,BLKFACT,FOPS);            <<00630>>04330000
   VALUE RECSIZE,BLKFACT,FOPS;                                 <<00630>>04335000
   INTEGER RECSIZE,BLKFACT;                                    <<00630>>04340000
   LOGICAL FOPS; OPTION FORWARD;                               <<00630>>04345000
DOUBLE PROCEDURE SCANFMAVT(FLAG,DEL'INDEX,LDEV'HODA,LODA,      <<06272>>04350000
                           PACBV);                             <<06272>>04355000
   VALUE FLAG,DEL'INDEX,LDEV'HODA,LODA,PACBV;                  <<06272>>04360000
   INTEGER FLAG,DEL'INDEX,LDEV'HODA,LODA;                      <<06272>>04365000
   DOUBLE PACBV;                                               <<06272>>04370000
   OPTION FORWARD,VARIABLE;                                    <<06272>>04375000
INTEGER PROCEDURE KOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,      <<KS.00>>04380000
   RECSIZE,DEVICE,FORMMSG,USERLABELS,BLOCKFACTOR,PRICOPBUFS,   <<KS.00>>04385000
   FILESIZE,NUMEXTENTS,INITALLOC,FILECODE);                    <<KS.00>>04390000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,USERLABELS,BLOCKFACTOR,     <<KS.00>>04395000
   PRICOPBUFS,FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;          <<KS.00>>04400000
   BYTE ARRAY FORMDESIGNATOR,DEVICE,FORMMSG;                   <<KS.00>>04405000
   LOGICAL FOPTIONS,AOPTIONS;                                  <<KS.00>>04410000
   INTEGER RECSIZE,USERLABELS,BLOCKFACTOR,PRICOPBUFS,          <<KS.00>>04415000
   NUMEXTENTS,INITALLOC,FILECODE;                              <<KS.00>>04420000
   DOUBLE FILESIZE;                                            <<KS.00>>04425000
   OPTION EXTERNAL;                                            <<KS.00>>04430000
PROCEDURE KCLOSE(FN,DISP,SEC);                                 <<KS.00>>04435000
   VALUE FN,DISP,SEC;                                          <<KS.00>>04440000
   INTEGER FN,DISP,SEC;                                        <<KS.00>>04445000
   OPTION EXTERNAL;                                            <<KS.00>>04450000
PROCEDURE KFCLOSE(FN,DISP,SEC);<<SECONDARY ENTRY TO FCLOSE>>   <<KS.00>>04455000
   VALUE FN,DISP,SEC;                                          <<KS.00>>04460000
   INTEGER FN,DISP,SEC;                                        <<KS.00>>04465000
   OPTION FORWARD;                                             <<KS.00>>04470000
PROCEDURE FFILEINFO (FILENUM, ITEMNUM1, ITEMVAL1,              <<01425>>04475000
                     ITEMNUM2, ITEMVAL2, ITEMNUM3, ITEMVAL3,   <<01425>>04480000
                     ITEMNUM4, ITEMVAL4, ITEMNUM5, ITEMVAL5);  <<01425>>04485000
   VALUE FILENUM, ITEMNUM1, ITEMNUM2, ITEMNUM3, ITEMNUM4,      <<01425>>04490000
         ITEMNUM5;                                             <<01425>>04495000
   INTEGER FILENUM, ITEMNUM1, ITEMNUM2, ITEMNUM3, ITEMNUM4,    <<01425>>04500000
           ITEMNUM5;                                           <<01425>>04505000
   BYTE ARRAY ITEMVAL1, ITEMVAL2, ITEMVAL3, ITEMVAL4,          <<01425>>04510000
              ITEMVAL5;                                        <<01425>>04515000
   OPTION VARIABLE, EXTERNAL;                                  <<01425>>04520000
PROCEDURE FGETINFO(FILENUM,FILENAME,FOPTIONS,AOPTIONS,         <<KS.00>>04525000
   RECSIZE,DEVTYPE,LDNUM,HDADDR,FILECODE,RECPTR,EOF,           <<KS.00>>04530000
   FLIMIT,LOGCOUNT,PHYSCOUNT,BLKSIZE,EXTSIZE,                  <<KS.00>>04535000
   NUMEXTENTS,USERLABELS,CREATORID,DISKADR);                   <<KS.00>>04540000
   VALUE FILENUM;                                              <<KS.00>>04545000
   INTEGER FILENUM,RECSIZE,DEVTYPE,FILECODE,BLKSIZE,           <<KS.00>>04550000
   NUMEXTENTS,USERLABELS;                                      <<KS.00>>04555000
   BYTE ARRAY FILENAME,CREATORID;                              <<KS.00>>04560000
   LOGICAL FOPTIONS,AOPTIONS,LDNUM,HDADDR,EXTSIZE;             <<KS.00>>04565000
   DOUBLE RECPTR,EOF,FLIMIT,LOGCOUNT,PHYSCOUNT,DISKADR;        <<KS.00>>04570000
   OPTION VARIABLE,EXTERNAL;           <<>>                             04575000
                                                               <<KS.00>>04580000
PROCEDURE FREADLABEL(FN,TARGET,TCOUNT,LBL);                    <<SP.11>>04585000
   VALUE FN,TCOUNT,LBL;                                        <<SP.11>>04590000
   INTEGER FN,TCOUNT,LBL;                                      <<SP.11>>04595000
   ARRAY TARGET;                                               <<SP.11>>04600000
   OPTION VARIABLE,EXTERNAL;           <<>>                             04605000
                                                               <<SP.11>>04610000
PROCEDURE FWRITELABEL(FN,TARGET,TCOUNT,LBL);                   <<SP.11>>04615000
   VALUE FN,TCOUNT,LBL;                                        <<SP.11>>04620000
   INTEGER FN,TCOUNT,LBL;                                      <<SP.11>>04625000
   ARRAY TARGET;                                               <<SP.11>>04630000
   OPTION VARIABLE,EXTERNAL;           <<>>                             04635000
                                                               <<04679>>04640000
PROCEDURE FSCLOSE(FILENUM,DISP,SEC);                           <<04679>>04645000
VALUE FILENUM,DISP,SEC;                                        <<04679>>04650000
INTEGER FILENUM,DISP,SEC;                                      <<04679>>04655000
OPTION FORWARD;                                                <<04679>>04660000
PROCEDURE SPECIAL'SPOOL'CLOSE(FILENUM,DISP,SECCODE);           << 8562>>04665000
VALUE FILENUM,DISP,SECCODE;                                    << 8562>>04670000
INTEGER FILENUM,DISP,SECCODE;                                  << 8562>>04675000
OPTION PRIVILEGED,UNCALLABLE,FORWARD;                          << 8562>>04680000
                                                               <<04679>>04685000
$PAGE "MPE-V DECLARTIONS - EXTERNAL PROCEDURES "               <<06272>>04690000
<<----------------------------------------------------------------------04695000
*                                                                      *04700000
*  EXTERNAL PROCEDURE DECLARATIONS                                     *04705000
*                                                                      *04710000
---------------------------------------------------------------------->>04715000
                                                                        04720000
PROCEDURE ABORTIOX (IOQX);                                     <<+0.05>>04725000
   VALUE IOQX;                                                 <<+0.05>>04730000
   INTEGER IOQX;                                               <<+0.05>>04735000
   OPTION EXTERNAL;                                            <<+0.05>>04740000
LOGICAL PROCEDURE ACCCHECK(LEVEL,AN,ASEC,GN,GSEC,CREATOR,FSEC,USERINFO);04745000
   VALUE LEVEL,ASEC,GSEC,FSEC;                                          04750000
   INTEGER LEVEL;                                                       04755000
   BYTE ARRAY AN,GN;                                                    04760000
   BYTE ARRAY CREATOR;                                                  04765000
   LOGICAL ASEC;                                                        04770000
   DOUBLE GSEC,FSEC;                                                    04775000
   BYTE ARRAY USERINFO;                                                 04780000
   OPTION VARIABLE,EXTERNAL;                                            04785000
INTEGER PROCEDURE ADDJTENTRY (N1,N2,N3,TNO,SIZE,INFO);                  04790000
   VALUE SIZE,TNO;                                                      04795000
   BYTE ARRAY N1,N2,N3;                                                 04800000
   INTEGER SIZE,TNO;                                                    04805000
   INTEGER ARRAY INFO;                                                  04810000
   OPTION EXTERNAL;                                                     04815000
INTEGER PROCEDURE ALLOCATE (INDEX,OLD,OUTPRI,ID,JMPIN,FORMMSG,          04820000
         JNUM,COPIES,DEVINFO,XDDADR,ACCESSTYPE);                        04825000
   VALUE   INDEX,OLD,OUTPRI,JMPIN,JNUM,COPIES;                          04830000
   INTEGER INDEX,OUTPRI,JMPIN,JNUM,COPIES,ACCESSTYPE;                   04835000
   LOGICAL OLD;                                                         04840000
   INTEGER ARRAY   ID,DEVINFO;                                          04845000
   INTEGER POINTER XDDADR;                                              04850000
   BYTE ARRAY      FORMMSG;                                             04855000
   OPTION EXTERNAL;                                                     04860000
INTEGER PROCEDURE ALLORIN (RCODE,USNAM,RPASS);                          04865000
   VALUE RCODE;                                                         04870000
   ARRAY USNAM,RPASS;                                                   04875000
   INTEGER RCODE;                                                       04880000
   OPTION VARIABLE,EXTERNAL;                                            04885000
LOGICAL PROCEDURE ALTDSEGSIZE (DSTX,SIZE);                              04890000
   VALUE DSTX,SIZE;                                                     04895000
   INTEGER DSTX,SIZE;                                                   04900000
   OPTION EXTERNAL;                                                     04905000
INTEGER PROCEDURE ALTPXFILESIZE (NEWSIZE);                              04910000
   VALUE NEWSIZE;                                                       04915000
   INTEGER NEWSIZE;                                                     04920000
   OPTION EXTERNAL;                                                     04925000
DOUBLE PROCEDURE ATTACHIO (LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS);  04930000
   VALUE LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                     04935000
   INTEGER LDEV,QMISC,DSTX,ADDR,FUNC,CNT,P1,P2,FLAGS;                   04940000
   OPTION EXTERNAL;                                                     04945000
INTEGER PROCEDURE CALENDAR;                                             04950000
   OPTION EXTERNAL;                                                     04955000
INTEGER PROCEDURE CREATETLTENT(FMSG,ID,FILNUM,ACCTYP,DENS);    <<02568>>04960000
   VALUE FILNUM,ACCTYP,DENS;                                   <<02568>>04965000
   INTEGER FILNUM,ACCTYP,DENS;                                 <<02568>>04970000
  BYTE ARRAY FMSG;                                             <<TL.02>>04975000
  ARRAY ID;                                                    <<TL.02>>04980000
  OPTION EXTERNAL;                                             <<TL.02>>04985000
                                                               <<TL.02>>04990000
PROCEDURE CLEANLDEV(DADDR);                                    <<TL.02>>04995000
  VALUE DADDR;                                                 <<02577>>05000000
  INTEGER DADDR;                                               <<TL.02>>05005000
  OPTION EXTERNAL;                                             <<TL.02>>05010000
                                                               <<TL.02>>05015000
INTEGER PROCEDURE CHECKUL(FN,CODE,FUNC);                       <<02688>>05020000
  VALUE FN,CODE,FUNC;                                          <<02549>>05025000
  INTEGER FN,CODE,FUNC;                                        <<02549>>05030000
  OPTION EXTERNAL;                                             <<TL.02>>05035000
                                                               <<TL.02>>05040000
INTEGER PROCEDURE POSITION(LDEV,FNUM,BLKFACT,RSIZ,FOPS,AOPS);  <<02549>>05045000
   VALUE LDEV,FNUM,AOPS;                                       <<02549>>05050000
   INTEGER LDEV,FNUM,BLKFACT,RSIZ;                             <<02549>>05055000
   LOGICAL FOPS,AOPS;                                          <<02549>>05060000
  OPTION EXTERNAL;                                             <<TL.02>>05065000
                                                               <<TL.02>>05070000
DOUBLE PROCEDURE WRITE'DENSITY(LDEV);                          <<02653>>05075000
   VALUE LDEV;                                                 <<02568>>05080000
   INTEGER LDEV;                                               <<02568>>05085000
   OPTION EXTERNAL;                                            <<02568>>05090000
                                                               <<02568>>05095000
PROCEDURE SET'LPDT'BOT(LDEV,VAL);                              <<02568>>05100000
   VALUE LDEV,VAL;                                             <<02568>>05105000
   INTEGER LDEV,VAL;                                           <<02568>>05110000
   OPTION EXTERNAL;                                            <<02568>>05115000
                                                               <<02568>>05120000
LOGICAL PROCEDURE CHECK'BOT(LDEV);                             <<06040>>05125000
VALUE LDEV;                                                    <<06040>>05130000
INTEGER LDEV;                                                  <<06040>>05135000
OPTION EXTERNAL;                                               <<06040>>05140000
                                                               <<06040>>05145000
PROCEDURE STORE'DENSITY(LDEV,BUFFER,MODE);                     <<02568>>05150000
   VALUE LDEV,MODE;                                            <<02568>>05155000
   INTEGER LDEV,MODE;                                          <<02568>>05160000
   ARRAY BUFFER;                                               <<02568>>05165000
   OPTION EXTERNAL;                                            <<02568>>05170000
                                                               <<02568>>05175000
PROCEDURE DEALLOCATE (XDEV);                                            05180000
   VALUE   XDEV;                                                        05185000
   DOUBLE XDEV;                                                <<06515>>05190000
   OPTION EXTERNAL;                                                     05195000
PROCEDURE DEALLORIN (RINNUM,USNAM);                                     05200000
   VALUE RINNUM;                                                        05205000
   INTEGER RINNUM;                                                      05210000
   ARRAY USNAM;                                                         05215000
   OPTION VARIABLE,EXTERNAL;                                            05220000
PROCEDURE DEBUG;                                                        05225000
   OPTION EXTERNAL;                                                     05230000
LOGICAL PROCEDURE DEVICESTATUS (LDEV);                                  05235000
   VALUE LDEV;                                                          05240000
   INTEGER LDEV;                                                        05245000
   OPTION EXTERNAL;                                                     05250000
                                                               << 8491>>05255000
                                                               << 8491>>05260000
INTEGER PROCEDURE GET'DSDEVICE(LDEV);                          << 8491>>05265000
VALUE LDEV;                                                    << 8491>>05270000
INTEGER LDEV;                                                  << 8491>>05275000
                                                               << 8491>>05280000
<<---------------------------------------------------------->> << 8491>>05285000
<<  This procedure returns info on potential CS/DS devices. >> << 8491>>05290000
<<                                                          >> << 8491>>05295000
<<       -2  No DSLINES configured                          >> << 8491>>05300000
<<       -1  Illegal LDEV passed                            >> << 8491>>05305000
<<        0  Non DS related device                          >> << 8491>>05310000
<<        1  DS related CS device (INP)                     >> << 8491>>05315000
<<        2  DS device                                      >> << 8491>>05320000
<<        3  DS pseudo terminal                             >> << 8491>>05325000
<<        4  PAD terminal                                   >> << 8491>>05330000
<<---------------------------------------------------------->> << 8491>>05335000
                                                               << 8491>>05340000
OPTION EXTERNAL;                                               << 8491>>05345000
                                                               << 8491>>05350000
DOUBLE PROCEDURE DIRECADJUST (NUMSECTS,DUMMY,AN,GN,MVTABX);    <<39.PV>>05355000
   VALUE NUMSECTS,DUMMY,MVTABX;                                <<39.PV>>05360000
   DOUBLE NUMSECTS;                                                     05365000
   INTEGER DUMMY,MVTABX;                                       <<39.PV>>05370000
   ARRAY AN,GN;                                                         05375000
   OPTION EXTERNAL,VARIABLE;                                   <<39.PV>>05380000
DOUBLE PROCEDURE DIRECFINDFILE (TYPE,LINKAGE'INDEXP,AN,        <<38.PV>>05385000
                                GN,FN,PRETURN,MVTABX);         <<38.PV>>05390000
   VALUE TYPE,LINKAGE'INDEXP,MVTABX;                           <<38.PV>>05395000
   INTEGER TYPE,MVTABX;                                        <<38.PV>>05400000
   DOUBLE  LINKAGE'INDEXP;                                              05405000
   ARRAY AN,GN,FN,PRETURN;                                              05410000
   OPTION EXTERNAL,VARIABLE;                                   <<38.PV>>05415000
DOUBLE PROCEDURE DIRECINSERTFILE (NUMSECTS, DUMMY, AN, GN,     <<38.PV>>05420000
                                  FN, FADDR, MVTABX);          <<RV.PV>>05425000
   VALUE NUMSECTS, DUMMY, FADDR, MVTABX;                       <<38.PV>>05430000
   DOUBLE NUMSECTS,FADDR;                                               05435000
   INTEGER DUMMY, MVTABX;                                      <<38.PV>>05440000
   ARRAY AN,GN,FN;                                                      05445000
   OPTION EXTERNAL, VARIABLE;                                  <<RV.PV>>05450000
DOUBLE PROCEDURE DIRECPURGEFILE (NUMSECTS, DUMMY, AN,          <<38.PV>>05455000
                                 GN, FN, MVTABX);              <<38.PV>>05460000
   VALUE NUMSECTS, DUMMY, MVTABX;                              <<38.PV>>05465000
   DOUBLE NUMSECTS;                                                     05470000
   INTEGER DUMMY, MVTABX;                                      <<38.PV>>05475000
   ARRAY AN,GN,FN;                                                      05480000
   OPTION EXTERNAL, VARIABLE;                                  <<21.PV>>05485000
DOUBLE PROCEDURE DIRECRESETFILE (NUMSECTS, DUMMY, AN, GN,      <<00088>>05490000
                                 FN, FADDR, MVTABX);           <<00088>>05495000
   VALUE NUMSECTS, DUMMY, FADDR, MVTABX;                       <<00088>>05500000
   DOUBLE NUMSECTS,FADDR;                                      <<00088>>05505000
   INTEGER DUMMY, MVTABX;                                      <<00088>>05510000
   ARRAY AN,GN,FN;                                             <<00088>>05515000
   OPTION EXTERNAL, VARIABLE; <<'INSERTFILE SANS SECURITY CHK>><<00088>>05520000
PROCEDURE DIRECSETFLAG (TYPE,LINKAGE'INDEXP,AN,GN,FN,MVTABX);  <<38.PV>>05525000
   VALUE TYPE,LINKAGE'INDEXP,MVTABX;                           <<38.PV>>05530000
   INTEGER TYPE,MVTABX;                                        <<38.PV>>05535000
   DOUBLE  LINKAGE'INDEXP;                                     <<38.PV>>05540000
   ARRAY AN,GN,FN;                                             <<32.PV>>05545000
   OPTION EXTERNAL,VARIABLE;                                   <<32.PV>>05550000
INTEGER PROCEDURE DISKALLOC (INDEX,NUMEXT,SPACEDATA,PVINFO);   <<RH.PV>>05555000
   VALUE INDEX,NUMEXT,PVINFO;                                  <<RH.PV>>05560000
   INTEGER INDEX,NUMEXT;                                       <<RH.PV>>05565000
   LOGICAL PVINFO;                                             <<RH.PV>>05570000
   DOUBLE ARRAY SPACEDATA;                                              05575000
   OPTION EXTERNAL;                                                     05580000
   COMMENT  RETURNS OPERATION STATUS AS RESULT:                         05585000
      0 - OK                                                            05590000
      1 - Space not available                                  ((DFS00))05595000
      2 - I/O or other error                                   ((DFS00))05600000
      3 - Free space allocation disabled on this ldev          ((DFS00))05605000
      4 - Device not available                                 ((DFS00))05610000
      5 - INVALID INDEX;                                                05615000
INTEGER PROCEDURE DISKDEALLOC (EXTSIZE,LASTEXTSIZE,NUMEXT,MAP);         05620000
   VALUE EXTSIZE,LASTEXTSIZE,NUMEXT;                                    05625000
   INTEGER EXTSIZE,LASTEXTSIZE,NUMEXT;                                  05630000
   DOUBLE ARRAY MAP;                                                    05635000
   OPTION EXTERNAL;                                                     05640000
   COMMENT  RETURNS OPERATION STATUS AS RESULT:                         05645000
      LEFT BYTE:                                                        05650000
         MAP ENTRY INDEX                                                05655000
      RIGHT BYTE:                                                       05660000
         0 - OK                                                         05665000
         1 - MISC. I/O ERROR                                            05670000
         2 - INVALID NUMBER OF SECTORS                                  05675000
         4 - INVALID SECTOR NUMBER                                      05680000
         5 - FREE SPACE TABLE FULL;                                     05685000
PROCEDURE ERROREXIT (WORDS,ERROR,ZERO);                                 05690000
   VALUE WORDS,ERROR,ZERO;                                              05695000
   INTEGER WORDS,ERROR,ZERO;                                            05700000
   OPTION EXTERNAL;                                                     05705000
PROCEDURE ERRORON;                                                      05710000
   OPTION EXTERNAL;                                                     05715000
LOGICAL PROCEDURE EXCHANGEDB (DSTX);                                    05720000
   VALUE DSTX;                                                          05725000
   LOGICAL DSTX;                                                        05730000
   OPTION EXTERNAL;                                                     05735000
PROCEDURE FCCLOSE(FILENUM,FCB,FLAB);                           <<HM.00>>05740000
   VALUE FILENUM,FCB,FLAB;                                     <<HM.00>>05745000
   INTEGER FILENUM;                                            <<HM.00>>05750000
   INTEGER POINTER FCB,FLAB;                                   <<HM.00>>05755000
   OPTION EXTERNAL;                                            <<HM.00>>05760000
INTEGER PROCEDURE FCINITACB(ACB,LIMIT,HEADREC,EPTR);           <<HM.00>>05765000
   VALUE ACB,LIMIT,HEADREC,EPTR;                               <<HM.00>>05770000
   INTEGER POINTER ACB;                                        <<HM.00>>05775000
   DOUBLE LIMIT,HEADREC,EPTR;                                  <<HM.00>>05780000
   OPTION EXTERNAL;                                            <<HM.00>>05785000
INTEGER PROCEDURE FCOPEN(ACB,LACBV);                           <<HM.00>>05790000
   VALUE ACB,LACBV;                                            <<HM.00>>05795000
   INTEGER POINTER ACB;                                        <<HM.00>>05800000
   DOUBLE LACBV;                                               <<06514>>05805000
   OPTION EXTERNAL;                                            <<HM.00>>05810000
INTEGER PROCEDURE FCWRITEOF(DUMMY1,DUMMY2);                    <<HM.00>>05815000
   VALUE DUMMY1,DUMMY2;                                        <<HM.00>>05820000
   INTEGER DUMMY1,DUMMY2;                                      <<HM.00>>05825000
   OPTION EXTERNAL;                                            <<HM.00>>05830000
INTEGER PROCEDURE FORMSG(INBUFF,SETNO,MSGNO,MASK,P1,P2,P3,     <<09.EB>>05835000
      P4,P5,OUTBUFF,OUTBUFFSIZE,OUTLEN,DEST,CONTROL);          <<09.EB>>05840000
   VALUE SETNO,MSGNO,MASK,P1,P2,P3,P4,P5,OUTBUFFSIZE,          <<09.EB>>05845000
      DEST,CONTROL;                                            <<09.EB>>05850000
   BYTE ARRAY INBUFF,OUTBUFF;                                  <<09.EB>>05855000
   INTEGER SETNO,MSGNO,OUTBUFFSIZE,DEST,OUTLEN;                <<09.EB>>05860000
   LOGICAL MASK,P1,P2,P3,P4,P5,CONTROL;                        <<09.EB>>05865000
   OPTION EXTERNAL;                                            <<09.EB>>05870000
INTEGER PROCEDURE GETDATASEG (MEMSIZE,VDSIZE);                          05875000
   VALUE MEMSIZE,VDSIZE;                                                05880000
   INTEGER MEMSIZE,VDSIZE;                                              05885000
   OPTION EXTERNAL;                                                     05890000
INTEGER PROCEDURE GETDEVINFO (DEVICE,DEVINFO);                          05895000
   BYTE ARRAY DEVICE;                                                   05900000
   INTEGER ARRAY DEVINFO;                                               05905000
   OPTION EXTERNAL;                                                     05910000
   COMMENT  RETURNS IN THE 9 WORD ARRAY DEVINFO CERTAIN PARAMETERS      05915000
      OF THE SPECIFIED DEVICE:                                          05920000
      IF DEVICE = <CLASSNAME> THEN                                      05925000
         DEVINFO(0) - DEVICE CLASS TABLE (NEGATIVE) INDEX               05930000
                (1) - DEVICE TYPE AS PER LDT                            05935000
                (2) - FOURTH WORD OF DEVICE CLASS TABLE                 05940000
            (4)-(8) - LDT ENTRY OF FIRST DEVICE IN CLASS                05945000
      IF DEVICE = <LOGICAL DEVICE NUMBER> THEN                          05950000
         DEVINFO(0) - LOGICAL DEVICE NUMBER                             05955000
                (1) - DEVICE TYPE AS PER LDT                            05960000
            (2)-(3) - LPDT ENTRY                                        05965000
            (4)-(8) - LDT ENTRY;                                        05970000
LOGICAL PROCEDURE GETSIR (SIRNUM);                                      05975000
   VALUE SIRNUM;                                                        05980000
   INTEGER SIRNUM;                                                      05985000
   OPTION EXTERNAL;                                                     05990000
PROCEDURE IMPEDE (PCBPT);                                               05995000
   VALUE PCBPT;                                                         06000000
   INTEGER PCBPT;                                                       06005000
   OPTION EXTERNAL;                                                     06010000
INTEGER PROCEDURE LDEVTOSUBTYPE(LDEV);                         <<01115>>06015000
   VALUE LDEV;                                                 <<01115>>06020000
   INTEGER LDEV;                                               <<01115>>06025000
   OPTION EXTERNAL;                                            <<01115>>06030000
INTEGER PROCEDURE LDEVTOTYPE(LDEV);                            <<01115>>06035000
   VALUE LDEV;                                                 <<01115>>06040000
   INTEGER LDEV;                                               <<01115>>06045000
   OPTION EXTERNAL;                                            <<01115>>06050000
PROCEDURE LOG5 (FN,DISP,SECT,DEV,REC,BLOCK,DADDR,RECTYPE);     <<06867>>06055000
   VALUE DADDR,DISP,SECT,DEV,REC,BLOCK,RECTYPE;                <<06867>>06060000
   INTEGER DADDR,DISP,DEV,RECTYPE;                             <<06867>>06065000
   DOUBLE SECT,REC,BLOCK;                                               06070000
   BYTE ARRAY FN;                                                       06075000
   OPTION EXTERNAL;                                                     06080000
PROCEDURE MMSTAT'(EVENT,P1,P2,P3,P4,P5,P6);                    <<06863>>06085000
   VALUE EVENT,P1,P2,P3,P4,P5,P6;                              <<06863>>06090000
   INTEGER EVENT,P1,P2,P3,P4,P5,P6;                            <<06863>>06095000
   OPTION EXTERNAL;                                            <<+0.04>>06100000
LOGICAL PROCEDURE MRCAPOK (SB, RIN);                           <<00560>>06105000
  VALUE SB, RIN;                                               <<00560>>06110000
  LOGICAL SB;                                                  <<00560>>06115000
  INTEGER RIN;                                                 <<00560>>06120000
  OPTION VARIABLE, EXTERNAL;                                   <<00560>>06125000
                                                              <<SP.ENV>>06130000
PROCEDURE PLOADENV(OUTFILENUM,ENVFILENAME,STATUS,ERRNUM);     <<SP.ENV>>06135000
   VALUE OUTFILENUM;                                          <<SP.ENV>>06140000
   INTEGER OUTFILENUM,STATUS,ERRNUM;                          <<SP.ENV>>06145000
   BYTE ARRAY ENVFILENAME;                                    <<SP.ENV>>06150000
   OPTION EXTERNAL;                                           <<SP.ENV>>06155000
                                                              <<SP.ENV>>06160000
PROCEDURE PCHECKENV( ENVFILENAME,STATUS, ERRNUM);             <<SP.ENV>>06165000
  BYTE ARRAY ENVFILENAME;                                     <<SP.ENV>>06170000
  INTEGER STATUS,ERRNUM;                                      <<SP.ENV>>06175000
   OPTION EXTERNAL;                                           <<SP.ENV>>06180000
LOGICAL PROCEDURE PRIMEDEVICE (LDEV,XDDEP,FORMS);              <<01027>>06185000
   VALUE   LDEV,XDDEP,FORMS;                                            06190000
   LOGICAL LDEV,FORMS;                                                  06195000
   POINTER XDDEP;                                                       06200000
   OPTION EXTERNAL;                                                     06205000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,A,B,C,D,E,           <<0U.EB>>06210000
      DEST,REPLY,BUFF,DST,IOTYPE);                             <<0U.EB>>06215000
   VALUE SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,           <<0U.EB>>06220000
      DST,IOTYPE;                                              <<0U.EB>>06225000
   LOGICAL SETNO,MSGNO,MASK,A,B,C,D,E,DEST,REPLY,BUFF,         <<0U.EB>>06230000
      DST,IOTYPE;                                              <<0U.EB>>06235000
   OPTION VARIABLE,EXTERNAL;                                   <<0U.EB>>06240000
PROCEDURE RELDATASEG (IX);                                              06245000
   VALUE IX;                                                            06250000
   LOGICAL IX;                                                          06255000
   OPTION EXTERNAL;                                                     06260000
PROCEDURE RELSIR (SIRNUM,A);                                            06265000
   VALUE SIRNUM,A;                                                      06270000
   INTEGER SIRNUM;                                                      06275000
   LOGICAL A;                                                           06280000
   OPTION EXTERNAL;                                                     06285000
INTEGER PROCEDURE REMJTENTRY (N1,N2,N3,TNO,ADR);                        06290000
   VALUE TNO,ADR;                                                       06295000
   BYTE ARRAY N1,N2,N3;                                                 06300000
   INTEGER TNO,ADR;                                                     06305000
   OPTION EXTERNAL;                                                     06310000
DOUBLE PROCEDURE REQSTATUS(LDN);                               <<01115>>06315000
   VALUE LDN; INTEGER LDN;                                     <<01115>>06320000
   OPTION EXTERNAL;                                            <<01115>>06325000
PROCEDURE RESETCRITICAL (OLDVAL);                                       06330000
   VALUE OLDVAL;                                                        06335000
   LOGICAL OLDVAL;                                                      06340000
   OPTION EXTERNAL;                                                     06345000
INTEGER PROCEDURE RETJTENTRY (N1,N2,N3,SIZE,TNO);                       06350000
   BYTE ARRAY N1,N2,N3;                                                 06355000
   INTEGER SIZE;                                                        06360000
   INTEGER ARRAY TNO;                                                   06365000
   OPTION EXTERNAL;                                                     06370000
PROCEDURE Return'Disc'Space (ldev, disc'address,               <<03509>>06375000
                             number'of'sectors);               <<03509>>06380000
   VALUE ldev, disc'address, number'of'sectors;                <<03509>>06385000
   INTEGER ldev;                                               <<03509>>06390000
   DOUBLE disc'address, number'of'sectors;                     <<03509>>06395000
   OPTION EXTERNAL;                                            <<03509>>06400000
PROCEDURE RLOCK (RIN,T);                                                06405000
   VALUE RIN,T;                                                         06410000
   INTEGER RIN;                                                         06415000
   LOGICAL T;                                                           06420000
   OPTION EXTERNAL;                                                     06425000
PROCEDURE RUNLOCK (RIN);                                                06430000
   VALUE RIN;                                                           06435000
   INTEGER RIN;                                                         06440000
   OPTION EXTERNAL;                                                     06445000
LOGICAL PROCEDURE SETCRITICAL;                                          06450000
   OPTION EXTERNAL;                                                     06455000
PROCEDURE SETWAKE (IOQX);                                               06460000
   VALUE IOQX;                                                          06465000
   INTEGER IOQX;                                                        06470000
   OPTION EXTERNAL;                                                     06475000
PROCEDURE SUDDENDEATH (EN);                                             06480000
   VALUE EN;                                                            06485000
   INTEGER EN;                                                          06490000
   OPTION EXTERNAL;                                                     06495000
PROCEDURE SYSTEMDEBUG;                                                  06500000
   OPTION EXTERNAL;                                                     06505000
INTEGER PROCEDURE THISCPU;                                     <<KJ.03>>06510000
    OPTION EXTERNAL;                                           <<KJ.03>>06515000
PROCEDURE UNIMPEDE (PCBPT);                                             06520000
   VALUE PCBPT;                                                         06525000
   INTEGER PCBPT;                                                       06530000
   OPTION EXTERNAL;                                                     06535000
                                                               <<TL.02>>06540000
INTEGER PROCEDURE XRETJTENTRY (N1,N2,N3,SIZE,INFO);                     06545000
   INTEGER SIZE;                                                        06550000
   INTEGER ARRAY INFO;                                                  06555000
   BYTE ARRAY N1,N2,N3;                                                 06560000
   OPTION EXTERNAL;                                                     06565000
PROCEDURE SREMOVEXDD (XDDSUBP);                                         06570000
   VALUE XDDSUBP;                                                       06575000
   INTEGER POINTER XDDSUBP;                                             06580000
   OPTION EXTERNAL;                                                     06585000
DOUBLE PROCEDURE XDDSPOOLINFO (DVAL,ITEM,XDDSUBP);                      06590000
   VALUE   DVAL,ITEM,XDDSUBP;                                           06595000
   LOGICAL ITEM;                                                        06600000
   DOUBLE  DVAL;                                                        06605000
   INTEGER POINTER XDDSUBP;                                             06610000
   OPTION EXTERNAL;                                                     06615000
PROCEDURE MOUNT (VSNAME,VSGROUP,VSACCNT,REQTYPE,GEN,           <<00211>>06620000
                 PVINFO,SOME'OTHER'PIN);                       <<00211>>06625000
    VALUE   GEN,SOME'OTHER'PIN;                                <<00211>>06630000
    INTEGER REQTYPE,GEN,PVINFO,SOME'OTHER'PIN;                 <<00211>>06635000
    BYTE ARRAY VSNAME,VSGROUP,VSACCNT;                         <<23.PV>>06640000
    OPTION VARIABLE,EXTERNAL;                                  <<23.PV>>06645000
                                                               <<23.PV>>06650000
                                                               <<23.PV>>06655000
PROCEDURE DISMOUNT (VSNAME,VSGROUP,VSACCT,REQTYPE,             <<00211>>06660000
                    PVINFO,SOME'OTHER'PIN);                    <<00211>>06665000
    VALUE   PVINFO,SOME'OTHER'PIN;                             <<00211>>06670000
    INTEGER REQTYPE,PVINFO,SOME'OTHER'PIN;                     <<00211>>06675000
    BYTE ARRAY VSNAME,VSGROUP,VSACCT;                          <<23.PV>>06680000
    OPTION EXTERNAL,VARIABLE;                                  <<23.PV>>06685000
                                                               <<23.PV>>06690000
                                                               <<23.PV>>06695000
DOUBLE PROCEDURE DIRECFIND (TYPE, LINKAGE'INDEXP, ANAME,       <<38.PV>>06700000
                            GUNAME, FNAME, PRETURN);           <<RV.PV>>06705000
    VALUE   TYPE, LINKAGE'INDEXP;                              <<38.PV>>06710000
    INTEGER TYPE;                                              <<RV.PV>>06715000
    DOUBLE  LINKAGE'INDEXP;                                    <<38.PV>>06720000
    ARRAY   ANAME, GUNAME, FNAME, PRETURN;                     <<RV.PV>>06725000
    OPTION EXTERNAL;                                           <<RV.PV>>06730000
                                                               <<RV.PV>>06735000
INTRINSIC CLOCK,FREAD,WHO,ASCII;                               <<06727>>06740000
INTRINSIC SEARCH,MYCOMMAND;                                   <<SP.ENV>>06745000
 PROCEDURE HELP  <<FOR DUMMY CALL>>;                           <<00117>>06750000
    OPTION EXTERNAL;                                           <<00117>>06755000
PROCEDURE FCHECK(FILENUM,ERRORCODE,TLOG,BLKNUM,NUMRECS);       <<KS.00>>06760000
   VALUE FILENUM;                                                       06765000
   INTEGER FILENUM,ERRORCODE,TLOG,NUMRECS;                              06770000
   DOUBLE BLKNUM;                                                       06775000
   OPTION VARIABLE,EXTERNAL;                                            06780000
LOGICAL PROCEDURE FBNDCHK(PARM,SIZE,UBND);                              06785000
VALUE PARM,SIZE,UBND;                                                   06790000
INTEGER PARM,SIZE,UBND;                                                 06795000
OPTION EXTERNAL;                                                        06800000
                                                               <<JB.IV>>06805000
PROCEDURE LOCK'CB(FLAGS,STACK'DST,STACK'TARGET,CBVECTOR);      <<06514>>06810000
          VALUE   FLAGS,STACK'DST,STACK'TARGET,CBVECTOR;       <<06514>>06815000
          INTEGER FLAGS,STACK'DST,STACK'TARGET;                <<06514>>06820000
          DOUBLE  CBVECTOR;                                    <<06514>>06825000
          OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;               <<04624>>06830000
                                                               <<04624>>06835000
PROCEDURE UNLOCK'CB( FLAGS, CBVECTOR);                         <<06514>>06840000
             VALUE   FLAGS, CBVECTOR;                          <<06514>>06845000
             INTEGER FLAGS;                                    <<06514>>06850000
             DOUBLE CBVECTOR;                                  <<06514>>06855000
             OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;            <<04624>>06860000
                                                               <<04624>>06865000
DOUBLE PROCEDURE GETFCB'INFO(FCBV,ITEM);                       <<04624>>06870000
VALUE   FCBV,ITEM;                                             <<04624>>06875000
INTEGER ITEM;                                                  <<06514>>06880000
DOUBLE FCBV;                                                   <<06514>>06885000
OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                         <<04624>>06890000
                                                               <<04624>>06895000
PROCEDURE IOMOVE(MODE,TARGET,TCOUNT);                          <<04516>>06900000
   VALUE MODE,TCOUNT;                                          <<04516>>06905000
   INTEGER TCOUNT;                                             <<04516>>06910000
   LOGICAL ARRAY TARGET;                                       <<04516>>06915000
   LOGICAL MODE;                                               <<04516>>06920000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<04516>>06925000
                                                               <<04516>>06930000
PROCEDURE LOC'ACB(DSTX,DQ,FILENUM,FLAGS,SIR,A);                <<04516>>06935000
   VALUE DSTX,DQ,FILENUM,FLAGS,SIR,A;                          <<04516>>06940000
   LOGICAL FLAGS;                                              <<04516>>06945000
   INTEGER DSTX,DQ,FILENUM,SIR,A;                              <<04516>>06950000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL,VARIABLE;             <<04516>>06955000
                                                               <<04516>>06960000
PROCEDURE UNLOC'ACB(DQ,FLAGS);                                 <<04516>>06965000
   VALUE DQ,FLAGS;                                             <<04516>>06970000
   INTEGER DQ;LOGICAL FLAGS;                                   <<04516>>06975000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<04516>>06980000
                                                               <<04516>>06985000
DOUBLE PROCEDURE WAITFORIO(IOQX);                              <<S7505>>06990000
    VALUE IOQX;                                                <<S7505>>06995000
    INTEGER IOQX;                                              <<S7505>>07000000
    OPTION EXTERNAL;                                           <<S7505>>07005000
                                                               <<S7505>>07010000
INTEGER PROCEDURE FQUIESCE'IO(MODE);                           <<04516>>07015000
   VALUE MODE;LOGICAL MODE;                                    <<04516>>07020000
   OPTION PRIVILEGED,UNCALLABLE,EXTERNAL;                      <<04516>>07025000
                                                               <<06862>>07030000
   LOGICAL PROCEDURE SFINDODD(DFID,ODD'OFFSET);                <<06862>>07035000
      VALUE DFID;                                              <<06862>>07040000
      INTEGER DFID,ODD'OFFSET;                                 <<06862>>07045000
      OPTION EXTERNAL;                                         <<06862>>07050000
                                                               <<07273>>07055000
PROCEDURE IOWAITPORT'EXPIRE;                                   <<06864>>07060000
   OPTION EXTERNAL;                                            <<06864>>07065000
                                                               <<06864>>07070000
LOGICAL PROCEDURE STACKCHECK(DST'NUM);                         <<07273>>07075000
VALUE DST'NUM;INTEGER DST'NUM;                                 <<07273>>07080000
                                                               <<07273>>07085000
<<**********************************************************>> <<07273>>07090000
<< STACKCHECK will retrun true if the DST sent is a stack,  >> <<07273>>07095000
<< any stack, not necessarily our own.                      >> <<07273>>07100000
<<**********************************************************>> <<07273>>07105000
                                                               <<07273>>07110000
OPTION EXTERNAL;                                               <<07273>>07115000
$PAGE "MPE-V File System - Utility procedures - LUN "          <<07273>>07120000
<<----------------------------------------------------------------------07125000
*                                                                      *07130000
*  GENERAL UTILITY PROCEDURES                                          *07135000
*                                                                      *07140000
---------------------------------------------------------------------->>07145000
                                                                        07150000
$ CONTROL SEGMENT = FILESYS4                                            07155000
INTEGER PROCEDURE LUN (VTABINX, MVTABX);                       <<RV.PV>>07160000
   <<CONVERTS THE VOLUME TABLE INDEX TO THE LOGICAL DEVICE NUMBER.      07165000
                                                                        07170000
     INPUT VARIABLES:                                                   07175000
         VTABINX - VOLUME TABLE INDEX                                   07180000
         MVTABX  - MOUNTED VOLUME TABLE INDEX                    RV.PV  07185000
                                                                        07190000
     OUTPUT VARIABLES:                                                  07195000
         LUN - LOGICAL DEVICE NUMBER                                    07200000
                                                                        07205000
     NOTE THAT DB IS SET TO THE VOLUME TABLE BUT IS RESET UPON          07210000
     RETURNING>>                                                        07215000
   VALUE VTABINX, MVTABX;                                      <<RV.PV>>07220000
   INTEGER VTABINX, MVTABX;                                    <<RV.PV>>07225000
   OPTION UNCALLABLE,PRIVILEGED;                                        07230000
   BEGIN                                                                07235000
   INTEGER RESULT = LUN;                                                07240000
                                                                        07245000
$  IF X0 = ON                                                           07250000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               07255000
      BEGIN                                                             07260000
      TOS := "LU"; TOS := "N ";                                         07265000
      ASSEMBLE(DZRO,DZRO; DZRO);                                        07270000
      FTITLE(*,*,*,*);                                                  07275000
      DEBUG                                                             07280000
      END;                                                              07285000
$  IF                                                                   07290000
                                                                        07295000
   IF MVTABX <> 0 THEN                                         <<RV.PV>>07300000
   BEGIN  <<GET LDEV FROM MVTAB USING LOCAL VTABINX >>         <<RV.PV>>07305000
       TOS := EXCHANGEDB (MVTABDST);                           <<RV.PV>>07310000
       LUN := MVTAB ((MVTABX*MVTABSZ)+5+((VTABINX-1)*2)).(0:8);<<RV.PV>>07315000
   END ELSE                                                    <<RV.PV>>07320000
   BEGIN                                                       <<RV.PV>>07325000
   TOS := EXCHANGEDB(VTAB);  <<SET DB TO VOLUME TABLE>>                 07330000
   LUN := ADB0(VTABINX*VTABENTRY+12).(0:8);  <<LOGICAL DEV. NR.>>       07335000
   END;                                                        <<RV.PV>>07340000
   ASSEMBLE(ZERO,XCH);                                                  07345000
   EXCHANGEDB(*);  <<RESET DB TO ORIG. DST>>                            07350000
   END;                                                                 07355000
$PAGE "MPE-V FILE SYSTEM - UTILITY PROCEDURES - VTABINX       "<<06272>>07360000
$ CONTROL SEGMENT = FILESYS4                                            07365000
INTEGER PROCEDURE VTABINX (LUN, LOCAL);                        <<RV.PV>>07370000
   <<CONVERTS THE LOGICAL UNIT NUMBER TO THE VOLUME TABLE INDEX.        07375000
                                                                        07380000
     INPUT VARIABLES:                                                   07385000
         LUN - LOGICAL UNIT NUMBER                                      07390000
         LOCAL - IF TRUE THEN LOCAL VTABX MUST BE RETRIEVED      RV.PV  07395000
                 FROM VTAB                                       RV.PV  07400000
                                                                        07405000
     OUTPUT VARIABLES:                                                  07410000
         VTABINX - VOLUME INFO                                          07415000
            VTABINX.(0:8) - VDD HEAD INDEX (VESTIGAL)                   07420000
            VTABINX.(8:8) - VOLUME TABLE INDEX                          07425000
                                                                        07430000
     NOTE THAT DB IS SET TO THE LDT BUT IS RESET UPON                   07435000
     RETURNING>>                                                        07440000
   VALUE LUN, LOCAL;                                           <<RV.PV>>07445000
   INTEGER LUN;                                                         07450000
   LOGICAL LOCAL;                                              <<RV.PV>>07455000
   OPTION UNCALLABLE,PRIVILEGED;                                        07460000
   BEGIN                                                                07465000
   INTEGER RESULT = VTABINX;                                            07470000
                                                                        07475000
$  IF X0 = ON                                                           07480000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               07485000
      BEGIN                                                             07490000
      TOS := "VT"; TOS := "AB"; TOS := "IN"; TOS := "X ";               07495000
      ASSEMBLE(DZRO,DZRO);                                              07500000
      FTITLE(*,*,*,*);                                                  07505000
      DEBUG                                                             07510000
      END;                                                              07515000
$  IF                                                                   07520000
                                                                        07525000
   TOS := EXCHANGEDB(LDTDST);                                  <<06515>>07530000
   TOS := ADB0(LUN*LDTENTRY+1);   ! Obtain volume table index. <<06515>>07535000
   TOS.(0:8) := ADB0(X+3);  <<VDD HEAD INDEX>>                          07540000
   VTABINX := TOS;   << VTAB and VDD head indices >>           <<*****>>07545000
   IF LOCAL THEN                                               <<RV.PV>>07550000
   BEGIN                                                       <<RV.PV>>07555000
       EXCHANGEDB (VTAB);                                      <<RV.PV>>07560000
       RESULT.(8:8) := ADB0 (RESULT.(8:8)*VTABENTRY+13).(4:4); <<RV.PV>>07565000
   END;                                                        <<RV.PV>>07570000
   ASSEMBLE(ZERO,XCH);                                                  07575000
   EXCHANGEDB(*);  <<RESET DB TO ORIG. DST>>                            07580000
   END;                                                                 07585000
$PAGE "MPE-V FILE SYSTEM - UTILITY PROCEDURES - VTABTOLDEV    "<<06272>>07590000
$ CONTROL SEGMENT = FILESYS4                                            07595000
PROCEDURE VTABTOLDEV (TARGET,SOURCE,COUNT,MVTABX);             <<RV.PV>>07600000
   <<MOVES AN EXTENT MAP FROM SOURCE TO TARGET AND CONVERTS THE         07605000
     THE VOLUME TABLE INDEX IN EACH EXTENT DESCRIPTOR INTO A            07610000
     LOGICAL DEVICE NUMBER.                                             07615000
                                                                        07620000
     INPUT VARIABLES:                                                   07625000
         SOURCE - SOURCE EXTENT MAP                                     07630000
         COUNT - NUMBER OF EXTENT ENTRIES                               07635000
         MVTABX- MOUNTED VOLUME TABLE INDEX                      RV.PV  07640000
                                                                        07645000
     OUTPUT VARIABLES:                                                  07650000
         TARGET - TARGET EXTENT MAP                                     07655000
                                                                        07660000
     NOTE THAT SOURCE AND TARGET MAY BE THE SAME MAPS.  ALSO, DB        07665000
     MUST BE SET TO THE STACK WHEN THIS PROCEDURE IS CALLED>>           07670000
   VALUE COUNT,MVTABX;                                         <<RV.PV>>07675000
   DOUBLE ARRAY TARGET,SOURCE;                                          07680000
   INTEGER COUNT,MVTABX;                                       <<RV.PV>>07685000
   OPTION PRIVILEGED,UNCALLABLE;                                        07690000
   BEGIN                                                                07695000
   INTEGER TEMP;                                                        07700000
   BYTE BTEMP = TEMP;                                                   07705000
$  IF X2 = ON                                                           07710000
   INTEGER TEMP1;                                                       07715000
$  IF                                                                   07720000
                                                                        07725000
$  IF X0 = ON                                                           07730000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               07735000
      BEGIN                                                             07740000
      TOS := "VT"; TOS := "AB"; TOS := "TO"; TOS := "LD";               07745000
      TOS := "EV";                                                      07750000
      ASSEMBLE(ZERO,DZRO);                                              07755000
      FTITLE(*,*,*,*);                                                  07760000
      DEBUG                                                             07765000
      END;                                                              07770000
$  IF                                                                   07775000
                                                                        07780000
   X := 0;  <<EXTENT INDEX>>                                            07785000
   TOS := COUNT;  <<NR. EXTENTS>>                                       07790000
   WHILE <> DO                                                          07795000
      BEGIN                                                             07800000
      TOS := SOURCE(X);  <<EXTENT DESCRIPTOR>>                          07805000
      IF <> THEN  <<EXTENT ALLOCATED?>>                                 07810000
         BEGIN                                                          07815000
         TOS := @TEMP;                                                  07820000
         IF MVTABX <> 0 THEN                                   <<RV.PV>>07825000
         BEGIN <<GET LDEV FROM MVTAB USING LOCAL VTABINX>>     <<RV.PV>>07830000
             TOS := MVTABDST;                                  <<RV.PV>>07835000
             TOS := INTEGER ((BS3-1)*2)+5+(MVTABX*MVTABENTRY); <<RV.PV>>07840000
         END ELSE                                              <<RV.PV>>07845000
         BEGIN                                                 <<RV.PV>>07850000
         TOS := VTAB; TOS := BS3*VTABENTRY+12;                          07855000
         END;                                                  <<RV.PV>>07860000
         TOS := 1;                                                      07865000
         ASSEMBLE(MFDS 4);  <<FETCH LDEV>>                              07870000
         BS1 := BTEMP  <<INSERT LDEV>>                                  07875000
         END;                                                           07880000
      TARGET(X) := TOS;  <<FIXED EXTENT DESCRIPTOR>>                    07885000
      ASSEMBLE(INCX,DECA)                                               07890000
      END                                                               07895000
   END;                                                                 07900000
$PAGE "MPE-V FILE SYSTEM - UTILITY PROCEDURES - LDEVTOVTAB    "<<06272>>07905000
$ CONTROL SEGMENT = FILESYS4                                            07910000
PROCEDURE LDEVTOVTAB (TARGET,SOURCE,COUNT,LOCAL);              <<RV.PV>>07915000
   <<MOVES AN EXTENT MAP FROM SOURCE TO TARGET AND CONVERTS THE         07920000
     LOGICAL DEVICE NUMBER IN EACH EXTENT DESCRIPTOR INTO A VOLUME      07925000
     TABLE INDEX.                                                       07930000
                                                                        07935000
     INPUT VARIABLES:                                                   07940000
         SOURCE - SOURCE EXTENT MAP                                     07945000
         COUNT - NUMBER OF EXTENT ENTRIES                               07950000
         LOCAL - IF TRUE THEN LOCAL VTABX MUST BE RETRIEVED      RV.PV  07955000
                 FROM VTAB                                       RV.PV  07960000
                                                                        07965000
     OUTPUT VARIABLES:                                                  07970000
         TARGET - TARGET EXTENT MAP                                     07975000
                                                                        07980000
     NOTE THAT SOURCE AND TARGET MAY BE THE SAME MAPS.  ALSO, DB        07985000
     MUST BE SET TO THE STACK WHEN THIS PROCEDURE IS CALLED>>           07990000
   VALUE COUNT,LOCAL;                                          <<RV.PV>>07995000
   DOUBLE ARRAY TARGET,SOURCE;                                          08000000
   INTEGER COUNT;                                                       08005000
   LOGICAL LOCAL;                                              <<RV.PV>>08010000
   OPTION PRIVILEGED,UNCALLABLE;                                        08015000
   BEGIN                                                                08020000
   INTEGER TEMP;                                                        08025000
                                                               <<06515>>08030000
$  IF X2 = ON                                                           08035000
   INTEGER TEMP1;                                                       08040000
$  IF                                                                   08045000
                                                                        08050000
$  IF X0 = ON                                                           08055000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               08060000
      BEGIN                                                             08065000
      TOS := "LD"; TOS := "EV"; TOS := "TO"; TOS := "VT";               08070000
      TOS := "AB";                                                      08075000
      ASSEMBLE(ZERO,DZRO);                                              08080000
      FTITLE(*,*,*,*);                                                  08085000
      DEBUG                                                             08090000
      END;                                                              08095000
$  IF                                                                   08100000
                                                                        08105000
   X := 0;  <<EXTENT INDEX>>                                            08110000
   TOS := COUNT;  <<NR. EXTENTS>>                                       08115000
   WHILE <> DO                                                          08120000
      BEGIN                                                             08125000
      TOS := SOURCE(X);  <<EXTENT DESCRIPTOR>>                          08130000
      IF <> THEN  <<EXTENT ALLOCATED?>>                                 08135000
         BEGIN                                                          08140000
         TOS := @TEMP;                                                  08145000
         TOS := LDTDST; TOS := BS3*LDTENTRY+1;                 <<06515>>08150000
         TOS := 1;                                                      08155000
         ASSEMBLE(MFDS 4);  <<FETCH VTAB INDEX>>                        08160000
         IF LOCAL THEN                                         <<RV.PV>>08165000
         BEGIN                                                 <<RV.PV>>08170000
             TOS := 0;                                         <<RV.PV>>08175000
             TOS := @S0;                                       <<RV.PV>>08180000
             TOS := VTAB;                                      <<RV.PV>>08185000
             TOS := TEMP*VTABENTRY+13;                         <<06515>>08190000
             TOS := 1;                                         <<RV.PV>>08195000
             ASSEMBLE (MFDS 4);                                <<RV.PV>>08200000
             TEMP := S0.(4:4);                                 <<06515>>08205000
             DEL; <<VTAB WORD 13>>                             <<RV.PV>>08210000
         END;                                                  <<RV.PV>>08215000
         IF TEMP = 0 THEN FTROUBLE(54); ! Volume table index   <<06515>>08220000
         BS1 := TEMP                    ! must be non-zero.    <<06515>>08225000
         END;                                                           08230000
      TARGET(X) := TOS;  <<FIXED EXTENT DESCRIPTOR>>                    08235000
      ASSEMBLE(INCX,DECA)                                               08240000
      END                                                               08245000
   END;                                                                 08250000
$PAGE "MPE-V FILE SYSTEM - UTILITY PROCEDURES - FALTPXFILE    "<<06272>>08255000
$ CONTROL SEGMENT = FILESYS5                                            08260000
INTEGER PROCEDURE FALTPXFILE (SIZE);                                    08265000
                                                               <<04512>>08270000
<<**********************************************************>> <<04512>>08275000
<< FALTPXFILE expands or contracts the PXFILE area and cor- >> <<04512>>08280000
<< rects all table pointers.                                >> <<04512>>08285000
<<                                                          >> <<04512>>08290000
<< INPUT VARIABLES:                                         >> <<04512>>08295000
<<    SIZE - Size in which to change PXFILE. Positive sig-  >> <<06514>>08300000
<<           nifies expand, negative is illegal.            >> <<06514>>08305000
<< OUTPUT VARIABLES:                                           <<04512>>08310000
<<    FALTPXFILE- A term in which to correct pointers into  >> <<04512>>08315000
<<                the PXFILE by calling procedures.         >> <<04512>>08320000
<< CONDITION CODE:                                          >> <<04512>>08325000
<<    CCE - OK!                                             >> <<04512>>08330000
<<    CCL - Error in expansion or contraction was tried.    >> <<06514>>08335000
<<                                                          >> <<04512>>08340000
<< NOTE: DB MUST be set to the stack upon entrance!         >> <<04512>>08345000
<<**********************************************************>> <<04512>>08350000
                                                               <<04512>>08355000
   VALUE SIZE;                                                          08360000
   INTEGER SIZE;                                                        08365000
   OPTION PRIVILEGED,UNCALLABLE;                                        08370000
   BEGIN                                                                08375000
   INTEGER POINTER                                             <<04512>>08380000
      PXFILE,      << Current PXFILE DB-rel. pointer.       >> <<04512>>08385000
      NEWAFT,      << New AFT DB-rel pointer.               >> <<04512>>08390000
      OLDAFT;      << Starting address of old AFT           >> <<04512>>08395000
   EQUATE                                                      <<04512>>08400000
      SUCCESSFUL=0;<< Successful call to ALTPXFILESIZE.     >> <<04512>>08405000
                                                                        08410000
$  IF X0 = ON                                                           08415000
   IF MONOTHER THEN  <<MONITORING?>>                                    08420000
      BEGIN                                                             08425000
      TOS := "FA"; TOS := "LT"; TOS := "PX"; TOS := "FI";               08430000
      TOS := "LE";                                                      08435000
      ASSEMBLE(ZERO,DZRO);                                              08440000
      FTITLE(*,*,*,*);                                                  08445000
      DEBUG                                                             08450000
      END;                                                              08455000
$  IF                                                                   08460000
                                                                        08465000
   SETPXFILE;        << Set PXFILE pointer.                 >> <<06514>>08470000
   IF SIZE < 0 THEN                                            <<06514>>08475000
      CONDCODE := CCL                                          <<06514>>08480000
   ELSE                                                        <<04512>>08485000
      BEGIN                       << Expansion              >> <<04512>>08490000
      SIZE := ((SIZE+127)/128)*128;  << Round up 128X       >> <<06514>>08495000
      IF ALTPXFILESIZE(SIZE) <> SUCCESSFUL  THEN               <<04512>>08500000
         CONDCODE := CCL                                       <<04512>>08505000
      ELSE                                                     <<04512>>08510000
         BEGIN                                                 <<04512>>08515000
                                                               <<04958>>08520000
         << The PXFILE area has now been expanded, must now  >><<04958>>08525000
         << move the AFT to begin at DL-5 (DL-1...DL-4 are   >><<04958>>08530000
         << the PXarea ptrs). Negative move count will move  >><<04958>>08535000
         << starting with AFT 1 to DL-5 ... AFT n to DL-5-m. >><<04958>>08540000
                                                               <<04958>>08545000
         SETPXFILE;         << Reset to new pointer.        >> <<04512>>08550000
         PUSH(DL);          << Find the new DL             >>  <<04958>>08555000
         @NEWAFT := TOS - 5;                                   <<04958>>08560000
         @OLDAFT := @NEWAFT - SIZE;                            <<04512>>08565000
         MOVE NEWAFT := OLDAFT, (-PXFAFTSIZE);                 <<04958>>08570000
         FALTPXFILE := -SIZE;   << Correction Term.         >> <<04512>>08575000
         END;                                                  <<04512>>08580000
      END;                                                     <<04512>>08585000
   END;                                                                 08590000
$PAGE "MPE-V FILE SYSTEM - UTILITY PROCEDURES - IOSTAT        "<<06513>>08595000
$ CONTROL SEGMENT = FILESYS4                                            08600000
INTEGER PROCEDURE IOSTAT(STAT);                                         08605000
   << Converts an ATTACHIO error number into a file system error        08610000
     number.  Only the right eight bits of the error word are           08615000
     used.                                                              08620000
                                                                        08625000
     Input variable:                                                    08630000
         STAT - ATTACHIO error word                                     08635000
                                                                        08640000
     Output variable:                                                   08645000
         IOSTAT - File system error number                              08650000
                                                                        08655000
     This procedure may be called with DB anywhere.  >>                 08660000
                                                                        08665000
VALUE STAT;                                                             08670000
INTEGER STAT;                                                           08675000
OPTION UNCALLABLE;                                                      08680000
   BEGIN                                                                08685000
   INTEGER ARRAY MAP(*) =PB :=                                          08690000
                                                                        08695000
   << 0, %10, ... %370 -- Pending.  Not normally reported >>            08700000
                                                                        08705000
      UNUSED,INVOP,INVOP,INVOP,INVOP,INVOP,UNUSED,UNUSED,               08710000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08715000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08720000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08725000
                                                                        08730000
   << 1, %11, ... %371 -- Successful >>                                 08735000
                                                                        08740000
      UNUSED,EOL,TAPERREC,EOT,UNUSED,UNUSED,UNUSED,UNUSED,              08745000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08750000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08755000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08760000
                                                                        08765000
   << 2, %12, ... %372 -- End of File >>                                08770000
                                                                        08775000
      EOF,EOF,EOF,EOF,EOF,EOF,EOF,EOF,                                  08780000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08785000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08790000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08795000
                                                                        08800000
   << 3, %13, ... %373 -- Unusual Conditions >>                         08805000
                                                                        08810000
      UNUSED,DATAPAR,SOFTIMEOUT,SOFTABORT,DATALOST,NOTREADY,POWERFAILED,08815000
         BOT,                                                           08820000
      RUNAWAY,EOT,UNUSED,UNUSED,PLIMIT,BADESCAPE,TIMEROVERFLOW,         08825000
         BROKENREAD,                                                    08830000
      UNUSED,DEVPWRUP,BOT,UNUSED,UNUSED,UNUSED,UNUSED,VFCRESET,         08835000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,          08840000
                                                                        08845000
   << 4, %14, ... %374 -- Irrecoverable error >>                        08850000
                                                                        08855000
      INVOP,TRANSERR,IOTIMEOUT,TIMERR,SIOFAIL,UNITFAIL,INVDISKADR,      08860000
         TAPERR,                                                        08865000
      SYSTEM,PTAPERR,SYSTEM,SYSTEM,SIOFAIL,BLANK'MEDIA,        <<03561>>08870000
        NO'SPARES, DLTDREC,                                    <<03561>>08875000
      NAVAILDEV, UNUSED, UNUSED, UNUSED, UNUSED, UNUSED,       <<03561>>08880000
        UNUSED, UNUSED,                                        <<03561>>08885000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED, <<6029>> 08890000
                                                                        08895000
   << 5, %15, ... %375 -- LYNX data control info error >>      <<6029>> 08900000
                                                               <<6029>> 08905000
      BADITEM,BADACCESS,UNUSED,PARITYERR,INVFORMAT,CHKSUMERR,  <<6029>> 08910000
         VALLTMIN,VALGTMAX,                                    <<6029>> 08915000
     VALUNSUP,CNTINSUF,CNTTOOBIG,UNUSED,OTHERFXN,UNUSED,UNUSED,<<6029>> 08920000
         UNUSED,                                               <<6029>> 08925000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED, <<6029>> 08930000
      UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED,UNUSED; <<6029>> 08935000
                                                               <<6029>> 08940000
$  IF X0 = ON                                                           08945000
   IF MONOTHER THEN                                                     08950000
      BEGIN                                                             08955000
      FTITLE("IOST","AT  ",0D,0D);                                      08960000
      DEBUG                                                             08965000
      END;                                                              08970000
$  IF                                                                   08975000
                                                                        08980000
   IF STAT.(13:3) > 5 THEN                                     <<6029>> 08985000
      TOS := UNUSED      << number unassigned >>                        08990000
   ELSE              << valid error numbers >>                          08995000
      TOS := MAP(STAT.(13:3)*%40+STAT.(8:5));  << convert >>            09000000
   IOSTAT := TOS    << FS error nr. >>                                  09005000
   END;          << procedure IOSTAT >>                                 09010000
$PAGE "MPE-V FILE SYSTEM - FTROUBLE - DIE! DIE! DIE! DIE! DIE!"<<06513>>09015000
$ CONTROL SEGMENT = FILESYS4                                            09020000
PROCEDURE FTROUBLE (CODE);                                              09025000
   VALUE CODE;                                                          09030000
   INTEGER CODE;                                                        09035000
   OPTION PRIVILEGED,UNCALLABLE;                                        09040000
   BEGIN                                                                09045000
                                                                        09050000
$  IF X0 = ON                                                           09055000
   IF MONOTHER THEN  <<MONITORING?>>                                    09060000
      BEGIN                                                             09065000
      TOS := "FT"; TOS := "RO"; TOS := "UB"; TOS := "LE";               09070000
      ASSEMBLE(DZRO,DZRO);                                              09075000
      FTITLE(*,*,*,*);                                                  09080000
      DEBUG                                                             09085000
      END;                                                              09090000
$  IF                                                                   09095000
                                                                        09100000
  SUDDENDEATH(CODE);                                           <<KJ.03>>09105000
   END;                                                                 09110000
$ CONTROL SEGMENT = FILESYS4                                            09115000
$PAGE "MPE-V FILE SYSTEM - UTILITY PROCEDURES - FTITLE        "<<06513>>09120000
PROCEDURE FTITLE (T1,T2,T3,T4);                                         09125000
   <<PRINTS THE SPECIFIED FILE SYSTEM PROCEDURE NAME ON $STDLIST.  THE  09130000
     NAME (AT MOST 15 CHARACTERS LONG) MUST BE TERMINATED BY 0 OR A     09135000
     BLANK.                                                             09140000
                                                                        09145000
     INPUT VARIABLES:                                                   09150000
         T1 - PROCEDURE NAME (FIRST 4 CHARACTERS)                       09155000
         T2 - PROCEDURE NAME (SECOND 4 CHARACTERS)                      09160000
         T3 - PROCEDURE NAME (THIRD 4 CHARACTERS)                       09165000
         T4 - PROCEDURE NAME (LAST 4 CHARACTERS)                        09170000
                                                                        09175000
     NOTE THAT DB MAY BE SET TO ANY DATA SEGMENT.  IT WILL BE SET TO THE09180000
     STACK AND THEN RESET BEFORE RETURNING TO THE CALLER>>              09185000
   VALUE T1,T2,T3,T4;                                                   09190000
   DOUBLE T1,T2,T3,T4;                                                  09195000
   OPTION PRIVILEGED,UNCALLABLE;                                        09200000
   BEGIN                                                                09205000
   INTEGER ARRAY TITLE (*) = T1;  <<PROCEDURE NAME>>                    09210000
   INTEGER DST;         ! Original DST number.                 <<06513>>09215000
   INTEGER PCBGLOBLOC;  ! PCBX Q-relative offset.              <<06513>>09220000
   INTEGER CHARS;       ! Number of characters in name.        <<06513>>09225000
                                                                        09230000
   DST := EXCHANGEDB(0);                                       <<06513>>09235000
   PXGLOBAL;             ! Initialize PCBGLOBLOC.              <<06513>>09240000
   CHARS := @TITLE&LSL(1);  ! Pointer to name.                 <<06513>>09245000
   TOS   := CHARS;                                             <<06513>>09250000
   SCAN BPS0 UNTIL " ",1;  <<STOP ON 0 OR BLANK>>                       09255000
   TOS := TOS-TOS;  <<NEG. NR. CHAR'S>>                                 09260000
   ATTACHIO(PXG'OUTPUTLDEV,0,0,@TITLE,1,CHARS,0,0,BFLAGS);     <<06513>>09265000
   EXCHANGEDB(DST)  <<RESET DB>>                                        09270000
   END;                                                                 09275000
$PAGE "MPE-V  FILE SYSTEM - LOC'VTENTRY "                      <<07273>>09280000
$CONTROL SEGMENT = FILESYS1                                    <<07273>>09285000
PROCEDURE LOC'VTENTRY(DQ,CBVECTOR);                            <<07273>>09290000
VALUE DQ,CBVECTOR;                                             <<07273>>09295000
INTEGER DQ;                                                    <<07273>>09300000
DOUBLE CBVECTOR;                                               <<07273>>09305000
                                                               <<57875>>09310000
OPTION PRIVILEGED, UNCALLABLE;                                 <<57875>>09315000
                                                               <<07273>>09320000
!------------------------------------------------------------- <<07273>>09325000
! This procedure copies the vector table entry of the          <<07273>>09330000
! given CB vector into the users Q-relative array.             <<07273>>09335000
!                                                              <<07273>>09340000
! Input variables:                                             <<07273>>09345000
!     DQ   - Callers Q-relative location of VT array.          <<07273>>09350000
!     CBVECTOR - CB vector, could be LACB or PACB              <<07273>>09355000
!------------------------------------------------------------- <<07273>>09360000
                                                               <<07273>>09365000
BEGIN                                                          <<07273>>09370000
INTEGER                                                        <<07273>>09375000
   PCBPT,                   ! For PCB defines.                 <<07273>>09380000
   STACKDST,                ! DST number of our stack.         <<07273>>09385000
   PXFILE'OFFSET := 0,      ! Stack rel. offset to PXFILE.     <<07273>>09390000
   PXCBT'OFFSET  := 0,      ! Stack rel. offset to CBTAB.      <<07273>>09395000
   PCBGLOBLOC;              ! Q relative offset to PXGLOB.     <<07273>>09400000
INTEGER                                                        <<07273>>09405000
   CBVECTOR'DSTN       = CBVECTOR + 0,                         <<07273>>09410000
   CBVECTOR'ENTRY      = CBVECTOR + 1;                         <<07273>>09415000
                                                               <<07273>>09420000
DQ := DQ - DELTAQ;          ! Our Q-relative offset to VT.     <<07273>>09425000
PCBPT := CURPRC;            ! Get current process pointer.     <<07273>>09430000
STACKDST := SPCBSTKDST;     ! Obtain stack num. from PCB.      <<07273>>09435000
                                                               <<07273>>09440000
!----------------------------------------------------------    <<07273>>09445000
! If the CB lives in our stack, then set PXCBT'OFFSET to       <<07273>>09450000
! the stack relative offset to the CBT for the MDS later.      <<07273>>09455000
!----------------------------------------------------------    <<07273>>09460000
                                                               <<07273>>09465000
IF CBVECTOR'DSTN = STACKDST THEN                               <<07273>>09470000
   BEGIN                                                       <<07273>>09475000
   GET'PXFILE'OFFSET;       ! Sets PXFILE'OFFSET for stack.    <<07273>>09480000
   PXCBT'OFFSET := PXFILE'OFFSET + PXFOVERHEAD;                <<07273>>09485000
   END;                                                        <<07273>>09490000
                                                               <<07273>>09495000
!----------------------------------------------------------    <<07273>>09500000
! Now copy the vector table entry to the Q-rel array.          <<07273>>09505000
! PXCBT'OFFSET will be zero for CB's in extra data segs.       <<07273>>09510000
!----------------------------------------------------------    <<07273>>09515000
                                                               <<07273>>09520000
PXGLOBAL;                   ! Get Q-rel offset to PXGLOB.      <<07273>>09525000
TOS := STACKDST;            ! Goes to our stack.               <<07273>>09530000
TOS := DQ-PCBGLOBLOC;       ! Stack relative offset to VT.     <<07273>>09535000
TOS := CBVECTOR'DSTN;       ! Vector DST and offset.           <<07273>>09540000
TOS := CBVECTOR'ENTRY + PXCBT'OFFSET;                          <<07273>>09545000
TOS := VTENTRY;             ! Vector table entry size.         <<07273>>09550000
MOVE'DS'5;                  ! Off they go!                     <<07273>>09555000
END;                                                           <<07273>>09560000
$ PAGE "MPE-V FILE SYSTEM - LOCK'CBT "                         <<06514>>09565000
<<----------------------------------------------------------------------09570000
*                                                                      *09575000
*  GENERAL CONTROL BLOCK MAINTENANCE PROCEDURES                         09580000
*                                                                      *09585000
---------------------------------------------------------------------->>09590000
                                                                        09595000
$ CONTROL SEGMENT = FILESYS1                                            09600000
PROCEDURE LOCK'CBT(CBTAB);                                     <<06514>>09605000
VALUE CBTAB;                                                   <<06514>>09610000
INTEGER POINTER CBTAB;                                         <<06514>>09615000
                                                               <<57875>>09620000
OPTION PRIVILEGED, UNCALLABLE;                                 <<57875>>09625000
                                                               <<06514>>09630000
<<**********************************************************>> <<06514>>09635000
<< This procedure is called by FCREATECB and FDELETECB to   >> <<06514>>09640000
<< lock a Control Block Table.  It simply checks the lock   >> <<06514>>09645000
<< bits.  If the CBT is not locked, it is locked. If the    >> <<06514>>09650000
<< CBT is already locked, then the process impedes in a     >> <<06514>>09655000
<< queue.  No lock count is kept because this is done only  >> <<06514>>09660000
<< once for any CBT when a Control Block is being entered   >> <<06514>>09665000
<< or deleted from a CB table.                              >> <<06514>>09670000
<<                                                          >> <<06514>>09675000
<< Input variable:                                          >> <<06514>>09680000
<<    CBTAB - An integer pointer to the Control Block Table.>> <<06514>>09685000
<<                                                          >> <<06514>>09690000
<< DB must be set to the DST containing the control block.  >> <<06514>>09695000
<< If we are dealing with an extra data segment, then the   >> <<06514>>09700000
<< CBTAB pointer will be zero.  If we are dealing with the  >> <<06514>>09705000
<< PXFILE CB table, then the pointer will be DB negative    >> <<06514>>09710000
<< pointing to the CB table in the PXFILE area.             >> <<06514>>09715000
<<**********************************************************>> <<06514>>09720000
                                                               <<06514>>09725000
BEGIN                                                          <<06514>>09730000
INTEGER                                                        <<06514>>09735000
   MY'PIN,    << My PIN number.                             >> <<06514>>09740000
   PCBPT;     << Pointer to PCB for defines.                >> <<06514>>09745000
                                                               <<06514>>09750000
PSEUDODISABLE;<< Insure mutual exclusion to lock words.     >> <<06514>>09755000
MY'PIN := CURPRC;                                              <<06514>>09760000
IF NOT CBTLOCK THEN                                            <<06514>>09765000
   BEGIN      << Control block table is not currenty locked.>> <<06514>>09770000
   CBTLOCK'BIT := 1;                                           <<06514>>09775000
   CBTPIN := MY'PIN;                                           <<06514>>09780000
   PSEUDOENABLE;                                               <<06514>>09785000
   END                                                         <<06514>>09790000
ELSE                                                           <<06514>>09795000
   BEGIN      << Locked, must impede on the control block.  >> <<06514>>09800000
   IF CBTHEAD = 0 THEN                                         <<06514>>09805000
      BEGIN   << No one else is waiting, we're at head.     >> <<06514>>09810000
      CBTHEAD := MY'PIN;                                       <<06514>>09815000
      CBTTAIL := MY'PIN;                                       <<06514>>09820000
      END                                                      <<06514>>09825000
   ELSE                                                        <<06514>>09830000
      BEGIN   << Wasn't empty, go to end of queue.          >> <<06514>>09835000
      PCBPT := CBTTAIL;                                        <<06514>>09840000
      SPCBNIMPPIN := MY'PIN;                                   <<06514>>09845000
      CBTTAIL := MY'PIN;                                       <<06514>>09850000
      END;                                                     <<06514>>09855000
   IMPEDE(0); << Go to sleep, go to sleep my pretty baby.   >> <<06514>>09860000
   END;                                                        <<06514>>09865000
END;                                                           <<06514>>09870000
$ PAGE "MPE-V FILE SYSTEM - UNLOCK'CBT "                       <<06514>>09875000
PROCEDURE UNLOCK'CBT(CBTAB);                                   <<06514>>09880000
VALUE CBTAB;                                                   <<06514>>09885000
INTEGER POINTER CBTAB;                                         <<06514>>09890000
                                                               <<57875>>09895000
OPTION PRIVILEGED, UNCALLABLE;                                 <<57875>>09900000
                                                               <<57875>>09905000
                                                               <<06514>>09910000
<<**********************************************************>> <<06514>>09915000
<< This procedure is called by FCREATECB and FDELETECB to   >> <<06514>>09920000
<< unlock a control block table.  If there is anyone wait-  >> <<06514>>09925000
<< ing on the CBT, then the head PIN will be unimpeded.     >> <<06514>>09930000
<< No lock count is kept since the CBT is only locked once  >> <<06514>>09935000
<< when a Control Block is entered into or deleted from the >> <<06514>>09940000
<< Control Block Table.                                     >> <<06514>>09945000
<<                                                          >> <<06514>>09950000
<< Input variable:                                          >> <<06514>>09955000
<<    CBTAB - An integer pointer to the CB table.           >> <<06514>>09960000
<<                                                          >> <<06514>>09965000
<< DB must be set to the DST containing the control block.  >> <<06514>>09970000
<< If we are dealing with an extra data segment, then the   >> <<06514>>09975000
<< CBTAB pointer will be zero.  If we are dealing with the  >> <<06514>>09980000
<< PXFILE CB table, then the pointer will be DB negative    >> <<06514>>09985000
<< pointing to the CB table in the PXFILE area.             >> <<06514>>09990000
<<**********************************************************>> <<06514>>09995000
                                                               <<06514>>10000000
BEGIN                                                          <<06514>>10005000
INTEGER                                                        <<06514>>10010000
   MY'PIN,    << My PIN number.                             >> <<06514>>10015000
   NEXT'PIN,  << Next PIN unimpeded for CBT.                >> <<06514>>10020000
   PCBPT;     << Pointer used for PCB defines.              >> <<06514>>10025000
                                                               <<06514>>10030000
PSEUDODISABLE;<< Insure mutual exclusion to lock words.     >> <<06514>>10035000
MY'PIN := CURPRC;                                              <<06514>>10040000
IF NOT CBTLOCK OR CBTPIN <> MY'PIN                             <<06514>>10045000
   THEN FTROUBLE(50);  << Trying to unlock a CBT not locked.>> <<06514>>10050000
                                                               <<06514>>10055000
IF CBTHEAD = 0 THEN                                            <<06514>>10060000
   BEGIN      << No one waiting, clear lock words and leave.>> <<06514>>10065000
   CBTLOCK'BIT := 0;                                           <<06514>>10070000
   CBTPIN := 0;                                                <<06514>>10075000
   END                                                         <<06514>>10080000
ELSE                                                           <<06514>>10085000
   BEGIN      << Unimpede the next process.                 >> <<06514>>10090000
   NEXT'PIN := PCBPT := CBTHEAD;   << Head PIN runx next.   >> <<06514>>10095000
   IF CBTHEAD = CBTTAIL THEN                                   <<06514>>10100000
      BEGIN               << No one else is waiting.        >> <<06514>>10105000
      CBTHEAD := 0;       << Clear waiting Queue.           >> <<06514>>10110000
      CBTTAIL := 0;                                            <<06514>>10115000
      END                                                      <<06514>>10120000
   ELSE       << Head becomes next in line, linked to NEXT. >> <<06514>>10125000
      CBTHEAD := SPCBNIMPPIN;                                  <<06514>>10130000
   SPCBNIMPPIN := 0;      << Clear the next impeded PIN.    >> <<06514>>10135000
   CBTPIN := NEXT'PIN;    << Next PIN is current PIN.       >> <<06514>>10140000
   UNIMPEDE(NEXT'PIN);    << Wake the chump up.             >> <<06514>>10145000
   END;                                                        <<06514>>10150000
PSEUDOENABLE;                                                  <<06514>>10155000
END;                                                           <<06514>>10160000
$PAGE "MPE-V CONTROL BLOCK LOCKING - COND'LOCK'CB "            <<06514>>10165000
PROCEDURE COND'LOCK'ACB(CBVECTOR,FMAVT'VAL,FI'VAL);            <<06514>>10170000
VALUE CBVECTOR,FMAVT'VAL,FI'VAL;                               <<06514>>10175000
INTEGER FMAVT'VAL,FI'VAL;                                      <<06514>>10180000
DOUBLE CBVECTOR;                                               <<06514>>10185000
OPTION VARIABLE, PRIVILEGED, UNCALLABLE;                       <<57875>>10190000
                                                               <<06514>>10195000
!------------------------------------------------------------- <<06514>>10200000
! This procedure conditionally locks the ACB.  Conditional     <<06514>>10205000
! lock means that the FMAVT SIR and possibly the FISIR must be <<06514>>10210000
! released before impeding on the ACB so as not to tie up the  <<06514>>10215000
! SIR(s) while we are waiting on the ACB.  Anywhere that the   <<06514>>10220000
! FMAVT is obtained must conditionally lock the ACB.  FOPEN is <<06514>>10225000
! a special case because it obtains both SIRs.                 <<06514>>10230000
!                                                              <<06514>>10235000
! Input variables:                                             <<06514>>10240000
!    CBVECTOR - ACB control block vector.                      <<06514>>10245000
!    FMAVT'VAL - Return parm from GETSIR.                      <<06514>>10250000
!    FI'VAL       -  "   "     "    "                          <<06514>>10255000
!------------------------------------------------------------- <<06514>>10260000
                                                               <<06514>>10265000
BEGIN                                                          <<06514>>10270000
INTEGER                                                        <<06514>>10275000
   FLAGS := 0;           << Sent to LOCK'CB for conditional.>> <<06514>>10280000
LOGICAL                                                        <<06514>>10285000
   PMAP  = Q-4;                                                <<06514>>10290000
DEFINE                                                         <<06514>>10295000
   FISIR'SENT = PMAP.(15:1)#;                                  <<06514>>10300000
                                                               <<06514>>10305000
FLAGS.(1:1) := 1;        << Set conditional lock bit.       >> <<06514>>10310000
LOCK'CB(FLAGS,0,0,CBVECTOR);                                   <<06514>>10315000
IF CARRY THEN                                                  <<06514>>10320000
   BEGIN                 << ACB already locked, release SIR.>> <<06514>>10325000
   IF FISIR'SENT                                               <<06514>>10330000
      THEN RELSIR(FISIR,FI'VAL);                               <<06514>>10335000
   RELSIR(FMAVTSIR,FMAVT'VAL);                                 <<06514>>10340000
   IMPEDE(0);            << Go to sleep my pretty baby.     >> <<06514>>10345000
   GETSIR(FMAVTSIR);     << Get that SIR back.              >> <<06514>>10350000
   IF FISIR'SENT                                               <<06514>>10355000
      THEN GETSIR(FISIR);                                      <<06514>>10360000
   END;                                                        <<06514>>10365000
ASSEMBLE(DDEL,DDEL;DEL); << Delete LOCK'CB return parms.    >> <<06514>>10370000
END;                     << That's all there is to it!      >> <<06514>>10375000
$PAGE "MPE-V CONTROL BLOCK LOCKING - FGET'CB      "            <<06514>>10380000
INTEGER PROCEDURE FGET'CB(CBVECTOR,FLAGS,FMAVT'SIR,A);         <<06514>>10385000
VALUE CBVECTOR,FLAGS,FMAVT'SIR,A;                              <<06514>>10390000
INTEGER FMAVT'SIR,A;                                           <<06514>>10395000
LOGICAL FLAGS;                                                 <<06514>>10400000
DOUBLE CBVECTOR;                                               <<06514>>10405000
OPTION VARIABLE;                                               <<06514>>10410000
                                                               <<06514>>10415000
<<**********************************************************>> <<06514>>10420000
<< FGET'CB takes the control vector sent (ACB in all present>> <<06514>>10425000
<< cases) and calculates the DB relative offset to the CB   >> <<06514>>10430000
<< in question.  The CB could be in our stack in an extra   >> <<06514>>10435000
<< data segment.  If lock has been requested, it then locks >> <<06514>>10440000
<< the control block and then sets DB to the CB DST.        >> <<06514>>10445000
<<                                                          >> <<06514>>10450000
<< Input variables:                                         >> <<06514>>10455000
<<    CBVECTOR - Control block vector to "get".             >> <<06514>>10460000
<<    FLAGS    - (15:1) on if control block to be locked.   >> <<06514>>10465000
<<    FMAVT'SIR,A - SIR and return parm.                    >> <<06514>>10470000
<<                                                          >> <<06514>>10475000
<< Note: DB must be set to the stack upon entrance and will >> <<06514>>10480000
<< be set to the DST containing the CB (if in an extra data >> <<06514>>10485000
<< segment, otherwise DB will remain at the stack.)         >> <<06514>>10490000
<<**********************************************************>> <<06514>>10495000
                                                               <<06514>>10500000
BEGIN                                                          <<06514>>10505000
<< VT array must be at Q+1 unless VTMQ equate is changed.   >> <<06514>>10510000
INTEGER ARRAY VT(0:VTENTRY) = Q;   << Vector table entry.   >> <<06514>>10515000
EQUATE VTMQ = 1;                   << Q-rel offset to VT.   >> <<06514>>10520000
INTEGER                                                        <<06514>>10525000
   PMAP = Q-4,                                                 <<06514>>10530000
   PCBPT,                 << Pointer to PCB for defines.    >> <<06514>>10535000
   STACKDST,              << Our stack DST number.          >> <<06514>>10540000
   PXFILE'OFFSET,         << Stack rel. offset to PXFILE.   >> <<06514>>10545000
   PXCBT'OFFSET,          << Stack rel. offset ot PXCB area.>> <<06514>>10550000
   PCBGLOBLOC;            << Q-rel offset to PXGLOBAL.      >> <<06514>>10555000
INTEGER                                                        <<06514>>10560000
   CBVECTOR'DSTN       = CBVECTOR + 0,                         <<06514>>10565000
   CBVECTOR'ENTRY      = CBVECTOR + 1;                         <<06514>>10570000
DEFINE                                                         <<06514>>10575000
   LOCK'REQUESTED = FLAGS.(15:1)#,                             <<06514>>10580000
   COND'LOCK      = PMAP.(14:2) = 3#;                          <<06514>>10585000
                                                               <<06514>>10590000
PCBPT := CURPRC;                                               <<06514>>10595000
STACKDST := SPCBSTKDST;                                        <<06514>>10600000
GET'PXFILE'OFFSET;        << Stack rel offset to PXFILE.    >> <<06514>>10605000
PXCBT'OFFSET := PXFILE'OFFSET + PXFOVERHEAD;                   <<06514>>10610000
                                                               <<06514>>10615000
<< Get the ACB vector table address.                        >> <<06514>>10620000
                                                               <<06514>>10625000
LOC'VTENTRY(VTMQ,CBVECTOR);                                    <<06514>>10630000
                                                               <<06514>>10635000
<< Now calculate the DB offset to ACB.                      >> <<06514>>10640000
                                                               <<06514>>10645000
IF CBVECTOR'DSTN <> STACKDST THEN                              <<06514>>10650000
   FGET'CB := VT'ADR      << Easy case, in extra data seg.  >> <<06514>>10655000
ELSE                                                           <<06514>>10660000
   BEGIN                  << A bit difficult, in stack.     >> <<06514>>10665000
   PXGLOBAL;              << Get PXGLOBAL offset.           >> <<06514>>10670000
   FGET'CB := (PXCBT'OFFSET + VT'ADR) - PXG'RELATIVE'DB;       <<06514>>10675000
   END;                                                        <<06514>>10680000
                                                               <<06514>>10685000
<< Now lock the control block if needed, maybe conditional. >> <<06514>>10690000
                                                               <<06514>>10695000
IF LOCK'REQUESTED THEN                                         <<06514>>10700000
   IF COND'LOCK THEN                                           <<06514>>10705000
      COND'LOCK'ACB(CBVECTOR,A)                                <<06514>>10710000
   ELSE                                                        <<06514>>10715000
      BEGIN                                                    <<06514>>10720000
      LOCK'CB(0,0,0,CBVECTOR);                                 <<06514>>10725000
      ASSEMBLE(DDEL,DDEL;DEL); << Delete all return parms.  >> <<06514>>10730000
      END;                                                     <<06514>>10735000
                                                               <<06514>>10740000
<< Not set DB to the DST containing the control block.      >> <<06514>>10745000
                                                               <<06514>>10750000
IF CBVECTOR'DSTN <> STACKDST                                   <<06514>>10755000
   THEN EXCHANGEDB(CBVECTOR'DSTN);                             <<06514>>10760000
                                                               <<06514>>10765000
END;                                                           <<06514>>10770000
$PAGE "FCREATECB Procedure"                                    <<C8485>>10775000
$CONTROL SEGMENT = FILESYS5                                    <<C8485>>10780000
                                                               <<C8485>>10785000
PROCEDURE FCREATECB (CB, CBVECTOR, STRATEGY, SIZE, TYPE);      <<C8485>>10790000
<<*********************************************************>>  <<C8485>>10795000
<< Finds space in a control block table for a control block>>  <<C8485>>10800000
<< of the specified size and type.  The control block will >>  <<C8485>>10805000
<< be returned locked if successfully created.  If any     >>  <<C8485>>10810000
<< error occurs, DB will remain at the stack and not       >>  <<C8485>>10815000
<< datastructure will be locked.                           >>  <<C8485>>10820000
<<                                                         >>  <<C8485>>10825000
<< Input variables:                                        >>  <<C8485>>10830000
<<   Strategy - Control block table insertion strategy     >>  <<C8485>>10835000
<<      0 - Use the PXFILE control block table             >>  <<C8485>>10840000
<<     -1 - Use/create a suer (NOBUF) control block table  >>  <<C8485>>10845000
<<     -2 - Use/create a system control block table        >>  <<C8485>>10850000
<<     -3 - Create a non-expandable control block table    >>  <<C8485>>10855000
<<     -4 - Try strategy 0, then try strategy -1           >>  <<C8485>>10860000
<<    -69 - Create a user control block table for UCOP     >>  <<C8485>>10865000
<<   SIZE - Size of control block in words                 >>  <<C8485>>10870000
<<   TYPE - Type of control block                          >>  <<C8485>>10875000
<<                                                         >>  <<C8485>>10880000
<< Output variables:                                       >>  <<C8485>>10885000
<<    CB  - DB relative pointer to the control block       >>  <<C8485>>10890000
<<    CBVECTOR - Control block vector                      >>  <<C8485>>10895000
<<                                                         >>  <<C8485>>10900000
<<  Condition Code:                                        >>  <<C8485>>10905000
<<     CCE - All went well                                 >>  <<C8485>>10910000
<<     CCL - Could not get the control block for one of the>>  <<C8485>>10915000
<<           following reasons:                            >>  <<C8485>>10920000
<<           * No room in the vector table                 >>  <<C8485>>10925000
<<           * No room in the CBT                          >>  <<C8485>>10930000
<<           * Could not expand DST                        >>  <<C8485>>10935000
<<           * Could not allocate a new dst                >>  <<C8485>>10940000
<<           * All user CBT's are full                     >>  <<C8485>>10945000
<<                                                         >>  <<C8485>>10950000
<< IMPORTANT SIDE EFFECT WARNING:                          >>  <<C8485>>10955000
<<   All output variables are returned by a partial cut-   >>  <<C8485>>10960000
<<   back of the stack.  Also, DB MUST be set to the stack >>  <<C8485>>10965000
<<   upon enterance.  If and only if successful, DB will   >>  <<C8485>>10970000
<<   be set to the DST containing the new control block,   >>  <<C8485>>10975000
<<   either the stack or an extra data segment.            >>  <<C8485>>10980000
<<   IF an error occurrs, DB will remain at the stack      >>  <<C8485>>10985000
<<*********************************************************>>  <<C8485>>10990000
                                                               <<C8485>>10995000
VALUE CB, CBVECTOR, STRATEGY, SIZE, TYPE;                      <<C8485>>11000000
INTEGER POINTER CB;                                            <<C8485>>11005000
INTEGER STRATEGY, SIZE, TYPE;                                  <<C8485>>11010000
DOUBLE CBVECTOR;                                               <<C8485>>11015000
                                                               <<C8485>>11020000
                                                               <<C8485>>11025000
BEGIN                                                          <<C8485>>11030000
EQUATE                                                         <<C8485>>11035000
   S'PXFILE = 0,            << Use PXFILE strategy >>          <<C8485>>11040000
   S'PX'OR'USER = -4,       << try pxfile then user cbt >>     <<C8485>>11045000
   S'USER'CBT = -1,         << create a user CBT >>            <<C8485>>11050000
   S'SYSTEM'CBT = -2,       << create/use a system CBT >>      <<C8485>>11055000
   S'CREATE'NON'EXPAND = -3,<< create a nonexpandable CBT >>   <<C8485>>11060000
   JUST'GET'USER'CBT = -69; << Create a user cbt for UCOP >>   <<C8485>>11065000
                                                               <<C8485>>11070000
LOGICAL END'OF'CB;         << true when at the end of cb  >>   <<C8485>>11075000
INTEGER NEW'GARBAGE'SIZE;  << Holds new garbage size       >>  <<C8485>>11080000
INTEGER POINTER NEXT'CB;   << Points to the next cb        >>  <<C8485>>11085000
INTEGER VT'ENTRY'NUMBER;   << Entry number of new CB       >>  <<C8485>>11090000
INTEGER CBVECTOR'DSTN = CBVECTOR + 0,                          <<C8485>>11095000
        CBVECTOR'ENTRY = CBVECTOR + 1;                         <<C8485>>11100000
INTEGER POINTER PXFILE;    << Points to PXFILE area        >>  <<C8485>>11105000
INTEGER SHRDST;            << Shared FCB table DST number  >>  <<C8485>>11110000
INTEGER MAX'ENTRY;         << Maximum number of VT entries >>  <<C8485>>11115000
                                                               <<C8485>>11120000
INTEGER POINTER VT;        << Vector table pointer         >>  <<C8485>>11125000
INTEGER DELTA'SIZE;        << Temporary variable           >>  <<C8485>>11130000
LOGICAL DONE;              << Temporary variable           >>  <<C8485>>11135000
INTEGER POINTER PXFCBT;    << Nobuf CBT table              >>  <<C8485>>11140000
                                                               <<C8485>>11145000
EQUATE                                                         <<C8485>>11150000
   SHR'DST'SIZE = 128;     << Shared FCB CBT list size     >>  <<C8485>>11155000
                                                               <<C8485>>11160000
INTEGER A;                 << Holds sir information        >>  <<C8485>>11165000
INTEGER SHFCBX;            << Points to shared FCB CBT list>>  <<C8485>>11170000
                           << element                      >>  <<C8485>>11175000
INTEGER POINTER CBTAB;     << Points to control block table>>  <<C8485>>11180000
INTEGER DSTX;              << DST number of control block  >>  <<C8485>>11185000
                                                               <<C8485>>11190000
EQUATE                                                         <<C8485>>11195000
   BUF'ACB'VTSIZE = CBTVT4*VTENTRY, << VectorTable size for>>  <<C8485>>11200000
                           << buffered control block table >>  <<C8485>>11205000
   SYS'ACB'VTSIZE = CBTVT3*VTENTRY,                            <<C8485>>11210000
                           << System control block vtsize  >>  <<C8485>>11215000
   USER'ACB'VTSIZE = CBTVT2*VTENTRY,                           <<C8485>>11220000
                           << User control block vtsize    >>  <<C8485>>11225000
   NON'EXPAND'CB'SIZE = BUF'ACB'VTSIZE + CBTOVERHEAD + 1;      <<C8485>>11230000
                           << Complete overhead for bufferd>>  <<C8485>>11235000
                           << pacb                         >>  <<C8485>>11240000
                                                               <<C8485>>11245000
DEFINE DSTXSIZE =                                              <<C8485>>11250000
   (ABS(ABS(DSTP)+DSTX*4).(3:13))*4#;                          <<C8485>>11255000
                                                               <<C8485>>11260000
INTEGER ARRAY VTSIZE(-3:-1) = PB := BUF'ACB'VTSIZE,            <<C8485>>11265000
                                    SYS'ACB'VTSIZE,            <<C8485>>11270000
                                    USER'ACB'VTSIZE;           <<C8485>>11275000
                           << Vector table sizes for diff. >>  <<C8485>>11280000
                           << different strategies         >>  <<C8485>>11285000
                                                               <<C8485>>11290000
                                                               <<C8485>>11295000
EQUATE                                                         <<C8485>>11300000
   VT'SIZE'INCREMENT = 4*VTENTRY, << Increment size for    >>  <<C8485>>11305000
                           << expanding the vector table   >>  <<C8485>>11310000
   MAX'VT'SIZE = 64*VTENTRY;<< Largest vector table size   >>  <<C8485>>11315000
                                                               <<C8485>>11320000
INTEGER DELTA'VT'SIZE;     << Change in expanded VT size   >>  <<C8485>>11325000
                                                               <<C8485>>11330000
INTEGER NEW'CB'SIZE;       << New control block size       >>  <<C8485>>11335000
                                                               <<C8485>>11340000
EQUATE FCB'LIST'SIZE = SHR'DST'SIZE;                           <<C8485>>11345000
                           << Maximum number of shared FCB >>  <<C8485>>11350000
                           << dst's                        >>  <<C8485>>11355000
INTEGER PXFCBTNR;          << Number of the user cb        >>  <<C8485>>11360000
                                                               <<C8485>>11365000
$PAGE "ADD'CB Subroutine"                                      <<C8485>>11370000
LOGICAL SUBROUTINE ADD'CB;                                     <<C8485>>11375000
<<*********************************************************>>  <<C8485>>11380000
<< Adds the control block too the space found by FIND'ROOM  >> <<C8485>>11385000
<< It is assumed that the following variables have been    >>  <<C8485>>11390000
<< initialized by FIND'ROOM:                               >>  <<C8485>>11395000
<<   CB - DB relative pointer to the control block space   >>  <<C8485>>11400000
<<        found                                            >>  <<C8485>>11405000
<<   ENTRY'NUMBER - Entry number of the vector table entry >>  <<C8485>>11410000
<<   DSTX - DST number of the control block                >>  <<C8485>>11415000
<<   ENTRY'POINTER - DB relative pointer to vector table   >>  <<C8485>>11420000
<<      entry                                              >>  <<C8485>>11425000
<< Returns true iff successful                             >>  <<C8485>>11430000
<< No parameters                                           >>  <<C8485>>11435000
<< Global Variables:                                       >>  <<C8485>>11440000
<<   STRATEGY (unchanged) - Type of strategy used          >>  <<C8485>>11445000
<<   CB (modified) - DB relative pointer to garbage control>>  <<C8485>>11450000
<<      block to be initialized to new control block       >>  <<C8485>>11455000
<<   NEW'GARBAGE'SIZE - Temporary variable                 >>  <<C8485>>11460000
<<   NEXT'CB (modified) - temporary variable               >>  <<C8485>>11465000
<<   VT (unchanged) - Free VT entry to be used for new CB  >>  <<C8485>>11470000
<<   CBVECTOR - Returned CBVECTOR pointing to control blk. >>  <<C8485>>11475000
<<   CBTAB (unchanged) - Pointer to control block table    >> <<C8485>>11480000
<<*********************************************************>>  <<C8485>>11485000
                                                               <<C8485>>11490000
BEGIN                                                          <<C8485>>11495000
                                                               <<C8485>>11500000
IF STRATEGY = S'CREATE'NON'EXPAND THEN                         <<C8485>>11505000
   BEGIN                                                       <<C8485>>11510000
   CB := 0;         << clear control block >>                  <<C8485>>11515000
   MOVE CB(1) := CB,(SIZE-1);                                  <<C8485>>11520000
   CBTYPE := TYPE;   << type is always PACB >>                 <<C8485>>11525000
   CBSIZE := SIZEACB; << put in basic size only >>             <<C8485>>11530000
   END                                                         <<C8485>>11535000
ELSE                                                           <<C8485>>11540000
   BEGIN                                                       <<C8485>>11545000
   NEW'GARBAGE'SIZE := CBSIZE - SIZE;                          <<C8485>>11550000
   CB := 0;                                                    <<C8485>>11555000
   MOVE CB(1) := CB,(SIZE-1); << clear out control block >>    <<C8485>>11560000
   CBTYPE := TYPE;            << init control block type >>    <<C8485>>11565000
   CBSIZE := SIZE;            << init size >>                  <<C8485>>11570000
   IF NEW'GARBAGE'SIZE > 0 THEN                                <<C8485>>11575000
      BEGIN                   << Init adjacent garbage CB>>    <<C8485>>11580000
      @NEXT'CB := @CB + SIZE; << set adjacent garbage size>>   <<C8485>>11585000
      NEXT'CB(0) := NEW'GARBAGE'SIZE;                          <<C8485>>11590000
      END;                                                     <<C8485>>11595000
   END;                                                        <<C8485>>11600000
<< Now initialize vector table entry >>                        <<C8485>>11605000
                                                               <<C8485>>11610000
CBVECTOR'DSTN := DSTX;                                         <<C8485>>11615000
IF CBVECTOR'DSTN = 0 THEN << PXFILE area >>                    <<C8485>>11620000
   CBVECTOR'DSTN := PXFDSTX; << CB is in our stack >>          <<C8485>>11625000
CBVECTOR'ENTRY := VT'ENTRY'NUMBER * VTENTRY + CBTOVERHEAD;     <<C8485>>11630000
VT'ADR := @CB - @CBTAB; << CBT rel address of control blk.>>   <<C8485>>11635000
                                                               <<C8485>>11640000
<< Initialize locking part of vector table >>                  <<C8485>>11645000
                                                               <<C8485>>11650000
VT'PIN := CURPRC;            << Locked by our PIN >>           <<C8485>>11655000
VT'CONTROL := %100400;       << Lock on count = 1 >>           <<C8485>>11660000
VT'QHEAD := VT'QTAIL := 0;   << Empty queues to start >>       <<C8485>>11665000
VT'SAVEQ'HEAD := VT'SAVEQ'TAIL := 0;                           <<C8485>>11670000
                                                               <<C8485>>11675000
<<*********************************************************>>  <<C8485>>11680000
<< Now we must unlock the control block.  It was locked    >>  <<C8485>>11685000
<< by FIND'ROOM when it found the appropriate control block>>  <<C8485>>11690000
<<*********************************************************>>  <<C8485>>11695000
                                                               <<C8485>>11700000
UNLOCK'CBT(CBTAB);                                             <<C8485>>11705000
ADD'CB := TRUE;   << always successful >>                      <<C8485>>11710000
END << subroutine ADD'CB >>;                                   <<C8485>>11715000
                                                               <<C8485>>11720000
$PAGE "GET'LIST'DST Subroutine"                                <<C8485>>11725000
LOGICAL SUBROUTINE GET'LIST'DST;                               <<C8485>>11730000
<<*********************************************************>>  <<C8485>>11735000
<< Sets DB to the dst containing a list of global shared   >>  <<C8485>>11740000
<< file control blocks                                     >>  <<C8485>>11745000
<< Returns true iff successful                             >>  <<C8485>>11750000
<< No parameters                                           >>  <<C8485>>11755000
<< Global Variables:                                       >>  <<C8485>>11760000
<<   SHFCBDST (maybe modified) - SYSGLOB cell containing   >>  <<C8485>>11765000
<<      the DST of the list of shared file control blocks  >>  <<C8485>>11770000
<<   SHRDST (modified) - DST of shared file control block  >>  <<C8485>>11775000
<<*********************************************************>>  <<C8485>>11780000
                                                               <<C8485>>11785000
BEGIN                                                          <<C8485>>11790000
IF ABSOLUTE(SHFCBDST) = 0 THEN                                 <<C8485>>11795000
   BEGIN                                                       <<C8485>>11800000
   SHRDST := GETDATASEG(SHR'DST'SIZE,SHR'DST'SIZE);            <<C8485>>11805000
   IF = THEN                                                   <<C8485>>11810000
      BEGIN                                                    <<C8485>>11815000
      GET'LIST'DST := TRUE;  << we have a list! >>             <<C8485>>11820000
      ABSOLUTE(SHFCBDST) := SHRDST; << init sysglob cell >>    <<C8485>>11825000
      EXCHANGEDB(SHRDST);  << set DB to new DST >>             <<C8485>>11830000
      FSSIZE := SHR'DST'SIZE;                                  <<C8485>>11835000
      FSDSTX := SHRDST;                                        <<C8485>>11840000
      FSVTSIZE := 0;                                           <<C8485>>11845000
      TOS := 2; ASSEMBLE(DUP,INCB);                            <<C8485>>11850000
      TOS := SHR'DST'SIZE-3;                                   <<C8485>>11855000
      ASSEMBLE(MOVE 3);  << this bit of assembly level code >> <<C8485>>11860000
                         << clears out the remaining space  >> <<C8485>>11865000
                         << in the DST                      >> <<C8485>>11870000
      END                                                      <<C8485>>11875000
   ELSE GET'LIST'DST := FALSE;  << could not get new DST >>    <<C8485>>11880000
   END                                                         <<C8485>>11885000
ELSE                                                           <<C8485>>11890000
   BEGIN << DST containing list already exists >>              <<C8485>>11895000
   GET'LIST'DST := TRUE;                                       <<C8485>>11900000
   EXCHANGEDB(ABSOLUTE(SHFCBDST)); << set DB to list DST >>    <<C8485>>11905000
   END;                                                        <<C8485>>11910000
END  << subroutine GET'LIST'DST >>;                            <<C8485>>11915000
                                                               <<C8485>>11920000
                                                               <<C8485>>11925000
$PAGE "GET'DATA'SEG Subroutine"                                <<C8485>>11930000
LOGICAL SUBROUTINE GET'DATA'SEG;                               <<C8485>>11935000
<<*********************************************************>>  <<C8485>>11940000
<< Gets an extra datasegment for a new control block       >>  <<C8485>>11945000
<< Returns true iff successful                             >>  <<C8485>>11950000
<< No parameters                                           >>  <<C8485>>11955000
<< Global Variables:                                       >>  <<C8485>>11960000
<<   DSTX (modified) - DST number of control block         >>  <<C8485>>11965000
<<*********************************************************>>  <<C8485>>11970000
                                                               <<C8485>>11975000
BEGIN                                                          <<C8485>>11980000
IF STRATEGY = S'CREATE'NON'EXPAND THEN                         <<C8485>>11985000
   BEGIN                                                       <<C8485>>11990000
   DSTX := GETDATASEG(NON'EXPAND'CB'SIZE + SIZE,               <<C8485>>11995000
                      NON'EXPAND'CB'SIZE + SIZE);              <<C8485>>12000000
   IF <> THEN                                                  <<C8485>>12005000
      GET'DATA'SEG := FALSE                                    <<C8485>>12010000
   ELSE                                                        <<C8485>>12015000
      GET'DATA'SEG := TRUE                                     <<C8485>>12020000
   END                                                         <<C8485>>12025000
ELSE                                                           <<C8485>>12030000
   BEGIN                                                       <<C8485>>12035000
   DSTX := GETDATASEG(FSEGINIT, FSEGMAX);                      <<C8485>>12040000
   IF <> THEN                                                  <<C8485>>12045000
      GET'DATA'SEG := FALSE                                    <<C8485>>12050000
   ELSE                                                        <<C8485>>12055000
      GET'DATA'SEG := TRUE                                     <<C8485>>12060000
   END;                                                        <<C8485>>12065000
END;  << subroutine GET'DATA'SEG >>                            <<C8485>>12070000
                                                               <<C8485>>12075000
$PAGE "CREATECBT Subroutine"                                   <<C8485>>12080000
LOGICAL SUBROUTINE CREATECBT;                                  <<C8485>>12085000
<<*********************************************************>>  <<C8485>>12090000
<< Creates a new control block                             >>  <<C8485>>12095000
<< Returns true iff successful                             >>  <<C8485>>12100000
<< No parameters                                           >>  <<C8485>>12105000
<< Global Variables:                                       >>  <<C8485>>12110000
<<   STRATEGY (unchanged) - what insertion strategy is used>>  <<C8485>>12115000
<<   DSTX (modified) - DST containing new CBT              >>  <<C8485>>12120000
<<   CBTAB (modified) - Points to new CBT                  >>  <<C8485>>12125000
<< Note that DB will be set to the new CBT iff successful  >>  <<C8485>>12130000
<<*********************************************************>>  <<C8485>>12135000
                                                               <<C8485>>12140000
BEGIN                                                          <<C8485>>12145000
IF GET'DATA'SEG THEN                                           <<C8485>>12150000
   BEGIN                                                       <<C8485>>12155000
   CREATECBT := TRUE;  << we successfully got a datasegment>>  <<C8485>>12160000
   IF STRATEGY = S'SYSTEM'CBT THEN                             <<C8485>>12165000
      ADB0(SHFCBX) := DSTX; << put dst number in shared fcb>>  <<C8485>>12170000
                            << list >>                         <<C8485>>12175000
   << Initialize the new control block >>                      <<C8485>>12180000
   EXCHANGEDB(DSTX);   << Set db to new control block >>       <<C8485>>12185000
   @CBTAB := 0;        << init pointer to start of dst >>      <<C8485>>12190000
   FSSIZE := DSTXSIZE; << init size of control block >>        <<C8485>>12195000
   FSDSTX := DSTX;     << init dst number of control block >>  <<C8485>>12200000
   FSVTSIZE := VTSIZE(STRATEGY);  << init vtsize of CBT    >>  <<C8485>>12205000
   CBTTYPEF := -STRATEGY;    << init type of control block >>  <<C8485>>12210000
   FSCONTROL := FSPIN := 0;  << set control and lock pin >>    <<C8485>>12215000
   FSHEAD := FSTAIL := 0;    << set lock queue variables >>    <<C8485>>12220000
   FSUNUSED := 0;            << set unused word >>             <<C8485>>12225000
   @VT := @FSVT;                                               <<C8485>>12230000
   VT(0) := 0;               << initialize all of vt table >>  <<C8485>>12235000
   MOVE VT(1) := VT(0),(VTSIZE(STRATEGY)-1);                   <<C8485>>12240000
   VT(VTSIZE(STRATEGY)) := FSSIZE - VTSIZE(STRATEGY)           <<C8485>>12245000
                              - CBTOVERHEAD;                   <<C8485>>12250000
     << initialize the first control block to be garbage >>    <<C8485>>12255000
   END                                                         <<C8485>>12260000
ELSE CREATECBT := FALSE;  << could not get extra dataseg >>    <<C8485>>12265000
END  << subroutine CREATECBT >>;                               <<C8485>>12270000
$PAGE "GET'FCB'DST Subroutine"                                 <<C8485>>12275000
LOGICAL SUBROUTINE GET'FCB'CBT;                                <<C8485>>12280000
<<*******************************************************>>    <<C8485>>12285000
<< Gets a global shared file control block dst and sets  >>    <<C8485>>12290000
<< DB to that control block                              >>    <<C8485>>12295000
<< Returns true iff successful                           >>    <<C8485>>12300000
<< No parameters                                         >>    <<C8485>>12305000
<< Global Variables:                                     >>    <<C8485>>12310000
<<   FISIR (modified) - file system sir                  >>    <<C8485>>12315000
<<   DSTX (modified) - dst number of current shared      >>    <<C8485>>12320000
<<                     control block                     >>    <<C8485>>12325000
<<   A (modified) - holds fisir                          >>    <<C8485>>12330000
<<*******************************************************>>    <<C8485>>12335000
                                                               <<C8485>>12340000
BEGIN                                                          <<C8485>>12345000
                                                               <<C8485>>12350000
A := GETSIR(FISIR);                                            <<C8485>>12355000
IF GET'LIST'DST THEN                                           <<C8485>>12360000
   BEGIN                                                       <<C8485>>12365000
   DSTX := ADB0(SHFCBX);                                       <<C8485>>12370000
   IF DSTX = 0 THEN                                            <<C8485>>12375000
      GET'FCB'CBT := CREATECBT                                 <<C8485>>12380000
   ELSE                                                        <<C8485>>12385000
      BEGIN                                                    <<C8485>>12390000
      EXCHANGEDB(DSTX);                                        <<C8485>>12395000
      @CBTAB := 0;                                             <<C8485>>12400000
      GET'FCB'CBT := TRUE;                                     <<C8485>>12405000
      END                                                      <<C8485>>12410000
   END                                                         <<C8485>>12415000
ELSE GET'FCB'CBT := FALSE;                                     <<C8485>>12420000
                                                               <<C8485>>12425000
RELSIR(FISIR,A);                                               <<C8485>>12430000
                                                               <<C8485>>12435000
END << subroutine GET'FCB'CBT >>;                              <<C8485>>12440000
                                                               <<C8485>>12445000
$PAGE "EXPANDCB Subroutine"                                    <<C8485>>12450000
LOGICAL SUBROUTINE EXPANDCB;                                   <<C8485>>12455000
<<*********************************************************>>  <<C8485>>12460000
<< Expands the control block and sets the cb to the new    >>  <<C8485>>12465000
<< space.                                                  >>  <<C8485>>12470000
<<                                                         >>  <<C8485>>12475000
<< Returns true iff successful                             >>  <<C8485>>12480000
<< Parameters:                                             >>  <<C8485>>12485000
<< Global Variables:                                       >>  <<C8485>>12490000
<<   CBT (input) - Control block table pointer             >>  <<C8485>>12495000
<<   CBTAB (input/output) - Points to new control block    >>  <<C8485>>12500000
<<   DSTX (unchanged) - DST number of control block table  >>  <<C8485>>12505000
<<*********************************************************>>  <<C8485>>12510000
                                                               <<C8485>>12515000
BEGIN                                                          <<C8485>>12520000
IF DSTX = 0 THEN  << we are at the pxfile area >>              <<C8485>>12525000
   BEGIN                                                       <<C8485>>12530000
   IF PXFCBTSIZE + SIZE > PXFCBTSIZEMAX THEN                   <<C8485>>12535000
      EXPANDCB := FALSE << cant expand that much !>>           <<C8485>>12540000
   ELSE                                                        <<C8485>>12545000
      BEGIN                                                    <<C8485>>12550000
      IF PXFSIZE - PXFOVERHEAD - PXFCBTSIZE - PXFAFTSIZE       <<C8485>>12555000
               < SIZE THEN                                     <<C8485>>12560000
         BEGIN  << we must expand the pxfile area >>           <<C8485>>12565000
         DELTA'SIZE := FALTPXFILE(SIZE);  << increase size >>  <<C8485>>12570000
         IF < THEN EXPANDCB := FALSE                           <<C8485>>12575000
         ELSE                                                  <<C8485>>12580000
            BEGIN                                              <<C8485>>12585000
            EXPANDCB := TRUE;                                  <<C8485>>12590000
            << Now iupdate pxfile pointers >>                  <<C8485>>12595000
            @PXFILE := @PXFILE + DELTA'SIZE; << re-init >>     <<C8485>>12600000
            @PXFCBT := @PXFCBT + DELTA'SIZE; << cbt pointer>>  <<C8485>>12605000
            @CBTAB := @CBTAB + DELTA'SIZE; << cbtab ptr >>     <<C8485>>12610000
            @VT := @VT + DELTA'SIZE;                           <<C8485>>12615000
                                      << vt entry pointer >>   <<C8485>>12620000
            @CB := @CB + DELTA'SIZE;                           <<C8485>>12625000
            CBTSIZE := CBTSIZE + SIZE;                         <<C8485>>12630000
            CBDESCRIP := CBTSIZE - (@CB - @CBTAB);             <<C8485>>12635000
                 << new garbage cb size >>                     <<C8485>>12640000
            END;                                               <<C8485>>12645000
         END                                                   <<C8485>>12650000
      ELSE                                                     <<C8485>>12655000
         BEGIN << Already enough room in pxfile area >>        <<C8485>>12660000
         CBTSIZE := CBTSIZE + SIZE; << increase cb size >>     <<C8485>>12665000
         CBDESCRIP := CBTSIZE - (@CB - @CBTAB);                <<C8485>>12670000
                 << put in garbage descriptor >>               <<C8485>>12675000
         EXPANDCB := TRUE;                                     <<C8485>>12680000
         END;                                                  <<C8485>>12685000
      END;  << less than max pxfile size >>                    <<C8485>>12690000
   END  << pxfile area control block >>                        <<C8485>>12695000
ELSE                                                           <<C8485>>12700000
   BEGIN << control block in extra datasegment >>              <<C8485>>12705000
   ALTDSEGSIZE(DSTX,SIZE+@CB-CBTSIZE);                         <<C8485>>12710000
   IF <> THEN                                                  <<C8485>>12715000
      EXPANDCB := FALSE                                        <<C8485>>12720000
   ELSE                                                        <<C8485>>12725000
      BEGIN                                                    <<C8485>>12730000
      EXPANDCB := TRUE;                                        <<C8485>>12735000
      CBTSIZE := DSTXSIZE;                                     <<C8485>>12740000
      CBDESCRIP := CBTSIZE - (@CB - @CBTAB);                   <<C8485>>12745000
      END;                                                     <<C8485>>12750000
   END;                                                        <<C8485>>12755000
END << subroutine EXPANDCB >>;                                 <<C8485>>12760000
                                                               <<C8485>>12765000
$PAGE "FIND'CB'ENTRY Subroutine"                               <<C8485>>12770000
LOGICAL SUBROUTINE FIND'CB'ENTRY;                              <<C8485>>12775000
<<*********************************************************>>  <<C8485>>12780000
<< Locates a place to put the new control block            >>  <<C8485>>12785000
<< Returns true iff successful                             >>  <<C8485>>12790000
<< Parameters:                                             >>  <<C8485>>12795000
<< Global Variables:                                       >>  <<C8485>>12800000
<<   CBTAB (input) - Control block table pointer           >>  <<C8485>>12805000
<<   CB (modified) - Address of the found control block    >>  <<C8485>>12810000
<<*********************************************************>>  <<C8485>>12815000
                                                               <<C8485>>12820000
BEGIN                                                          <<C8485>>12825000
@CB := @CBTVT + CBTVTSIZE; << set to first control block >>    <<C8485>>12830000
<< End'of'cb is true when at the end of the control block >>   <<*8609>>12835000
<< table.  This occurs either when CB (control block      >>   <<*8609>>12840000
<< pointer) is pointing to the last control block and that>>   <<*8609>>12845000
<< control block is a garbage control block, or CB points >>   <<*8609>>12850000
<< past the control block table.                          >>   <<*8609>>12855000
IF @CB = @CBTAB + CBTSIZE THEN                                 <<*8695>>12860000
   END'OF'CB := TRUE << Past end of CB table >>                <<*8695>>12865000
ELSE                                                           <<*8695>>12870000
   END'OF'CB := CBTYPE = CBGARBAGE LAND                        <<*8695>>12875000
         LOGICAL(@CB+CBSIZE) = LOGICAL(@CBTAB+CBTSIZE);        <<*8695>>12880000
         << Last control block in CBT and is garbage >>        <<*8695>>12885000
WHILE NOT END'OF'CB AND (NOT (CBTYPE = CBGARBAGE LAND          <<*8695>>12890000
                              SIZE <= CBSIZE)) DO              <<*8695>>12895000
<< while not at the end and wont fit in a garbage cb >>        <<*8695>>12900000
   BEGIN                                                       <<C8485>>12905000
   @CB := @CB + CBSIZE;  << point to next control block >>     <<C8485>>12910000
   IF @CB = @CBTAB + CBTSIZE THEN                              <<*8695>>12915000
      END'OF'CB := TRUE  << Past end of CB table >>            <<*8695>>12920000
   ELSE                                                        <<*8695>>12925000
      END'OF'CB := CBTYPE = CBGARBAGE LAND                     <<*8695>>12930000
            LOGICAL(@CB+CBSIZE) = LOGICAL(@CBTAB+CBTSIZE);     <<*8695>>12935000
            << Last control block in table >>                  <<*8695>>12940000
   END;                                                        <<C8485>>12945000
                                                               <<C8485>>12950000
IF (@CB = @CBTAB + CBTSIZE) OR (SIZE > CBSIZE) THEN            <<C8485>>12955000
               << could not find a place to put it >>          <<C8485>>12960000
   FIND'CB'ENTRY := EXPANDCB  << try expanding it >>           <<C8485>>12965000
ELSE FIND'CB'ENTRY := TRUE;  << we found a place to put it>>   <<C8485>>12970000
END <<subroutine FIND'CB'ENTRY >>;                             <<C8485>>12975000
                                                               <<C8485>>12980000
$PAGE "GET'VT'ENTRY Subroutine"                                <<C8485>>12985000
LOGICAL SUBROUTINE GET'VT'ENTRY;                               <<C8485>>12990000
<<*********************************************************>>  <<C8485>>12995000
<< Gets a vt entry from the control block table pointed to >>  <<C8485>>13000000
<< by CBTAB.  Expects DB to point to the control block     >>  <<C8485>>13005000
<<                                                         >>  <<C8485>>13010000
<< Returns true iff successful                             >>  <<C8485>>13015000
<< Parameters:                                             >>  <<C8485>>13020000
<< Global Variables:                                       >>  <<C8485>>13025000
<<   CBTAB - points to file control block table (input)    >>  <<C8485>>13030000
<<   VT   (modified) - Points to the VT entry,             >>  <<C8485>>13035000
<<     at the end of the procedure it points to the choosen>>  <<C8485>>13040000
<<     VT entry                                            >>  <<C8485>>13045000
<<   VT'ENTRY'NUMBER (modified) - Number of the found VT   >>  <<C8485>>13050000
<<      entry                                              >>  <<C8485>>13055000
<<   MAX'ENTRY (modified) - Maximum number of VT entries   >>  <<C8485>>13060000
<<     for this table                                      >>  <<C8485>>13065000
<<   DELTA'VT'SIZE (modified) - temporary, used in         >>  <<C8485>>13070000
<<     calculating the change in vector table size when    >>  <<C8485>>13075000
<<     expanding the vector table                          >>  <<C8485>>13080000
<<  NEW'CB'SIZE (modified) - temporary, holds new vtsize   >>  <<C8485>>13085000
<<     when expanding the table                            >>  <<C8485>>13090000
<<*********************************************************>>  <<C8485>>13095000
                                                               <<C8485>>13100000
BEGIN                                                          <<C8485>>13105000
@VT := @CBTVT;  << point to first vt entry >>                  <<C8485>>13110000
VT'ENTRY'NUMBER := 0;         << initial entry number >>       <<C8485>>13115000
MAX'ENTRY := CBTVTSIZE/VTENTRY-1;  << last entry number >>     <<C8485>>13120000
                                                               <<C8485>>13125000
WHILE (VT <> 0) AND (VT'ENTRY'NUMBER <= MAX'ENTRY) DO          <<C8485>>13130000
   BEGIN  << search for an unused VT entry >>                  <<C8485>>13135000
   @VT := @VT + VTENTRY;                                       <<C8485>>13140000
                 << increment entry pointer to next vt entry>> <<C8485>>13145000
   VT'ENTRY'NUMBER := VT'ENTRY'NUMBER + 1;                     <<C8485>>13150000
   END;                                                        <<C8485>>13155000
                                                               <<C8485>>13160000
IF VT'ENTRY'NUMBER <= MAX'ENTRY THEN                           <<C8485>>13165000
   GET'VT'ENTRY := TRUE  << found one!!>>                      <<C8485>>13170000
ELSE                                                           <<C8485>>13175000
   BEGIN                                                       <<C8485>>13180000
   <<***********************************************>>         <<C8485>>13185000
   << Now we must try to expand the vector table    >>         <<C8485>>13190000
   << The only way we can do this is to take some   >>         <<C8485>>13195000
   << space from the following control block, but   >>         <<C8485>>13200000
   << it must of course be a garbage control block  >>         <<C8485>>13205000
   <<***********************************************>>         <<C8485>>13210000
   @CB := @CBTVT+CBTVTSIZE;<< use cb to point to first cb >>   <<C8485>>13215000
   IF CBTYPE = CBGARBAGE THEN                                  <<C8485>>13220000
      BEGIN << can take some memory from this cb >>            <<C8485>>13225000
      TOS := CBSIZE;                                           <<C8485>>13230000
      TOS := VT'SIZE'INCREMENT;                                <<C8485>>13235000
      TOS := MAX'VT'SIZE - CBTVTSIZE;                          <<C8485>>13240000
      MIN3;  << quickly find the minimum of the above 3 >>     <<C8485>>13245000
      DELTA'VT'SIZE := TOS;                                    <<C8485>>13250000
      IF DELTA'VT'SIZE >= VTENTRY THEN  << it fits!!>>         <<C8485>>13255000
         BEGIN                                                 <<C8485>>13260000
         CBTVTSIZE := CBTVTSIZE + DELTA'VT'SIZE;               <<C8485>>13265000
         NEW'CB'SIZE := CBSIZE - DELTA'VT'SIZE;                <<C8485>>13270000
         IF NEW'CB'SIZE > 0 THEN                               <<C8485>>13275000
            BEGIN  << we must change the cbsize >>             <<C8485>>13280000
            @CB := @CB + DELTA'VT'SIZE;  << pt to new cb >>    <<C8485>>13285000
            CBDESCRIP := NEW'CB'SIZE;  << store garb. header>> <<C8485>>13290000
            END;                                               <<C8485>>13295000
         END                                                   <<C8485>>13300000
      ELSE GET'VT'ENTRY := FALSE; << it don't fit >>           <<C8485>>13305000
      END                                                      <<C8485>>13310000
   ELSE GET'VT'ENTRY := FALSE; << no garbage control block >>  <<C8485>>13315000
   END;                                                        <<C8485>>13320000
END << subroutine GET'VT'ENTRY >>;                             <<C8485>>13325000
                                                               <<C8485>>13330000
$PAGE "CREATE'FIXED'CB'ENTRY Subroutine"                       <<C8485>>13335000
LOGICAL SUBROUTINE CREATE'FIXED'CB'ENTRY;                      <<C8485>>13340000
<<*********************************************************>>  <<C8485>>13345000
<< Creates a non-expandable control block table            >>  <<C8485>>13350000
<< Returns true iff successful                             >>  <<C8485>>13355000
<< No parameters                                           >>  <<C8485>>13360000
<< Global Variables:                                       >>  <<C8485>>13365000
<<   CBTAB (modified) - control block table offset         >>  <<C8485>>13370000
<<*********************************************************>>  <<C8485>>13375000
                                                               <<C8485>>13380000
BEGIN                                                          <<C8485>>13385000
IF CREATECBT THEN                                              <<C8485>>13390000
   BEGIN                                                       <<C8485>>13395000
   LOCK'CBT(CBTAB);                                            <<C8485>>13400000
   IF GET'VT'ENTRY THEN                                        <<*8609>>13405000
      BEGIN                                                    <<*8609>>13410000
      CREATE'FIXED'CB'ENTRY := TRUE;                           <<*8609>>13415000
      << We don't need to find a control block entry since >>  <<*8609>>13420000
      << there is only one cb entry for this block.  Also  >>  <<*8609>>13425000
      << there is the possibility of the control block size>>  <<*8609>>13430000
      << being greater than 16K, therefore we just init    >>  <<*8609>>13435000
      << the only control block.                           >>  <<*8609>>13440000
                                                               <<*8609>>13445000
      @CB := @CBTVT + CBTVTSIZE; << Point to control block >>  <<*8609>>13450000
      CB := 0;  << Clear control block >>                      <<*8609>>13455000
      MOVE CB(1) := CB,(SIZE-1);                               <<*8609>>13460000
      CBTYPE := TYPE;                                          <<*8609>>13465000
      CBSIZE := SIZEACB; << Only put in basic size >>          <<*8609>>13470000
      END                                                      <<*8609>>13475000
   ELSE                                                        <<C8485>>13480000
      BEGIN                                                    <<C8485>>13485000
      UNLOCK'CBT(CBTAB);                                       <<C8485>>13490000
      EXCHANGEDB(0);                                           <<C8485>>13495000
      CREATE'FIXED'CB'ENTRY := FALSE;                          <<C8485>>13500000
      END;                                                     <<C8485>>13505000
   END                                                         <<C8485>>13510000
ELSE CREATE'FIXED'CB'ENTRY := FALSE;                           <<C8485>>13515000
END <<subroutine CREATE'FIXED'CB'ENTRY >>;                     <<C8485>>13520000
                                                               <<C8485>>13525000
$PAGE "GET'SYSTEM'CB'ENTRY Subroutine"                         <<C8485>>13530000
LOGICAL SUBROUTINE GET'SYSTEM'CB'ENTRY;                        <<C8485>>13535000
<<*********************************************************>>  <<C8485>>13540000
<< Gets a system control block entry                       >>  <<C8485>>13545000
<< Returns - true iff successful                           >>  <<C8485>>13550000
<< No parameters                                           >>  <<C8485>>13555000
<< Globals Variables:                                      >>  <<C8485>>13560000
<<   SHFCBX (modified) - points to the dst number of the   >>  <<C8485>>13565000
<<      control block we are looking at within the shared  >>  <<C8485>>13570000
<<      fcb system table                                   >>  <<C8485>>13575000
<<   DONE (modified) - temporary variable signalling the   >>  <<C8485>>13580000
<<      finding of a control block entry                   >>  <<C8485>>13585000
<<*********************************************************>>  <<C8485>>13590000
                                                               <<C8485>>13595000
BEGIN                                                          <<C8485>>13600000
SHFCBX := CBTOVERHEAD;  << initialize pointer to first dstn>>  <<C8485>>13605000
DONE := FALSE;                                                 <<C8485>>13610000
WHILE (SHFCBX < FCB'LIST'SIZE) AND (NOT DONE) AND              <<C8485>>13615000
       GET'FCB'CBT DO                                          <<C8485>>13620000
   BEGIN                                                       <<C8485>>13625000
   LOCK'CBT(CBTAB); << CBTAB is set by GET'FCB'CBT >>          <<C8485>>13630000
   IF GET'VT'ENTRY AND FIND'CB'ENTRY THEN                      <<C8485>>13635000
      DONE := TRUE                                             <<C8485>>13640000
   ELSE                                                        <<C8485>>13645000
      BEGIN                                                    <<C8485>>13650000
      UNLOCK'CBT(CBTAB);                                       <<C8485>>13655000
      EXCHANGEDB(0);                                           <<C8485>>13660000
      SHFCBX := SHFCBX + 1; << Try next global table >>        <<C8485>>13665000
      END;                                                     <<C8485>>13670000
   END;                                                        <<C8485>>13675000
                                                               <<C8485>>13680000
GET'SYSTEM'CB'ENTRY := DONE;                                   <<C8485>>13685000
END << subroutine GET'SYSTEM'CB'ENTRY >>;                      <<C8485>>13690000
                                                               <<C8485>>13695000
$PAGE "GET'USER'CB'ENTRY Subroutine"                           <<C8485>>13700000
LOGICAL SUBROUTINE GET'USER'CB'ENTRY;                          <<C8485>>13705000
<<*********************************************************>>  <<C8485>>13710000
<< Gets a user CBtable entry.  First it trys to get an     >>  <<C8485>>13715000
<< existing table and add an entry to it.  If that fails   >>  <<C8485>>13720000
<< then it trys to create a new user CBT                   >>  <<C8485>>13725000
<<                                                         >>  <<C8485>>13730000
<< Returns - true iff successful                           >>  <<C8485>>13735000
<< No parameters                                           >>  <<C8485>>13740000
<< Global Variables:                                       >>  <<C8485>>13745000
<<   PXFCBTNR (modified) - Counts the number of pxfile     >>  <<C8485>>13750000
<<     user control blocks have been looked at             >>  <<C8485>>13755000
<<   DONE (modified) - Temp variable, tells when a space   >>  <<C8485>>13760000
<<     has been found                                      >>  <<C8485>>13765000
<<   DSTX (modified) - Dst number of user control block    >>  <<C8485>>13770000
<<   CBTAB (modified) - pointer to control block table     >>  <<C8485>>13775000
<<   PXFCBT (modified) - pointer to pxfile user control    >>  <<C8485>>13780000
<<                       block table                       >>  <<C8485>>13785000
<<*********************************************************>>  <<C8485>>13790000
                                                               <<C8485>>13795000
BEGIN                                                          <<C8485>>13800000
DONE := FALSE;                                                 <<C8485>>13805000
PXFCBTNR := 0;  << Set the number of user cbts to zero >>      <<C8485>>13810000
@PXFCBT := @PXFCBT1;  << Point to first user CBT       >>      <<C8485>>13815000
DSTX := PXFCBT;       << Set dst to first user CBT    >>       <<C8485>>13820000
WHILE DSTX <> 0 AND (PXFCBTNR < PXFCBTMAX) AND NOT DONE DO     <<C8485>>13825000
   BEGIN                                                       <<C8485>>13830000
   EXCHANGEDB(DSTX);   << exchange db to user cbt >>           <<C8485>>13835000
   @CBTAB := 0;        << set control block to 0 >>            <<C8485>>13840000
   LOCK'CBT(CBTAB);                                            <<C8485>>13845000
   IF GET'VT'ENTRY AND FIND'CB'ENTRY THEN                      <<C8485>>13850000
      DONE := TRUE                                             <<C8485>>13855000
   ELSE                                                        <<C8485>>13860000
      BEGIN                                                    <<C8485>>13865000
      PXFCBTNR := PXFCBTNR + 1;  << increment count >>         <<C8485>>13870000
      @PXFCBT := @PXFCBT + 1;    << increment table ptr >>     <<C8485>>13875000
      UNLOCK'CBT(CBTAB);                                       <<C8485>>13880000
      EXCHANGEDB(0);             << set back to user stack >>  <<C8485>>13885000
      DSTX := PXFCBT;            << Set dst to next user CBT>> <<C8485>>13890000
      END;                                                     <<C8485>>13895000
   END;                                                        <<C8485>>13900000
                                                               <<C8485>>13905000
IF PXFCBTNR < PXFCBTMAX AND DSTX = 0 THEN                      <<C8485>>13910000
   BEGIN  << end of list for user cbt's, create a new one >>   <<C8485>>13915000
   PUSH(Q);  << save q relative address of table pointer  >>   <<C8485>>13920000
   TOS := -TOS + @PXFCBT;                                      <<C8485>>13925000
             << this is necessary for split stack calls   >>   <<C8485>>13930000
   IF CREATECBT THEN                                           <<C8485>>13935000
      BEGIN                                                    <<C8485>>13940000
      AQ0(TOS) := DSTX;  << put dst# of new cbt in table  >>   <<C8485>>13945000
      @CBTAB := 0;                                             <<C8485>>13950000
      LOCK'CBT(CBTAB);                                         <<C8485>>13955000
      IF GET'VT'ENTRY AND FIND'CB'ENTRY THEN                   <<C8485>>13960000
         GET'USER'CB'ENTRY := TRUE                             <<C8485>>13965000
      ELSE                                                     <<C8485>>13970000
         BEGIN                                                 <<C8485>>13975000
         UNLOCK'CBT(CBTAB);                                    <<C8485>>13980000
         EXCHANGEDB(0);                                        <<C8485>>13985000
         GET'USER'CB'ENTRY := FALSE;                           <<C8485>>13990000
         END;                                                  <<C8485>>13995000
      END                                                      <<C8485>>14000000
   ELSE                                                        <<C8485>>14005000
      BEGIN                                                    <<C8485>>14010000
      GET'USER'CB'ENTRY := FALSE;                              <<C8485>>14015000
      ASSEMBLE(DEL);  << get rid of q-rel address on stack >>  <<C8485>>14020000
      END;                                                     <<C8485>>14025000
   END                                                         <<C8485>>14030000
ELSE GET'USER'CB'ENTRY := DONE;                                <<C8485>>14035000
END <<subroutine GET'USER'CB'ENTRY >>;                         <<C8485>>14040000
                                                               <<C8485>>14045000
$PAGE "GET'PX'CB'ENTRY Subroutine"                             <<C8485>>14050000
LOGICAL SUBROUTINE GET'PX'CB'ENTRY;                            <<C8485>>14055000
<<*********************************************************>>  <<C8485>>14060000
<< Gets a pxfile control block entry                       >>  <<C8485>>14065000
<< Returns true iff successful                             >>  <<C8485>>14070000
<< No parameters                                           >>  <<C8485>>14075000
<< Global Variables:                                       >>  <<C8485>>14080000
<<   DSTX (modified) - The DST number of the control block >>  <<C8485>>14085000
<<   CBTAB (modified) - Pointer to the control block table >>  <<C8485>>14090000
<<*********************************************************>>  <<C8485>>14095000
                                                               <<C8485>>14100000
BEGIN                                                          <<C8485>>14105000
IF PXFNOCB THEN                                                <<C8485>>14110000
   GET'PX'CB'ENTRY := FALSE << Can't add to stack because >>   <<C8485>>14115000
                            << user specified NOCB        >>   <<C8485>>14120000
ELSE                                                           <<C8485>>14125000
   BEGIN                                                       <<C8485>>14130000
   DSTX := 0;  << Set DST to user's stack                 >>   <<C8485>>14135000
   @CBTAB := @PXFCBTAB;  << PXFile's control block table  >>   <<C8485>>14140000
   LOCK'CBT(CBTAB);    << Lock the control block table    >>   <<C8485>>14145000
   IF GET'VT'ENTRY THEN                                        <<C8485>>14150000
      BEGIN                                                    <<C8485>>14155000
      IF FIND'CB'ENTRY THEN                                    <<C8485>>14160000
         GET'PX'CB'ENTRY := TRUE                               <<C8485>>14165000
      ELSE                                                     <<C8485>>14170000
         BEGIN                                                 <<C8485>>14175000
         GET'PX'CB'ENTRY := FALSE;                             <<C8485>>14180000
         UNLOCK'CBT(CBTAB);                                    <<C8485>>14185000
         END;                                                  <<C8485>>14190000
      END                                                      <<C8485>>14195000
   ELSE                                                        <<C8485>>14200000
      BEGIN                                                    <<C8485>>14205000
      GET'PX'CB'ENTRY := FALSE;                                <<C8485>>14210000
      UNLOCK'CBT(CBTAB);                                       <<C8485>>14215000
      END;                                                     <<C8485>>14220000
   END;                                                        <<C8485>>14225000
END << subroutine GET'PX'CB'ENTRY >>;                          <<C8485>>14230000
                                                               <<C8485>>14235000
$PAGE "FIND'ROOM Subroutine"                                   <<C8485>>14240000
LOGICAL SUBROUTINE FIND'ROOM;                                  <<C8485>>14245000
<<*********************************************************>>  <<C8485>>14250000
<< Finds room in the control block table                   >>  <<C8485>>14255000
<< Input parameters - None                                 >>  <<C8485>>14260000
<< Output parameters - None                                >>  <<C8485>>14265000
<< Returns - True if successful, false if not              >>  <<C8485>>14270000
<< Global Variables:                                       >>  <<C8485>>14275000
<<   Strategy (unchanged) - Strategy used to find entry    >>  <<C8485>>14280000
<<*********************************************************>>  <<C8485>>14285000
                                                               <<C8485>>14290000
BEGIN                                                          <<C8485>>14295000
IF STRATEGY = S'PXFILE THEN                                    <<C8485>>14300000
   FIND'ROOM := GET'PX'CB'ENTRY                                <<C8485>>14305000
ELSE IF STRATEGY = S'PX'OR'USER THEN                           <<C8485>>14310000
   BEGIN                                                       <<C8485>>14315000
   IF GET'PX'CB'ENTRY THEN                                     <<C8485>>14320000
      FIND'ROOM := TRUE                                        <<C8485>>14325000
   ELSE                                                        <<C8485>>14330000
      BEGIN                                                    <<C8485>>14335000
      STRATEGY := -1; << Set strategy to try s'user'cbt >>     <<C8485>>14340000
      FIND'ROOM := GET'USER'CB'ENTRY;                          <<C8485>>14345000
      END;                                                     <<C8485>>14350000
   END                                                         <<C8485>>14355000
ELSE IF STRATEGY = S'USER'CBT THEN                             <<C8485>>14360000
   FIND'ROOM := GET'USER'CB'ENTRY                              <<C8485>>14365000
ELSE IF STRATEGY = S'SYSTEM'CBT THEN                           <<C8485>>14370000
   FIND'ROOM := GET'SYSTEM'CB'ENTRY                            <<C8485>>14375000
ELSE IF STRATEGY = S'CREATE'NON'EXPAND THEN                    <<C8485>>14380000
   FIND'ROOM := CREATE'FIXED'CB'ENTRY                          <<C8485>>14385000
ELSE FTROUBLE(466); << DIE! No known strategy >>               <<C8485>>14390000
END << subroutine FIND'ROOM >>;                                <<C8485>>14395000
                                                               <<C8485>>14400000
$PAGE "FCREATECB Entry Point"                                  <<C8485>>14405000
<<**********************************>>                         <<C8485>>14410000
<< Entry point to FCREATECB         >>                         <<C8485>>14415000
<<**********************************>>                         <<C8485>>14420000
                                                               <<C8485>>14425000
SETPXFILE;                                                     <<C8485>>14430000
IF STRATEGY = JUST'GET'USER'CBT THEN                           <<C8485>>14435000
   BEGIN                                                       <<C8485>>14440000
   STRATEGY := S'USER'CBT;<< tell create to create a user cbt>><<C8485>>14445000
   IF CREATECBT THEN                                           <<C8485>>14450000
      CONDCODE := CCE                                          <<C8485>>14455000
   ELSE CONDCODE := CCL;                                       <<C8485>>14460000
   END                                                         <<C8485>>14465000
ELSE                                                           <<C8485>>14470000
   BEGIN                                                       <<C8485>>14475000
   IF FIND'ROOM THEN                                           <<C8485>>14480000
      BEGIN                                                    <<C8485>>14485000
      IF ADD'CB THEN CONDCODE := CCE                           <<C8485>>14490000
      ELSE CONDCODE := CCL;                                    <<C8485>>14495000
      END                                                      <<C8485>>14500000
   ELSE CONDCODE := CCL;                                       <<C8485>>14505000
   END;                                                        <<C8485>>14510000
                                                               <<C8485>>14515000
RETURN 3;                                                      <<C8485>>14520000
END  << procedure FCREATECB>>;                                 <<C8485>>14525000
$PAGE "MPEV-V FILE SYSTEM - FDELETECB "                        <<C8485>>14530000
$ CONTROL SEGMENT = FILESYS5                                            14535000
PROCEDURE FDELETECB (CBVECTOR);                                <<06514>>14540000
                                                               <<06514>>14545000
<<**********************************************************>> <<06514>>14550000
<< Deletes the control block having the specified vector.   >> <<06514>>14555000
<< If the control block is in a non-expandable extra data   >> <<06514>>14560000
<< segment, then release the extra data segment.            >> <<06514>>14565000
<<   Input variable:                                        >> <<06514>>14570000
<<       CBVECTOR - Control block vector                    >> <<06514>>14575000
<<                                                          >> <<06514>>14580000
<< This procedure may be called with DB anywhere.           >> <<06514>>14585000
<<**********************************************************>> <<06514>>14590000
                                                               <<06514>>14595000
VALUE CBVECTOR;                                                <<06514>>14600000
DOUBLE CBVECTOR;                                               <<06514>>14605000
OPTION PRIVILEGED,UNCALLABLE;                                  <<06514>>14610000
   BEGIN                                                                14615000
   INTEGER POINTER                                             <<06514>>14620000
      PXFILE,              << PXFILE pointer.               >> <<06514>>14625000
      CBTAB,               << Pointer to CB table.          >> <<06514>>14630000
      CB;                  << Pointer to CB itself.         >> <<06514>>14635000
DOUBLE POINTER                                                 <<06514>>14640000
      VT'DBL;              << Double VT pntr for clearing.  >> <<06514>>14645000
   INTEGER                                                     <<06514>>14650000
      PCBPT,               ! Pointer to PCB for PCB defines    <<06514>>14655000
      CBTTYPE,             << Type of CBT: PXFILE, etc.     >> <<06514>>14660000
      CBVECTOR'DSTN = CBVECTOR + 0,                            <<06514>>14665000
      CBVECTOR'ENTRY= CBVECTOR + 1;                            <<06514>>14670000
   INTEGER ORIG'DB,STACKDST;                                   <<06514>>14675000
                                                                        14680000
$  IF X0 = ON                                                           14685000
   IF MONOTHER THEN  <<MONITORING?>>                                    14690000
      BEGIN                                                             14695000
      TOS := "FD"; TOS := "EL"; TOS := "ET"; TOS := "EC";               14700000
      TOS := "B ";                                                      14705000
      ASSEMBLE(ZERO,DZRO);                                              14710000
      FTITLE(*,*,*,*);                                                  14715000
      DEBUG                                                             14720000
      END;                                                              14725000
$  IF                                                                   14730000
                                                                        14735000
   <<* * * LOCATE CONTROL BLOCK * * *>>                                 14740000
                                                                        14745000
   PCBPT := CURPRC;                                            <<06514>>14750000
   ORIG'DB := SPCBXDSDST; ! Save current DB, extra or stack    <<06514>>14755000
   STACKDST:= SPCBSTKDST; ! Obtain or stack DST number         <<06514>>14760000
   @CB := FGET'CB(CBVECTOR,0); << Get to DB containing CB.  >> <<06514>>14765000
   @CBTAB := 0;  << Assume that the CB is in extra data seg.>> <<06514>>14770000
   IF STACKDST = CBVECTOR'DSTN THEN                            <<06514>>14775000
      BEGIN      << Control block is in our stack.          >> <<06514>>14780000
      SETPXFILE; << Set CBTAB pointer to PXFILE CBT.        >> <<06514>>14785000
      @CBTAB := @PXFCBTAB;                                     <<06514>>14790000
      END;                                                     <<06514>>14795000
                                                                        14800000
   <<* * * LOCK CONTROL BLOCK TABLE * * *>>                             14805000
                                                                        14810000
   LOCK'CBT(CBTAB);                                            <<06514>>14815000
                                                                        14820000
   !---------------------------------------------------------- <<06727>>14825000
   ! Get control block table type:                             <<06727>>14830000
   !    0 = PXFILE                                             <<06727>>14835000
   !    1 = NOBUF [Expandable]                                 <<06727>>14840000
   !    2 = System shared CB                                   <<06727>>14845000
   !    3 = Non-expandable [buffered PACB]                     <<06727>>14850000
   ! If this is a buffered PACB, then simply release the DST   <<06727>>14855000
   ! and exit.                                                 <<06727>>14860000
   !---------------------------------------------------------- <<06727>>14865000
                                                               <<00300>>14870000
   CBTTYPE := CBTTYPEF;                                        <<00300>>14875000
   IF CBTTYPE = 3 THEN                                         <<06727>>14880000
      BEGIN   ! Buffered PACB, release the DST and split.      <<06727>>14885000
      EXCHANGEDB(0);     ! Can't have DB set to dying DST.     <<06727>>14890000
      RELDATASEG(CBVECTOR'DSTN);                               <<06727>>14895000
      GO EXIT;                                                 <<06727>>14900000
      END;                                                     <<06727>>14905000
                                                               <<00300>>14910000
   <<* * * CLEAR VECTOR TABLE ENTRY * * *>>                             14915000
                                                                        14920000
   @VT'DBL := @CBTAB + CBVECTOR'ENTRY; << VT entry pntr.    >> <<06514>>14925000
   VT'DBL(0) := VT'DBL(1) := VT'DBL(2) := VT'DBL(3) := 0D;     <<06514>>14930000
                                                               <<06514>>14935000
   <<*******************************************************>> <<06514>>14940000
   << If the predecessor control block is a garbage control >> <<06514>>14945000
   << block, then combine it with the CB just deleted.      >> <<06514>>14950000
   <<*******************************************************>> <<06514>>14955000
                                                                        14960000
   TOS := @CBTVT+CBTVTSIZE;  <<FIRST CB POINTER>>                       14965000
   IF @CB <> @PS0 THEN  <<NOT FIRST CB?>>                               14970000
      BEGIN                                                             14975000
      WHILE @PS0(PS0.(2:14)) <> @CB DO TOS := TOS+X;                    14980000
      IF PS0.(0:2) = CBGARBAGE THEN  <<PRED. IS GARBAGE?>>              14985000
         BEGIN                                                          14990000
         PS0.(2:14) := CBSIZE+X;  <<NEW GARBAGE SIZE>>                  14995000
         @CB := TOS  <<NEW CB POINTER>>                                 15000000
         END                                                            15005000
      END;                                                              15010000
                                                                        15015000
   <<*******************************************************>> <<06514>>15020000
   << Now, if the successor CB is garbage, then combine it  >> <<06514>>15025000
   << also with the deleted CB.                             >> <<06514>>15030000
   <<*******************************************************>> <<06514>>15035000
                                                                        15040000
   TOS := @CB+CBSIZE;  <<SUCCESSOR CB POINTER>>                         15045000
   IF @PS0 <> @CBTAB+CBTSIZE AND PS0.(0:2) = CBGARBAGE THEN             15050000
      CBSIZE := CBSIZE+PS0.(2:14);  <<NEW GARBAGE SIZE>>                15055000
                                                                        15060000
   <<* * * MAKE GARBAGE OUT OF (COMBINED) CONTROL BLOCK * * *>>         15065000
                                                                        15070000
   CBTYPE := CBGARBAGE;  <<MAKE TYPE GARBAGE>>                          15075000
                                                                        15080000
   <<*******************************************************>> <<06514>>15085000
   << If the Control Block Table is empty and it's not a    >> <<06514>>15090000
   << shared CBT, then release the data segment.  If it is  >> <<06514>>15095000
   << a NOBUF, expandable CBT, then clear the DST number    >> <<06514>>15100000
   << from the PXFILE area.                                 >> <<06514>>15105000
   <<*******************************************************>> <<06514>>15110000
                                                                        15115000
   @CB := @CBTVT+CBTVTSIZE;  <<FIRST CB>>                               15120000
   IF CBTYPE = CBGARBAGE AND @CB+CBSIZE = @CBTAB+CBTSIZE AND            15125000
     (CBTTYPE = 1 OR CBTTYPE = 3)  THEN                        <<06514>>15130000
    BEGIN   << CBT IS EMPTY AND NOT SHARED. >>                 <<00300>>15135000
    EXCHANGEDB(0);  << Set DB to stack >>                      <<00433>>15140000
    IF CBTTYPE = 1 THEN    << IF NOBUF CBT, >>                 <<00433>>15145000
      BEGIN        << CLEAR OUT PXFILE POINTERS TO IT >>       <<00300>>15150000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              15155000
      TOS := @PXFCBT1;  <<FIRST USER CBT DST NR.>>                      15160000
      TOS := PXFCBTMAX;  <<NR. USER CBT'S>>                             15165000
      DO BEGIN                                                          15170000
         IF CBVECTOR'DSTN = PS1 THEN PS1 := 0;                 <<06514>>15175000
         ASSEMBLE(INCB,DECA)                                            15180000
         END UNTIL =;                                                   15185000
      DDEL;                                                             15190000
      END;  << OF CLEAR PXFILE POINTERS >>                     <<00300>>15195000
      RELDATASEG(CBVECTOR'DSTN)                                <<06514>>15200000
    END  << OF CBT IS EMPTY AND NOT SHARED >>                  <<00300>>15205000
   ELSE  <<UNLOCK C.B. TABLE>>                                          15210000
      UNLOCK'CBT(CBTAB);                                       <<06514>>15215000
                                                               <<06727>>15220000
EXIT:                                                          <<06727>>15225000
                                                               <<06727>>15230000
   EXCHANGEDB(ORIG'DB);                                        <<06514>>15235000
   END;      << procedure FDELETECB >>                                  15240000
$PAGE "MPE-V  FILE SYSTEM - UPDATE'LACB "                      <<06514>>15245000
                                                               <<06514>>15250000
PROCEDURE UPDATE'LACB(LACBV,PACBV);                            <<06514>>15255000
VALUE LACBV,PACBV;                                             <<06514>>15260000
DOUBLE  LACBV,PACBV;                                           <<06514>>15265000
                                                               <<57875>>15270000
OPTION PRIVILEGED, UNCALLABLE;                                 <<57875>>15275000
                                                               <<06514>>15280000
<<**********************************************************>> <<06514>>15285000
<< This procedure updates the LACB from the PACB.  It is    >> <<06514>>15290000
<< used by FOPEN and FOPENDA.  It updates all but the first >> <<06514>>15295000
<< word of the LACB from the corresponding words in the     >> <<06514>>15300000
<< PACB. If the LACBV is zero, then the file was not opened >> <<06514>>15305000
<< multi-access.  Simply reset DB back to the stack and re- >> <<06514>>15310000
<< turn.                                                    >> <<06514>>15315000
<<                                                          >> <<06514>>15320000
<< Note: Upon entrance, DB will be set to the DST contain-  >> <<06514>>15325000
<< ing the ACB.  Upon exit, DB will be reset to the stack.  >> <<06514>>15330000
<<                                                          >> <<06514>>15335000
<< Input variables:                                         >> <<06514>>15340000
<<    LACBV and PACBV - Logical and Physical ACB vectors.   >> <<06514>>15345000
<<**********************************************************>> <<06514>>15350000
                                                               <<06514>>15355000
BEGIN                                                          <<06514>>15360000
<< VT array must be at Q+1 unless VTMQ equate is changed.   >> <<06514>>15365000
INTEGER ARRAY VT(0:VTENTRY-1)=Q;  << Vector Table entry.    >> <<06514>>15370000
EQUATE VTMQ = 1;            << Q-rel. offset to VT array.   >> <<06514>>15375000
INTEGER                                                        <<06514>>15380000
   LACBV'DSTN       = LACBV + 0,                               <<06514>>15385000
   LACBV'ENTRY      = LACBV + 1,                               <<06514>>15390000
   PACBV'DSTN       = PACBV + 0,                               <<06514>>15395000
   PACBV'ENTRY      = PACBV + 1;                               <<06514>>15400000
INTEGER                                                        <<06514>>15405000
   PCBPT,                   ! Pointer to PCB or defines        <<06514>>15410000
   PXFILE'OFFSET,           << Stack rel offset to PXFILE.  >> <<06514>>15415000
   PXCBT'OFFSET,            << Stack rel offset to CBTAB.   >> <<06514>>15420000
   STACKDST,                << Stack DST number.            >> <<06514>>15425000
   LACB'VTA,                << LACB vector table address.   >> <<06514>>15430000
   PACB'VTA;                << PACB vector table address.   >> <<06514>>15435000
                                                               <<06514>>15440000
PCBPT := CURPRC;                                               <<06514>>15445000
EXCHANGEDB(0);              << Always reset DB to the stack.>> <<06514>>15450000
IF LACBV <> 0D THEN                                            <<06514>>15455000
   BEGIN                    << Update LACB, it exists.      >> <<06514>>15460000
   STACKDST := SPCBSTKDST;  << Stack DST number.            >> <<06514>>15465000
   GET'PXFILE'OFFSET;       << Stack rel offset to PXFILE.  >> <<06514>>15470000
   PXCBT'OFFSET := PXFILE'OFFSET + PXFOVERHEAD;                <<06514>>15475000
                                                               <<06514>>15480000
   << Get the ACB vector table address.                     >> <<06514>>15485000
                                                               <<06514>>15490000
   LOC'VTENTRY(VTMQ,LACBV); << Get LACB vector table entry. >> <<06514>>15495000
   LACB'VTA := VT'ADR;      << Get LACV vector table addr.  >> <<06514>>15500000
   LOC'VTENTRY(VTMQ,PACBV); << Get PACB vector table entry. >> <<06514>>15505000
   PACB'VTA := VT'ADR;      << GeT PACB vector table addr.  >> <<06514>>15510000
                                                               <<06514>>15515000
   << Now copy all of LACB except first word from PACB.     >> <<06514>>15520000
                                                               <<06514>>15525000
   TOS := LACBV'DSTN;       << LACB DST.                    >> <<06514>>15530000
   TOS := LACB'VTA+1;       << One word into LACB.          >> <<06514>>15535000
   IF LACBV'DSTN = STACKDST << Add PXCTAB if in stack.      >> <<06514>>15540000
      THEN TOS := TOS + PXCBT'OFFSET;                          <<06514>>15545000
   TOS := PACBV'DSTN;       << PACB DST.                    >> <<06514>>15550000
   TOS := PACB'VTA + 1;     << One word into PACB.          >> <<06514>>15555000
   IF PACBV'DSTN = STACKDST << Add PXCTAB if in stack.      >> <<06514>>15560000
      THEN TOS := TOS + PXCBT'OFFSET;                          <<06514>>15565000
   TOS := SIZELACB - 1;     << Copy all but one word of LACB>> <<06514>>15570000
   MOVE'DS'5;               << Off they go!                 >> <<06514>>15575000
   END;                                                        <<06514>>15580000
                                                               <<06514>>15585000
END;                                                           <<06514>>15590000
$PAGE "MPE-V FILE SYSTEM - SETACB"                             <<06272>>15595000
$ CONTROL SEGMENT = FILESYS5                                            15600000
PROCEDURE SETACB (ACB,PACBV,LACBV,FLAGS,AFTX,AOPTIONS,FOPTIONS,<<06514>>15605000
   DTYPE,RSIZE,BSIZE,NUMBUFFERS,BLOCKFACTOR,DADDR,PINFO,       <<06514>>15610000
   DNTYPE'DISP,DISKADR,ENDPTR,EOFPTR,MSGINFO);                 <<HM.00>>15615000
                                                               <<06272>>15620000
<<**********************************************************>> <<06272>>15625000
<< SETACB creates a PACB (and an LACB if the file was opened>> <<06272>>15630000
<< multi-access). The ACB's are physically created via the  >> <<06272>>15635000
<< procedure FCREATECB.  After creation, most of the ACB    >> <<06272>>15640000
<< variables are then initialized.  The remainder of the    >> <<06272>>15645000
<< ACB variables are initialized in FOPEN or FOPENDA if this>> <<06272>>15650000
<< is an old disk file.                                     >> <<06272>>15655000
<<                                                          >> <<06272>>15660000
<< The PACB and LACB will always be locked when exiting     >> <<06272>>15665000
<< SETACB.  The PACB could be locked in a variety of ways.  >> <<06272>>15670000
<< First, if this is an old disk file that was already      >> <<06272>>15675000
<< opened multi-access, then the PACB was found via SCAN-   >> <<06272>>15680000
<< FMAVT and locked in FOPEN.  For any multi-access file,   >> <<06272>>15685000
<< SETACB will scan the FMAVT for the PACBV via SCANFMAVT.  >> <<06272>>15690000
<< If it is found, then the file was previously opened      >> <<06272>>15695000
<< multi-access.  If it is non-disk file (like a terminal), >> <<06272>>15700000
<< then FOPEN did not lock the PACB (PACBLOCKED will be     >> <<06272>>15705000
<< FALSE) and thus SETACB will lock the PACB via FGETCB.    >> <<06272>>15710000
<<                                                          >> <<06272>>15715000
<< If the file was not opened multi-access (each open gets  >> <<06272>>15720000
<< its own PACB) or if this is the first open of a multi-   >> <<06272>>15725000
<< access file, then FCREATECB will lock the PACB when it   >> <<06272>>15730000
<< creates it.                                              >> <<06272>>15735000
<<                                                          >> <<06272>>15740000
<< The LACB is also locked when it is created in FCREATECB  >> <<06272>>15745000
<< and it stays locked until it is deleted via DELACB when  >> <<06272>>15750000
<< the file is closed.  This is because LACB's are, of      >> <<06272>>15755000
<< course, never shared.                                    >> <<06272>>15760000
<<                                                          >> <<06272>>15765000
<<   Input variables:                                       >> <<06272>>15770000
<<       FLAGS - True if the PACB was locked in FOPEN, true >> <<06272>>15775000
<<               only for an old multi-access disk file that>> <<06272>>15780000
<<               was previously opened.                     >> <<06272>>15785000
<<       AFTX - AFT entry index (file number)               >> <<06272>>15790000
<<       AOPTIONS - AOPTIONS from FOPEN or FOPENDA          >> <<06272>>15795000
<<       FOPTIONS - FOPTIONS from FOPEN or FOPENDA          >> <<06272>>15800000
<<       DTYPE - Device type of the file.                   >> <<06272>>15805000
<<       RSIZE - Record size (in bytes positive bytes)      >> <<06272>>15810000
<<       BSIZE - Block size (in words)                      >> <<06272>>15815000
<<       NUMBUFFERS - Number of buffers if opened buffered. >> <<06272>>15820000
<<       BLOCKFACTOR - Blocking factor                      >> <<06272>>15825000
<<       DADDR - LDEV number (of first extent if disc)      >> <<06272>>15830000
<<       PINFO - Spoolfile infor array                      >> <<06272>>15835000
<<       DNTYPE'DISP - Name type and FCLOSE disposition     >> <<06272>>15840000
<<       DISKADR - Disk address for SCANFMAVT               >> <<06272>>15845000
<<       ENDPTR  - End of file data block                   >> <<06272>>15850000
<<       EOFPTR  - EOF in records/blocks                    >> <<06272>>15855000
<<       MSGINFO - IPC file info array                      >> <<06272>>15860000
<<                                                          >> <<06272>>15865000
<<                                                          >> <<06514>>15870000
<<   Output variables:                                      >> <<06514>>15875000
<<       ACB - DB relative pointer to the PACB              >> <<06272>>15880000
<<       PACBV - Physcial ACB vector                        >> <<06272>>15885000
<<       LACBV - Logical ACB vector (if existant)           >> <<06272>>15890000
<<       FLAGS - Bit 15 on if LACB was needed               >> <<06272>>15895000
<<               Bit 14 on if the PACB already existed,     >> <<06272>>15900000
<<                  ie SCANFMAVT found this files entry.    >> <<06272>>15905000
<<                                                          >> <<06272>>15910000
<<   Condition Code:                                        >> <<06272>>15915000
<<       CCE - OK                                           >> <<06272>>15920000
<<       CCL - Error of some type in allocating the DST for >> <<06272>>15925000
<<             the ACB.                                     >> <<06272>>15930000
<<       CCG - Could not allocate an FMAVT entry for a      >> <<06272>>15935000
<<             multi-access file.                           >> <<06272>>15940000
<<                                                          >> <<06272>>15945000
<<   DB setting - DB must be set to the stack upon entry.   >> <<06272>>15950000
<<   If we were successfull then DB will be set to the DST  >> <<06272>>15955000
<<   containing the ACB. Otherwise DB will be not change.   >> <<06272>>15960000
<<   NOTE: Output variables are returned by a partial cut-  >> <<06272>>15965000
<<   back of the stack.                                     >> <<06272>>15970000
<<**********************************************************>> <<06272>>15975000
                                                               <<06272>>15980000
   VALUE PACBV,LACBV,FLAGS,AFTX,AOPTIONS,FOPTIONS,DTYPE,RSIZE, <<06514>>15985000
      BSIZE,NUMBUFFERS,BLOCKFACTOR,DADDR,DNTYPE'DISP,          <<06514>>15990000
      DISKADR,ENDPTR,EOFPTR;                                   <<HM.00>>15995000
   INTEGER AFTX,DTYPE,RSIZE,BSIZE,NUMBUFFERS,                  <<06514>>16000000
      BLOCKFACTOR,DADDR,DNTYPE'DISP;                                    16005000
   DOUBLE PACBV,LACBV;                                         <<06514>>16010000
   INTEGER ARRAY ACB;                                                   16015000
   LOGICAL FLAGS,AOPTIONS,FOPTIONS;                            <<06514>>16020000
   ARRAY PINFO,MSGINFO;                                        <<HM.00>>16025000
   DOUBLE DISKADR,ENDPTR,EOFPTR;                               <<HM.00>>16030000
   OPTION PRIVILEGED,UNCALLABLE;                                        16035000
$PAGE                                                          <<06272>>16040000
   BEGIN                                                                16045000
                                                               <<06514>>16050000
   INTEGER POINTER PXFILE;  <<PXFILE POINTER>>                          16055000
   INTEGER                                                     <<06272>>16060000
      PACB'SIZE,         << Size in words of new PACB.      >> <<06272>>16065000
      LACB'SIZE,         <<   "   "   "    "  "  LACB.      >> <<06727>>16070000
      OVER'HEAD;         << Size of buffer overhead.        >> <<06727>>16075000
   DEFINE                                                      <<06727>>16080000
      MAX'BUFF'SIZE=(32764-OVER'HEAD)/NUMBUFFERS-BLKBUFDISP#;  <<06727>>16085000
   INTEGER ACBX;  <<UTILITY VARIABLE>>                                  16090000
   DOUBLE POINTER ACBDBL = ACB;                                         16095000
   INTEGER POINTER BLK;  <<ACB BUFFER POINTER>>                         16100000
   DOUBLE POINTER BLKDBL = BLK;                                         16105000
   INTEGER P1 = DISKADR+0;                                              16110000
   INTEGER P2 = DISKADR+1;                                              16115000
   INTEGER POINTER LACB;  <<LACB POINTER>>                              16120000
   LOGICAL OLDSIR;  <<OLD FMAVT SIR>>                                   16125000
   LOGICAL PACBLOCKED;  <<PACB LOCKED FLAG>>                            16130000
                                                               <<HM.00>>16135000
   <<IPC ACCESS>>                                              <<HM.00>>16140000
   ARRAY IPCINFO(0:3)=Q;                                       <<HM.00>>16145000
   DOUBLE FILELIMIT=IPCINFO;                                   <<HM.00>>16150000
   DOUBLE NUMHEADEREC=IPCINFO+2;                               <<HM.00>>16155000
   LOGICAL MSGFILE,SAVEMSGFILE;                                <<HM.00>>16160000
                                                                        16165000
   <<SPOOLFILE ACCESS>>                                                 16170000
                                                                        16175000
   ARRAY SPINFO (0:13) = Q;                                             16180000
   LOGICAL SPOOLF = SPINFO+0;                                           16185000
   INTEGER POINTER XDDEP = SPINFO+1;                                    16190000
   INTEGER SPVDEV = SPINFO+5;                                           16195000
   INTEGER SPFOPT = SPINFO+6;                                           16200000
   INTEGER SPAOPT = SPINFO+7;                                           16205000
   INTEGER SPREC  = SPINFO+8;                                           16210000
   INTEGER SPSTATE= SPINFO+9;                                           16215000
   ARRAY SPFN (*) = SPINFO+10;                                          16220000
   DOUBLE SCAN'FMAVT;                                          <<06272>>16225000
   INTEGER                                                     <<06272>>16230000
      SCAN1 = SCAN'FMAVT + 1,                                  <<06272>>16235000
      STRATEGY,I;                                              <<06272>>16240000
   LOGICAL FMAVT'FLAGS;                                        <<06272>>16245000
   DEFINE                                                      <<06272>>16250000
       PACB'IS'OLD = FLAGS.(14:1)#, << Signifies PACB exists>> <<06272>>16255000
       PACB'IS'NEW = NOT PACB'IS'OLD#,                         <<06272>>16260000
       LACB'NEEDED = FLAGS.(15:1)#; << LACB is needed.      >> <<06272>>16265000
   INTEGER                                                     <<06514>>16270000
      LACBV'DSTN   = LACBV + 0,                                <<06514>>16275000
      LACBV'ENTRY  = LACBV + 1,                                <<06514>>16280000
      PACBV'DSTN   = PACBV + 0,                                <<06514>>16285000
      PACBV'ENTRY  = PACBV + 1;                                <<06514>>16290000
                                                                        16295000
$  IF X0 = ON                                                           16300000
   IF MONOTHER THEN  <<MONITORING?>>                                    16305000
      BEGIN                                                             16310000
      TOS := "SE"; TOS := "TA"; TOS := "CB";                            16315000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        16320000
      FTITLE(*,*,*,*);                                                  16325000
      DEBUG                                                             16330000
      END;                                                              16335000
$  IF                                                                   16340000
                                                               <<06514>>16345000
                                                               <<06514>>16350000
                                                               <<06514>>16355000
                                                               <<06514>>16360000
                                                                        16365000
                                                               <<06514>>16370000
SUBROUTINE EXIT(DELETE,CC');                                   <<06272>>16375000
VALUE DELETE,CC';                                              <<06272>>16380000
LOGICAL DELETE,CC';                                            <<06272>>16385000
                                                               <<06272>>16390000
!------------------------------------------------------------- <<06514>>16395000
! Exit SETACB in a number of ways.  If DELETE is true, then    <<06514>>16400000
! DELACB must be called to decrement the ACB share counts. If  <<06514>>16405000
! the ACB has just been created, then, of course, it will be   <<06514>>16410000
! deleted.  If not, then DELACB will properly decrement the    <<06514>>16415000
! share counts and unlock the ACB for us.  When we return to   <<06514>>16420000
! FOPEN or FOPENDA with an error, the ACB will be taken care   <<06514>>16425000
! of and properly purged (if new) or unlocked (if old).        <<06514>>16430000
!------------------------------------------------------------- <<06514>>16435000
                                                               <<06272>>16440000
BEGIN                                                          <<06272>>16445000
IF DELETE THEN                                                 <<06272>>16450000
   BEGIN                                                       <<06272>>16455000
   EXCHANGEDB(0);           << Set DB back to the stack.    >> <<06272>>16460000
   DELACB(PACBV,LACBV,AOPACTYPE);                              <<06514>>16465000
   END;                                                        <<06272>>16470000
IF LACB'NEEDED THEN                                            <<06272>>16475000
   BEGIN                                                       <<06272>>16480000
   RELSIR(FMAVTSIR,OLDSIR);                                    <<06272>>16485000
   END;                                                        <<06272>>16490000
CONDCODE := CC';                                               <<06272>>16495000
ASSEMBLE(EXIT 18);          << Leave output on stack.       >> <<06514>>16500000
END;                                                           <<06272>>16505000
$PAGE "MPE-V FILE SYSTEM - SETACB - MAIN BLOCK"                <<06272>>16510000
                                                               <<06514>>16515000
   SETPXFILE;        << Initialize PXFILE pointer.          >> <<06514>>16520000
   MOVE SPINFO := PINFO, (14);                                          16525000
   IF FOPMSGFILE AND NOT AOPCOPY                               <<06272>>16530000
      THEN MSGFILE := TRUE                                     <<06272>>16535000
      ELSE MSGFILE := FALSE;                                   <<06272>>16540000
   SAVEMSGFILE:=(MSGFILE LAND NOT AOPWRITE);                   <<HM.00>>16545000
   IF MSGFILE THEN MOVE IPCINFO:=MSGINFO,(4);                  <<HM.00>>16550000
                                                               <<06272>>16555000
   <<* * * CHECK LOGICAL/PHYSICAL ACB REQUIREMENTS * * *>>              16560000
                                                                        16565000
   LACBV := 0D;                                                <<06514>>16570000
   PACBLOCKED := FLAGS; << FLAGS input signifies PACB lock. >> <<06272>>16575000
   FLAGS := 0;          << Clear return FLAGS word.         >> <<06272>>16580000
                                                               <<06272>>16585000
   <<*******************************************************>> <<06272>>16590000
   << If the file was opened multi-access, then we need to  >> <<06272>>16595000
   << scan the FMAVT to obtain the PACBV.  Set up the FLAGS >> <<06272>>16600000
   << word according to the specs in SCANFMAVT.             >> <<06272>>16605000
   <<*******************************************************>> <<06272>>16610000
                                                               <<06272>>16615000
   IF AOPMULTAC <> 0 THEN                                      <<06272>>16620000
      BEGIN   << LACB is required, file was opened multi.   >> <<06272>>16625000
      LACB'NEEDED := TRUE;                                     <<06272>>16630000
      OLDSIR := GETSIR(FMAVTSIR);                                       16635000
      FMAVT'FLAGS:=0; << Start with job, disk file, search. >> <<06272>>16640000
      FMAVT'FLAGS.(12:1) := AOPGLOBALMULTAC;                   <<06272>>16645000
                                                               <<06272>>16650000
      IF DTYPE.(10:3) = DIRACC THEN                            <<06272>>16655000
         P1.(0:8) := DADDR  << Place disk LDEV in upper bits>> <<06272>>16660000
      ELSE                                                     <<06272>>16665000
         BEGIN  << Non disk file, device file of some type. >> <<06272>>16670000
         FMAVT'FLAGS.(13:1) := 1; << Set device bit.        >> <<06272>>16675000
         DISKADR := 0D;                                        <<06272>>16680000
         P1 := DADDR;       << Place LDEV in full word.     >> <<06272>>16685000
         END;                                                           16690000
                                                               <<06272>>16695000
      <<****************************************************>> <<06272>>16700000
      << Now scan the FMAVT.  If our entry already exist,   >> <<06272>>16705000
      << then the PACB already exists, we use the same one. >> <<06272>>16710000
      << Lock it if needed, set ACB pointer and skip to     >> <<06272>>16715000
      << LACB creation with DB set to ACB data segment.     >> <<06272>>16720000
      <<****************************************************>> <<06272>>16725000
                                                               <<06272>>16730000
      SCAN'FMAVT := SCANFMAVT(FMAVT'FLAGS,,P1,P2);             <<06272>>16735000
      PACBV := SCAN'FMAVT;                                     <<06514>>16740000
      IF PACBV <> 0D THEN                                      <<06514>>16745000
         BEGIN                                                          16750000
         PACB'IS'OLD := TRUE;                                  <<06272>>16755000
                                                               <<06272>>16760000
         <<*************************************************>> <<06272>>16765000
         << Get to ACB, obtain ACB offset and lock if not   >> << 8543>>16770000
         << already locked.  If the ACB has not been locked,>> << 8543>>16775000
         << then this must be a device file since FOPEN     >> << 8543>>16780000
         << will always lock the PACB for disc files.  Send >> << 8543>>16785000
         << the FMAVT so that FGETCB  will release the SIR  >> << 8543>>16790000
         << before impeding on the PACB.                    >> << 8543>>16795000
         <<*************************************************>> <<06272>>16800000
                                                               <<06272>>16805000
         IF PACBLOCKED                                         <<06514>>16810000
            THEN @ACB := FGET'CB(PACBV,0)                      <<06514>>16815000
            ELSE @ACB := FGET'CB(PACBV,1,FMAVTSIR,OLDSIR);     <<06514>>16820000
                                                               <<06514>>16825000
         GOTO CLACB;   << Jump to creation of LACB.         >> <<06272>>16830000
         END                                                            16835000
      END;                                                              16840000
                                                                        16845000
   <<*******************************************************>> <<06272>>16850000
   << ACB needed to be created. Calculate size needed       >> <<06272>>16855000
   << for the ACB.  For buffered files, we must calculate   >> <<06272>>16860000
   << the size needed for the extra data segment. For       >> <<06272>>16865000
   << message files, add extra words to standard ACB %64.   >> <<06514>>16870000
   <<*******************************************************>> <<06272>>16875000
                                                                        16880000
   PACB'SIZE := SIZEACB;                                       <<06272>>16885000
   IF MSGFILE                                                  <<06272>>16890000
      THEN PACB'SIZE := PACB'SIZE + MSGACBEXTEND;              <<06272>>16895000
   IF NOT AOPINHIBITBUF THEN  <<BUFFERING?>>                            16900000
      BEGIN                                                             16905000
      IF NUMBUFFERS > 16 THEN  <<TOO MANY BUFFERS?>>           <<HM.00>>16910000
         NUMBUFFERS:=16;                                       <<HM.00>>16915000
      IF MSGFILE THEN                                          <<HM.00>>16920000
         BEGIN                                                 <<HM.00>>16925000
         IF NUMBUFFERS <= 1 THEN NUMBUFFERS:=2;                <<HM.00>>16930000
         IF DBL(NUMBUFFERS) > (FILELIMIT/DBL(BLOCKFACTOR)) THEN<<HM.00>>16935000
            NUMBUFFERS:=INT(FILELIMIT)/BLOCKFACTOR;            <<HM.00>>16940000
         PACB'SIZE := PACB'SIZE + NUMBUFFERS;                  <<06272>>16945000
         END;                                                  <<HM.00>>16950000
                                                               <<06727>>16955000
      !------------------------------------------------------- <<06727>>16960000
      ! Make sure that the number of buffers requested times   <<06727>>16965000
      ! the block size plus the overhead is not larger than    <<06727>>16970000
      ! the maximum extra data segment size.  If so, trim the  <<06727>>16975000
      ! number of buffers by 1.  If it is still larger and we  <<06727>>16980000
      ! are down to one buffer, return an error.               <<06727>>16985000
      !------------------------------------------------------- <<06727>>16990000
                                                               <<06727>>16995000
      OVER'HEAD := PACB'SIZE+CBTOVERHEAD+VTENTRY;              <<06727>>17000000
      WHILE BSIZE > MAX'BUFF'SIZE DO                           <<06727>>17005000
         BEGIN                    ! Try with one less buffer.  <<06727>>17010000
         NUMBUFFERS := NUMBUFFERS - 1;                         <<06727>>17015000
         IF NUMBUFFERS = 0 OR (MSGFILE LAND NUMBUFFERS = 1)    <<06727>>17020000
            THEN EXIT(FALSE,CCL); ! No luck, not enouph room.  <<06727>>17025000
         END;                                                  <<06727>>17030000
      PACB'SIZE := PACB'SIZE+NUMBUFFERS*(BSIZE+BLKBUFDISP);    <<06272>>17035000
      END;                                                     <<06272>>17040000
                                                               <<06272>>17045000
   <<*******************************************************>> <<06272>>17050000
   << For buffered files, create non-expandable extra data  >> <<06272>>17055000
   << segment.  For unbuffered, put ACB in PXFILE area.     >> <<06272>>17060000
   << Create the ACB via FCREATECB.  DB will return set to  >> <<06272>>17065000
   << the data segment of the new ACB, stack or extra DS.   >> <<06272>>17070000
   <<*******************************************************>> <<06272>>17075000
                                                               <<06514>>17080000
   IF NOT AOPINHIBITBUF THEN                                   <<06514>>17085000
      STRATEGY := -3         ! Buffer files get own DST.       <<06514>>17090000
   ELSE                      ! NOBUF file, go two ways.        <<06514>>17095000
      IF AOPMULTAC <> 0 OR AOPGLOBALAFT                        <<06514>>17100000
         THEN STRATEGY := -2  ! Placed in system shared CB DST.<<06514>>17105000
         ELSE STRATEGY := -4; ! PXFILE or user NOBUF CB DST.   <<06514>>17110000
                                                               <<06272>>17115000
   FCREATECB(DUM,0D,STRATEGY,PACB'SIZE,CBPACB);                <<06514>>17120000
   IF < THEN EXIT(FALSE,CCL);                                  <<06272>>17125000
   PACBV := TOS;     << Obtianed from FCREATECB via partial >> <<06272>>17130000
   @ACB  := TOS;     << cutback of the stack.               >> <<06272>>17135000
                                                                        17140000
   <<*******************************************************>> <<06272>>17145000
   << Initialize most of the ACB variables properly.        >> <<06272>>17150000
   <<*******************************************************>> <<06272>>17155000
                                                                        17160000
   ACBSHCNTIN := 0;    << Initialize input LACB counts.     >> <<06514>>17165000
   ACBSHCNT   := 0;    << Total share count.                >> <<06514>>17170000
   ACBHIBLK := -1D;                                                     17175000
   ACBDTYPE := DTYPE;  <<DEVICE TYPE>>                                  17180000
   ACBDADDR := DADDR;  <<LOG. DEV. NR.>>                                17185000
   IF SPOOLF THEN  <<SPOOLFILE ACCESS?>>                                17190000
      BEGIN                                                             17195000
      ACBSPXDDX := @XDDEP;                                              17200000
      IF INTEGER(SPOOLF) > 0 THEN  <<VIRTUAL DEVICE?>>                  17205000
         BEGIN                                                          17210000
         ACBSPOOLIO := LOGICAL(ACBSPXDDX.(0:1)) LOR 2;                  17215000
         ACBSPVDEV := SPVDEV;                                           17220000
         ACBSPFOPT := SPFOPT;                                           17225000
         ACBSPAOPT := SPAOPT;                                           17230000
         ACBSPTYRC := SPREC                                             17235000
         END                                                            17240000
      END;                                                              17245000
   ACBRSIZE := RSIZE;  <<RECORD SIZE - IN BYTES>>                       17250000
   ACBBSIZE := BSIZE;  <<BLOCK SIZE - IN WORDS>>                        17255000
   ACBDNTD := DNTYPE'DISP;  << name type & disposition >>      <<*****>>17260000
   ACBBLKFACT := BLOCKFACTOR;  <<BLOCKING FACTOR>>                      17265000
   IF (SAVEMSGFILE OR AOPAPPEND) AND NOT AOPCOPY THEN          <<HM.00>>17270000
      BEGIN                                                    <<HM.00>>17275000
      IF MSGFILE OR FOPVARIABLE THEN ACBBLK:=ENDPTR;           <<HM.00>>17280000
      ACBFPTR:=EOFPTR;                                         <<HM.00>>17285000
      END;                                                     <<HM.00>>17290000
                                                               <<06272>>17295000
   <<*******************************************************>> <<06272>>17300000
   << For buffered files, initialize buffering variables.   >> <<06272>>17305000
   << Then, initialize all buffer block numbers to -1, sig- >> <<06272>>17310000
   << nifying empty buffer.                                 >> <<06272>>17315000
   <<*******************************************************>> <<06272>>17320000
                                                               <<06272>>17325000
   IF NOT AOPINHIBITBUF THEN  <<BUFFERING?>>                            17330000
      BEGIN                                                             17335000
      ACBBUFSIZE := BLKBUFDISP+BSIZE;  <<block buffer size>>   <<00822>>17340000
      ACBNUMBUFS := NUMBUFFERS-1;  <<NR. BUFFERS LESS 1>>               17345000
      ACBBUFUSED := 0;  << init. record pointer >>             <<*****>>17350000
                                                                        17355000
      << Initialize block buffers.                          >> <<06272>>17360000
                                                                        17365000
      IF NOT MSGFILE OR AOPCOPY THEN                           <<HM.00>>17370000
         BEGIN                                                 <<HM.00>>17375000
         @BLK := @ACBBUFPOOL;  <<FIRST BLOCK BUFFER>>          <<HM.00>>17380000
         I := NUMBUFFERS;                                      <<06272>>17385000
         WHILE I > 0 DO                                        <<06272>>17390000
            BEGIN                                              <<06272>>17395000
            BLKBLOCK := -1D;         << Mark buffer empty.  >> <<06272>>17400000
            @BLK := @BLK+ACBBUFSIZE; << Next block buffer.  >> <<06272>>17405000
            I := I-1;                                          <<06272>>17410000
            END;                                               <<06272>>17415000
         END;                                                  <<HM.00>>17420000
      END;                                                              17425000
                                                                        17430000
   <<*******************************************************>> <<06272>>17435000
   << If the file was opened multi-access, then create an   >> <<06272>>17440000
   << LACB for the file.                                    >> <<06272>>17445000
   <<*******************************************************>> <<06272>>17450000
                                                                        17455000
CLACB:                                                                  17460000
   IF LACB'NEEDED THEN                                         <<06272>>17465000
      BEGIN                                                             17470000
                                                               <<06272>>17475000
      <<****************************************************>> <<06272>>17480000
      << Allocate LACB storage via FCREATECB.  Again, DB    >> <<06272>>17485000
      << will be set to the data segment containing the     >> <<06272>>17490000
      << LACB, most likely the stack.  However, if program  >> <<06272>>17495000
      << was run with NOCB, then it will be in an extra DS. >> <<06272>>17500000
      <<****************************************************>> <<06272>>17505000
                                                                        17510000
      EXCHANGEDB(0);  <<RESET DB TO STACK>>                             17515000
      LACB'SIZE := SIZELACB;                                   <<06272>>17520000
      IF MSGFILE THEN LACB'SIZE := LACB'SIZE + MSGLACBEXTEND;  <<06272>>17525000
      IF AOPGLOBALAFT                                          <<06514>>17530000
         THEN STRATEGY := -2 ! System wide CB DST.             <<06514>>17535000
         ELSE STRATEGY := -4;! Try PXFILE, then NOBUF CB DST.  <<06514>>17540000
      FCREATECB(DUM,0D,STRATEGY,LACB'SIZE,CBLACB);             <<06514>>17545000
      IF < THEN  <<ERROR?>>                                             17550000
         BEGIN                                                          17555000
         IF PACB'IS'NEW                                        <<06272>>17560000
            THEN DELACB(PACBV,0D)   << Delete the new PACB. >> << 8485>>17565000
            ELSE UNLOCK'CB(0,PACBV);<< Unlock the old PACB. >> << 8485>>17570000
         EXIT(FALSE,CCL);                                      <<06272>>17575000
         END;                                                           17580000
      LACBV := TOS;  <<LACB VECTOR>>                                    17585000
      @LACB := TOS;  <<LACB POINTER>>                                   17590000
                                                               <<06514>>17595000
                                                               <<06272>>17600000
      <<****************************************************>> <<06272>>17605000
      << First, reset DB from the LACB DST to PACB DST.     >> <<06272>>17610000
      << Then, if the PACB has just been created, then in-  >> <<06272>>17615000
      << sert an entry into the FMAVT for this file.  If    >> <<06272>>17620000
      << SCANFMAVT returns a 0, then the FMAVT is out of    >> <<06272>>17625000
      << entries, report an error.                          >> <<06272>>17630000
      <<****************************************************>> <<06272>>17635000
                                                               <<06272>>17640000
      IF LACBV'DSTN <> PACBV'DSTN                              <<06272>>17645000
         THEN EXCHANGEDB(PACBV'DSTN);                          <<06272>>17650000
      ACBSHCNT := ACBSHCNT+1;                                  << 8485>>17655000
      IF AOPREAD THEN                                          << 8485>>17660000
         ACBSHCNTIN := ACBSHCNTIN + 1;                         << 8485>>17665000
      IF PACB'IS'NEW THEN                                      <<06272>>17670000
         BEGIN                                                 <<04519>>17675000
         FMAVT'FLAGS.(14:2) := 1;  << Indicate ADD entry.   >> <<06272>>17680000
         SCAN'FMAVT:=SCANFMAVT(FMAVT'FLAGS,,P1,P2,PACBV);      <<06514>>17685000
         ACBFMAVTX := SCAN1; << Index is in word 1.         >> <<06272>>17690000
         IF ACBFMAVTX = 0    << Out of FMAVT entries        >> <<04519>>17695000
            THEN EXIT(TRUE,CCG);                               <<06272>>17700000
         END;                                                  <<04519>>17705000
      END;                                                              17710000
                                                                        17715000
   <<*******************************************************>> <<06272>>17720000
   << Now initialize the LACB variables in the PACB.  If an >> <<06272>>17725000
   << LACB exists, then the physical LACB will be initial-  >> <<06272>>17730000
   << ized with top of the PACB in FOPEN or FOPENDA via     >> <<06272>>17735000
   << the procedure UPDATE'LACB.                            >> <<06272>>17740000
   <<*******************************************************>> <<06272>>17745000
                                                                        17750000
   ACBFNUM := AFTX;  <<FILE NUMBER>>                                    17755000
   ACBFOPTIONS := FOPTIONS;  <<FOPTIONS>>                               17760000
   ACBAOPTIONS := AOPTIONS;  <<AOPTIONS>>                               17765000
   ACBLSTATE := 0;  <<CLEAR MISC. STATE FLAGS>>                         17770000
   IF (AOPINHIBITBUF) AND (AOPMULTIREC) AND (ACBDTYPE < CARDR) AND      17775000
      NOT ACBCIRFILE AND NOT ACBMSGFILE AND                    <<HM.00>>17780000
      ((BSIZE.(9:7) = 0) OR (DTYPE=FDISC))                     <<01115>>17785000
     THEN ACBSTREAM := 1;   <<STREAM I/O>>                     <<01115>>17790000
   ACBCTL := 0;                                                         17795000
   ACBSETMODE := 0;                                            <<06514>>17800000
   ACBERROR := 0;                                                       17805000
   ACBTLOG := 0;                                                        17810000
   IF AOPINHIBITBUF THEN  <<TERMINAL KLUDGE?>>                          17815000
      BEGIN                                                             17820000
      ACBRSIZE := RSIZE;                                                17825000
      ACBBSIZE := BSIZE                                                 17830000
      END;                                                              17835000
   ACBSTOPCHAR := 0;                                           <<00.06>>17840000
                                                                        17845000
   IF MSGFILE THEN                                             <<HM.00>>17850000
      BEGIN                                                    <<HM.00>>17855000
      IF PACB'IS'NEW AND                                       <<06272>>17860000
      FCINITACB(ACB,FILELIMIT,NUMHEADEREC,ENDPTR) <> SUCCESSFUL<<06272>>17865000
         THEN EXIT(TRUE,CCL);                                  <<06272>>17870000
                                                               <<06272>>17875000
      IF NOT ACBCOPY AND FCOPEN(ACB,LACBV) <> SUCCESSFUL       <<06272>>17880000
         THEN EXIT(TRUE,CCL);                                  <<06272>>17885000
      END;                                                     <<04741>>17890000
                                                               <<04741>>17895000
   EXIT(FALSE,CCE); << A-OK, rip this joint!                >> <<06272>>17900000
   END;       << procedure SETACB >>                                    17905000
$PAGE "MPE-V FILE SYSTEM - DELACB             "                <<06272>>17910000
$ CONTROL SEGMENT = FILESYS7                                            17915000
PROCEDURE DELACB (PACBV,LACBV,ACCESS'TYPE);                    <<06514>>17920000
 VALUE   ACCESS'TYPE,PACBV,LACBV;                              <<06514>>17925000
 INTEGER ACCESS'TYPE;                                          <<06514>>17930000
 DOUBLE PACBV,LACBV;                                           <<06514>>17935000
 OPTION  PRIVILEGED,UNCALLABLE,VARIABLE;                       <<06514>>17940000
                                                               <<06514>>17945000
 !------------------------------------------------------------ <<06514>>17950000
 ! This procedure has three main functions.  First, if an LACB <<06514>>17955000
 ! exists (the file was multi-access), then it deletes the     <<06514>>17960000
 ! LACB and decrements the ACB share counts.  Next, if we are  <<06514>>17965000
 ! NOT the last accessor to the ACB, then the PACB must be un- <<06514>>17970000
 ! locked by us!  FCLOSE, SETACB and FOPENDA are counting on   <<06514>>17975000
 ! us to unlock the ACB after decrementing the share counts.   <<06514>>17980000
 ! Lastly, if the ACB share count has gone to 0, then we will  <<06514>>17985000
 ! delete the ACB and, if it was multi-access, delete its en-  <<06514>>17990000
 ! try from the FMAVT.                                         <<06514>>17995000
 !                                                             <<06514>>18000000
 ! Input variables:                                            <<06514>>18005000
 !   PACBV, LACBV - Physical and Logical ACB vectors.          <<06514>>18010000
 !   ACCESS'TYPE  - This is the access type of the file.       <<06514>>18015000
 !                  it is sent in the case that this is        <<06514>>18020000
 !                  not the last access to the ACB and the     <<06514>>18025000
 !                  ACB share counts must be decremented.      <<06514>>18030000
 !------------------------------------------------------------ <<06514>>18035000
                                                               <<06514>>18040000
   BEGIN                                                       <<06514>>18045000
   INTEGER POINTER ACB;                                        <<06514>>18050000
   INTEGER                                                     <<06514>>18055000
       FMAVTX,           ! Index into FMAVT for multi file.    <<06514>>18060000
       DSTX,             ! Current DB.                         <<06514>>18065000
       TOTAL'SHARE'CNT := 0,                                   <<06514>>18070000
       GMULTAC,          ! Used to save the multi-access bits. <<06514>>18075000
       FMAVT'FLAGS,                                            <<06514>>18080000
       PCBPT;            ! Used for PCB defines.               <<06514>>18085000
   LOGICAL PMAP = Q-4;                                         <<06514>>18090000
   DEFINE                                                      <<06514>>18095000
      SHARE'MODE      = PMAP.(15:1)#,                          <<06514>>18100000
      READ'ACCESS     = ACCESS'TYPE = 0#;                      <<06514>>18105000
                                                               <<06514>>18110000
$  IF X0 = ON                                                  <<06514>>18115000
   IF MONOTHER THEN  <<MONITORING?>>                           <<06514>>18120000
      BEGIN                                                    <<06514>>18125000
      TOS := "DE"; TOS := "LA"; TOS := "CB";                   <<06514>>18130000
      ASSEMBLE(ZERO,DZRO; DZRO);                               <<06514>>18135000
      FTITLE(*,*,*,*);                                         <<06514>>18140000
      DEBUG                                                    <<06514>>18145000
      END;                                                     <<06514>>18150000
$  IF                                                          <<06514>>18155000
                                                               <<06514>>18160000
   !---------------------------------------------------------- <<06514>>18165000
   ! If the file was opened multi-access (LACB exists), then   <<06514>>18170000
   ! delete the LACB and decrement the ACB share count and the <<06514>>18175000
   ! read access share count if open for read.  Next, obtain   <<06514>>18180000
   ! the Index of the FMAVT of the files entry and the global  <<06514>>18185000
   ! multi access bits for use by SCANFMAVT.                   <<06514>>18190000
   !---------------------------------------------------------- <<06514>>18195000
                                                               <<06514>>18200000
   PCBPT := CURPRC;                                            <<06514>>18205000
   IF LACBV <> 0D THEN    ! Was the file opened multi-access?  <<06514>>18210000
      BEGIN                                                    <<06514>>18215000
      DSTX := SPCBXDSDST; ! Save current DB, extra or stack.   <<06514>>18220000
      FDELETECB(LACBV);   ! First, delete the LACB.            <<06514>>18225000
      ! DB will be set to the ACB DST upon return from FGETCB. <<06514>>18230000
      @ACB := FGET'CB(PACBV,0);                                <<06514>>18235000
      GMULTAC:=ACBGLOBALMULTAC;                                <<06514>>18240000
      IF SHARE'MODE AND READ'ACCESS                            <<06514>>18245000
         THEN ACBSHCNTIN := ACBSHCNTIN - 1;                    <<06514>>18250000
      ACBSHCNT := ACBSHCNT-1;                                  <<06514>>18255000
      TOTAL'SHARE'CNT := ACBSHCNT;                             <<06514>>18260000
      FMAVTX := ACBFMAVTX;                                     <<06514>>18265000
      EXCHANGEDB(DSTX);   ! Reset to original DB, xtra or stk. <<06514>>18270000
      IF TOTAL'SHARE'CNT > 0                                   <<06514>>18275000
         THEN UNLOCK'CB(0,PACBV);                              <<06514>>18280000
      END;                                                     <<06514>>18285000
                                                               <<06514>>18290000
   !---------------------------------------------------------- <<06514>>18295000
   ! If this is the last accessor to the PACB, then delete the <<06514>>18300000
   ! FMAVT entry via SCANFMAVT and delete the PACB.            <<06514>>18305000
   !---------------------------------------------------------- <<06514>>18310000
                                                               <<06514>>18315000
   IF TOTAL'SHARE'CNT = 0 THEN                                 <<06514>>18320000
      BEGIN                                                    <<06514>>18325000
      FMAVT'FLAGS := 2;       ! Signify delete.                <<06514>>18330000
      FMAVT'FLAGS.(12:1) := GMULTAC;                           <<06514>>18335000
      IF LACBV <> 0D                                           <<06514>>18340000
         THEN SCANFMAVT(FMAVT'FLAGS,FMAVTX);                   <<06514>>18345000
      FDELETECB(PACBV)        ! Delete the PACB now.           <<06514>>18350000
      END                                                      <<06514>>18355000
   END;                                                        <<06514>>18360000
$PAGE "MPE-V FILE SYSTEM - SCANFMAVT          "                <<06272>>18365000
$ CONTROL SEGMENT = FILESYS5                                            18370000
DOUBLE PROCEDURE SCANFMAVT(FLAG,DEL'INDEX,LDEV'HODA,LODA,      <<06272>>18375000
                           PACBV);                             <<06272>>18380000
 VALUE   FLAG,DEL'INDEX,LDEV'HODA,LODA,PACBV;                  <<06272>>18385000
 INTEGER FLAG,DEL'INDEX,LDEV'HODA,LODA;                        <<06272>>18390000
 DOUBLE PACBV;                                                 <<06272>>18395000
 OPTION  PRIVILEGED,UNCALLABLE,VARIABLE;                       <<06272>>18400000
                                                               <<04519>>18405000
<<**********************************************************>> <<04519>>18410000
<< SCANFMAVT will do one of the following:                  >> <<04519>>18415000
<< (1) Search for an entry based on Disk Address of the file>> <<04519>>18420000
<<     and Job or System multi.                             >> <<04519>>18425000
<< (2) Add a new entry.                                     >> <<04519>>18430000
<< (3) Delete an entry.                                     >> <<04519>>18435000
<<                                                          >> <<04519>>18440000
<< INPUT VARIABLES:                                         >> <<04519>>18445000
<<    FLAG.(12:1)=0 JOB, =1 SYSTEM MULTI-ACCESS             >> <<04519>>18450000
<<        .(13:1)=0 DISK,=1 DEVICE                          >> <<04519>>18455000
<<        .(14:2)=0 SEARCH FOR ENTRY(SCANFMAVT := PACBV)    >> <<06272>>18460000
<<               =1 ADD NEW ENTRY   (SCANFMAVT := INDEX)    >> <<06272>>18465000
<<               =2 DELETE ENTRY                            >> <<06272>>18470000
<<                                                          >> <<04519>>18475000
<<    DEL'INDEX - Word offset into FMAVT of entry to delete.>> <<06272>>18480000
<<    LDEV'HODA - Word two of FMAVT entry for add & search. >> <<06272>>18485000
<<    LODA      - Word three of FMAVT, for add & search.    >> <<06272>>18490000
<<    PACBV     - Double word three for adding an entry.    >> <<06272>>18495000
<<                                                          >> <<04519>>18500000
<< OUTPUT VARIABLES:                                        >> <<04519>>18505000
<<    SCANFMAVT - If we are adding an entry, the word index >> <<04519>>18510000
<<                into the FMAVT into word zero of return.  >> <<06272>>18515000
<<                If we are searching for an entry, the     >> <<04519>>18520000
<<                PACBV, words 4 and 5 of the entry are re- >> <<06272>>18525000
<<                turned into the double return value.      >> <<06272>>18530000
<<                                                          >> <<04519>>18535000
<<   Returned condition code for Scan option:               >> <<04519>>18540000
<<                                                          >> <<04519>>18545000
<<      CCG - File's entry not found                        >> <<04519>>18550000
<<      CCE - File's entry found with either system multi-  >> <<04519>>18555000
<<            access opened by a process in the same job as >> <<04519>>18560000
<<            current opener.                               >> <<04519>>18565000
<<      CCL - Entry found, but caller is not eligible.      >> <<04519>>18570000
<<                                                          >> <<04519>>18575000
<< NOTE: DB can be set anywhere upon entrance to this       >> <<06272>>18580000
<< procedure.                                               >> <<06272>>18585000
<<**********************************************************>> <<04519>>18590000
                                                               <<06514>>18595000
                                                               <<06514>>18600000
                                                               <<06514>>18605000
  BEGIN                                                                 18610000
                                                               <<06272>>18615000
   DOUBLE                                                      <<06272>>18620000
      TEST;            << TEST agaist words 0 and 1.        >> <<06272>>18625000
   INTEGER                                                     <<06272>>18630000
      TEST0 = TEST  ,  << TEST against word 0 of entry.     >> <<06272>>18635000
      TEST1 = TEST+1,  << TEST against word 1 of entry.     >> <<06272>>18640000
      INDEX := 0    ,  << Index into FMAVT.                 >> <<06272>>18645000
      PCBGLOBLOC    ,  << Q rel offset to PXGLOBAL.         >> <<06272>>18650000
      SCANFMAVT1 = SCANFMAVT + 1,                              <<06272>>18655000
      BLANK,           << Index into FMAVT for blanking.    >> <<06272>>18660000
      ORIG'DB;         << DB upon entrance, usually ACB DST.>> <<06272>>18665000
   LOGICAL                                                     <<06272>>18670000
      FOUND'ENTRY;     << Did we find the entry?            >> <<06272>>18675000
                                                               <<04519>>18680000
   EQUATE  SEARCH = 0, ADD = 1, DELETE = 2;                    <<04519>>18685000
                                                                        18690000
$  IF X0 = ON                                                           18695000
   IF MONOTHER THEN  <<MONITORING?>>                                    18700000
      BEGIN                                                             18705000
      TOS := "SC"; TOS := "AN"; TOS := "FM"; TOS := "AV";               18710000
      TOS := "T ";                                                      18715000
      ASSEMBLE(ZERO,DZRO);                                              18720000
      FTITLE(*,*,*,*);                                                  18725000
      DEBUG                                                             18730000
      END;                                                              18735000
$  IF                                                                   18740000
                                                                        18745000
   << Set TEST words to be compared with words 0 and 1 of   >> <<06272>>18750000
   << the entries.  Set up Device & Global bits and JIT DST.>> <<06272>>18755000
                                                               <<04519>>18760000
   SCANFMAVT := 0D;                                            <<06272>>18765000
   TEST := 0D;                                                 <<06272>>18770000
   IF FM'FLAG'MODE <> DELETE THEN                              <<06272>>18775000
      BEGIN                 << Adding or searching.         >> <<06272>>18780000
      IF FM'FLAG'MODE = SEARCH OR FM'FLAG'JOB THEN             <<06272>>18785000
         BEGIN              << Not adding a G-mulit entry.  >> <<06272>>18790000
         PXGLOBAL;                                             <<06272>>18795000
         FM'TEST'JITDST := PXG'JITDST;                         <<06272>>18800000
         END;                                                           18805000
      FM'TEST'VALID := 1;       << Bit 1 always on in word 0>> <<06272>>18810000
      FM'TEST'GLOB'DEV := FM'FLAG'GLOB'DEV;                    <<06272>>18815000
      END;                                                              18820000
                                                               <<04519>>18825000
   ORIG'DB := EXCHANGEDB(FMAVTDST);                            <<06272>>18830000
$PAGE                                                          <<04519>>18835000
   <<*******************************************************>> <<04519>>18840000
   << Now, either delete, add or scan for an entry.         >> <<04519>>18845000
   <<*******************************************************>> <<04519>>18850000
                                                               <<04519>>18855000
   CASE FM'FLAG'MODE OF                                        <<06272>>18860000
      BEGIN                                                    <<04519>>18865000
                                                               <<04519>>18870000
      <<****************************************************>> <<04519>>18875000
      << Searching for an entry.  Check against words 0 to 2>> <<04519>>18880000
      <<****************************************************>> <<04519>>18885000
                                                               <<04519>>18890000
      BEGIN                                                    <<04519>>18895000
      CONDCODE := CCG;      << Assume entry not found.      >> <<04519>>18900000
      FOUND'ENTRY := FALSE;                                    <<04519>>18905000
      INDEX := FM'ENTRY'SIZE;  << Start at word 6, entry 1. >> <<06272>>18910000
      WHILE INDEX < FM'CURR'SIZE AND NOT FOUND'ENTRY DO        <<06272>>18915000
         BEGIN                                                 <<04519>>18920000
         IF FM'TESTW <> 0 AND               << Used entry?  >> <<06272>>18925000
            FM'DEVICE = FM'TEST'DEVICE AND  << Device?      >> <<06272>>18930000
            FM'LDEV'HODA = LDEV'HODA AND                       <<06272>>18935000
            FM'LODA = LODA THEN                                <<06272>>18940000
            BEGIN  << Found a matching entry                >> <<04519>>18945000
            IF FM'JITDST = FM'TEST'JITDST OR                   <<06272>>18950000
               FM'JITDST = 0 THEN                              <<06272>>18955000
               BEGIN  << Matched JOB or G-multi (any job)   >> <<04519>>18960000
               SCANFMAVT := FM'PACBV;  << Return PACBV.     >> <<06272>>18965000
               CONDCODE := CCE;                                <<04519>>18970000
               END                                             <<04519>>18975000
            ELSE                                               <<04519>>18980000
               CONDCODE := CCL;                                <<04519>>18985000
            FOUND'ENTRY := TRUE;                               <<04519>>18990000
            END;                                               <<04519>>18995000
         INDEX := INDEX + FM'ENTRY'SIZE;                       <<06272>>19000000
         END;                                                  <<04519>>19005000
      END;                                                     <<04519>>19010000
                                                               <<06514>>19015000
      <<****************************************************>> <<04519>>19020000
      << Adding an entry.  First, try to find an unused en- >> <<04519>>19025000
      << try.  If none available, enlarge table.  MAX'FMAVT'>> <<04519>>19030000
      << SIZE is largest possible.  When we hit that, we    >> <<04519>>19035000
      << zero it out, and if we try to expand again, FAIL ! >> <<04519>>19040000
      <<****************************************************>> <<04519>>19045000
                                                               <<04519>>19050000
      BEGIN                                                    <<04519>>19055000
      INDEX := FM'ENTRY'SIZE; << Start at entry 1, word 6.  >> <<06272>>19060000
      WHILE INDEX < FM'CURR'SIZE AND FM'TESTW <> 0             <<06272>>19065000
         DO INDEX := INDEX + FM'ENTRY'SIZE;                    <<06272>>19070000
                                                               <<04519>>19075000
      IF INDEX + FM'ENTRY'SIZE < FM'CURR'SIZE THEN             <<06272>>19080000
         BEGIN                     << Found an unused entry >> <<04519>>19085000
         FM'TESTW     := TEST0;          << Word 0.         >> <<06272>>19090000
         FM'JITDST    := FM'TEST'JITDST; << Word 1.         >> <<06272>>19095000
         FM'LDEV'HODA := LDEV'HODA;      << Word 2.         >> <<06272>>19100000
         FM'LODA      := LODA;           << Word 3.         >> <<06272>>19105000
         FM'PACBV     := PACBV;          << Words 4 and 5.  >> <<06272>>19110000
         SCANFMAVT1   := INDEX;    << Return word index     >> <<06272>>19115000
         END                                                   <<04519>>19120000
      ELSE                                                     <<04519>>19125000
         BEGIN << No more unused entrys, enlarge table.     >> <<04519>>19130000
         IF FM'MAX'SIZE = 0 THEN RETURN;  << Out of entries.>> <<06272>>19135000
         FM'CURR'SIZE := FM'CURR'SIZE + 128;                   <<06272>>19140000
         IF FM'CURR'SIZE >= FM'MAX'SIZE THEN                   <<06272>>19145000
            BEGIN                                              <<04519>>19150000
            FM'CURR'SIZE := FM'MAX'SIZE;                       <<06272>>19155000
            FM'MAX'SIZE := 0;     << Can expand no more!    >> <<06272>>19160000
            END;                                               <<04519>>19165000
                                                               <<04519>>19170000
         << Expand and blank out table.                     >> <<04519>>19175000
                                                               <<04519>>19180000
         ALTDSEGSIZE(FMAVTDST,128); << Enlarge table.       >> <<06272>>19185000
         IF <> THEN RETURN;         << No can do!           >> <<04519>>19190000
         BLANK := INDEX;                                       <<04519>>19195000
         DO                                                    <<04519>>19200000
           BEGIN                                               <<04519>>19205000
           FMAVT(BLANK) := 0;                                  <<06272>>19210000
           BLANK := BLANK + FM'ENTRY'SIZE;                     <<06272>>19215000
           END                                                 <<04519>>19220000
         UNTIL BLANK >= FM'CURR'SIZE;                          <<06272>>19225000
                                                               <<04519>>19230000
         << Now fill in new entry.                          >> <<04519>>19235000
                                                               <<04519>>19240000
         FM'TESTW     := TEST0;          << Word 0.         >> <<06272>>19245000
         FM'JITDST    := FM'TEST'JITDST; << Word 1.         >> <<06272>>19250000
         FM'LDEV'HODA := LDEV'HODA;      << Word 2.         >> <<06272>>19255000
         FM'LODA      := LODA;           << Word 3.         >> <<06272>>19260000
         FM'PACBV     := PACBV;          << Words 4 and 5.  >> <<06272>>19265000
         SCANFMAVT1   := INDEX;    << Return word index     >> <<06272>>19270000
         END;  << No more unused entrys, enlarge table.     >> <<04519>>19275000
      END;  << Adding an entry.                             >> <<04519>>19280000
                                                               <<06272>>19285000
      <<****************************************************>> <<04519>>19290000
      << Delete an entry.  Zero out word 0 to delete.       >> <<04519>>19295000
      <<****************************************************>> <<04519>>19300000
                                                               <<04519>>19305000
      FMAVT(DEL'INDEX) := 0;   << It's gone, finito, dead!! >> <<06272>>19310000
                                                               <<04519>>19315000
    END;  << End of CASE MODE OF Search, Add or Delete!     >> <<04519>>19320000
   EXCHANGEDB(ORIG'DB);  << Get back to DB upon entry.      >> <<04519>>19325000
  END;                                                                  19330000
$ PAGE "MPE-V BASELINE FILE SYSTEM - DISCSIZE          "       <<06272>>19335000
<<----------------------------------------------------------------------19340000
*                                                                      *19345000
*  FILE ACCESS SUPPORT PROCEDURES                                      *19350000
*                                                                      *19355000
---------------------------------------------------------------------->>19360000
                                                                        19365000
$CONTROL SEGMENT=FILESYS1                                      <<01115>>19370000
DOUBLE PROCEDURE DISCSIZE(LDEV);                               <<01115>>19375000
                                                               <<01115>>19380000
   VALUE LDEV;                                                 <<01115>>19385000
   INTEGER LDEV;                                               <<01115>>19390000
                                                               <<01115>>19395000
   OPTION PRIVILEGED,UNCALLABLE;                               <<01115>>19400000
                                                               <<01115>>19405000
   COMMENT   THIS PROCEDURE RETURNS THE NUMBER OF SECTORS      <<01115>>19410000
             FOR THE DISC ON DEVICE LDEV.  IT COMPUTES         <<01115>>19415000
             THIS NUMBER BASED ON THE TYPE AND SUBTYPE OF      <<01115>>19420000
             THE DEVICE AND, FOR FLOPPY DISCS, WHETHER         <<01115>>19425000
             AN HP OR IBM FORMAT FLOPPY IS MOUNTED AND         <<01115>>19430000
             WHETHER THE FLOPPY IS ONE OR TWO SIDED.           <<01115>>19435000
             THE COUNT IS COMPUTED BY MULTIPLYING THE          <<01115>>19440000
             MAXIMUM NUMBER OF CYLINDERS ON THE DEVICE BY      <<01115>>19445000
             THE NUMBER OF SECTORS PER CYLINDER.  THIS MAY     <<01115>>19450000
             BE AN OPTIMISTIC ESTIMATE IF ANY TRACK SPARING    <<01115>>19455000
             HAS BEEN DONE.  THE NUMBER RETURNED IS THE        <<01115>>19460000
             PROPER VALUE FOR A FOREIGN DISC FILESIZE.         <<01115>>19465000
           ;                                                   <<01115>>19470000
                                                               <<01115>>19475000
   BEGIN                                                       <<01115>>19480000
                                                               <<01115>>19485000
      INTEGER TYPE, SUBTYPE, TTTT, OLDDB;                      <<01115>>19490000
   DOUBLE T'DISCSIZE = DISCSIZE;                               <<*7667>>19495000
   DOUBLE IO'STATUS;  <<Return parm from ATTACHIO        >>    <<*7667>>19500000
   INTEGER                                                     <<*7667>>19505000
          IO'STAT1 = IO'STATUS, <<Word 1 of return.       >>   <<*7667>>19510000
          IO'STAT2 = IO'STATUS+1; <<Word 2 of return.     >>   <<*7667>>19515000
                                                               <<01115>>19520000
      << IF IN SPLIT STACK, GET OUT >>                         <<01115>>19525000
      CHECKDB;                                                 <<01115>>19530000
      IF <> THEN OLDDB:=EXCHANGEDB(0)  <<GET STACK>>           <<01115>>19535000
            ELSE OLDDB:=0;                                     <<01115>>19540000
                                                               <<01115>>19545000
      TYPE:=LDEVTOTYPE(LDEV);                                  <<01115>>19550000
      SUBTYPE:=LDEVTOSUBTYPE(LDEV);                            <<01115>>19555000
                                                               <<01115>>19560000
      << COMPUTE SIZE >>                                       <<01115>>19565000
                                                               <<01115>>19570000
      COMMENT COMPUTE THE DISC SIZE HERE *** ;                 <<01115>>19575000
                                                               <<01115>>19580000
      DISCSIZE:=2000000000D;  <<DEFAULT VALUE>>                <<01115>>19585000
                                                               <<01115>>19590000
      IF TYPE=0 THEN <<REAL DISC>>                             <<01115>>19595000
         IF NOT (4<=SUBTYPE<=9) THEN GO XIT <<DEFAULT>>        <<01115>>19600000
          ELSE                                                 <<01115>>19605000
           CASE SUBTYPE-4 OF <<DISCSIZE:=SEC/CYL * CYL>>       <<01115>>19610000
            BEGIN                                              <<01115>>19615000
             <<ST 4>> DISCSIZE:=96D*410D;                      <<01115>>19620000
             <<ST 5>> DISCSIZE:=48D*410D;                      <<01115>>19625000
             <<ST 6>> DISCSIZE:=144D*410D;                     <<01115>>19630000
             <<ST 7>> DISCSIZE:=144D*410D;                     <<01115>>19635000
             <<ST 8>> DISCSIZE:=240D*822D;                     <<01115>>19640000
             <<ST 9>> DISCSIZE:=576D*822D;                     <<01115>>19645000
            END                                                <<01115>>19650000
      ELSE IF TYPE=2 THEN <<FLEXIBLE DISC>>                    <<01115>>19655000
         BEGIN                                                 <<01115>>19660000
           TOS:=REQSTATUS(LDEV); <<GET TTTT STATUS FIELD>>     <<01115>>19665000
           ASSEMBLE(XCH;DEL;EXF 3:4);                          <<01115>>19670000
           TTTT:=TOS;                                          <<01115>>19675000
           IF 0<=TTTT<=8 THEN <<VALID>>                        <<01115>>19680000
             CASE TTTT OF                                      <<01115>>19685000
               BEGIN                                           <<01115>>19690000
                 <<0000>> DISCSIZE:=0D;        <<EMPTY DRV>>   <<01115>>19695000
                 <<0001>>     ;                <<BLANK 1-SIDED>> <<FDF>>19700000
                 <<0010>> DISCSIZE:=30D*67D;   <<HP 1-SIDED>>  <<01115>>19705000
                 <<0011>>     ;                <<DOESN'T OCCUR>> <<FDF>>19710000
                 <<0100>>     ;                <<DOESN'T OCCUR>> <<FDF>>19715000
                 <<0101>>     ;                <<DOESN'T OCCUR>> <<FDF>>19720000
                 <<0110>> DISCSIZE:=60D*67D;   <<HP 2-SIDED>>  <<01115>>19725000
                 <<0111>>     ;                <<DOESN'T OCCUR>> <<FDF>>19730000
                 <<1000>> DISCSIZE:=26D*75D;   <<IBM 1-SIDED>> <<01115>>19735000
               END;                                            <<01115>>19740000
         END                                                   <<*7667>>19745000
      ELSE IF TYPE = 3 THEN  << cs80 disc >>                   <<*7667>>19750000
         BEGIN                                                 <<*7667>>19755000
     IO'STATUS:=ATTACHIO(LDEV,0,0,@T'DISCSIZE,13,2,0,0,BFLAGS);<<*7667>>19760000
         IF (IO'STAT1 <> 1) OR (T'DISCSIZE <= 0D) THEN         <<*7667>>19765000
            DISCSIZE := 2000000000D                            <<*7667>>19770000
         ELSE DISCSIZE := T'DISCSIZE + 1D;                     <<*7667>>19775000
         END;                                                  <<*7667>>19780000
                                                               <<01115>>19785000
XIT:  IF OLDDB<>0 THEN EXCHANGEDB(OLDDB); <<RESTORE DB>>       <<01115>>19790000
   END; <<DISCSIZE>>                                           <<01115>>19795000
<<**********************************************************>> <<04517>>19800000
<<   FCONVBLK has been deleted and replaced with FCONV'BLK  >> <<04517>>19805000
<<**********************************************************>> <<04517>>19810000
                                                               <<04517>>19815000
$ PAGE "MPE-V BASELINE FILE SYSTEM - FCREATE               "   <<06272>>19820000
<<----------------------------------------------------------------------19825000
*                                                                      *19830000
*  DISC SPACE MAINTENANCE PROCEDURES                                    19835000
*                                                                      *19840000
---------------------------------------------------------------------->>19845000
                                                                        19850000
$ CONTROL SEGMENT = FILESYS6                                            19855000
INTEGER PROCEDURE FCREATE (DEVICE,FCB,FOPTIONS,RSIZE,BF,SECTOFF,NUMEXTS,19860000
   FLIM,INITALLOC,SPOOLF,XDDX,PVINFO);                         <<RV.PV>>19865000
   <<CREATES A NEW DISC FILE BY MAPPING THE FILE INTO EXTENTS,          19870000
     ALLOCATING THE INITIAL EXTENTS, AND INITIALIZES THE FCB BUFFER     19875000
     FOR THE FILE.                                                      19880000
                                                                        19885000
     INPUT PARAMETERS:                                                  19890000
         DEVICE - POSITIVE => LOGICAL DEVICE NUMBER                     19895000
                  NEGATIVE => DEVICE CLASS TABLE INDEX                  19900000
         FCB - FCB BUFFER                                               19905000
         FOPTIONS - FOPTIONS                                            19910000
         RSIZE - RECORD SIZE (POS. BYTES)                               19915000
         BF - BLOCKING FACTOR                                           19920000
         SECTOFF - NUMBER OF USER LABELS                                19925000
         NUMEXTS - NUMBER OF EXTENTS                                    19930000
         FLIM - NUMBER OF RECORDS IN THE FILE                           19935000
         INITALLOC - NUMBER OF INITIALLY ALLOCATED EXTENTS              19940000
                                                                        19945000
     OUTPUT PARAMETERS:                                                 19950000
         FCREATE - ERROR RETURN FROM DISKALLOC                          19955000
            0 - NO ERROR                                                19960000
            1 - Space not available                            ((DFS00))19965000
            2 - I/O error                                      ((DFS00))19970000
            3 - Free space allocation disabled                 ((DFS00))19975000
            4 - Device not available                           ((DFS00))19980000
            5 - Invalid device                                 ((DFS00))19985000
            6 - Extent size greater than 65K sectors           ((DFS00))19990000
            7 - Data offset greater thant 255 sectors          ((DFS00))19995000
                                                                        20000000
     NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS PROCEDURE          20005000
     IS CALLED>>                                                        20010000
   VALUE   DEVICE,FOPTIONS,RSIZE,BF,SECTOFF,NUMEXTS,FLIM,               20015000
           INITALLOC,SPOOLF,XDDX,PVINFO;                       <<RV.PV>>20020000
   INTEGER DEVICE,RSIZE,BF,NUMEXTS,                            <<00117>>20025000
           INITALLOC,XDDX,PVINFO;                              <<RV.PV>>20030000
   LOGICAL FOPTIONS,SPOOLF,SECTOFF;                            <<00117>>20035000
   INTEGER ARRAY FCB;                                                   20040000
   DOUBLE FLIM;                                                         20045000
   OPTION PRIVILEGED,UNCALLABLE;                                        20050000
   BEGIN                                                                20055000
   DOUBLE ARRAY FCBDBL (*) = FCB;                                       20060000
   DOUBLE POINTER EXTMAP;         << Extent map to FCLEAR.  >> <<04279>>20065000
   INTEGER FCBLEN;  <<FCB LENGTH>>                                      20070000
   LOGICAL EXTSIZE;   << NR. SECTORS IN EXTENT >>              <<00117>>20075000
   LOGICAL LASTEXTSIZE;  << NR. SECTORS IN LAST EXTENT >>      <<00117>>20080000
   INTEGER                                                     <<04330>>20085000
      I             ,  << Utility variable.                 >> <<04330>>20090000
      FLAB'ULAB'EXTS,  << Num. of extents needed for labels.>> <<04330>>20095000
      LDEV          ;  << LDEV of extent to FCLEAR.         >> <<04330>>20100000
   LOGICAL                                                     <<04330>>20105000
      CLEAR'NUM     ,  << Number of sectors to FCLEAR.      >> <<04330>>20110000
      CLEAR'SECTS   ,  << Total number of sectors to clear. >> <<04330>>20115000
      LI=I          ,                                          <<04330>>20120000
      SPB           ;  << Sectors per block                 >> <<04330>>20125000
                                                               <<04330>>20130000
   DOUBLE SECTTOT,  << # file sectors, includ. lablels.     >> <<04279>>20135000
          SECTADDR; << Sector Address of extent to FCLEAR.  >> <<04279>>20140000
   INTEGER                                                     <<04279>>20145000
       P1=SECTADDR; << Word one of sector address.          >> <<04279>>20150000
   INTEGER POINTER XDDEP;  <<XDD SUBENTRY>>                             20155000
   DOUBLE SPDADDR;  <<SPOOLFILE LABEL ADDRESS>>                         20160000
                                                                        20165000
$  IF X0 = ON                                                           20170000
   IF MONOTHER THEN  <<MONITORING?>>                                    20175000
      BEGIN                                                             20180000
      TOS := "FC"; TOS := "RE"; TOS := "AT"; TOS := "E ";               20185000
      ASSEMBLE(DZRO,DZRO);                                              20190000
      FTITLE(*,*,*,*);                                                  20195000
      DEBUG                                                             20200000
      END;                                                              20205000
$  IF                                                                   20210000
                                                                        20215000
   IF INTEGER (SPOOLF) > 0 THEN                                         20220000
      BEGIN                                                             20225000
      @XDDEP := XDDX;                                                   20230000
      SPDADDR := XDDSPOOLINFO(0D,2,XDDEP);  <<GET LABEL ADDR>> <<+1.03>>20235000
      END;                                                              20240000
   TOS:=GETBLKSIZE(RSIZE,BF,FOPTIONS);                         <<00630>>20245000
   SPB := (TOS+127)&LSR(7);  << SECTORS PER BLOCK >>                    20250000
   SECTOFF := ((SECTOFF+SPB)/SPB)*SPB;  <<OFFSET TO DATA>>              20255000
   IF SECTOFF > 255 THEN  << TOO BIG? >>                       <<00117>>20260000
      BEGIN                                                             20265000
      TOS := 7;                                                <<03509>>20270000
      GO EXIT                                                           20275000
      END;                                                              20280000
                                                                        20285000
   <<* * * COMPUTE FILE SIZE IN BLOCKS * * *>>                          20290000
                                                                        20295000
   IF FOPMSGFILE THEN FLIM:=FLIM+2D;  <<OPEN/CLOSE REC>>       <<HM.00>>20300000
   << Calculate number of blocks in the file for data   >>     <<01968>>20305000
   TOS := FLIM;                   << file limit >>             <<01968>>20310000
   TOS := DOUBLE(LOGICAL(BF));     << block factor >>          <<01968>>20315000
   ASMB(DDIV);                    << calc. # blks in file  >>  <<01968>>20320000
   IF TOS<>0D THEN TOS:=TOS+1D;   << round up if necessary >>  <<01968>>20325000
   <<  Calculate number of sectors in file for data  >>        <<01968>>20330000
   TOS := TOS*DOUBLE(SPB);       << Sectors in file >>         <<01968>>20335000
   IF OVERFLOW THEN  << Result is greater than the >>          <<01968>>20340000
      BEGIN          << largest positive doubleword. >>        <<01968>>20345000
E3:   TOS := 1;  << Error code >>                              <<03509>>20350000
      GO EXIT                                                  <<01968>>20355000
      END;                                                     <<01968>>20360000
   TOS := TOS+DOUBLE(SECTOFF);   << Add label sectors >>       <<01968>>20365000
   IF OVERFLOW OR CARRY THEN GO E3;   << Too big. >>           <<01968>>20370000
   SECTTOT := DS1;               << Total sectors in file >>   <<01968>>20375000
   IF NUMEXTS > MAXEXTENTS THEN  << Too many extents? >>       <<01968>>20380000
      NUMEXTS := MAXEXTENTS      << Maximum extents allowed >> <<01968>>20385000
   ELSE IF NUMEXTS < 1 THEN                                    <<01968>>20390000
      NUMEXTS := DEFNUMEXTS;     << Default no. of extents >>  <<01968>>20395000
   TOS := DOUBLE(NUMEXTS);       << No. of extents to try for>><<01968>>20400000
   ASMB(DDIV);                   << Sectors/extent, lv rmndr >><<01968>>20405000
   IF TOS <> 0D THEN TOS:=TOS+1D;<< Round up, if necessary >>  <<01968>>20410000
   IF S1 <> 0 THEN                                             <<01968>>20415000
      BEGIN       << Extent size > 2**16 sectors. >>           <<01968>>20420000
      TOS := 6;                                                <<03509>>20425000
      GO EXIT                                                  <<01968>>20430000
      END;                                                     <<01968>>20435000
   EXTSIZE := TOS;  <<NR. SECTORS IN EXTENT>>                           20440000
   IF (LI := EXTSIZE MOD SPB) <> 0 THEN                        <<00117>>20445000
      BEGIN                                                    <<01968>>20450000
      EXTSIZE := EXTSIZE-LI+SPB;   << Adjust extent size >>    <<01968>>20455000
      IF OVERFLOW OR CARRY THEN GO E3;   << Too big. >>        <<01968>>20460000
      END;                                                     <<01968>>20465000
   <<* * * RECOMPUTE LAST EXTENT SIZE * * *>>                           20470000
                                                                        20475000
   IF FOPMSGFILE THEN                                          <<HM.00>>20480000
      BEGIN                                                    <<HM.00>>20485000
      FLIM:=DBL(EXTSIZE/SPB)*DBL(NUMEXTS*BF)-DBL(BF);          <<HM.00>>20490000
      TOS := NUMEXTS;                                          <<HM.00>>20495000
      TOS := EXTSIZE;                                          <<HM.00>>20500000
      END                                                      <<HM.00>>20505000
   ELSE                                                        <<HM.00>>20510000
      BEGIN                                                    <<HM.00>>20515000
      TOS := SECTTOT;  <<TOTAL NR. SECTORS>>                   <<HM.00>>20520000
      TOS := EXTSIZE;  <<NR. SECTORS IN EXTENT>>               <<HM.00>>20525000
      ASSEMBLE(LDIV,TEST);                                     <<HM.00>>20530000
      IF <> THEN  <<SMALLER LAST EXTENT?>>                     <<HM.00>>20535000
         ASSEMBLE(INCB)                                        <<HM.00>>20540000
      ELSE  <<LAST EXTENT SAME SIZE>>                          <<HM.00>>20545000
         TOS := TOS+EXTSIZE;                                   <<HM.00>>20550000
      END;                                                     <<HM.00>>20555000
   LASTEXTSIZE := TOS;  <<NR. SECTORS LAST EXTENT>>                     20560000
   NUMEXTS := TOS MOD (MAXEXTENTS+1);  <<ADJUST NR. EXTENTS>>           20565000
                                                                        20570000
   <<* * * INITIALIZE FCB BUFFER * * *>>                                20575000
                                                                        20580000
   FCBLEN := SIZEBFCB+NUMEXTS&LSL(1);  <<FCB SIZE>>                     20585000
   TOS := @FCB; PS0 := 0;  <<CLEAR FCB BUFFER>>                         20590000
   ASSEMBLE(DUP,INCB); TOS := FCBLEN-1; ASSEMBLE(MOVE 3);               20595000
   FCBFOPTIONS := FOPTIONS;  <<FOPTIONS>>                               20600000
   FCBDEVICE := DEVICE;  <<DEVICE SPECIFICATION>>                       20605000
   FCBFLIM := FLIM;                                                     20610000
   FCBEXTSIZE := EXTSIZE;                                               20615000
   FCBLASTEXTSIZE := LASTEXTSIZE;  <<LAST EXTENT SIZE>>                 20620000
   FCBBLKFACT := BF;                                                    20625000
   FCBSECTPBLK := SPB;                                                  20630000
   FCBSECTOFF := SECTOFF;                                               20635000
   FCBNUMEXTS := NUMEXTS-1;                                             20640000
                                                                        20645000
   <<* * * ALLOCATE INITIAL EXTENTS OF FILE * * *>>                     20650000
                                                                        20655000
   IF INITALLOC <= 0 THEN  << No extent allocation? >>         <<01084>>20660000
      INITALLOC := 1  <<ALLOCATE FILE LABEL EXTENT>>                    20665000
   ELSE IF INITALLOC > NUMEXTS THEN  <<TOO MANY?>>                      20670000
      INITALLOC := NUMEXTS;  <<NR. EXT'S IN FILE>>                      20675000
   << Calculate minimum number of extents needed for labels >> <<04279>>20680000
      FLAB'ULAB'EXTS := (SECTOFF+EXTSIZE-1)/EXTSIZE;           <<04279>>20685000
      IF FLAB'ULAB'EXTS > INITALLOC                            <<04279>>20690000
         THEN INITALLOC := FLAB'ULAB'EXTS;                     <<04279>>20695000
   TOS := @FCBEXTMAP;  <<EXTENT MAP POINTER>>                           20700000
   X := 0;  <<EXTENT NR.>>                                              20705000
   TOS := INITALLOC;  <<EXTENT COUNTER>>                                20710000
   DO BEGIN                                                             20715000
      TOS := 0;  <<FIRST HALF OF EXTENT ENTRY>>                         20720000
      TOS := IF X = NUMEXTS-1 THEN LASTEXTSIZE ELSE EXTSIZE;            20725000
      DPS3(X) := TOS;  <<INIT. EXTENT ENTRY>>                           20730000
      ASSEMBLE(INCX,DECA)                                               20735000
      END UNTIL =;                                                      20740000
   IF INTEGER(SPOOLF) > 0 THEN  <<SPOOLED FILE?>>                       20745000
      BEGIN                                                             20750000
      FCBLABEL := SPDADDR;                                              20755000
      TOS := 0;                                                         20760000
      END                                                               20765000
   ELSE  <<REGULAR FILE>>                                               20770000
      BEGIN                                                             20775000
      TOS := DISKALLOC(IF SPOOLF THEN 0 ELSE DEVICE,INITALLOC,          20780000
         FCBEXTMAP,PVINFO).(8:8);  <<ALLOCATE EXTENTS>>        <<RV.PV>>20785000
      IF <> THEN GO EXIT;  <<ERROR>>                                    20790000
      FCBPVINFO := PVINFO;                                     <<RV.PV>>20795000
                                                               <<04279>>20800000
      << FCLEAR the label extents, usually only the first.  >> <<04279>>20805000
                                                               <<04279>>20810000
      @EXTMAP := @FCBEXTMAP;                                   <<04279>>20815000
      CLEAR'SECTS := SECTOFF;                                  <<04330>>20820000
      FOR I:=1 UNTIL FLAB'ULAB'EXTS DO                         <<04279>>20825000
         BEGIN                                                 <<04279>>20830000
         SECTADDR := EXTMAP(I-1);    << LDEV, HODA and LODA >> <<04279>>20835000
         LDEV := P1.(0:8);           << LDEV of extent.     >> <<04279>>20840000
         P1.(0:8) := 0;              << Clear out LDEV.     >> <<04279>>20845000
         IF CLEAR'SECTS > EXTSIZE    << Whole extent        >> <<04330>>20850000
            THEN CLEAR'NUM := EXTSIZE                          <<04330>>20855000
            ELSE CLEAR'NUM := CLEAR'SECTS;                     <<04330>>20860000
         FCLEAR(FALSE,LDEV,SECTADDR,CLEAR'NUM);                <<04279>>20865000
         CLEAR'SECTS := CLEAR'SECTS - CLEAR'NUM; << Cut back>> <<04330>>20870000
         END;                                                  <<04279>>20875000
                                                               <<04279>>20880000
      END;                                                              20885000
                                                                        20890000
   <<* * * INITIALIZE FCB BUFFER AGAIN * * *>>                          20895000
                                                                        20900000
   TOS := @I;  <<TEMP CELL>>                                            20905000
   TOS := LDTDST; TOS := FCBLDEV*LDTENTRY+2;                   <<06515>>20910000
   TOS := 1;                                                            20915000
   ASSEMBLE(MFDS 4);                                                    20920000
   FCBDTYPE := I.(10:6);  ! Device type of first extent.       <<06515>>20925000
   FCBSUBTYPE := LPDT(FCBLDEV*LPDTENTRY+1).T'SUBTYPE;          <<06515>>20930000
                                                                        20935000
EXIT:                                                                   20940000
   FCREATE := TOS  <<ERROR NR.>>                                        20945000
   END;         << procedure FCREATE >>                                 20950000
$PAGE "MPEV BASELINE FILE SYSTEM - FCLEAR "                    <<06514>>20955000
$ CONTROL SEGMENT = FILESYS1                                            20960000
INTEGER PROCEDURE FCLEAR (ASCII,DADDR,SECTADDR,NUM);                    20965000
   <<CLEARS CONTIGUOUS DISC SPACE TO 0'S (BINARY) OR BLANKS (ASCII).    20970000
                                                                        20975000
     INPUT VARIABLES:                                                   20980000
         ASCII - FILL VALUE TO BE USED                                  20985000
            TRUE => ASCII FILE - USE "  "                               20990000
            FALSE => BINARY FILE - USE 0                                20995000
         DADDR - LOGICAL DEVICE NUMBER OF DISC                          21000000
         SECTADDR - STARTING SECTOR NUMBER                              21005000
         NUM - NUMBER OF SECTORS TO BE CLEARED                          21010000
                                                                        21015000
     OUTPUT VARIABLES:                                                  21020000
         FCLEAR - NOT USED                                              21025000
                                                                        21030000
     THIS PROCEDURE MAY BE CALLED WITH DB SET TO THE STACK OR ANY       21035000
     FILE DATA SEGMENT.  NOTE THAT I/O ERRORS ARE NOT REPORTED TO       21040000
     THE CALLING PROCEDURE>>                                            21045000
   VALUE ASCII,DADDR,SECTADDR,NUM;                                      21050000
   LOGICAL ASCII,DADDR,NUM;                                             21055000
   DOUBLE SECTADDR;                                                     21060000
   OPTION PRIVILEGED,UNCALLABLE;                                        21065000
   BEGIN                                                                21070000
   INTEGER P1 = SECTADDR;  <<SECTOR NR. - FIRST HALF>>                  21075000
   INTEGER P2 = SECTADDR+1;  <<SECTOR NR. - SECOND HALF>>               21080000
   DOUBLE DL := 0D;                                                     21085000
   LOGICAL L = DL+1;                                                    21090000
                                                                        21095000
$  IF X0 = ON                                                           21100000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               21105000
      BEGIN                                                             21110000
      TOS := "FC"; TOS := "LE"; TOS := "AR";                            21115000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        21120000
      FTITLE(*,*,*,*);                                                  21125000
      DEBUG                                                             21130000
      END;                                                              21135000
$  IF                                                                   21140000
                                                                        21145000
   DO BEGIN                                                             21150000
      L := IF NUM > 255 THEN 255 ELSE NUM;                              21155000
      TOS := ATTACHIO(DADDR,0,0,0,IF ASCII THEN 6 ELSE 5,               21160000
         L&LSL(7),P1,P2,BFLAGS);  <<CLEAR SECTORS>>            <<+0.05>>21165000
      DEL;                                                              21170000
      IF TOS.(8:8) <> 1 THEN RETURN;  <<ATTIO ERROR?>>                  21175000
      SECTADDR := SECTADDR+DL;                                          21180000
      NUM := NUM-L                                                      21185000
      END UNTIL =                                              <<01968>>21190000
   END;                                                                 21195000
$ PAGE "MPE-V BASELINE FILE SYSTEM - FSECTORS              "   <<06272>>21200000
$CONTROL SEGMENT = FILESYS7    << FSECTORS >>                           21205000
DOUBLE PROCEDURE FSECTORS (FLAB);                                       21210000
   <<COMPUTES THE TOTAL NUMBER OF SECTORS CURRENTLY ALLOCATED BY THE    21215000
     FILE OF THE SPECIFIED LABEL.                                       21220000
                                                                        21225000
     INPUT VARIABLES:                                                   21230000
         FLAB - FILE LABEL POINTER                                      21235000
                                                                        21240000
     OUTPUT VARIABLES:                                                  21245000
         FSECTORS - NUMBER OF SECTORS ALLOCATED                         21250000
                                                                        21255000
     >>                                                                 21260000
   INTEGER ARRAY FLAB;                                                  21265000
   OPTION UNCALLABLE,PRIVILEGED;                                        21270000
   BEGIN                                                                21275000
   DOUBLE RESULT = FSECTORS;                                            21280000
   DOUBLE ARRAY FLABDBL (*) = FLAB;                                     21285000
                                                                        21290000
$  IF X0 = ON                                                           21295000
   IF MONOTHER THEN  <<MONITORING?>>                                    21300000
      BEGIN                                                             21305000
      TOS := "FS"; TOS := "EC"; TOS := "TO"; TOS := "RS";               21310000
      ASSEMBLE(DZRO,DZRO);                                              21315000
      FTITLE(*,*,*,*);                                                  21320000
      DEBUG                                                             21325000
      END;                                                              21330000
$  IF                                                                   21335000
                                                                        21340000
   TOS := @FLEXTMAP;  <<EXTENT ENTRY POINTER>>                          21345000
   TOS := FLNUMEXTS;  <<EXTENT COUNTER>>                                21350000
   DO BEGIN                                                             21355000
      IF DPS1 <> 0D THEN  <<EXTENT ALLOCATED?>>                         21360000
         BEGIN                                                          21365000
         TOS := 0;  << HIGH ORDER EXTENT SIZE >>               <<00300>>21370000
         IF S1 = 0 THEN  <<LAST EXTENT?>>                               21375000
            TOS := FLLASTEXTSIZE                                        21380000
         ELSE  <<REGULAR EXTENT>>                                       21385000
            TOS := FLEXTSIZE;                                           21390000
         RESULT := RESULT+TOS  <<ADD TO TOTAL>>                         21395000
         END;                                                           21400000
      ASSEMBLE(INCB,INCB; DECA)                                         21405000
      END UNTIL <                                                       21410000
   END;                                                                 21415000
                                                               <<06514>>21420000
$ PAGE "MPE-V BASELINE FILE SYSTEM - GETBLKSIZE            "   <<06272>>21425000
<<***********************************************************>><<00630>>21430000
$CONTROL SEGMENT=FILESYS6                                      <<00630>>21435000
                                                               <<00630>>21440000
INTEGER PROCEDURE GETBLKSIZE(RECSIZE,BLKFACTOR,FOPTIONS);      <<00630>>21445000
  VALUE RECSIZE,BLKFACTOR,FOPTIONS;                            <<00630>>21450000
  INTEGER RECSIZE,   <<IN POS BYTES>>                          <<00630>>21455000
          BLKFACTOR;                                           <<00630>>21460000
  LOGICAL FOPTIONS;                                            <<00630>>21465000
  OPTION UNCALLABLE;                                           <<00630>>21470000
BEGIN                                                          <<00630>>21475000
  DEFINE OVFL= QSTATUS.(4:1) #;                                <<00630>>21480000
  INTEGER QSTATUS= Q-1;                                        <<00630>>21485000
  LOGICAL ERROR:= FALSE;                                       <<00630>>21490000
                                                               <<00630>>21495000
                                                               <<00630>>21500000
  TOS:=(RECSIZE+1)/2 * BLKFACTOR;                              <<00630>>21505000
  IF < OR OVERFLOW THEN ERROR:=TRUE;                           <<00630>>21510000
  IF FOPMSGFILE THEN                                           <<HM.00>>21515000
    BEGIN  <<MESSAGE FILE>>                                    <<HM.00>>21520000
    TOS:=TOS+2+BLKFACTOR*IPCBLKOVERHEAD;                       <<HM.00>>21525000
    IF < OR OVERFLOW THEN ERROR:=TRUE;                         <<HM.00>>21530000
    END                                                        <<HM.00>>21535000
  ELSE IF FOPRIO THEN                                          <<HM.00>>21540000
    BEGIN                                                      <<00630>>21545000
    TOS:=TOS + (BLKFACTOR+15)/16;  <<FOR ACTIVE REC TABLE>>    <<00630>>21550000
    IF < OR OVERFLOW THEN ERROR:=TRUE;                         <<00630>>21555000
    END;                                                       <<00630>>21560000
  GETBLKSIZE:=TOS.(1:15); <<ALWAYS POSITIVE>>                  <<00630>>21565000
  OVFL:=IF ERROR THEN 1 ELSE 0;                                <<00630>>21570000
END; <<PROCEDURE GETBLKSIZE>>                                  <<00630>>21575000
$PAGE "MPV-IV FILE SYSTEM - GETBLKFACTOR"                      <<06272>>21580000
                                                               <<00630>>21585000
<<***********************************************************>><<00630>>21590000
$CONTROL SEGMENT = FILESYS6    << GETBLKFACTOR >>                       21595000
                                                               <<00630>>21600000
INTEGER PROCEDURE GETBLKFACTOR(BLKSIZE,RECSIZE,FOPTIONS);      <<00630>>21605000
  VALUE BLKSIZE,RECSIZE,FOPTIONS;                              <<00630>>21610000
  INTEGER BLKSIZE,  <<IN POS WORDS>>                           <<00630>>21615000
          RECSIZE;  <<IN POS BYTES>>                           <<00630>>21620000
  LOGICAL FOPTIONS;                                            <<00630>>21625000
  OPTION UNCALLABLE;                                           <<00630>>21630000
BEGIN                                                          <<00630>>21635000
  INTEGER WDRSIZE;                                             <<00630>>21640000
                                                               <<00630>>21645000
                                                               <<00630>>21650000
  WDRSIZE:=(RECSIZE+1)/2;                                      <<00630>>21655000
  IF FOPMSGFILE THEN                                           <<HM.00>>21660000
     TOS:=(BLKSIZE-2)/(WDRSIZE+IPCBLKOVERHEAD)                 <<HM.00>>21665000
  ELSE IF FOPRIO THEN                                          <<HM.00>>21670000
    BEGIN                                                      <<00630>>21675000
    TOS:=16D*DOUBLE(BLKSIZE) / (16D*DOUBLE(WDRSIZE)+1D);       <<00630>>21680000
    DELB;                                                      <<00630>>21685000
    END                                                        <<HM.00>>21690000
 ELSE                                                          <<HM.00>>21695000
    TOS:=BLKSIZE/WDRSIZE;                                      <<HM.00>>21700000
  GETBLKFACTOR:=TOS;                                           <<00630>>21705000
END; <<PROCEDURE GETBLKFACTOR>>                                <<00630>>21710000
$CONTROL SEGMENT=FILESYS7                                      << 7602>>21715000
PROCEDURE COMPLETE'IO(BUFFER'DST);                             <<S7505>>21720000
VALUE BUFFER'DST;                                              <<S7505>>21725000
INTEGER BUFFER'DST;                                            <<S7505>>21730000
OPTION PRIVILEGED, UNCALLABLE;                                 <<57875>>21735000
                                                               <<S7505>>21740000
<<---------------------------------------------------------->> <<S7505>>21745000
<< This procedure is called by FCLOSE to complete any out-  >> <<S7505>>21750000
<< standing I/O's for the buffered file.  This is performed >> <<S7505>>21755000
<< mainly for disc caching so that the I/O completion is    >> <<S7505>>21760000
<< always assosiated with the PIN that initiated the I/O.   >> <<S7505>>21765000
<< Caching gets upset (SF671) when the PIN that started the >> <<S7505>>21770000
<< I/O is gone when the I/O is complete.  We simply call    >> <<S7505>>21775000
<< WAITFORIO against the block and store the I/O status in  >> <<S7505>>21780000
<< the block header.  We flag the block head so that IOMOVE >> <<S7505>>21785000
<< will check the status of the I/O later.                  >> <<S7505>>21790000
<<                                                          >> <<S7505>>21795000
<< Input variable:                                          >> <<S7505>>21800000
<<    BUFFER'DST - DST number of the PACB and its corres-   >> <<S7505>>21805000
<<                 ponding buffers.                         >> <<S7505>>21810000
<<                                                          >> <<S7505>>21815000
<< Note:                                                    >> <<S7505>>21820000
<<    DB can be anywhere upon entry into this procedure.    >> <<S7505>>21825000
<<    Also, this is one of those procedures that expects    >> << 7602>>21830000
<<    the ACB at Q-XX, where XX=61 in this case.  It is     >> << 7602>>21835000
<<    even more strange in that it operates on the stack    >> << 7602>>21840000
<<    ACB (to be updated by FCLOSE) and the block headers   >> << 7602>>21845000
<<    directly in the PACB extra data segment.              >> << 7602>>21850000
<<---------------------------------------------------------->> <<S7505>>21855000
                                                               <<S7505>>21860000
BEGIN                                                          <<S7505>>21865000
INTEGER ARRAY ACB(*) = Q-61;                                   << 7602>>21870000
INTEGER POINTER                                                << 7602>>21875000
   BLK,             << Pointer to the buffer header.        >> <<S7505>>21880000
   VT;              << Pointer to the vector table entry.   >> <<S7505>>21885000
DOUBLE ACB'BTFRCT = ACB + 22;                                  << 7602>>21890000
DOUBLE  POINTER BLKDBL = BLK;                                  <<S7505>>21895000
INTEGER                                                        <<S7505>>21900000
   NUMBUFFS,                                                   <<S7505>>21905000
   ORIGINAL'DB;     << DB upon entry.                       >> <<S7505>>21910000
                                                               <<S7505>>21915000
ORIGINAL'DB := EXCHANGEDB(BUFFER'DST);                         <<S7505>>21920000
@VT  := CBTOVERHEAD;                                           <<S7505>>21925000
@BLK := VT'ADR + SIZEACB;                                      << 7602>>21930000
                                                               << 7602>>21935000
                                                               <<S7505>>21940000
NUMBUFFS := ACBNUMBUFS + 1;                                    <<S7505>>21945000
WHILE NUMBUFFS > 0 DO                                          <<S7505>>21950000
   BEGIN     << For each buffer, complete any pending I/O.  >> <<S7505>>21955000
   IF BLKBLOCK >= 0D THEN                                      <<S7505>>21960000
      BEGIN  << Block is not empty, check it out.           >> <<S7505>>21965000
      IF LOGICAL(BLKIOPEND) THEN                               <<S7505>>21970000
         BEGIN                                                 <<S7505>>21975000
         IF BLKIOQX <> 0 THEN                                  <<S7505>>21980000
            BEGIN          << I/O pending, call WAITFORIO.  >> <<S7505>>21985000
            BLKIOCB := WAITFORIO(BLKIOQX);                     <<S7505>>21990000
            BLKDONTWAIT := 1; << Check for errors later.    >> <<S7505>>21995000
            BLKIOQX := 0;                                      <<S7505>>22000000
            ACB'BTFRCT := ACB'BTFRCT + 1D;                     << 7602>>22005000
            END;                                               <<S7505>>22010000
         BLKIOCOMP := 0;                                       <<S7505>>22015000
         END;                                                  <<S7505>>22020000
      END;                                                     <<S7505>>22025000
   @BLK := @BLK + ACBBUFSIZE;                                  <<S7505>>22030000
   NUMBUFFS := NUMBUFFS - 1;                                   <<S7505>>22035000
   END;                                                        <<S7505>>22040000
                                                               <<S7505>>22045000
EXCHANGEDB(ORIGINAL'DB);                                       <<S7505>>22050000
END;                                                           <<S7505>>22055000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - FINDAFTENT   "           <<06272>>22060000
<<----------------------------------------------------------------------22065000
*                                                                      *22070000
*  SUPPORT PROCEDURES FOR CALLABLE INTRINSICS                          *22075000
*                                                                      *22080000
---------------------------------------------------------------------->>22085000
                                                                        22090000
$ CONTROL SEGMENT = FILESYS5                                            22095000
INTEGER PROCEDURE FINDAFTENT;                                           22100000
   <<FINDS AN AVAILABLE AFT ENTRY AND RETURNS THE ENTRY NUMBER          22105000
     AS THE RESULT.                                                     22110000
                                                                        22115000
     OUTPUT VARIABLES:                                                  22120000
         FINDAFTENT - ENTRY NUMBER                                      22125000
            0 - NO ENTRY AVAILABLE OR PXFILE EXPANSION FAILURE          22130000
            N - AFT ENTRY NUMBER = FILE NUMBER (1 <= N <= 255)          22135000
         Condition Code -                                        18479  22140000
            CCE              no error                            18479  22145000
            CCL              PXFILE expansion failed             18479  22150000
                                                                        22155000
     NOTE THAT THIS PROCEDURE MUST BE CALLED WITH DB SET TO THE         22160000
     STACK>>                                                            22165000
   OPTION PRIVILEGED,UNCALLABLE;                                        22170000
   BEGIN                                                                22175000
   ENTRY FINDANYAFTENT;                                        <<01815>>22180000
   EQUATE                                                      <<06726>>22185000
      INIT'VT             = CBTVT1*VTENTRY,                    <<06726>>22190000
      INIT'PXFILE'LESS'VT = PXFOVERHEAD+CBTOVERHEAD+1,         <<07162>>22195000
      INIT'CBT'LESS'VT    = CBTOVERHEAD+1,                     <<06726>>22200000
      INDEX'TO'CBT        = PXFOVERHEAD+CBTOVERHEAD;           <<06726>>22205000
   DEFINE                                                      <<06726>>22210000
      AVAILABLE'BLOCK'SIZE = PXFSIZE-PXFOVERHEAD-PXFCBTSIZE-   <<06726>>22215000
                             PXFAFTSIZE#;                      <<06726>>22220000
   LOGICAL FIND'ANY;        << True if any AFT entry is OK >>  <<01815>>22225000
   INTEGER POINTER                                             <<06726>>22230000
      PXFILE,                  ! Pointer to PXFILE area.       <<06726>>22235000
      AFT;                     ! Used to scan AFT area.        <<06726>>22240000
   DOUBLE POINTER AFTDBL = AFT;                                <<06726>>22245000
   INTEGER                                                     <<06726>>22250000
      INIT'VT'SIZE,            ! Initial vector table size.    <<06726>>22255000
      PCBPT,                   ! PCB pointer for defines.      <<06726>>22260000
      FILENUM,                 ! File number being looked at.  <<06726>>22265000
      NUM'ENTRIES,             ! Number of active AFT's.       <<06726>>22270000
      PRE'ALLOC'CBT'DST,       ! Preallocated when UCOP        <<06726>>22275000
                               ! launches a job.               <<06726>>22280000
      CORRECTION'TERM;         ! Returned from FALTPXFILE.     <<06726>>22285000
                                                                        22290000
$  IF X0 = ON                                                           22295000
   IF MONOTHER THEN  <<MONITORING?>>                                    22300000
      BEGIN                                                             22305000
      TOS := "FI"; TOS := "ND"; TOS := "AF"; TOS := "TE";               22310000
      TOS := "NT";                                                      22315000
      ASSEMBLE(ZERO,DZRO);                                              22320000
      FTITLE(*,*,*,*);                                                  22325000
      DEBUG                                                             22330000
      END;                                                              22335000
$  IF                                                                   22340000
                                                                        22345000
   << For FOPEN and FOPENDA, any AFT entry (including 1 and >> <<01708>>22350000
   << 2 - $STDIN and $STDLIST) can be assigned.  For all    >> <<01708>>22355000
   << other callers, only AFT 3 or greater can be assigned. >> <<01708>>22360000
   FIND'ANY := FALSE;                                          <<01708>>22365000
   GO START;                                                   <<01708>>22370000
FINDANYAFTENT:                                                 <<01708>>22375000
   FIND'ANY := TRUE;                                           <<01708>>22380000
START:                                                         <<01708>>22385000
                                                               <<01708>>22390000
   !---------------------------------------------------------- <<06726>>22395000
   ! Check for virgin PXFILE area.  If the PXFILE area is un-  <<06726>>22400000
   ! formatted, then set up the PXFILE overhead area and the   <<06726>>22405000
   ! control block area.  Set the CB table size, the vector    <<06726>>22410000
   ! table size, the DST number and create one singe garbage   <<06726>>22415000
   ! control block with a size of one.                         <<06726>>22420000
   !---------------------------------------------------------- <<06726>>22425000
                                                                        22430000
   PCBPT := CURPRC;                                            <<06514>>22435000
   SETPXFILE;                                                  <<06514>>22440000
   IF PXFCBTSIZE = 0 THEN                                      <<06726>>22445000
      BEGIN              ! Unformatted PXFILE, let's do it.    <<06726>>22450000
      IF PXFNOCB                                               <<06726>>22455000
         THEN INIT'VT'SIZE := 0                                <<06726>>22460000
         ELSE INIT'VT'SIZE := INIT'VT;                         <<06726>>22465000
      PRE'ALLOC'CBT'DST := PXFCBT1;                            <<06726>>22470000
      IF PXFSIZE < INIT'PXFILE'LESS'VT+INIT'VT'SIZE THEN       <<06726>>22475000
         BEGIN           ! Initial size to small, must expand. <<06726>>22480000
         CORRECTION'TERM := FALTPXFILE(128);                   <<06726>>22485000
         IF < THEN                                             <<06726>>22490000
            BEGIN        ! Error occured, return CCL.          <<06726>>22495000
            CONDCODE := CCL;                                   <<06726>>22500000
            RETURN;                                            <<06726>>22505000
            END;                                               <<06726>>22510000
         @PXFILE := @PXFILE+CORRECTION'TERM;                   <<06726>>22515000
         END;                                                           22520000
      PXFCBT1 := PRE'ALLOC'CBT'DST;                            <<06726>>22525000
      PXFCBTSIZE := INIT'VT'SIZE+INIT'CBT'LESS'VT;             <<06726>>22530000
      PXFVTSIZE := INIT'VT'SIZE;                               <<06726>>22535000
      PXFDSTX := SPCBSTKDST;   ! Post stack DST number.        <<06726>>22540000
      PXFVT := 0;              ! Clear the vector table.       <<06726>>22545000
      IF NOT PXFNOCB THEN                                      <<06726>>22550000
         BEGIN                                                 <<06726>>22555000
         TOS := @PXFVT + 1;                                    <<06726>>22560000
         MOVE * := PXFVT,(INIT'VT'SIZE-1);                     <<06726>>22565000
         END;                                                  <<06726>>22570000
      ! Initialize a garbage control block with a size of 1.   <<06726>>22575000
      PXFILE(INIT'VT'SIZE+INDEX'TO'CBT) := 1;                  <<06726>>22580000
      END;                                                     <<06726>>22585000
                                                               <<06726>>22590000
                                                               <<06726>>22595000
   PXFFOPEN := 0;        ! Initialize error numbers to zero.   <<06726>>22600000
   PXFCOPEN := 0;                                              <<06726>>22605000
   PXFDOPEN := 0;                                              <<06726>>22610000
   PXFKOPEN := 0;                                              <<06726>>22615000
                                                                        22620000
   !---------------------------------------------------------- <<06726>>22625000
   ! Search the AFT for a free entry.  Start at either file-   <<06726>>22630000
   ! number 1 or 3.  Scan until we find a free entry or the    <<06726>>22635000
   ! current AFT counter goes to zero.                         <<06726>>22640000
   !---------------------------------------------------------- <<06726>>22645000
                                                                        22650000
   IF FIND'ANY THEN                                            <<01708>>22655000
      BEGIN   ! FINDANYAFTENT, including $STDIN/LIST AFT's.    <<06726>>22660000
      FILENUM := 1;                      ! Start at file # 1.  <<06726>>22665000
      NUM'ENTRIES := PXFAFTSIZE/AFTENTRY;                      <<06726>>22670000
      @AFT := @PXFILE+PXFSIZE-AFTENTRY;  ! Points to AFT 1.    <<06726>>22675000
      END                                                      <<01815>>22680000
   ELSE                                                        <<01815>>22685000
      BEGIN   ! FINDAFTENT, skip over $STDIN/LIST AFT entries. <<06726>>22690000
      FILENUM := 3;                      ! Start at file # 3.  <<06726>>22695000
      NUM'ENTRIES := PXFAFTSIZE/AFTENTRY - 2;                  <<06726>>22700000
      @AFT := @PXFILE+PXFSIZE-3*AFTENTRY;! Points to AFT 3.    <<06726>>22705000
      END;                                                     <<01815>>22710000
                                                               <<01815>>22715000
   WHILE NUM'ENTRIES > 0 AND AFTDBL <> 0D DO                   <<06726>>22720000
      BEGIN  ! Scan for an available AFT entry.                <<06726>>22725000
      @AFT := @AFT - AFTENTRY;                                 <<06726>>22730000
      FILENUM := FILENUM + 1;                                  <<06726>>22735000
      NUM'ENTRIES := NUM'ENTRIES - 1;                          <<06726>>22740000
      END;                                                              22745000
                                                                        22750000
   !---------------------------------------------------------- <<06726>>22755000
   ! If there are no free entries, we may have to expand the   <<06726>>22760000
   ! PXFILE area.  If the available block that is located be-  <<06726>>22765000
   ! tween the control block area and the AFT area is less     <<06726>>22770000
   ! than one AFTENTRY in size, then go ahead and expand the   <<06726>>22775000
   ! PXFILE area.  In either case, use the AFT entry directly  <<06726>>22780000
   ! above the last current active entry.                      <<06726>>22785000
   !---------------------------------------------------------- <<06726>>22790000
                                                                        22795000
   IF NUM'ENTRIES <= 0 THEN                                    <<07048>>22800000
      BEGIN  ! No free AFT entry, may have to expand PXFILE.   <<06726>>22805000
      IF AVAILABLE'BLOCK'SIZE < AFTENTRY THEN                  <<06726>>22810000
         BEGIN                                                          22815000
         CORRECTION'TERM := FALTPXFILE(128);                   <<06726>>22820000
         IF < THEN               ! Error! If so, report it.    <<06726>>22825000
            BEGIN                                              <<02357>>22830000
            CONDCODE:=CCL;                                     <<02357>>22835000
            RETURN;                                            <<02357>>22840000
            END;                                               <<02357>>22845000
         @PXFILE := @PXFILE+CORRECTION'TERM;                   <<06726>>22850000
         END;                                                           22855000
      PXFAFTSIZE := FILENUM*AFTENTRY; ! New AFT size.          <<06726>>22860000
      END;                                                              22865000
                                                               <<06726>>22870000
   AFTDBL := AFTDBL(1) := AFTDBL(2) := 0D;                     <<06726>>22875000
   FINDAFTENT := FILENUM;             ! Return file number.    <<06726>>22880000
   CONDCODE:=CCE;                                              <<02357>>22885000
   END;      << procedure FINDAFTENT >>                                 22890000
$PAGE "MPE-V BASELINE FILE SYSTEM - FIND'GLOBAL'AFTENT"        <<06514>>22895000
INTEGER PROCEDURE FIND'GLOBAL'AFTENT;                          <<06514>>22900000
                                                               <<57875>>22905000
OPTION PRIVILEGED, UNCALLABLE;                                 <<57875>>22910000
                                                               <<57875>>22915000
                                                               <<06514>>22920000
!************************************************************* <<06514>>22925000
!     This procedure finds and initializes a global AFT entry. <<06514>>22930000
! It finds the entry in the global AFT DST.  If the sysglob    <<06514>>22935000
! cell containing this DST number is 0, then we must first al- <<06514>>22940000
! locate a global AFT DST.  The PACBV DST number of the AFT is <<06514>>22945000
! initialized with a -1 to reserve the AFT entry.  DB will al- <<06514>>22950000
! ways be set to the stack upon entrance and will be set to    <<06514>>22955000
! the stack upon exit.                                         <<06514>>22960000
!************************************************************* <<06514>>22965000
                                                               <<06514>>22970000
BEGIN                                                          <<06514>>22975000
INTEGER                                                        <<06514>>22980000
   AFT'SIZE,               ! Size in words of the global AFT   <<06514>>22985000
   A;                      ! Used by GETSIR                    <<06514>>22990000
LOGICAL                                                        <<06514>>22995000
   FOUND'ONE;              ! Becomes true when we found one.   <<06514>>23000000
INTEGER POINTER                                                <<06514>>23005000
   AFT;                    ! Pointer to AFT                    <<06514>>23010000
DOUBLE POINTER                                                 <<06514>>23015000
   AFTDBL = AFT;                                               <<06514>>23020000
EQUATE                                                         <<06514>>23025000
   INIT'AFT'SIZE = 100*AFTENTRY,                               <<06514>>23030000
   MAX'AFT'SIZE  = 5000*AFTENTRY;                              <<06514>>23035000
DEFINE                                                         <<06514>>23040000
   DST'SIZE = (ABS(ABS(DSTP)+GLOBAL'AFT'DSTN*4).(3:13))*4#;    <<06514>>23045000
                                                               <<06514>>23050000
SUBROUTINE ERROR'EXIT;                                         <<06514>>23055000
BEGIN                                                          <<06514>>23060000
CONDCODE := CCL;                                               <<06514>>23065000
GOTO EXIT;                                                     <<06514>>23070000
END;                                                           <<06514>>23075000
                                                               <<06514>>23080000
A := GETSIR(FISIR);        ! Protect global AFT DST            <<06514>>23085000
CONDCODE := CCE;           ! Assume all is A-OK                <<06514>>23090000
IF GLOBAL'AFT'DSTN <> 0 THEN                                   <<06514>>23095000
   BEGIN                                                       <<06514>>23100000
   EXCHANGEDB(GLOBAL'AFT'DSTN);                                <<06514>>23105000
   AFT'SIZE := DST'SIZE;                                       <<06514>>23110000
   END                                                         <<06514>>23115000
ELSE                                                           <<06514>>23120000
   BEGIN                   ! Not yet created                   <<06514>>23125000
   TOS := GETDATASEG(INIT'AFT'SIZE,MAX'AFT'SIZE);              <<06514>>23130000
   IF <> THEN ERROR'EXIT;                                      <<06514>>23135000
   GLOBAL'AFT'DSTN := TOS;                                     <<06514>>23140000
   EXCHANGEDB(GLOBAL'AFT'DSTN);                                <<06514>>23145000
   AFT'SIZE := DST'SIZE;                                       <<06514>>23150000
   @AFT := 0;              ! Clear new DST                     <<06514>>23155000
   AFT := 0;                                                   <<06514>>23160000
   MOVE AFT(1) := AFT,(AFT'SIZE-1);                            <<06514>>23165000
   END;                                                        <<06514>>23170000
                                                               <<06514>>23175000
FOUND'ONE := FALSE;                                            <<06514>>23180000
@AFT := AFTENTRY;          ! We will start at AFT 1            <<06514>>23185000
WHILE NOT FOUND'ONE AND @AFT + AFTENTRY <= AFT'SIZE DO         <<06514>>23190000
   BEGIN                                                       <<06514>>23195000
   IF AFTDBL = 0D                                              <<06514>>23200000
      THEN FOUND'ONE := TRUE                                   <<06514>>23205000
      ELSE @AFT := @AFT + AFTENTRY;                            <<06514>>23210000
   END;                                                        <<06514>>23215000
                                                               <<06514>>23220000
                                                               <<06514>>23225000
IF NOT FOUND'ONE THEN                                          <<06514>>23230000
   BEGIN                   ! Must expand the DST               <<06514>>23235000
   ALTDSEGSIZE(GLOBAL'AFT'DSTN,INIT'AFT'SIZE);                 <<06514>>23240000
   IF <> THEN ERROR'EXIT;                                      <<06514>>23245000
   AFT := 0;               ! Clear new area                    <<06514>>23250000
   MOVE AFT(1) := AFT,(INIT'AFT'SIZE-1);                       <<06514>>23255000
   END;                                                        <<06514>>23260000
                                                               <<06514>>23265000
! At this point, AFT points to the new AFT entry, clear it.    <<06514>>23270000
                                                               <<06514>>23275000
AFTDBL := AFTDBL(1) := AFTDBL(2) := 0D;                        <<06514>>23280000
AFTPACBVDSTN := -1;        ! Reserve the AFT entry             <<06514>>23285000
FIND'GLOBAL'AFTENT := -(@AFT/AFTENTRY);                        <<06514>>23290000
                                                               <<06514>>23295000
EXIT:                                                          <<06514>>23300000
                                                               <<06514>>23305000
RELSIR(FISIR,A);                                               <<06514>>23310000
EXCHANGEDB(0);                                                 <<06514>>23315000
END;                                                           <<06514>>23320000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - FNFORMAT   "             <<06272>>23325000
$ CONTROL SEGMENT = FILESYS5                                            23330000
LOGICAL PROCEDURE FNFORMAT (STRING,FN,GN,AN,LW);                        23335000
   <<PARSES THE SPECIFIED FILE REFERENCE STRING INTO SIMPLE FILE        23340000
     NAMES AND PLACES THESE NAMES INTO THE SPECIFIED BYTE ARRAYS.       23345000
                                                                        23350000
     INPUT VARIABLES:                                                   23355000
         STRING - FILE REFERENCE STRING                                 23360000
                                                                        23365000
     OUTPUT VARIABLES:                                                  23370000
         FNFORMAT - FILE REFERENCE FORMAT TYPE                          23375000
            0 - FULL NAME                                               23380000
            1 - ACCOUNT NAME ABSENT                                     23385000
            2 - GROUP AND ACCOUNT NAMES ABSENT                          23390000
            3 - NULL NAME                                               23395000
            4 - INVALID NAME                                            23400000
         FN - LOCAL FILE NAME                                           23405000
         GN - GROUP NAME                                                23410000
         AN - ACCOUNT NAME                                              23415000
         LW - LOCKWORD                                                  23420000
                                                                        23425000
     THE RESULTING SIMPLE FILE NAMES ARE 8 BYTES LONG, LEFT             23430000
     JUSTIFIED, UPSHIFTED AND HAVE TRAILING BLANKS ADDED.  IF A         23435000
     SIMPLE FILE NAME IS NOT IN THE FILE REFERENCE THE CORRESPONDING    23440000
     BYTE ARRAY WILL BE BLANK>>                                         23445000
   VALUE STRING;                                                        23450000
   BYTE POINTER STRING;                                                 23455000
   ARRAY FN,GN,AN,LW;                                                   23460000
   OPTION PRIVILEGED,UNCALLABLE;                                        23465000
   BEGIN                                                                23470000
   INTEGER STRLEN;       << To save string length for return >><<02350>>23475000
   ARRAY BLANX (*) = PB := "        ";                                  23480000
   INTEGER SCODE;                                                       23485000
   LOGICAL GT1;                                                         23490000
   BYTE POINTER BP;                                                     23495000
                                                                        23500000
   LOGICAL SUBROUTINE FILLCHKMV (TADDR,FADDR);                          23505000
      <<CHECKS, UPSHIFTS AND MOVES TO THE SPECIFIED TARGET ARRAY        23510000
        A SIMPLE FILE NAME.  ALSO ADVANCES THE FILE NAME POINTER        23515000
        OVER THE SIMPLE FILE NAME.                                      23520000
                                                                        23525000
        INPUT VARIABLES:                                                23530000
            TADDR - TARGET WORD ARRAY                                   23535000
            FADDR - SOURCE BYTE POINTER                                 23540000
                                                                        23545000
        OUTPUT VARIABLES:                                               23550000
            FILLCHKMV - ERROR FLAG                                      23555000
               0 - ILLEGAL SIMPLE FILE NAME                             23560000
               1 - LEGAL SIMPLE FILE NAME                               23565000
            FADDR - NEW SOURCE BYTE POINTER                             23570000
                                                                        23575000
        NOTE THAT THE SOURCE BYTE POINTER (FADDR) IS BY REFERENCE>>     23580000
      VALUE TADDR;                                                      23585000
      POINTER TADDR;                                                    23590000
      BYTE POINTER FADDR;                                               23595000
      BEGIN                                                             23600000
      TOS := TOS := @FADDR;                                             23605000
      MOVE * := * WHILE AN,1;  <<DELIMIT NAME>>                         23610000
      GT1 := TOS;                                                       23615000
      X := STRLEN := GT1-LOGICAL(@FADDR);  <<Name length>>     <<02350>>23620000
      IF NOT (0 <= X <= 8) THEN RETURN;  <<ILLEGAL LENGTH?>>            23625000
      @BP := @FADDR;                                                    23630000
      TOS := @TADDR&LSL(1);                                             23635000
      MOVE * := BP WHILE ANS;  <<MOVE AND UPSHIFT NAME>>                23640000
      @FADDR := GT1;  <<ADVANCE STRING POINTER>>                        23645000
      FILLCHKMV := 1;                                                   23650000
      X := STRLEN;  << Return length through X register >>     <<02350>>23655000
      END;                                                              23660000
                                                                        23665000
   INTEGER SUBROUTINE BUMPNAMPTR (STRING);                              23670000
      <<CHECKS THE FILE NAME DELIMITER POINTED TO BY STRING,            23675000
        RETURNS THE DELIMITER TYPE AS THE RESULT AND SETS STRING        23680000
        TO THE FIRST CHARACTER OF THE SIMPLE FILE NAME FOLLOWING        23685000
        THE DELIMITER.                                                  23690000
                                                                        23695000
        INPUT VARIABLES:                                                23700000
            STRING - FILE NAME POINTER                                  23705000
                                                                        23710000
        OUTPUT VARIABLES:                                               23715000
            BUMPNAMPTR - DELIMITER TYPE                                 23720000
               0 - ILLEGAL DELIMITER                                    23725000
               1 - "." => GROUP/ACCOUNT NAME NEXT                       23730000
               2 - "/" => LOCKWORD NEXT                                 23735000
      >>                                                                23740000
      BYTE POINTER STRING;                                              23745000
      BEGIN                                                             23750000
      IF STRING > %200 THEN  <<SPECIAL NAME DELIMITER?>>                23755000
         BEGIN                                                          23760000
         STRING := LOGICAL(INTEGER(STRING)) LAND %177;                  23765000
         BUMPNAMPTR := 1                                                23770000
         END                                                            23775000
      ELSE  <<REGULAR NAME DELIMITER>>                                  23780000
         BEGIN                                                          23785000
         IF STRING = "." THEN                                           23790000
            BUMPNAMPTR := 1                                             23795000
         ELSE IF STRING = "/" THEN                                      23800000
            BUMPNAMPTR := 2                                             23805000
         ELSE  <<ILLEGAL DELIMITER>>                                    23810000
            RETURN;                                                     23815000
         @STRING := @STRING+1  <<SKIP OVER DELIMITER>>                  23820000
         END                                                            23825000
      END;                                                              23830000
                                                                        23835000
   MOVE FN := BLANX,(4);  <<CLEAR LOCAL NAME>>                          23840000
   MOVE GN := BLANX,(4);  <<CLEAR GROUP NAME>>                          23845000
   MOVE AN := BLANX,(4);  <<CLEAR ACCOUNT NAME>>                        23850000
    << CHECK FOR NULL NAME >>                                           23855000
   IF NOT (%101 <= INTEGER(STRING) <= %132) AND                         23860000
      NOT (%141 <= INTEGER(STRING) <= %172) THEN  <<NOT ALPHABETIC?>>   23865000
      BEGIN                                                    <<00104>>23870000
       IF (%60 <=INTEGER(STRING)<=%71) THEN                    <<00104>>23875000
       TOS:=4 ELSE TOS:=3;                                     <<00104>>23880000
       GO EXIT;                                                <<00104>>23885000
      END;                                                     <<00104>>23890000
   IF NOT FILLCHKMV(FN,STRING) THEN GO INV;  <<INVALID LOCAL NAME?>>    23895000
   SCODE := BUMPNAMPTR(STRING);  <<SKIP OVER DELIMITER>>                23900000
   IF SCODE = 2 THEN  <<LOCKWORD NEXT?>>                                23905000
      BEGIN                                                             23910000
      IF NOT FILLCHKMV(LW,STRING) THEN GO INV;  <<INVALID LOCKWORD?>>   23915000
      IF   X=0 THEN        << Special meaning: null lockword >><<02350>>23920000
           LW:="/ "   << Forces lkwd viol if lockword exists >><<02350>>23925000
      ELSE IF NOT (%101<=INTEGER(LW.(0:8))<=%132) <<Not alpha>><<02350>>23930000
           THEN GO INV;                                        <<02350>>23935000
      SCODE := BUMPNAMPTR(STRING);  <<SKIP OVER DELIMITER>>             23940000
      IF SCODE = 2 THEN GO INV  <<LOCKWORD NEXT?>>                      23945000
      END;                                                              23950000
   IF SCODE = 1 THEN  <<GROUP/ACCOUNT NAME NEXT?>>                      23955000
      BEGIN                                                             23960000
      IF NOT FILLCHKMV(GN,STRING) THEN GO INV;  <<INVALID GROUP NAME?>> 23965000
      SCODE := BUMPNAMPTR(STRING);  <<SKIP OVER DELIMITER>>             23970000
      IF SCODE = 2 THEN GO INV;  <<LOCKWORD NEXT?>>                     23975000
      IF SCODE = 1 THEN  <<ACCOUNT NAME NEXT?>>                         23980000
         BEGIN                                                          23985000
         IF NOT FILLCHKMV(AN,STRING) THEN GO INV;  <<INVAL. ACCT NAME?>>23990000
         IF STRING = "." OR STRING = "/" THEN GO INV;          <<04795>>23995000
                                                               <<04795>>24000000
         TOS := 0  <<FULL NAME>>                                        24005000
         END                                                            24010000
      ELSE                                                              24015000
         TOS := 1  <<ACCT. NAME ABSENT>>                                24020000
      END                                                               24025000
   ELSE  <<NO GROUP/ACCOUNT NAME>>                                      24030000
      TOS := 2;  <<GROUP AND ACCT. NAMES ABSENT>>                       24035000
   GO EXIT;                                                             24040000
                                                                        24045000
INV:                                                                    24050000
   TOS := 4;                                                            24055000
                                                                        24060000
EXIT:                                                                   24065000
   FNFORMAT := TOS  <<FORMAT TYPE>>                                     24070000
   END;      << procedure FNFORMAT >>                                   24075000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - FQFORMAT   "             <<06272>>24080000
$ CONTROL SEGMENT = FILESYS5                                   <<04132>>24085000
LOGICAL PROCEDURE FQFORMAT (FREF,FN,GN,AN,LW);                 <<04132>>24090000
   COMMENT                                                     <<04132>>24095000
   TRIES TO OBTAIN FILE REFERENCE STRING FROM :FILE CMD        <<04132>>24100000
   PARSES THE FILE REFERENCES INTO SIMPLE FILE NAMES           <<04132>>24105000
                                                               <<04132>>24110000
   INPUT VARIABLES:                                            <<04132>>24115000
      FREF - FILE REF. STRING                                  <<04132>>24120000
      FN   - LOCAL FILE NAME                                   <<04132>>24125000
      GN   - GROUP NAME                                        <<04132>>24130000
      AN   - ACCOUNT NAME                                      <<04132>>24135000
      LW   - LOCKWORD                                          <<04132>>24140000
                                                               <<04132>>24145000
   OUTPUT VARIABLES:                                           <<04132>>24150000
      FQFORMAT - FILE REFERENCE FORMAT TYPE                    <<04132>>24155000
         0 - FULL NAME                                         <<04132>>24160000
         1 - ACCOUNT NAME ABSENT                               <<04132>>24165000
         2 - GROUP AND ACCOUNT NAMES ABSENT                    <<04132>>24170000
         4 - INVALID NAME                                      <<04132>>24175000
      FREF - NEW FILE REF. STRING                              <<04132>>24180000
      FN   - NEW LOCAL FILE NAME                               <<04132>>24185000
      GN   - GROUP NAME                                        <<04132>>24190000
      AN   - ACCOUNT NAME                                      <<04132>>24195000
      LW   - LOCKWORD                                          <<04132>>24200000
                                                               <<04132>>24205000
   NOTE: ONLY FOLLOWING :FILE COMMAND ARE VALID:               <<04132>>24210000
         :FILE X = Y                                           <<04132>>24215000
         :FILE X = *Y;                                         <<04132>>24220000
                                                               <<04132>>24225000
VALUE FREF;                                                    <<04132>>24230000
BYTE POINTER FREF;                                             <<04132>>24235000
ARRAY FN,GN,AN,LW;                                             <<04132>>24240000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04132>>24245000
                                                               <<04132>>24250000
BEGIN                                                          <<04132>>24255000
INTEGER I;                                                     <<04132>>24260000
BYTE POINTER BFNAME;  <<PNT TO FILE REF. STRING IN JDT>>       <<04132>>24265000
ARRAY FTAB(0:120);    <<:FILE COMMAND PARM. BUFFER >>          <<04132>>24270000
LOOP:                                                          <<04132>>24275000
IF INTEGER(FREF) = "*" THEN                                    <<04132>>24280000
  BEGIN                                                        <<04132>>24285000
  MOVE FREF := FREF(1),(8);                                    <<04132>>24290000
  FREF(8) := " ";                                              <<04132>>24295000
  MOVE FREF := FREF WHILE ANS;                                 <<04132>>24300000
  GN := "."; AN := ".";                                        <<04132>>24305000
  IF XRETJTENTRY (FREF,GN,AN,I,FTAB) = 0 THEN                  <<04132>>24310000
     BEGIN                                                     <<04132>>24315000
     I := FTAB.(8:8);    <<FORMAL DESIGNATOR NAME SIZE (W)>>   <<04132>>24320000
     <<CHECK (PMAP OF FEQ) IF :FILE X=Y OR :FILE X=*Y>>        <<04132>>24325000
     IF FTAB(I+1)  = 1 AND (FTAB(I+2) = %1000 OR FTAB(I+2) = 0)<<04132>>24330000
        THEN BEGIN                                             <<04132>>24335000
        @BFNAME := @FTAB(I+4)&LSL(1); <<SET PNT TO FILE REF.>> <<04132>>24340000
        I := FTAB(I+3).(0:8);  <<FILE REF. STRING SIZE>>       <<04132>>24345000
        MOVE FREF := BFNAME,(I);  <<COPY FILE REF. STRING>>    <<04132>>24350000
        FREF(I) := " ";                                        <<04132>>24355000
        I := FNFORMAT(FREF,FN,GN,AN,LW);  <<CHECK IF VALID>>   <<04132>>24360000
        IF I = 3 THEN GOTO LOOP;  <<MORE FILE EQ?>>            <<04132>>24365000
        END                                                    <<04132>>24370000
        ELSE GOTO E;                                           <<04132>>24375000
     END                                                       <<04132>>24380000
     ELSE GOTO E;  <<FILE EQ. NOT FOUND>>                      <<04132>>24385000
  END                                                          <<04132>>24390000
  ELSE                                                         <<04132>>24395000
E:                                                             <<04132>>24400000
  I := 4;                                                      <<04132>>24405000
FQFORMAT := I;  <<FORMAT TYPE>>                                <<04132>>24410000
END;                                                           <<04132>>24415000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - FMLNAME    "             <<06272>>24420000
$ CONTROL SEGMENT = FILESYS5                                            24425000
INTEGER PROCEDURE FMLNAME (FD,GN,AN,FOPTIONS);                          24430000
   VALUE FD;                                                            24435000
   BYTE POINTER FD;                                                     24440000
   BYTE ARRAY GN,AN;                                                    24445000
   INTEGER FOPTIONS;                                                    24450000
   OPTION PRIVILEGED,UNCALLABLE;                                        24455000
   COMMENT                                                              24460000
     SCANS FORMAL DESIGNATOR:                                           24465000
       $STDLIST      RETURNS  1                                         24470000
       $NEWPASS      RETURNS  2                                         24475000
       $OLDPASS      RETURNS  3                                         24480000
       $STDIN        RETURNS  4                                         24485000
       $STDINX       RETURNS  5                                         24490000
       $NULL         RETURNS  6                                         24495000
       *ACTUAL NAME  RETURNS  0                                         24500000
       ACTUAL NAME   RETURNS  0                                         24505000
   ;                                                                    24510000
   BEGIN                                                                24515000
   BYTE ARRAY TABLE (0:40);                                    <<06513>>24520000
   INTEGER ARRAY INX (*) =PB := 7,7,7,6,5,4;                   <<01.01>>24525000
   INTEGER ARRAY RSLT (*) =PB := 1,2,3,5,4,6;                  <<01.01>>24530000
  ARRAY FTAB(0:120);                                           <<TL.02>>24535000
   BYTE POINTER BP;                                                     24540000
   INTEGER I;                                                           24545000
                                                                        24550000
   MOVE TABLE := "STDLISTNEWPASSOLDPASSSTDINXSTDINNULL";       <<06513>>24555000
   IF INTEGER(FD) = %52 THEN  <<"*"?>>                                  24560000
      BEGIN                                                             24565000
      MOVE FD := FD(1),(35);                                            24570000
      FD(8) := " ";                                                     24575000
      MOVE FD := FD WHILE ANS;                                          24580000
      GN := "."; AN := ".";                                             24585000
      IF XRETJTENTRY(FD,GN,AN,I,FTAB) <> 0 THEN                         24590000
         BEGIN   << ERROR: NO FILE EQN FOR NAME >>             <<00117>>24595000
         FOPDESIGNATOR := 7;                                            24600000
         RETURN;                                                        24605000
         END;                                                           24610000
      FOPNOEQUATE := 0;                                                 24615000
      END                                                               24620000
   ELSE IF INTEGER(FD) = %44 THEN  <<"$"?>>                             24625000
      BEGIN                                                             24630000
      FD(8) := " ";                                                     24635000
      MOVE FD(1) := FD(1) WHILE ANS;                                    24640000
                                                               <<01.01>>24645000
      @BP := @TABLE;                                                    24650000
      FOR I := 0 STEP 1 UNTIL 5 DO                                      24655000
         BEGIN                                                          24660000
         TOS := @FD(1);                                                 24665000
         TOS := @BP;                                                    24670000
         TOS := INX(I);                                                 24675000
         @BP := @BP+S0;                                                 24680000
                                                               <<01.01>>24685000
         IF * = *, (TOS) THEN                                  <<06513>>24690000
            BEGIN                                                       24695000
            MOVE FD := FD(1),(35);                                      24700000
            FOPDESIGNATOR := RSLT(I);                          <<01.01>>24705000
            RETURN;                                                     24710000
            END;                                                        24715000
         END;                                                           24720000
      FOPDESIGNATOR := 7;  << ERROR: $ NOT FOLLOWED BY STDIN, ETC.>>    24725000
      RETURN;                                                           24730000
      END;                                                              24735000
   FMLNAME := 1;  << NAME, NOT $STDIN, ETC. >>                 <<00117>>24740000
   END;     << procedure FMLNAME >>                                     24745000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - PARSE'DENSITY "          <<06272>>24750000
                                                               <<02568>>24755000
$CONTROL SEGMENT=FILESYS6                                      <<02568>>24760000
                                                               <<02568>>24765000
LOGICAL PROCEDURE PARSE'DENSITY(PARM,PARMLEN,DEN'VALUE);       <<02568>>24770000
   VALUE PARMLEN;                                              <<02568>>24775000
   INTEGER                                                     <<02568>>24780000
      DEN'VALUE,  << Output: internal density rep >>           <<02568>>24785000
      PARMLEN;    << Input:  length of PARM in bytes. >>       <<02568>>24790000
   BYTE ARRAY PARM;                                            <<02568>>24795000
   OPTION UNCALLABLE;                                          <<02568>>24800000
BEGIN                                                          <<02568>>24805000
                                                               <<02568>>24810000
   << This procedure takes any string of alphanumeric >>       <<02568>>24815000
   << characters, and returns TRUE if it is a valid   >>       <<02568>>24820000
   << parameter for the "DEN" keyword of the FOPEN    >>       <<02568>>24825000
   << device parameter.  It also returns the internal >>       <<02568>>24830000
   << representation of that string in "DEN'VALUE".   >>       <<02568>>24835000
                                                               <<02568>>24840000
   INTEGER                                                     <<02568>>24845000
      ENTRYNO;  << Return from SEARCH >>                       <<02568>>24850000
   BYTE POINTER                                                <<02568>>24855000
      DICT'PTR; << Points to definition in DEN'DICT >>         <<02568>>24860000
   BYTE ARRAY PDENSITY(*) = PB :=                              <<04517>>24865000
      7,4,"6250",DEN'6250,                                     <<02568>>24870000
      7,4,"1600",DEN'1600,                                     <<02568>>24875000
      6,3,"800",DEN'800,                                       <<07271>>24880000
      0;                                                       <<02568>>24885000
   EQUATE                                                      <<02568>>24890000
      PDENSITYL = 21;                                          <<07271>>24895000
   BYTE ARRAY                                                  <<02568>>24900000
      DEN'DICT(0:PDENSITYL-1);   << Local dict copy >>         <<02568>>24905000
                                                               <<02568>>24910000
                                                               <<02568>>24915000
   MOVE DEN'DICT := PDENSITY,(PDENSITYL);                      <<02568>>24920000
                                                               <<02568>>24925000
   ENTRYNO := SEARCH(PARM,PARMLEN,DEN'DICT,DICT'PTR);          <<02568>>24930000
   IF ENTRYNO <> 0 THEN                                        <<02568>>24935000
      BEGIN      << Valid parameter >>                         <<02568>>24940000
      PARSE'DENSITY := TRUE;                                   <<02568>>24945000
      DEN'VALUE := DICT'PTR;                                   <<02568>>24950000
      END;                                                     <<02568>>24955000
                                                               <<02568>>24960000
END;   << of PARSE'DENSITY >>                                  <<02568>>24965000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - PARSE'DEV'PARMS"         <<06272>>24970000
                                                              <<SP.ENV>>24975000
$CONTROL SEGMENT=FILESYS6                                     <<SP.ENV>>24980000
                                                              <<SP.ENV>>24985000
INTEGER PROCEDURE PARSE'DEV'PARMS(BYTE'STRING,DEVPARMS);      <<SP.ENV>>24990000
   BYTE ARRAY BYTE'STRING;                                    <<SP.ENV>>24995000
   LOGICAL ARRAY DEVPARMS;                                    <<SP.ENV>>25000000
   OPTION UNCALLABLE;                                          <<01901>>25005000
                                                              <<SP.ENV>>25010000
   BEGIN                                                      <<SP.ENV>>25015000
                                                              <<SP.ENV>>25020000
   COMMENT                                                    <<SP.ENV>>25025000
                                                              <<SP.ENV>>25030000
     This procedure parses the keyword parameters such as     <<SP.ENV>>25035000
              ENV=environment file name                       <<SP.ENV>>25040000
              OUTQ=outqname                                   <<SP.ENV>>25045000
              DEN=density                                      <<02524>>25050000
     separated by semicolons, in the Device parameter of      <<SP.ENV>>25055000
     FOPEN and in the Job File Equation table produced by     <<SP.ENV>>25060000
     the :FILE command. This string beginning with the Device <<SP.ENV>>25065000
     parameter is in BYTE'STRING. An example string is  ;     <<SP.ENV>>25070000
       << LP;ENV=EPOC.PUB.SYS;OUTQ=FAST (CR)>>                <<SP.ENV>>25075000
   COMMENT                                                    <<SP.ENV>>25080000
                                                              <<SP.ENV>>25085000
     This procedure is called by FOPEN and by FILECOMVALS.    <<SP.ENV>>25090000
     The first call to PARSE'DEV'PARMS should be made with    <<SP.ENV>>25095000
     the first word of DEVPARMS set to 0, indicating it is    <<SP.ENV>>25100000
     uninitialized.                                           <<SP.ENV>>25105000
                                                              <<SP.ENV>>25110000
  The DEVPARMS array is a structured array and it looks like: <<SP.ENV>>25115000
                                                              <<SP.ENV>>25120000
      _____________________________________________           <<SP.ENV>>25125000
      |                                           |           <<SP.ENV>>25130000
      |    TOKEN 1        |          INDEX1       |           <<SP.ENV>>25135000
      |-------------------------------------------|           <<SP.ENV>>25140000
      |    TOKEN 2        |          INDEX2       |           <<SP.ENV>>25145000
      |-------------------------------------------|           <<SP.ENV>>25150000
                           .                                  <<SP.ENV>>25155000
                           .                                  <<SP.ENV>>25160000
                           .                                  <<SP.ENV>>25165000
      |-------------------------------------------|           <<SP.ENV>>25170000
      |    -1             |  next avail pointer   |           <<SP.ENV>>25175000
      |-------------------------------------------|           <<SP.ENV>>25180000
      |   LEN1            |  value string         |           <<SP.ENV>>25185000
      |-------------------------------------------|           <<SP.ENV>>25190000
      |   LEN2            |  value string         |           <<SP.ENV>>25195000
      |-------------------------------------------|           <<SP.ENV>>25200000
      |                    .                      |           <<SP.ENV>>25205000
                           .                                  <<SP.ENV>>25210000
                           .                                  <<SP.ENV>>25215000
      |___________________________________________|           <<SP.ENV>>25220000
                                                              <<SP.ENV>>25225000
                                                              <<SP.ENV>>25230000
                                                              <<SP.ENV>>25235000
     Note that the -1 is at DEVPARMS(2*NUM'DP'TOKENS)          <<02524>>25240000
     where NUM'DP'TOKENS is the number of different kinds      <<02524>>25245000
     of tokens there are.  NUM'DP'TOKENS must be changed if    <<02524>>25250000
     new tokens are added.  Tokens are:                        <<02524>>25255000
           ENV   =  "EN"                                      <<SP.ENV>>25260000
           OUTQ  =  "OQ"                                      <<SP.ENV>>25265000
           DEN   =  "DN"                                       <<02524>>25270000
                                                              <<SP.ENV>>25275000
    All tokens are two bytes.                                 <<SP.ENV>>25280000
                                                              <<SP.ENV>>25285000
                          END OF COMMENT;                     <<SP.ENV>>25290000
                                                              <<SP.ENV>>25295000
   BYTE POINTER BP;                                           <<SP.ENV>>25300000
   BYTE ARRAY PKEYLIST(*) = PB :=                             <<SP.ENV>>25305000
        7,3,"ENV",ENV'DEFN,    << DEFN = 2 character token. >> <<02524>>25310000
        8,4,"OUTQ",OUTQ'DEFN,                                  <<02524>>25315000
        7,3,"DEN",DEN'DEFN,                                    <<02524>>25320000
        0;                     << end of keylist. >>           <<02524>>25325000
   EQUATE                                                      <<02524>>25330000
      PKEYLISTL   = 23,  << length of "SEARCH" dict. >>        <<02524>>25335000
      MAXPARMS    = 10,  << max. number of dev. parms >>       <<02524>>25340000
      NUMKEYWORDS = NUM'DP'TOKENS;                             <<02524>>25345000
   LOGICAL                                                     <<02524>>25350000
      FIRST,                                                   <<02524>>25355000
      CONTINUE;          << parsing flag >>                    <<02524>>25360000
   BYTE ARRAY KEYLIST(0:PKEYLISTL-1);                         <<SP.ENV>>25365000
   DOUBLE ARRAY PARMS(0:MAXPARMS-1);                           <<02524>>25370000
   DOUBLE DL':=[8/"=",8/";",8/%15,8/0]D;                                25375000
      BYTE ARRAY DELIMITERS(*) = DL';                                   25380000
   INTEGER                                                     <<02524>>25385000
      NUMPARMS,   << return from MYCOMMAND >>                  <<02524>>25390000
      J,          << loop variable         >>                  <<02524>>25395000
      I;          << parm index thru keyword loop >>           <<02524>>25400000
   BYTE ARRAY BDEVPARMS(*) = DEVPARMS;                        <<SP.ENV>>25405000
   EQUATE                                                     <<SP.ENV>>25410000
       CAR'RETURN = %15,                                       <<02524>>25415000
       EQUAL = 0,                                             <<SP.ENV>>25420000
       SEMICOLON  = 1,                                        <<SP.ENV>>25425000
       CR = 2;                                                <<SP.ENV>>25430000
   EQUATE                                                     <<SP.ENV>>25435000
       SUCCESSFUL = 0,                                        <<SP.ENV>>25440000
       EXPECT'EQUAL = 1,                                      <<SP.ENV>>25445000
       UNDEFINED'KEYWORD = 2,                                 <<SP.ENV>>25450000
       EXPECT'SEMI'CR    = 3,                                 <<SP.ENV>>25455000
       DEVPARMS'OVERFLOW = 4,                                  <<02524>>25460000
       DEVARRAY'OVERFLOW = 5;                                  <<02524>>25465000
   INTEGER INDEX,NEXTDELIM,PARMLEN;                            <<02524>>25470000
   INTEGER ENTRYNO;                                           <<SP.ENV>>25475000
   BYTE POINTER DEFN;                                         <<SP.ENV>>25480000
   BYTE POINTER BDEV'PTR;                                      <<02524>>25485000
   BYTE ARRAY COPY'BYTE'STRING(0:BDEVPARM'END);                <<02524>>25490000
                                                               <<02524>>25495000
   LOGICAL SUBROUTINE GETNEXT;                                 <<02524>>25500000
      << explodes one entry from parms array >>                <<02524>>25505000
   BEGIN                                                       <<02524>>25510000
      IF I+1 > MAXPARMS THEN  << more than we can handle >>    <<02524>>25515000
         BEGIN                                                 <<02524>>25520000
         PARSE'DEV'PARMS := DEVPARMS'OVERFLOW;                 <<02524>>25525000
         RETURN;                                               <<02524>>25530000
         END;                                                  <<02524>>25535000
      TOS := PARMS(I);  << get full entry >>                   <<02524>>25540000
      NEXTDELIM := S0.(11:5);  << get trailing delim >>        <<02524>>25545000
      PARMLEN := TOS&LSR(8);   << pick up length >>            <<02524>>25550000
      @BP := TOS;  << parm pointer >>                          <<02524>>25555000
      I := I+1;                                                <<02524>>25560000
      GETNEXT := TRUE;   << no overflow >>                     <<02524>>25565000
   END;  << of get next >>                                     <<02524>>25570000
                                                               <<02524>>25575000
   LOGICAL SUBROUTINE UPDATE'DEV'PARM;                         <<02524>>25580000
                                                               <<02524>>25585000
   BEGIN                                                      <<SP.ENV>>25590000
                                                              <<SP.ENV>>25595000
      << Subroutine UPDATE'DEV'PARMS matches the token to >>  <<SP.ENV>>25600000
      << previous entry in DEVPARMS and builds a string and >><<SP.ENV>>25605000
      << length entry and indexes it.  >>                     <<SP.ENV>>25610000
   INDEX := DEVPARMS(J*2+1) := NEXT'AVAIL'PTR;                <<SP.ENV>>25615000
   NEXT'AVAIL'PTR := NEXT'AVAIL'PTR + 1 +                      <<02524>>25620000
        ( LOGICAL(PARMLEN)+2 )&LSR(1);                         <<02524>>25625000
   IF NEXT'AVAIL'PTR > DEVPARM'END + 1  THEN                   <<02524>>25630000
      BEGIN                                                   <<SP.ENV>>25635000
      PARSE'DEV'PARMS := DEVPARMS'OVERFLOW;                   <<SP.ENV>>25640000
      END                                                     <<SP.ENV>>25645000
   ELSE                                                       <<SP.ENV>>25650000
      BEGIN                                                   <<SP.ENV>>25655000
      UPDATE'DEV'PARM := TRUE;                                 <<02524>>25660000
      DEVPARMS(INDEX) := PARMLEN + 1;                          <<02524>>25665000
      MOVE BDEVPARMS( (INDEX+1)&LSL(1) ) := BP,(PARMLEN+1);    <<02524>>25670000
      END;                                                    <<SP.ENV>>25675000
   END;     << subroutine UPDATE'DEV'PARMS >>                 <<SP.ENV>>25680000
                                                              <<SP.ENV>>25685000
                                                              <<SP.ENV>>25690000
   FIRST := TRUE;                                              <<02524>>25695000
   PARSE'DEV'PARMS := 0;    << initialize >>                  <<SP.ENV>>25700000
   IF DEVPARMS = 0 THEN                                       <<SP.ENV>>25705000
      BEGIN      << initialize array >>                       <<SP.ENV>>25710000
      MOVE DEVPARMS(1) := DEVPARMS,(NUMKEYWORDS*2);           <<SP.ENV>>25715000
      DEVPARMS(NUMKEYWORDS*2) := -1;                          <<SP.ENV>>25720000
      NEXT'AVAIL'PTR := (NUMKEYWORDS+1)*2;                     <<02524>>25725000
                << next available cell >>                     <<SP.ENV>>25730000
                                                              <<SP.ENV>>25735000
      END;                                                    <<SP.ENV>>25740000
   MOVE COPY'BYTE'STRING := BYTE'STRING,(BDEVPARM'END);        <<02524>>25745000
      << Set up keyword array and search for keywords  >>     <<SP.ENV>>25750000
      << in BYTE'STRING >>                                    <<SP.ENV>>25755000
   COPY'BYTE'STRING(BDEVPARM'END) := %15;  << CR terminator >> <<02524>>25760000
   CONTINUE := TRUE;                                          <<SP.ENV>>25765000
       MOVE COPY'BYTE'STRING := COPY'BYTE'STRING WHILE ANS,0;  <<01882>>25770000
   DO                                                         <<SP.ENV>>25775000
      BEGIN                                                   <<SP.ENV>>25780000
      IF BPS0 = "." OR BPS0 = "/" OR BPS0 = "#" OR            <<SP.ENV>>25785000
              BPS0 = "*" THEN                                 <<SP.ENV>>25790000
         BEGIN  DEL; TOS := TOS +1; ASSEMBLE(DUP);                      25795000
               MOVE * := * WHILE ANS,0;                        <<01882>>25800000
         END                                                            25805000
      ELSE  CONTINUE := FALSE;                                <<SP.ENV>>25810000
      END                                                     <<SP.ENV>>25815000
   UNTIL NOT CONTINUE;                                        <<SP.ENV>>25820000
   @BP := TOS;                                                 <<02524>>25825000
   DEL;                                                        <<02524>>25830000
   IF BP = ";" THEN                                            <<02524>>25835000
      BEGIN          << indicates some keywords >>             <<02524>>25840000
                                                               <<02524>>25845000
      MOVE KEYLIST := PKEYLIST,(PKEYLISTL);                    <<02524>>25850000
      MYCOMMAND(COPY'BYTE'STRING,DELIMITERS,MAXPARMS,          <<02524>>25855000
                NUMPARMS,PARMS);                               <<02524>>25860000
      I := 1;  << skip first parameter, i.e. DEVICE >>         <<02524>>25865000
                                                               <<02524>>25870000
      DO BEGIN  << search for valid keywords >>                <<02524>>25875000
                                                               <<02524>>25880000
         IF NOT GETNEXT THEN RETURN;                           <<02524>>25885000
                                                               <<02524>>25890000
         ENTRYNO := SEARCH(BP,PARMLEN,KEYLIST,DEFN);           <<02524>>25895000
         IF ENTRYNO = 0 THEN                                   <<02524>>25900000
            BEGIN   << keyword not in table >>                 <<02524>>25905000
            IF FIRST THEN RETURN;                              <<02524>>25910000
            PARSE'DEV'PARMS := UNDEFINED'KEYWORD;              <<02524>>25915000
            RETURN;                                            <<02524>>25920000
            END;                                               <<02524>>25925000
                                                               <<02524>>25930000
         IF NEXTDELIM <> EQUAL THEN                            <<02524>>25935000
            BEGIN                                              <<02524>>25940000
            IF FIRST THEN RETURN;                              <<02524>>25945000
            PARSE'DEV'PARMS := EXPECT'EQUAL;                   <<02524>>25950000
            RETURN;                                            <<02524>>25955000
            END;                                               <<02524>>25960000
                                                               <<02524>>25965000
         IF FIRST THEN                                         <<02524>>25970000
            BEGIN            <<make sure terminated by CR>>    <<02524>>25975000
            SCAN COPY'BYTE'STRING UNTIL CAR'RETURN, 1;         <<02524>>25980000
            J := TOS - LOGICAL(@COPY'BYTE'STRIN);              <<02524>>25985000
            IF J >= BDEVPARM'END THEN                          <<02524>>25990000
               BEGIN         <<no CR, missing or lost in trans><<02524>>25995000
               PARSE'DEV'PARMS := DEVARRAY'OVERFLOW;           <<02524>>26000000
               RETURN;                                         <<02524>>26005000
               END;                                            <<02524>>26010000
            END;                                               <<02524>>26015000
                                                               <<02524>>26020000
         FIRST := FALSE;                                       <<02524>>26025000
         IF NOT GETNEXT THEN RETURN;                           <<02524>>26030000
                                                               <<02524>>26035000
         << if keyword already defined in DEVPARMS, then >>    <<02524>>26040000
         << replace it, else make a new token entry.     >>    <<02524>>26045000
                                                               <<02524>>26050000
         J := -1;                                              <<02524>>26055000
         CONTINUE := TRUE;                                     <<02524>>26060000
                                                               <<02524>>26065000
         DO BEGIN    << see if exists already >>               <<02524>>26070000
            J := J + 1;                                        <<02524>>26075000
            @BDEV'PTR := @BDEVPARMS(J&LSL(2));                 <<02524>>26080000
            IF BDEV'PTR = DEFN,(2) THEN                        <<02524>>26085000
               CONTINUE := FALSE       << replace old >>       <<02524>>26090000
            ELSE IF DEVPARMS(J&LSL(1)) = 0 THEN                <<02524>>26095000
               BEGIN                                           <<02524>>26100000
               MOVE BDEV'PTR := DEFN,(2);                      <<02524>>26105000
               CONTINUE := FALSE;      << add new entry >>     <<02524>>26110000
               END;                                            <<02524>>26115000
            END                                                <<02524>>26120000
         UNTIL NOT CONTINUE OR (J+1 >= NUMKEYWORDS);           <<02524>>26125000
                                                               <<02524>>26130000
         << should always drop out of above with continue  >>  <<02524>>26135000
         << equal to false. Other test is just precaution >>   <<02524>>26140000
         << against DEVPARMS being clobberred.             >>  <<02524>>26145000
                                                               <<02524>>26150000
         IF NOT CONTINUE THEN                                  <<02524>>26155000
            BEGIN                                              <<02524>>26160000
            IF NOT UPDATE'DEV'PARM THEN RETURN;                <<02524>>26165000
            END;                                               <<02524>>26170000
                                                               <<02524>>26175000
         END                                                   <<02524>>26180000
      UNTIL NEXTDELIM <> SEMICOLON;                            <<02524>>26185000
                                                               <<02524>>26190000
      IF NEXTDELIM <> CR THEN                                  <<02524>>26195000
         BEGIN                                                 <<02524>>26200000
         PARSE'DEV'PARMS := EXPECT'SEMI'CR;                    <<02524>>26205000
         END;                                                  <<02524>>26210000
                                                               <<02524>>26215000
      END;                                                              26220000
   END;     << procedure PARSE'DEV'PARMS >>                   <<SP.ENV>>26225000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - GET'DEV'PARM "           <<06272>>26230000
                                                              <<SP.ENV>>26235000
   LOGICAL PROCEDURE GET'DEV'PARM(TOKEN, DEVPARMS, INDEX);    <<SP.ENV>>26240000
                                                              <<SP.ENV>>26245000
      VALUE TOKEN;                                            <<SP.ENV>>26250000
      INTEGER TOKEN;                                           <<01863>>26255000
      INTEGER ARRAY DEVPARMS;                                  <<01863>>26260000
      INTEGER INDEX;                                          <<SP.ENV>>26265000
   OPTION UNCALLABLE;                                          <<01901>>26270000
                                                              <<SP.ENV>>26275000
   << GET'DEV'PARM is passed the token of a device parameter >><<01815>>26280000
   << and the array DEVPARMS which was previously formatted >><<SP.ENV>>26285000
   << by the procedure PARSE'DEV'PARMS >>                     <<SP.ENV>>26290000
   << See PARSE'DEV'PARMS for a list of tokens. >>            <<SP.ENV>>26295000
                                                              <<SP.ENV>>26300000
   BEGIN                                                      <<SP.ENV>>26305000
                                                              <<SP.ENV>>26310000
   INTEGER I;                                                 <<SP.ENV>>26315000
                                                              <<SP.ENV>>26320000
   I := INDEX := 0;                                           <<SP.ENV>>26325000
   IF DEVPARMS <> 0 THEN DO                                             26330000
      BEGIN                                                   <<SP.ENV>>26335000
      IF DEVPARMS(I) = TOKEN THEN                              <<02524>>26340000
         BEGIN   << Token found >>                            <<SP.ENV>>26345000
         INDEX := DEVPARMS(I+1);                               <<02524>>26350000
         IF DEVPARMS(INDEX) > 1                                <<02524>>26355000
            THEN GET'DEV'PARM := TRUE                          <<02524>>26360000
            ELSE INDEX := 0; << NULL PARM = NO PARM >>         <<02524>>26365000
         END;                                                  <<02524>>26370000
      END                                                      <<02524>>26375000
   UNTIL DEVPARMS( (I:=I+2) ) <= 0;                            <<02524>>26380000
   END;     << procedure GET'DEV'PARM >>                      <<SP.ENV>>26385000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - FILECOMVALS  "           <<06272>>26390000
$ CONTROL SEGMENT = FILESYS6                                            26395000
LOGICAL PROCEDURE FILECOMVALS (N1,N2,N3,FD,DEVL,FOPT,AOPT,NBUFS,DISP,   26400000
   RSIZE,NUMEXTS,INITALLOC,BF,FILESIZE,FILECODE,STATE,PMAP,    <<01815>>26405000
   FMSG,DEVPARMS,DP'ERROR);                                    <<02524>>26410000
                                                               <<02524>>26415000
COMMENT                                                        <<02524>>26420000
   <<THIS PROCEDURE MERGES THE SPECIFIED FOPEN PARAMETERS WITH THOSE    26425000
     OF THE APPROPRIATE :FILE COMMAND, IF ANY, PENDING AGAINST          26430000
     THE FILE.                                                          26435000
                                                                        26440000
     INPUT PARAMETERS:                                                  26445000
         N1 - LOCAL FILE NAME                                           26450000
         N2 - GROUP NAME                                                26455000
         N3 - ACCOUNT NAME                                              26460000
         FD - FORMAL FILE DESIGNATOR                                    26465000
         DEVL - DEVICE CLASS OR LOGICAL DEVICE NUMBER                   26470000
         FOPT - FOPTIONS                                                26475000
         AOPT - AOPTIONS                                                26480000
         NBUFS - (0:4)OUTPRI,(4:7)NUMCOPIES,(11:5)NUMBUFFERS            26485000
         DISP - FCLOSE DISPOSITION                                      26490000
         RSIZE - RECORD SIZE                                            26495000
         NUMEXTS - NUMBER OF EXTENTS                                    26500000
         INITALLOC - NUMBER OF EXTENTS TO BE ALLOCATED                  26505000
         BF - BLOCKING FACTOR                                           26510000
         FILESIZE - NUMBER OF RECORDS IN FILE                           26515000
         FILECODE - FILE CODE                                           26520000
         STATE - FOPEN STATE WORD                                       26525000
         PMAP - FOPEN PARAMETER BIT MAP                                 26530000
         DEVPARMS - device parameter keyword array              SP.ENV  26535000
                   - see procedure PARSE'DEV'PARMS for info     SP.ENV  26540000
                                                                        26545000
     OUTPUT VARIABLES:                                                  26550000
         FILECOMVALS - FILE EQUATION FLAG                               26555000
            FALSE - NO FILE EQUATION                                    26560000
            TRUE - FILE EQUATION AFFECTED                               26565000
         DP'ERROR - contains the result of the call            <<02524>>26570000
                    to PARSE'DEV'PARMS                         <<02524>>26575000
         FMSG - forms message, byte 0 is the parmflag for      << 7622>>26580000
                the forms message, byte 1 is the length and    << 7622>>26585000
                the remaining bytes are the forms message.     << 7622>>26590000
                If the forms message was specified and a       << 7622>>26595000
                message of length zero was found, a null       << 7622>>26600000
                message is inserted (period and semicolon)     << 7622>>26605000
         PLUS ALL INPUT PARAMETERS                                      26610000
                                                                        26615000
     THIS PROCEDURE MUST BE CALLED WITH DB SET TO THE STACK>>           26620000
                                                               <<02524>>26625000
;  << end of comment >>                                        <<02524>>26630000
                                                               <<02524>>26635000
   BYTE ARRAY N1,N2,N3,FD,DEVL,FMSG;                           <<TL.02>>26640000
   LOGICAL FOPT,AOPT;                                                   26645000
   INTEGER NBUFS,DISP,RSIZE,NUMEXTS,INITALLOC,BF,FILECODE;              26650000
   LOGICAL STATE,PMAP;                                                  26655000
   DOUBLE FILESIZE;                                                     26660000
   LOGICAL ARRAY DEVPARMS;                                    <<SP.ENV>>26665000
   LOGICAL DP'ERROR;                                           <<02524>>26670000
   OPTION PRIVILEGED,UNCALLABLE;                                        26675000
   BEGIN                                                                26680000
   INTEGER RESULT = FILECOMVALS;                                        26685000
   INTEGER SCAN'LEN; << len of device field to 1st CR/semi. >> <<02524>>26690000
   EQUATE CR'SEMI'COLON = %6473;                              <<SP.ENV>>26695000
   INTEGER ARRAY FTAB (0:120); <<:FILE COMMAND PARM BUFF>>     <<TL.02>>26700000
   BYTE ARRAY BFTAB (*) = FTAB;                                         26705000
   ARRAY LFTAB (*) = FTAB;                                     <<01333>>26710000
   INTEGER I;  <<UTILITY VARIABLE>>                                     26715000
   BYTE POINTER BSCAN;                                                  26720000
   INTEGER POINTER WSCAN;                                               26725000
   DOUBLE POINTER WSCANDBL = WSCAN;                                     26730000
    BYTE ARRAY COPY'DEVL(0:MAXDEVLEN);  <<Room for terminator>><<02524>>26735000
                                                                        26740000
   <<* * * GET :FILE PARAMETERS FROM JOB TABLE * * *>>                  26745000
                                                                        26750000
   I := 3;                                                              26755000
   IF XRETJTENTRY(N1,N2,N3,I,FTAB) = 0 THEN  <<:FILE COMMAND?>>         26760000
      BEGIN                                                             26765000
                                                                        26770000
      <<* * * MERGE PARAMETERS * * *>>                                  26775000
                                                                        26780000
      I := FTAB.(8:8);  <<NR. WORDS FOR FORMAL DESIGNATOR>>             26785000
      @BSCAN := @BFTAB(2);  <<SET TO FORMAT DESIGNATOR>>                26790000
      FTAB(1).(0:1) := 0;  <<CLEAR MYSTERY BIT>>                        26795000
      I := I&LSL(1);  <<NR. BYTES FOR FORMAL DESIGNATOR>>               26800000
      MOVE FD := BSCAN,(I);  <<COPY FORMAL DESIGNATOR>>                 26805000
      FD(I) := " ";  <<APPEND TRAILING BLANK>>                          26810000
      @BSCAN := @BSCAN+I+6;  <<SET TO ACTUAL DESIGNATOR>>               26815000
      @FTAB := @FTAB+I&LSR(1)+1;  <<SET TO FIRST BIT MAP>>              26820000
      @BFTAB := @FTAB&LSL(1);                                           26825000
      TOS := FTAB;  <<FIRST BIT MAP>>                                   26830000
      IF LS0.(15:1) THEN  <<RETURN NEW NAME?>>                          26835000
         BEGIN                                                          26840000
         I := BFTAB(4);                                                 26845000
         MOVE FD := BSCAN,(I);                                          26850000
         FD(I) := " ";                                                  26855000
         @BSCAN := @BSCAN+I                                             26860000
         END;                                                           26865000
      IF LS0.(14:1) THEN  <<RETURN NEW DEVICE CLASS?>>                  26870000
                << or device parms such as "ENV=", "OUTQ=">>  <<SP.ENV>>26875000
         BEGIN                                                          26880000
         I := BFTAB(5);  <<NR. BYTES FOR DEVICE CLASS NAME>>            26885000
                 << + device parm keywords length >>          <<SP.ENV>>26890000
         MOVE COPY'DEVL := BSCAN,(MAXDEVLEN);                  <<02524>>26895000
         COPY'DEVL(MAXDEVLEN) := %15;                          <<02524>>26900000
         SCAN COPY'DEVL UNTIL CR'SEMI'COLON,1;                 <<02524>>26905000
         SCAN'LEN := TOS - LOGICAL(@COPY'DEVL);                <<02524>>26910000
         IF SCAN'LEN >= I THEN  << NO KEYWORDS >>              <<02524>>26915000
            SCAN'LEN := I;                                     <<02524>>26920000
         IF SCAN'LEN <> 0 THEN  << device exists >>            <<02524>>26925000
            BEGIN                                              <<02524>>26930000
            MOVE DEVL := BSCAN,(SCAN'LEN);                     <<02524>>26935000
            DEVL(SCAN'LEN) := " ";    << terminator >>         <<02524>>26940000
            END;                                               <<02524>>26945000
         IF SCAN'LEN <> I AND BSCAN(SCAN'LEN) = ";" THEN       <<02524>>26950000
            BEGIN          << keywords >>                      <<02524>>26955000
            DP'ERROR := PARSE'DEV'PARMS(BSCAN,DEVPARMS);       <<02524>>26960000
            END;                                               <<02524>>26965000
         @BSCAN := @BSCAN+I  <<SKIP OVER DEVICE CLASS NAME>>            26970000
                             << and device parameters >>      <<SP.ENV>>26975000
         END;                                                           26980000
      @WSCAN := (@BSCAN+1)&LSR(1);  <<SET TO FOPTIONS>>                 26985000
      IF LS0.(13:1) THEN FOPT.FOPDOMAINF := WSCAN.FOPDOMAINF;           26990000
      IF LS0.(12:1) THEN FOPT.FOPASCIIF := WSCAN.FOPASCIIF;             26995000
      IF LS0.(11:1) THEN                                                27000000
         FOPT.FOPDESIGNATORF := WSCAN.FOPDESIGNATORF                    27005000
      ELSE                                                              27010000
         FOPT.FOPDESIGNATORF := 0;  <<MAKE ACTUAL>>                     27015000
      IF LS0.(10:1) THEN FOPT.FOPFORMATF := WSCAN.FOPFORMATF;           27020000
      IF LS0.(9:1) THEN FOPT.FOPCONTROLF := WSCAN.FOPCONTROLF;          27025000
      IF LFTAB(1).(0:1) THEN FOPT.FILETYPE:=WSCAN.FILETYPE;    <<HM.01>>27030000
      IF LFTAB(1).(1:1) THEN                                   <<01333>>27035000
         BEGIN                                                 <<01333>>27040000
         FTAB(1).(1:1) := WSCAN.FOPLABELLEDF;                  <<01333>>27045000
         FOPT.FOPLABELLEDF := WSCAN.FOPLABELLEDF;              <<01333>>27050000
         END;                                                  <<01333>>27055000
      @WSCAN := @WSCAN+1;  <<SET TO AOPTIONS>>                          27060000
      IF LS0.(8:1) THEN AOPT.AOPCOPYF:=WSCAN.AOPCOPYF;         <<HM.00>>27065000
      IF LS0.(7:1) THEN                                                 27070000
         BEGIN                                                          27075000
         AOPT.AOPACTYPEF := WSCAN.AOPACTYPEF;                           27080000
         PMAP.(5:1) := 1                                                27085000
         END;                                                           27090000
      IF LS0.(6:1) THEN AOPT.AOPMULTIRECF := WSCAN.AOPMULTIRECF;        27095000
      IF LS0.(5:1) THEN AOPT.AOPACMODEF := WSCAN.AOPACMODEF;            27100000
      IF LS0.(4:1) THEN AOPT.AOPINHIBITBUFF := WSCAN.AOPINHIBITBUFF;    27105000
      IF LS0.(3:1) THEN NBUFS.(11:5) := WSCAN(1).(3:5);                 27110000
      IF LS0.(2:1) THEN DISP := WSCAN(1).(13:3);                        27115000
      IF LS0.(1:1) THEN RSIZE := WSCAN(2);                              27120000
      IF LS0.(0:1) THEN                                                 27125000
         BEGIN                                                          27130000
         BF := WSCAN(3).(8:8);                                          27135000
         STATE.DEFAULTBF := 0                                           27140000
         END;                                                           27145000
      DEL;  <<DELETE FIRST BIT MAP>>                                    27150000
      TOS := FTAB(1);  <<SECOND BIT MAP>>                               27155000
      IF LS0.(15:1) THEN INITALLOC := WSCAN(1).(8:5)+1;        <<01968>>27160000
      IF LS0.(14:1) THEN NUMEXTS := WSCAN(3).(0:5)+1;                   27165000
      IF LS0.(13:1) THEN FILESIZE := WSCANDBL(2);                       27170000
      IF LS0.(12:1) THEN FILECODE := WSCAN(6);                          27175000
      IF LS0.(11:1) THEN NBUFS.(0:4) := WSCAN(7).(0:4);                 27180000
      IF LS0.(10:1) THEN NBUFS.(4:7) := WSCAN(7).(4:7);                 27185000
      IF LS0.( 9:1) THEN AOPT.AOPMULTACF := WSCAN.AOPMULTACF;           27190000
      IF LS0.( 8:1) THEN AOPT.AOPNOWAITF := WSCAN.AOPNOWAITF;           27195000
      IF LS0.(7:1) THEN AOPT.AOPLOCKINGF := WSCAN.AOPLOCKINGF; <<01815>>27200000
      IF LS0.(1:2) <> 0 THEN                                   <<02568>>27205000
         BEGIN    << Forms/Tape Label >>                       <<02568>>27210000
         @BSCAN := (@WSCAN+10)&LSL(1) + 1;                     << 7622>>27215000
         FMSG(0) := LS0.(1:2);     << flag indicates msg there << 7622>>27220000
         MOVE FMSG(1) := BSCAN,(BSCAN+1);                      << 7622>>27225000
            << byte 0 of fmsg is flag, byte 1 is length >>     << 7622>>27230000
         IF BSCAN = 0  << null length >> THEN                  << 7622>>27235000
            BEGIN                                              << 7622>>27240000
            FMSG(1) := 2;         << setup dummy fmsg >>       << 7622>>27245000
            FMSG(2) := ".";                                    << 7622>>27250000
            FMSG(3) := ";";                                    << 7622>>27255000
            END;                                               << 7622>>27260000
         END;    << KSAM/FORMS/LABEL >>                        <<01815>>27265000
      RESULT := RESULT+1      << return True >>                         27270000
      END                                                               27275000
   END;     << procedure FILECOMVALS >>                                 27280000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - STUFF'DEV'PARMS "        <<06272>>27285000
PROCEDURE STUFF'DEV'PARMS(DEVPARMS,RESULT);                    <<02524>>27290000
VALUE RESULT;                                                  <<02524>>27295000
ARRAY DEVPARMS;                                                <<02524>>27300000
INTEGER RESULT;                                                <<02524>>27305000
                                                               <<02524>>27310000
OPTION UNCALLABLE;                                             <<02524>>27315000
BEGIN                                                          <<02524>>27320000
   INTEGER PARM'INDEX,DEVLEN;                                  <<02524>>27325000
   LOGICAL CONTINUE := TRUE;                                   <<02524>>27330000
   BYTE POINTER OUTPUT' = RESULT;                              <<02524>>27335000
                                                               <<02524>>27340000
   BYTE ARRAY BDEVPARMS(*) = DEVPARMS;                         <<02524>>27345000
                                                               <<02524>>27350000
   MOVE OUTPUT' := OUTPUT' WHILE ANS,0;                        <<02524>>27355000
   DO                                                          <<02524>>27360000
      BEGIN                                                    <<02524>>27365000
         IF BPS0 = "." OR BPS0 = "/" OR                        <<02524>>27370000
            BPS0 = "*" OR BPS0 = "#" THEN                      <<02524>>27375000
            BEGIN                                              <<02524>>27380000
               DEL;                                            <<02524>>27385000
               TOS := TOS + 1;                                 <<02524>>27390000
               ASSEMBLE(DUP);                                  <<02524>>27395000
               MOVE * := * WHILE ANS,0;                        <<02524>>27400000
            END                                                <<02524>>27405000
         ELSE                                                  <<02524>>27410000
            CONTINUE := FALSE;                                 <<02524>>27415000
      END                                                      <<02524>>27420000
   UNTIL NOT CONTINUE;                                         <<02524>>27425000
   DEVLEN := TOS - LOGICAL(@OUTPUT');                          <<02524>>27430000
   DEL;                                                        <<02524>>27435000
   IF GET'DEV'PARM(OUTQ'TOKEN,DEVPARMS,PARM'INDEX) THEN        <<02524>>27440000
   BEGIN                                                       <<02524>>27445000
      MOVE OUTPUT'(DEVLEN) := ";OUTQ=";                        <<02524>>27450000
      DEVLEN := DEVLEN + 6;                                    <<02524>>27455000
      MOVE OUTPUT'(DEVLEN) := BDEVPARMS((PARM'INDEX+1)&LSL(1)),<<02524>>27460000
                             (DEVPARMS(PARM'INDEX) - 1);       <<02524>>27465000
      DEVLEN := DEVLEN + INTEGER(DEVPARMS(PARM'INDEX)) - 1;    <<02524>>27470000
   END;                                                        <<02524>>27475000
   IF GET'DEV'PARM(DEN'TOKEN,DEVPARMS,PARM'INDEX) THEN         <<02524>>27480000
   BEGIN                                                       <<02524>>27485000
      MOVE OUTPUT'(DEVLEN) := ";DEN=";                         <<02524>>27490000
      DEVLEN := DEVLEN + 5;                                    <<02524>>27495000
      MOVE OUTPUT'(DEVLEN) := BDEVPARMS((PARM'INDEX+1)&LSL(1)),<<02524>>27500000
                             (DEVPARMS(PARM'INDEX) - 1);       <<02524>>27505000
      DEVLEN := DEVLEN + INTEGER(DEVPARMS(PARM'INDEX)) - 1;    <<02524>>27510000
   END;                                                        <<02524>>27515000
   OUTPUT'(DEVLEN) := %15;                                     <<02524>>27520000
END; << procedure STUFF'DEV'PARMS >>                           <<02524>>27525000
$ PAGE "MPE-V  BASELINE FILE SYSTEM - FLOCKWORD       "        <<06272>>27530000
$ CONTROL SEGMENT = FILESYS4                                            27535000
LOGICAL PROCEDURE FLOCKWORD (USERLW,FLAB,A,B,PACBV);                    27540000
   <<CHECKS THE SUPPLIED LOCKWORD AGAINST THE FILE LOCKWORD.  IF        27545000
     NONE IS SUPPLIED AND THE FILE HAS A LOCKWORD THEN THE USER         27550000
     IS PROMPTED FOR THE LOCKWORD.                               00822  27555000
                                                                        27560000
     INPUT VARIABLES:                                                   27565000
         USERLW - SUPPLIED LOCKWORD (8 BYTES WITH TRAILING BLANKS)      27570000
         FLAB - FILE LABEL POINTER                                      27575000
         A - CALLER'S GETSIR(FISIR) RESULT                              27580000
         B - CALLER'S GETSIR(FMAVTSIR) RESULT                           27585000
         PACBV - MULTIACCESS PACB VECTOR                                27590000
            0 - PACB NOT LOCKED                                         27595000
            N - VECTOR OF LOCKED PACB                                   27600000
                                                                        27605000
     OUTPUT VARIABLES:                                                  27610000
         FLOCKWORD - ERROR FLAG                                         27615000
            0 - LOCKWORD VIOLATION                                      27620000
            1 - SUPPLIED LOCKWORD MATCHES FILE LOCKWORD                 27625000
            2 - PROMPTED LOCKWORD MATCHES FILE LOCKWORD                 27630000
         USERLW - SUPPLIED OR PROMPTED LOCKWORD                         27635000
                                                                        27640000
     NOTE THAT THE FILE SIR IS RELEASED IF THE SUPPLIED LOCKWORD        27645000
     DOES NOT MATCH THE FILE LOCKWORD.  THIS IS BECAUSE WE DON'T        27650000
     WANT TO HOLD THE SIR WHILE WE ARE PROMPTING THE USER FOR           27655000
     THE LOCKWORD; THE TERMINAL READ IS BLOCKED AND THE USER MAY        27660000
     TAKE AN INDETERMINATE AMOUNT OF TIME TO RESPOND.  ALSO, DB         27665000
     MUST BE SET TO THE STACK WHEN THIS PROCEDURE IS CALLED>>           27670000
   VALUE A,B,PACBV;                                                     27675000
   BYTE ARRAY USERLW;                                                   27680000
   ARRAY FLAB;                                                          27685000
   INTEGER A,B;                                                <<06514>>27690000
   DOUBLE PACBV;                                               <<06514>>27695000
   OPTION UNCALLABLE,PRIVILEGED;                                        27700000
   BEGIN                                                                27705000
   BYTE POINTER FILELW;  <<FILE LOCKWORD>>                              27710000
   INTEGER CNT;  <<MESSAGE LENGTH>>                                     27715000
   BYTE ARRAY MESSAGE (0:37);  <<MESSAGE BUFFER>>                       27720000
                                                                        27725000
$  IF X0 = ON                                                           27730000
   IF MONOTHER THEN  <<MONITORING?>>                                    27735000
      BEGIN                                                             27740000
      TOS := "FL"; TOS := "OC"; TOS := "KW"; TOS := "OR";               27745000
      TOS := "D ";                                                      27750000
      ASSEMBLE(ZERO,DZRO);                                              27755000
      FTITLE(*,*,*,*);                                                  27760000
      DEBUG                                                             27765000
      END;                                                              27770000
$  IF                                                                   27775000
                                                                        27780000
   @FILELW := @FLLOCKWORD&LSL(1);  <<FILE LOCKWORD>>                    27785000
   X := -1;                                                    <<00600>>27790000
   WHILE (X:=X+1)<8 DO IF FILELW(X) = 0 THEN FILELW(X):=" ";   <<00600>>27795000
   IF USERLW = FILELW,(8) THEN  <<LOCKWORD MATCH?>>                     27800000
      BEGIN                                                             27805000
      TOS := 1;                                                         27810000
      GO EXIT                                                           27815000
      END;                                                              27820000
                                                               <<*8096>>27825000
   IF FILELW = " " AND USERLW = "/" THEN                       <<*8096>>27830000
      BEGIN                                                    <<*8096>>27835000
      USERLW := " ";                                           <<*8096>>27840000
      TOS := 1;                                                <<*8096>>27845000
      GO EXIT;                                                 <<*8096>>27850000
      END;                                                     <<*8096>>27855000
                                                               <<*8096>>27860000
   RELSIR(FISIR,A);  <<RELEASE FILE SIR>>                               27865000
   IF PACBV <> 0D THEN  <<UNLOCK PACB?>>                       <<06514>>27870000
      UNLOCK'CB(0,PACBV);                                      <<06514>>27875000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);  <<RELEASE FMAVT SIR>>           27880000
   IF FILELW = " " THEN  <<NO FILE LOCKWORD?>>                          27885000
      BEGIN                                                             27890000
E0:   TOS := 0;                                                         27895000
      GO EXIT                                                           27900000
      END;                                                              27905000
   IF USERLW <> " " THEN GO E0;  <<MISMATCH?>>                          27910000
                                                                        27915000
   <<* * * PROMPT USER FOR LOCKWORD * * *>>                             27920000
                                                                        27925000
   TOS := @MESSAGE; BPS0 := " ";                                        27930000
   ASSEMBLE(DUP,INCB); MOVE * := *,(37);  <<CLEAR BUFFER>>              27935000
                                                                        27940000
   MOVE MESSAGE := "LOCKWORD: ",2;                                      27945000
   ASSEMBLE(DUP);                                                       27950000
   TOS := @FLLOCNAME&LSL(1);                                            27955000
   MOVE * := *,(8);  <<LOCAL FILE NAME>>                                27960000
   SCAN * UNTIL " ",1;                                                  27965000
   BPS0 := ".";                                                         27970000
   ASSEMBLE(INCA,DUP);                                                  27975000
   TOS := @FLGRPNAME&LSL(1);                                            27980000
   MOVE * := *,(8);  <<GROUP NAME>>                                     27985000
   SCAN * UNTIL " ",1;                                                  27990000
   BPS0 := ".";                                                         27995000
   ASSEMBLE(INCA,DUP);                                                  28000000
   TOS := @FLACCTNAME&LSL(1);                                           28005000
   MOVE * := *,(8);  <<ACCOUNT NAME>>                                   28010000
   SCAN * UNTIL " ",1;                                                  28015000
   BPS0 := "?";                                                         28020000
   CNT := TOS+1-@MESSAGE;  <<MESSAGE LENGTH>>                           28025000
                                                                        28030000
   IF NOT FREPLY(MESSAGE,CNT) THEN GO E0;  <<PROMPTING ERROR?>>         28035000
   MOVE USERLW := MESSAGE,(8);  <<PROMPTED LOCKWORD>>                   28040000
   IF USERLW <> FILELW,(8) THEN GO E0;  <<MISMATCH?>>                   28045000
   TOS := 2;                                                            28050000
EXIT:                                                                   28055000
   FLOCKWORD := TOS                                                     28060000
   END;                                                                 28065000
$ PAGE " MPE-V  BASELINE FILE SYSTEM - FLABIO               "  <<06272>>28070000
<<----------------------------------------------------------------------28075000
*                                                                      *28080000
*  UNCALLABLE (MPE SUPPORT) INTRINSICS                                 *28085000
*                                                                      *28090000
---------------------------------------------------------------------->>28095000
                                                                        28100000
$ CONTROL SEGMENT = FILESYS4                                            28105000
INTEGER PROCEDURE FLABIO (LDEV,SECTOR,FUNC,FLAB);                       28110000
   <<THIS PROCEDURE READS AND WRITES FILE LABELS.  IT ALSO CHECKS FOR   28115000
     DATA CREDIBILITY VIA A CHECKSUM ON THE FILE LABEL.                 28120000
                                                                        28125000
     INPUT VARIABLES:                                                   28130000
         LDEV - LOGICAL DEVICE NUMBER OF FILE LABEL                     28135000
         SECTOR - SECTOR NUMBER OF FILE LABEL                           28140000
         FUNC - I/O MODE                                                28145000
            0 - READ                                                    28150000
            1 - WRITE                                                   28155000
           -1 - Write, setting the disc caching serial I/O bit          28160000
                on.  This insures that the writes are flushed           28165000
                to disc in the order in which they came in.             28170000
                This is coordinated with DFS in insure integ-           28175000
                grity between extent allocation and DFS in              28180000
                systems with disc caching.                              28185000
         FLAB - FILE LABEL POINTER                                      28190000
                                                                        28195000
     OUTPUT VARIABLES:                                                  28200000
         FLABIO - ERROR FLAG                                            28205000
            0 - OK                                                      28210000
            1 - HARD ERROR - DIRECTORY ENTRY SHOULD BE FLAGGED          28215000
            2 - SOFT ERROR - DIRECTORY ENTRY SHOULD NOT BE FLAGGED      28220000
                                                                        28225000
     NOTE THAT THIS PROCEDURE IS USED BY INITIAL/SYSDUMP, STORE/RESTORE 28230000
     AND LOG AS WELL AS THE FILE SYSTEM.  ALSO, DB MUST BE SET TO THE   28235000
     STACK WHEN THIS PROCEDURE IS CALLED>>                              28240000
   VALUE LDEV,SECTOR,FUNC;                                              28245000
   INTEGER LDEV,FUNC;                                                   28250000
   DOUBLE SECTOR;                                                       28255000
   INTEGER ARRAY FLAB;                                                  28260000
   OPTION PRIVILEGED,UNCALLABLE;                                        28265000
   BEGIN                                                                28270000
   DEFINE READ = NOT LOGICAL(FUNC)#,                                    28275000
          WRITE = LOGICAL(FUNC)#;                                       28280000
   INTEGER P1 = SECTOR;  <<SECTOR NUMBER - FIRST HALF>>                 28285000
   INTEGER P2 = SECTOR+1;  <<SECTOR NUMBER - SECOND HALF>>              28290000
   INTEGER ATTIOFLAGS;                                         <<06870>>28295000
   DEFINE                                                      <<06870>>28300000
      ATTIOFLAG'SERIAL = ATTIOFLAGS.(5:1)#;                    <<06870>>28305000
   DOUBLE POINTER FLABDBL = FLAB;                                       28310000
                                                               <<01901>>28315000
   SUBROUTINE CHEKFLAB;                                        <<01901>>28320000
   << This routine checks that the 1st extent in the file label<<01901>>28325000
   << (just read or about to be written) is not zero and at    <<01901>>28330000
   << least the sector address matches the address passed in as<<01901>>28335000
   << a parameter to FLABIO.>>                                 <<01901>>28340000
   BEGIN                                                       <<01901>>28345000
   TOS:=FLLABEL;                                               <<01901>>28350000
   IF = THEN BEGIN      << Addr of 1st extent is zero >>       <<01901>>28355000
             DDEL;                                             <<01901>>28360000
             GO INVFL;                                         <<01901>>28365000
             END                                               <<01901>>28370000
   ELSE BEGIN                                                  <<01901>>28375000
        << It would be too expensive to convert vol. number >> <<01901>>28380000
        << in flabel to ldev for every read or write of a   >> <<01901>>28385000
        << file label.  But at least we can check that the  >> <<01901>>28390000
        << sector address matches the parameter SECTOR.     >> <<01901>>28395000
        S1.(0:8):=0;       << Zero out volume number     >>    <<01901>>28400000
        IF TOS <> SECTOR   << Address doesn't match      >>    <<01901>>28405000
        THEN GO INVFL;                                         <<01901>>28410000
        END;                                                   <<01901>>28415000
   END;                                                        <<01901>>28420000
                                                                        28425000
$  IF X0 = ON                                                           28430000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               28435000
      BEGIN                                                             28440000
      TOS := "FL"; TOS := "AB"; TOS := "IO";                            28445000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        28450000
      FTITLE(*,*,*,*);                                                  28455000
      DEBUG                                                             28460000
      END;                                                              28465000
$  IF                                                                   28470000
                                                               <<+0.06>>28475000
   <<* * * VERIFY THAT CALLER HAS FILE SIR * * *>>             <<+0.06>>28480000
                                                               <<+0.06>>28485000
$  IF X2 = ON                                                  <<+0.06>>28490000
   <<The idea was that if the caller was fooling around with >><<04138>>28495000
   <<the file label he should have the file SIR.  However it >><<04138>>28500000
   <<was found that good calls to do label I/O may not own   >><<04138>>28505000
   <<file SIR - and so the check was commented out 12/10/76  >><<04138>>28510000
   <<We will leave it in until such time we wish to track    >><<04138>>28515000
   <<down all callers and start enforcing this rule.         >><<04138>>28520000
<< IF GETPROCNUM <> SIR(FISIR*SIRENTRY).(0:8)    >>            <<04138>>28525000
<<    THEN FTROUBLE(0);                          >>            <<04138>>28530000
$  IF                                                          <<+0.06>>28535000
                                                                        28540000
   P1.(0:8):=0;         << Zero out volume number of SECTOR >> <<01901>>28545000
   ATTIOFLAGS := BFLAGS; << Blocked I/O.                    >> <<06870>>28550000
   IF FUNC = -1 THEN                                           <<06870>>28555000
      BEGIN              << Special cach serial write.      >> <<06870>>28560000
      ATTIOFLAG'SERIAL := 1;                                   <<06870>>28565000
      FUNC := 1;         << Reset to normal write.          >> <<06870>>28570000
      END;                                                     <<06870>>28575000
   IF WRITE THEN  <<UPDATE CHECKSUM?>>                                  28580000
      BEGIN                                                             28585000
      <<*** To catch bad file labels *** >>                    <<01901>>28590000
      CHEKFLAB;                                                <<01901>>28595000
      CHECKSUM;  <<GENERATE NEW CHECKSUM>>                              28600000
      FLCHECKSUM := TOS  <<UPDATE CHECKSUM>>                            28605000
      END;                                                              28610000
   TOS := ATTACHIO(LDEV,0,0,@FLAB,FUNC,128,P1,P2,ATTIOFLAGS);  <<06870>>28615000
   DEL;                                                                 28620000
   IF TOS.(8:8) <> 1 THEN  <<ATTACHIO ERROR?>>                          28625000
      BEGIN                                                             28630000
      IF READ THEN GO SOFT;  <<READ FAILURE?>>                          28635000
      GO HARD  <<WRITE FAILURE>>                                        28640000
      END;                                                              28645000
   IF READ THEN  <<VERIFY CHECKSUM?>>                                   28650000
      BEGIN                                                             28655000
      <<*** To catch bad file labels *** >>                    <<01901>>28660000
      CHEKFLAB;                                                <<01901>>28665000
      CHECKSUM;  <<GENERATE CHECKSUM>>                                  28670000
      ASSEMBLE(TEST);                                                   28675000
      IF = OR FLCHECKSUM <> 0 THEN  <<VERIFY CHECKSUM?>>                28680000
         IF TOS <> FLCHECKSUM THEN  <<CHECKSUM MISMATCH?>>              28685000
            BEGIN                                                       28690000
     INVFL: FLLABEL := 0D;  <<INVALIDATE FIRST EXTENT>>        <<01901>>28695000
            FLNUMEXTS := 0;  <<INVALIDATE REMAINING EXTENTS>>           28700000
            GO HARD                                                     28705000
            END                                                         28710000
      END;                                                              28715000
   TOS := 0;  <<NO ERROR>>                                              28720000
   GO EXIT;                                                             28725000
                                                                        28730000
HARD:                                                                   28735000
   TOS := 1;  <<HARD ERROR>>                                            28740000
   GO EXIT;                                                             28745000
                                                                        28750000
SOFT:                                                                   28755000
   TOS := 2;  <<SOFT ERROR>>                                            28760000
                                                                        28765000
EXIT:                                                                   28770000
   FLABIO := TOS  <<ERROR NR.>>                                         28775000
   END;                                                                 28780000
$ PAGE " MPE-V  BASELINE FILE SYSTEM - FLABIOERR            "  <<06272>>28785000
$ CONTROL SEGMENT = FILESYS4                                            28790000
PROCEDURE FLABIOERR (FLAG,FILENUM,FGANAME);                             28795000
                                                               <<04516>>28800000
  <<********************************************************>> <<04516>>28805000
  << This procedure flags a director entry as having a bad  >> <<04516>>28810000
  << file label and prints an error message of the opera-   >> <<04516>>28815000
  << tor's console.  Also, invalidated the FCB to prevent   >> <<04516>>28820000
  << further access of the file.                            >> <<04516>>28825000
  <<                                                        >> <<04516>>28830000
  << Input Variables:                                       >> <<04516>>28835000
  <<   FLAG - Error severity code                           >> <<04516>>28840000
  <<      1 - Hard error (write failure or checksum wrong)  >> <<04516>>28845000
  <<      2 - Soft error (Read failure)                     >> <<04516>>28850000
  <<   FILENUM - File number                                >> <<04516>>28855000
  <<      0 - File number not available                     >> <<04516>>28860000
  <<      N - File number                                   >> <<04516>>28865000
  <<   FGANAME - File Name Array (Optional, used if File-   >> <<04516>>28870000
  <<                              num = 0 )                 >> <<04516>>28875000
  <<      1st. 8 bytes - File name                          >> <<04516>>28880000
  <<      2nd. 8 bytes - Group name                         >> <<04516>>28885000
  <<      3rd. 8 bytes - Account name                       >> <<04516>>28890000
  <<                                                        >> <<04516>>28895000
  << Note that this procedure is used by those modules that >> <<04516>>28900000
  << also use FLABIO.  Also, DB must be set to the stack    >> <<04516>>28905000
  << when this procedure is called.                         >> <<04516>>28910000
  <<********************************************************>> <<04516>>28915000
                                                               <<04516>>28920000
   VALUE FLAG,FILENUM,FGANAME;                                          28925000
   LOGICAL FLAG;                                                        28930000
   INTEGER FILENUM,FGANAME;                                             28935000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                               28940000
   BEGIN                                                                28945000
   LOGICAL PMAP = Q-4;  <<PARAMETER BIT MAP>>                           28950000
   INTEGER I,J,K;  <<UTILITY INTEGERS>>                                 28955000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   28960000
   INTEGER FOPTIONS := 0;  <<FOPTIONS>>                                 28965000
   INTEGER LDEV := 0;  <<LOGICAL DEVICE NR.>>                           28970000
   INTEGER ARRAY FILEID (0:11);  <<FILE NAME BUFFER>>                   28975000
   BYTE ARRAY FILEID'B (*) = FILEID;                           <<04516>>28980000
   DEFINE FN = FILEID#,  <<LOCAL FILE NAME>>                            28985000
          GN = FILEID(4)#,  <<GROUP NAME>>                              28990000
          AN = FILEID(8)#;  <<ACCOUNT NAME>>                            28995000
   INTEGER ARRAY FID (0:13);                                            29000000
   BYTE ARRAY FID'B (*) = FID;                                 <<04516>>29005000
                                                               <<04516>>29010000
   INTEGER ACBDST;  <<STACK DST NR.>>                                   29015000
   INTEGER FCBV;  <<FCB VECTOR>>                                        29020000
   DOUBLE                                                      <<04624>>29025000
      FCB'CB'ADDR,      << Control block DST and offset.    >> <<04624>>29030000
      FCB'STK'ADDR;     << Stack DST and offset of FCB.     >> <<04624>>29035000
   INTEGER POINTER FCB; << FCB pointer to stack array.      >> <<04624>>29040000
   DOUBLE POINTER FCBDBL = FCB; << Double FCB.              >> <<04624>>29045000
   INTEGER FCBMQ;       << Q offset to FCB stack array.     >> <<04624>>29050000
   LOGICAL FCB'FLAG;    << Flag word returned by LOCK'CB.   >> <<04624>>29055000
   LOGICAL ACB'FLAGS;         << Flags sent to LOC'ACB      >> <<04516>>29060000
                                                               <<04516>>29065000
   <<*******************************************************>> <<04516>>29070000
   << ACB'POINTERS - Below are the declarations and equates >> <<04516>>29075000
   << for the PACB and AFT arrays.  LOC'ACB places the AFT  >> <<04516>>29080000
   << at ACB(-4) to ACB(-1) and the PACB follows.           >> <<04516>>29085000
                                                               <<04516>>29090000
   INTEGER ACBMQ;                                              <<04516>>29095000
   INTEGER AFTE;    <<AFT entry word 0, type and $NULL bit. >> <<04516>>29100000
   DOUBLE  PACBV;   << Physical ACB Vector                  >> <<06514>>29105000
   DOUBLE  LACBV;   << Logical  ACB Vector                  >> <<06514>>29110000
   INTEGER IOQX;    << No-wait I/O pending Queue index.     >> <<04516>>29115000
                                                               <<04516>>29120000
   << The order of the above declarationa cannot be changed >> <<04516>>29125000
   << in any way.  Also, the ACB declaration must immed-    >> <<04516>>29130000
   << iately follow.                                        >> <<04516>>29135000
                                                               <<04516>>29140000
   INTEGER ARRAY ACB(0:SIZEXACB-1) = Q;                        <<04516>>29145000
   DOUBLE ARRAY ACBDBL(*)=ACB;                                 <<06514>>29150000
                                                               <<04516>>29155000
   <<  If any variables are needed to be added to this      >> <<04516>>29160000
   << procedure, they should be added after ACB since ACB'  >> <<04516>>29165000
   << LOCATION won't have to be changes.                    >> <<04516>>29170000
   <<*******************************************************>> <<04516>>29175000
                                                               <<04516>>29180000
                                                                        29185000
$  IF X0 = ON                                                           29190000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               29195000
      BEGIN                                                             29200000
      TOS := "FL"; TOS := "AB"; TOS := "IO"; TOS := "ER";               29205000
      TOS := "R ";                                                      29210000
      ASSEMBLE(ZERO,DZRO);                                              29215000
      FTITLE(*,*,*,*);                                                  29220000
      DEBUG                                                             29225000
      END;                                                              29230000
$  IF                                                                   29235000
                                                                        29240000
   IF FILENUM <> 0 OR PMAP THEN  <<FILE NAME AVAILABLE?>>               29245000
      BEGIN                                                             29250000
      IF FILENUM <> 0 THEN  <<FILE IS OPEN?>>                           29255000
         BEGIN                                                          29260000
                                                               <<04516>>29265000
         <<*************************************************>> <<04516>>29270000
         <<  Copy our AFT entry and ACB's onto the stack    >> <<04516>>29275000
         <<  into our Q relative array.                     >> <<04516>>29280000
         <<*************************************************>> <<04516>>29285000
                                                                        29290000
         CRIT := SETCRITICAL;                                           29295000
         ACB'FLAGS := STATUS;                                  <<06296>>29300000
         ACB'FLAGS.(1:15):=0; <<Privmode check only         >> <<04516>>29305000
         GET'ACB'Q'LOC;                                        <<04516>>29310000
         LOC'ACB(ACBDST,ACBMQ,FILENUM,ACB'FLAGS);              <<04516>>29315000
         ACBDST := TOS;  << LOC'ACB returns DST on TOS      >> <<04516>>29320000
                                                               <<04516>>29325000
                                                               <<04516>>29330000
         IF < THEN  <<ILLEGAL FILE NR.?>>                               29335000
            BEGIN                                                       29340000
            RESETCRITICAL(CRIT);                                        29345000
            GO UNKNOWN                                                  29350000
            END;                                                        29355000
         MOVE FN := ACBNAME , (4);       << Move local copy >> <<04624>>29360000
                                         << of file name.   >> <<04516>>29365000
                                                                        29370000
         <<*************************************************>> <<04624>>29375000
         << Allocate FCB array on stack and set up pointer. >> <<04624>>29380000
         << Copy the FCB into the stack via LOCK'CB.  We are>> <<04624>>29385000
         << copying the FCB w/o the extent map.             >> <<04624>>29390000
         <<*************************************************>> <<04624>>29395000
                                                               <<04624>>29400000
                                                               <<06514>>29405000
         ALLOC'C'FCB;                                          <<06514>>29410000
         GET'FCB'Q'LOC;       << Set FCBMQ for LOCK'CB.     >> <<04624>>29415000
         LOCK'CB(0,0,FCBMQ,ACBFCB);                            <<06514>>29420000
         FCB'CB'ADDR  := TOS; <<  CB DST and offset.        >> <<04624>>29425000
         FCB'STK'ADDR := TOS; << STK DST and offset.        >> <<04624>>29430000
         FCB'FLAG := TOS;     << Flag word, not used here.  >> <<04624>>29435000
                                                               <<04624>>29440000
         TOS := FCB'STK'ADDR; << Targer addresses, to stack.>> <<04624>>29445000
         TOS := FCB'CB'ADDR;  << Source , from FCB.         >> <<04624>>29450000
         TOS := SIZEBFCB;     << Copy 1st. 36 words.        >> <<04624>>29455000
         MOVE'DS'5;           << They're off!               >> <<04624>>29460000
                                                               <<04624>>29465000
         MOVE GN := FCBGN,(8);<< Group and Account.         >> <<04624>>29470000
         LDEV := FCBLDEV;                                      <<07047>>29475000
                                                               <<04624>>29480000
         << Now invalidate the FCB!                         >> <<04624>>29485000
                                                               <<04624>>29490000
         IF FLAG THEN                                          <<04624>>29495000
            BEGIN             << Prevent further access.    >> <<04624>>29500000
            FCBDISP := HARDFLABERR;                            <<04624>>29505000
            FCBUSERLBL := 0;  << Clear User Labels.         >> <<04624>>29510000
            FCBEOF  := 0D;    << Clear EOF.                 >> <<04624>>29515000
            FCBFLIM := 0D;    << Clear File Limit.          >> <<04624>>29520000
            << Now copy changed FCB back to Control Block.  >> <<04624>>29525000
            TOS := FCB'CB'ADDR;  << Target, to CB.          >> <<04624>>29530000
            TOS := FCB'STK'ADDR; << Source, from stack.     >> <<04624>>29535000
            TOS := SIZEBFCB;     << Copy 36 words back.     >> <<04624>>29540000
            MOVE'DS'5;           << They're off!            >> <<04624>>29545000
            END;                                               <<04624>>29550000
                                                               <<04624>>29555000
         << Unlock FCB and ACB now.                         >> <<04624>>29560000
         UNLOCK'CB(0,ACBFCB);                                  <<06514>>29565000
         UNLOC'ACB(ACBMQ,0);  << Release ACB >>                <<04516>>29570000
                                                               <<04516>>29575000
         RESETCRITICAL(CRIT)                                            29580000
         END                                                            29585000
      ELSE  <<USE SUPPLIED FILE NAME>>                                  29590000
         BEGIN                                                 <<07047>>29595000
         @FILEID := FGANAME;                                   <<07047>>29600000
         @FILEID'B := FGANAME&LSL(1);                          <<07047>>29605000
         END;                                                  <<07047>>29610000
                                                                        29615000
      <<* * * COMPOSE FILE NAME FOR MESSAGE * * *>>                     29620000
                                                                        29625000
      K := -1;                                                          29630000
      FOR I := 0 STEP 8 UNTIL 23 DO                                     29635000
         BEGIN                                                          29640000
         FOR J := 0 STEP 1 UNTIL 7 DO                                   29645000
            IF FILEID'B(I+J) <> " " THEN                       <<04516>>29650000
               FID'B(K := K+1) := FILEID'B(I+J);               <<04516>>29655000
         FID'B(K := K+1) := "."                                <<04516>>29660000
         END;                                                           29665000
      FID'B(K) := 0;                                           <<04516>>29670000
                                                                        29675000
      <<* * * FLAG DIRECTORY ENTRY * * *>>                              29680000
                                                                        29685000
      IF FLAG THEN   ! Flag the directory?                     <<07047>>29690000
         IF FILENUM <> 0 AND FCBPERMANENT OR                   <<07047>>29695000
            FILENUM = 0                                        <<07047>>29700000
            THEN DIRECSETFLAG (0,0D,AN,GN,FN);                 <<07047>>29705000
      END                                                               29710000
   ELSE  <<UNKNOWN FILE NAME>>                                          29715000
UNKNOWN:                                                                29720000
      MOVE FID := ("UNKNOWN",0);                                        29725000
                                                                        29730000
   <<* * * PRINT MESSAGE ON OPERATOR CONSOLE * * *>>                    29735000
                                                                        29740000
   GENMSG(1,FLABERRNO,%10000,LDEV,@FID'B,,,,0);                <<07047>>29745000
   << FILE LABEL ERROR MESSAGE >>                              <<0U.EB>>29750000
                                                                        29755000
   END;                                                                 29760000
$ PAGE " MPE-V  BASELINE FILE SYSTEM - FREPLY                " <<06272>>29765000
$ CONTROL SEGMENT = FILESYS4                                            29770000
LOGICAL PROCEDURE FREPLY (MESSAGE,LENGTH);                              29775000
   <<WRITES THE SPECIFIED MESSAGE ON $STDLIST AND READS THE REPLY       29780000
     FROM $STDIN.                                                       29785000
                                                                        29790000
     INPUT VARIABLES:                                                   29795000
         MESSAGE - MESSAGE TO BE WRITTEN                                29800000
         LENGTH - MESSAGE LENGTH IN BYTES                               29805000
                                                                        29810000
     OUTPUT VARIABLES:                                                  29815000
         FREPLY - ERROR INDICATION                                      29820000
            TRUE - OK                                                   29825000
            FALSE - ERROR                                               29830000
         MESSAGE - REPLY TO MESSAGE (8 CHAR'S WITH BLANKS ADDED)        29835000
                                                                        29840000
     NOTE THAT THIS PROCEDURE IS USED BY THE CI AND STORE/RESTORE AS    29845000
     WELL AS THE FILE SYSTEM.  ALSO, DB MUST BE SET TO THE STACK WHEN   29850000
     THIS PROCEDURE IS CALLED>>                                         29855000
   VALUE LENGTH;                                                        29860000
   BYTE ARRAY MESSAGE;                                                  29865000
   INTEGER LENGTH;                                                      29870000
   OPTION UNCALLABLE,PRIVILEGED;                                        29875000
   BEGIN                                                                29880000
   EQUATE C0 = 9*5,  <<LOCKWORD MASK LENGTH>>                  <<+0.05>>29885000
          C1 = C0+2+1;  <<CR,LF PLUS 1 FOR ROUNDOFF>>          <<+0.05>>29890000
   LOGICAL                                                     <<06.EB>>29895000
      HARDCOPY:=FALSE,                                         <<06.EB>>29900000
      ECHOWASOFF:=TRUE;                                        <<06.EB>>29905000
   INTEGER TERM'TYPE;                                          <<07420>>29910000
   INTEGER PCBGLOBLOC;    <<PXGLOB POINTER>>                   <<06513>>29915000
   INTEGER POINTER BUF;  <<TERMINAL MESSAGE BUFFER>>                    29920000
   BYTE POINTER BBUF;  <<SAME>>                                         29925000
                                                                        29930000
$  IF X0 = ON                                                           29935000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               29940000
      BEGIN                                                             29945000
      TOS := "FR"; TOS := "EP"; TOS := "LY";                            29950000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        29955000
      FTITLE(*,*,*,*);                                                  29960000
      DEBUG                                                             29965000
      END;                                                              29970000
$  IF                                                                   29975000
                                                                        29980000
   PXGLOBAL; <<INIT. PCBX POINTER>>                            <<06513>>29985000
   IF PXG'JOBTYPE <> 1 THEN GO NFG;  <<NOT SESSION?>>          <<06513>>29990000
   PUSH(S);                                                             29995000
   ASSEMBLE(INCA,DUP);                                                  30000000
   @BUF := TOS;  <<MESSAGE BUFFER>>                                     30005000
   @BBUF := TOS&LSL(1);                                                 30010000
   TOS := (LENGTH+C1)&LSR(1);  <<NR. WORDS FOR BUFFER>>        <<+0.05>>30015000
   ASSEMBLE(ADDS 0);  <<ALLOCATE BUFFER>>                               30020000
   MOVE BBUF := MESSAGE,(LENGTH);  <<COPY MESSAGE>>                     30025000
   BBUF(LENGTH) := %15;  <<INSERT CR>>                                  30030000
   BBUF(LENGTH+1) := %12;  <<INSERT LF>>                                30035000
   LENGTH := LENGTH+2;                                                  30040000
   ATTACHIO(PXG'OUTPUTLDEV,0,0,@TERM'TYPE,192,1,55,1,BFLAGS);  <<07420>>30045000
   IF TERM'TYPE = 3 OR TERM'TYPE = 4 THEN                      <<07420>>30050000
      BEGIN   ! Hard copy device, hide lockword in garbage.    <<07420>>30055000
      HARDCOPY := TRUE;                                        <<06.EB>>30060000
      MOVE BBUF(LENGTH) :=                                              30065000
         ("MMMMMMMM",%15,"WWWWWWWW",%15,"XXXXXXXX",%15,        <<+0.05>>30070000
          "mmmmmmmm",%15,"xxxxxxxx",%15);  <<LOCKWORD MASK>>   <<+0.05>>30075000
      LENGTH := LENGTH+C0                                      <<+0.05>>30080000
      END;                                                              30085000
                                                               <<07420>>30090000
   IF NOT HARDCOPY THEN << TURN ECHO OFF >>                    <<06.EB>>30095000
      BEGIN                                                    <<06.EB>>30100000
      TOS := ATTACHIO(PXG'INPUTLDEV,0,0,0,9,0,0,0,BFLAGS);     <<06513>>30105000
      ECHOWASOFF := TOS;<<TRUE IF ECHO WAS ALREADY OFF>>       <<06.EB>>30110000
      DEL;                                                     <<06.EB>>30115000
      END;                                                     <<06.EB>>30120000
   TOS := ATTACHIO(PXG'OUTPUTLDEV,0,0,@BUF,1,-LENGTH,%320,0,   <<06513>>30125000
      BFLAGS);  <<ASK FOR LOCKWORD>>                           <<+0.05>>30130000
   DEL;                                                                 30135000
   IF TOS.(8:8) <> 1 THEN GO NFG;  <<ATTACHIO ERROR?>>                  30140000
   TOS := FREAD(1,BUF,-10); << READ LOCKWORD >>                <<04134>>30145000
   IF <> THEN GOTO NFG; << ERROR DURING READ >>                <<04134>>30150000
   X := TOS;                                                   <<04134>>30155000
   IF NOT (1 <= X <= 8) THEN GO NFG;  <<ILLEGAL AMOUNT?>>               30160000
   BBUF(X) := %15;  <<SPECIAL FOR MOVE TERMINATOR>>                     30165000
   TOS := @MESSAGE; BPS0 := " ";  <<BLANK FILL>>                        30170000
   ASSEMBLE(DUP,INCB); MOVE * := *,(7);                                 30175000
   MOVE MESSAGE := BBUF WHILE ANS;  <<COPY AND UPSHIFT REPLY>>          30180000
   TOS := TRUE;  <<OK>>                                                 30185000
   GO EXIT;                                                             30190000
                                                                        30195000
NFG:                                                                    30200000
   TOS := FALSE;  <<ERROR>>                                             30205000
                                                                        30210000
EXIT:                                                                   30215000
   FREPLY := TOS;                                              <<06.EB>>30220000
   IF NOT HARDCOPY AND NOT ECHOWASOFF THEN << TURN ECHO ON >>  <<06.EB>>30225000
      ATTACHIO(PXG'INPUTLDEV,0,0,0,8,0,0,0,BFLAGS);            <<06513>>30230000
   END;                                                                 30235000
$ PAGE " MPE-V  FILE SYSTEM - FOPENDA - DECLARATIONS "         <<06272>>30240000
$ CONTROL SEGMENT = FILESYS6                                            30245000
INTEGER PROCEDURE FOPENDA (DADDR,DISKADR,AOPTIONS,NUMBUFFERS,FILECODE,  30250000
   ASEC,DISP,FOPTIONS,PVINFO,MSGINFO);                         <<HM.00>>30255000
     <<THIS PROCEDURE OPENS AN OLD DISC FILE WHOSE FILE LABEL IS ON THE 30260000
     SPECIFIED LOGICAL DEVICE AT THE SPECIFIED SECTOR NUMBER.           30265000
                                                                        30270000
     INPUT VARIABLES:                                                   30275000
         DADDR - LOGICAL DEVICE NUMBER OF FILE LABEL                    30280000
         DISKADR - SECTOR NUMBER OF FILE LABEL                          30285000
         AOPTIONS - AOPTIONS                                            30290000
         NUMBUFFERS - NUMBER OF BUFFERS                                 30295000
         FILECODE - FILE CODE                                           30300000
         ASEC - ACCESS TYPE FROM AOPTIONS                               30305000
         DISP - DISPOSITION (FROM FILE EQN) AND NAME TYPE               30310000
         FOPTIONS - USER'S FOPTIONS                              HM.00  30315000
                    Note FOPDOMAIN must be set for temporary OR  FDOMN  30320000
                    permanent directory  ( 3 is invalid )      <<F7504  30325000
         MSGINFO - IPC INFO ARRAY                                HM.00  30330000
                                                                        30335000
     OUTPUT VARIABLES:                                                  30340000
         FOPENDA - FILE NUMBER                                          30345000
                                                                        30350000
     CONDITION CODE:                                                    30355000
         CCE - OK                                                       30360000
         CCL - ERROR                                                    30365000
                                                                        30370000
     NOTE THAT THIS PROCEDURE IS INTENDED FOR THE LOADER AS WELL AS THE 30375000
     FILE SYSTEM.  ALSO, DB MUST BE SET TO THE STACK WHEN THIS          30380000
     PROCEDURE IS CALLED>>                                              30385000
   VALUE DADDR,DISKADR,AOPTIONS,NUMBUFFERS,FILECODE,           <<RV.PV>>30390000
         ASEC,DISP,FOPTIONS,PVINFO;                            <<HM.00>>30395000
   INTEGER DADDR,NUMBUFFERS,FILECODE,ASEC,DISP,PVINFO;         <<RV.PV>>30400000
   DOUBLE DISKADR;                                                      30405000
   LOGICAL AOPTIONS,FOPTIONS;                                  <<HM.00>>30410000
   ARRAY MSGINFO;                                              <<HM.00>>30415000
   OPTION VARIABLE,PRIVILEGED,UNCALLABLE;                               30420000
   BEGIN                                                                30425000
   LOGICAL PMAP = Q-4;  <<PARAMETER BIT MAP>>                           30430000
   DEFINE                                                      << 7580>>30435000
      FOPTION'PASSED = PMAP.(13:1)#;                           << 7580>>30440000
   INTEGER TEMP;  <<UTILITY VARIABLE>>                                  30445000
   INTEGER CLID;  <<COLD LOAD ID>>                                      30450000
                                                                        30455000
   <<MISC. FILE PARAMETERS>>                                            30460000
                                                                        30465000
                                                               <<07393>>30470000
   ARRAY FALLOCERR(*) = PB := NOSPACE, DISCIOERR,              <<07393>>30475000
             DISC'SPACE'ALLOCATION'DISABLED, NAVAILDEV,        <<07393>>30480000
             UNDEFDEV, BADEXTENT, BADOFFSET;                   <<07393>>30485000
                                                               <<07393>>30490000
   ARRAY SPALLOCERR(*) = PB := SPOOLBADEXT, SPOOLDEVDOWN,      <<07393>>30495000
              SPOOLNOSPACE, SPOOLERROR, SPOOLNOCLASS,          <<07393>>30500000
              SPOOLBADOFF;                                     <<07393>>30505000
                                                               <<07393>>30510000
   INTEGER                                                     <<07273>>30515000
      RSIZE,          ! Record size, positive bytes.           <<07273>>30520000
      BF,             ! Blocking factor (obvious, no?)         <<07273>>30525000
      ATYPE,          ! Access type, from AOPTIONS.            <<07273>>30530000
      EXCL,           ! Exclusive access to the file?          <<07273>>30535000
      PCBPT;          ! PCB pointer for PCB defines.           <<07273>>30540000
                                                                        30545000
   <<MISC. DEVICE PARAMETERS>>                                          30550000
                                                                        30555000
   INTEGER VDADDR;  <<VOLUME TABLE INDEX>>                              30560000
   INTEGER ARRAY DEVINFO (0:8);  <<DEVICE INFO>>                        30565000
                                                                        30570000
   <<PCBX VARIABLES>>                                                   30575000
                                                                        30580000
   INTEGER POINTER PXFILE;  <<PXFILE POINTER>>                          30585000
                                                                        30590000
   <<AFT VARIABLES>>                                                    30595000
                                                                        30600000
   INTEGER AFTX;  <<AFT INDEX (FILE NR.)>>                              30605000
   INTEGER FILENUM = AFTX;    ! Used by SETAFT                 <<06514>>30610000
   INTEGER POINTER AFT;                                        <<06514>>30615000
                                                                        30620000
   <<ACB VARIABLES>>                                                    30625000
                                                                        30630000
   DOUBLE                                                      <<06514>>30635000
      PACBV,       << Physical ACB vector.                  >> <<06514>>30640000
      LACBV;       << Logical ACB vector.                   >> <<06514>>30645000
   INTEGER                                                     <<06514>>30650000
      PACBV'DSTN = PACBV + 0,                                  <<06514>>30655000
      PACBV'ENTRY= PACBV + 1,                                  <<06514>>30660000
      LACBV'DSTN = LACBV + 0,                                  <<06514>>30665000
      LACBV'ENTRY= LACBV + 1;                                  <<06514>>30670000
   LOGICAL LACBF;  <<LOG/PHYS ACB FLAG>>                                30675000
   DEFINE  << LACBF is returned by SETACB with these flags. >> <<06272>>30680000
       LACB'NEEDED   = LACBF.(15:1)#, << LACB was created.  >> <<06272>>30685000
       PACB'IS'OLD   = LACBF.(14:1)#, << PACB existed alrdy.>> <<06272>>30690000
       PACB'IS'NEW   = NOT PACB'IS'OLD#;                       <<06272>>30695000
                                                               <<06514>>30700000
   INTEGER POINTER ACB;  <<ACB POINTER>>                                30705000
   DOUBLE POINTER ACBDBL = ACB;                                         30710000
                                                               <<06514>>30715000
                                                                        30720000
   <<FCB VARIABLES>>                                                    30725000
                                                                        30730000
   DOUBLE                                                      <<06514>>30735000
      FCBV := 0D;            << FCB Vector.                 >> <<06514>>30740000
   LOGICAL                                                     <<07273>>30745000
      FCBV'DSTN  = FCBV + 0;                                   <<07273>>30750000
   LOGICAL                                                     <<06514>>30755000
      SHFCB := FALSE,        << Do we have a shared FCB?    >> <<04624>>30760000
      NEWFCB := FALSE;       << Was a new FCB created?      >> <<04624>>30765000
   INTEGER                                                     <<04624>>30770000
      STRATEGY,              << Where will the FCB go?      >> <<06514>>30775000
      FCBSI,                 << Size of our FCB.            >> <<04624>>30780000
      EMSI;                  << Extent map size.            >> <<04624>>30785000
   DOUBLE FCBPARMS;          << FCB(0) and FCB(1).          >> <<04624>>30790000
   INTEGER                                                     <<04624>>30795000
      FCB'0=FCBPARMS,        << FCB(0), contains the size.  >> <<04624>>30800000
      FCBMQ;                 << Q relative offset of FCB.   >> <<04624>>30805000
   ARRAY FCB(0:SIZEDFCB);    << Local FCB buffer.           >> <<04624>>30810000
   DOUBLE ARRAY FCBDBL(*)=FCB;                                 <<04624>>30815000
                                                                        30820000
   <<FILE LABEL VARIABLES>>                                             30825000
                                                                        30830000
   INTEGER POINTER FLAB;  <<FILE LABEL POINTER>>                        30835000
   DOUBLE POINTER FLABDBL = FLAB;                                       30840000
   INTEGER FNAMEDL; << DL relative address of File Name.    >> <<06514>>30845000
   INTEGER P1 = DISKADR;  <<FIRST HALF OF FILE LABEL SECTOR NR.>>       30850000
   INTEGER P2 = DISKADR+1;  <<SECOND HALF OF FILE LABEL SECTOR NR.>>    30855000
                                                                        30860000
   <<RESOURCE FLAGS>>                                                   30865000
                                                                        30870000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   30875000
   LOGICAL PACBLOCKED := FALSE;  <<SPECIAL PACB LOCK FLAG>>             30880000
   LOGICAL A;  <<USED BY GETSIR>>                                       30885000
   LOGICAL RESOURCES := FALSE;  <<FOR ERROR RECOVERY>>                  30890000
   DEFINE DISKLOCK = (15:1)#,  <<DISKALLOC CALLED?>>                    30895000
          SIRLOCK = (14:1)#,  <<GETSIR CALLED?>>                        30900000
          FCBLOCK = (13:1)#,  <<FCB LOCKED VIA FGETCB?>>                30905000
          ACBLOCK = (12:1)#,  <<PHYSICAL ACB CREATED?>>                 30910000
          FMAVTLOCK = (11:1)#,  << FMAVT SIR is locked.     >> <<06514>>30915000
          GLOBAFT   = (10:1)#;  << Global AFT reserved.     >> <<06514>>30920000
                                                                        30925000
   <<SPOOLFILE ACCESS>>                                                 30930000
                                                                        30935000
   INTEGER POINTER PINFO;                                               30940000
   ARRAY SPINFO(0:13) = Q;                                              30945000
   LOGICAL SPOOLF = SPINFO+0;                                           30950000
   INTEGER POINTER XDDEP = SPINFO+1;                                    30955000
   INTEGER SPDADDR       = SPINFO+2;                                    30960000
   DOUBLE  SPDISKADDR    = SPINFO+3;                                    30965000
   INTEGER SPVDEV = SPINFO+5;                                           30970000
   INTEGER SPFOPT = SPINFO+6;                                           30975000
   INTEGER SPAOPT = SPINFO+7;                                           30980000
   INTEGER SPREC  = SPINFO+8;                                           30985000
   INTEGER SPSTATE= SPINFO+9;                                           30990000
   ARRAY SPFN(*) = SPINFO+10;                                           30995000
                                                               <<HM.00>>31000000
   <<MSG FILE ACCESS>>                                         <<HM.00>>31005000
                                                               <<HM.00>>31010000
   LOGICAL MSGFILE:=FALSE;                                     <<HM.00>>31015000
   DOUBLE ARRAY DMSGINFO(*)=MSGINFO;                           <<HM.00>>31020000
   DEFINE FILELIMIT=DMSGINFO#;                                 <<HM.00>>31025000
   DEFINE NUMHEADEREC=DMSGINFO(1)#;                            <<HM.00>>31030000
   INTEGER                                                     <<06272>>31035000
      FMAVT'FLAGS;                                             <<06272>>31040000
                                                               <<00630>>31045000
                                                               <<00630>>31050000
                                                               <<06514>>31055000
                                                               <<06514>>31060000
                                                               <<06514>>31065000
<<                   ADJUSTOPS                              >> <<06514>>31070000
                                                               <<06514>>31075000
                                                               <<06514>>31080000
   INTEGER SUBROUTINE ADJUSTOPS;                               <<00630>>31085000
   BEGIN                                                       <<00630>>31090000
      COMMENT:                                                 <<00630>>31095000
         RESOLVE ANY INCONSISTENCIES VIS-A-VIS FOPS AND AOPS.  <<00630>>31100000
         RETURN ERROR CODE (>=0), OR -1 IF NO ERRORS;          <<00630>>31105000
                                                               <<00630>>31110000
      ADJUSTOPS := -1;                                         <<00630>>31115000
      IF FLCIRFILE THEN                                        <<06272>>31120000
         BEGIN                                                 <<HM.00>>31125000
         IF AOPSEMI THEN                                       <<HM.00>>31130000
            AOPACMODE:=IF AOPREAD THEN 3 ELSE 1;               <<HM.00>>31135000
         IF NOT AOPREAD THEN                                   <<HM.00>>31140000
            BEGIN                                              <<HM.00>>31145000
            IF NOT AOPCOPY THEN AOPINHIBITBUF:=0;              <<HM.00>>31150000
            IF AOPMULTAC = 0 THEN AOPMULTAC:=2;                <<HM.00>>31155000
            IF AOPWRITESAVE THEN                               <<HM.00>>31160000
               ATYPE:=3  <<SET IT TO APPEND>>                  <<HM.00>>31165000
            ELSE IF AOPACTYPE > 3 THEN                         <<HM.00>>31170000
               BEGIN                                           <<HM.00>>31175000
               TOS:=ACCVIOL;                                   <<HM.00>>31180000
               GO ERR;                                         <<HM.00>>31185000
               END;                                            <<HM.00>>31190000
            END;                                               <<HM.00>>31195000
         IF NOT AOPINHIBITBUF THEN AOPMULTIREC:=0;             <<HM.00>>31200000
         END                                                   <<HM.00>>31205000
      ELSE IF FLRIO THEN                                       <<00630>>31210000
        BEGIN                                                  <<00630>>31215000
        AOPCOPY := 0;                                          <<HM.00>>31220000
        IF NOT AOPINHIBITBUF THEN                              <<00630>>31225000
           BEGIN                                               <<00630>>31230000
           AOPMULTIREC := 0;                                   <<00630>>31235000
           AOPNOWAIT := 0;                                     <<00630>>31240000
           END;                                                <<00630>>31245000
        END;                                                   <<00630>>31250000
   END; <<SUBROUTINE ADJUSTOPS>>                               <<00630>>31255000
                                                               <<HM.00>>31260000
$ PAGE " MPE-V  FILE SYSTEM - FOPENDA - CHECKMSGEXCLSM "       <<06272>>31265000
   SUBROUTINE CHECKMSGEXCLSN;                                  <<HM.00>>31270000
      BEGIN                                                    <<HM.00>>31275000
      IF (FCBEXCLSTAT = -1) THEN                               <<HM.00>>31280000
         BEGIN  <<FILE ALREADY OPENED EXCLUSIVELY>>            <<HM.00>>31285000
         IF ATYPE = 0 THEN                                     <<HM.00>>31290000
            BEGIN  <<USER IS A READER>>                        <<HM.00>>31295000
            IF FCBOCNTIN > 0 THEN GO E1;<<ALREADY READ OPENED>><<HM.00>>31300000
            END                                                <<HM.00>>31305000
         ELSE IF FCBOCNTOUT > 0 THEN <<USER IS A WRITER>>      <<HM.00>>31310000
            GO E1;  <<ALREADY OPENED FOR WRITE>>               <<HM.00>>31315000
         EXCL:=1; AOPACMODE:=1;  <<CHANGE USER TO EXCLUSIVE>>  <<01675>>31320000
         END                                                   <<HM.00>>31325000
      ELSE IF FCBEXCLSTAT > 0 THEN                             <<HM.00>>31330000
         BEGIN  <<ALREADY OPENED FOR ONE RDR, MULTIPLE WTR>>   <<HM.00>>31335000
         IF ATYPE = 0 AND FCBOCNTIN > 0 THEN GO E1;            <<HM.00>>31340000
         EXCL:=2; AOPACMODE:=2;  <<CHANGE USER TO SEMI>>       <<01675>>31345000
         END                                                   <<01675>>31350000
      ELSE                                                     <<01675>>31355000
         BEGIN  <<ALREADY OPENED SHARE>>                       <<01675>>31360000
         EXCL:=3; AOPACMODE:=3;                                <<01675>>31365000
         END;                                                  <<01675>>31370000
      END;  <<CHECKMSGEXCLSN>>                                 <<01675>>31375000
                                                               <<00630>>31380000
                                                               <<06514>>31385000
                                                               <<06514>>31390000
                                                               <<06514>>31395000
<<                       LABELIO                            >> <<06514>>31400000
                                                               <<06514>>31405000
   SUBROUTINE LABELIO (RW);                                             31410000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           31415000
                                                                        31420000
        INPUT VARIABLES:                                                31425000
            RW - I/O MODE                                               31430000
               0 - READ                                                 31435000
               1 - WRITE                                                31440000
                                                                        31445000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE IS   31450000
        CALLED>>                                                        31455000
      VALUE RW;                                                         31460000
      INTEGER RW;                                                       31465000
      BEGIN                                                             31470000
      X := FLABIO(DADDR,DISKADR,RW,FLAB);  <<R/W LABEL>>                31475000
      IF <> THEN  <<ERROR?>>                                            31480000
         BEGIN                                                          31485000
         IF NOT LOGICAL(RW) THEN  <<READ?>>                             31490000
            FLABIOERR(X,0)                                              31495000
         ELSE  <<WRITE>>                                                31500000
            FLABIOERR(X,0,@FLLOCNAME);                                  31505000
         TOS := LBLIOERR;                                               31510000
         GO ERR                                                         31515000
      ; HELP  <<FOR DUMMY CALL>>;                              <<00117>>31520000
         END                                                            31525000
      END;                                                              31530000
                                                               <<06514>>31535000
                                                               <<06514>>31540000
<<                    UPDATE'FCB                            >> <<06514>>31545000
                                                               <<06514>>31550000
   SUBROUTINE UPDATE'FCB(FCBV);                                <<04624>>31555000
   VALUE FCBV;DOUBLE FCBV;                                     <<06514>>31560000
                                                               <<04624>>31565000
      <<****************************************************>> <<04624>>31570000
      << Updates the actual FCB in the control block (where >> <<04624>>31575000
      << ever it may be) by overlaying  it with the updated >> <<04624>>31580000
      << FCB that exists on the stack. Do not copy FCB(0).  >> <<04624>>31585000
      <<****************************************************>> <<04624>>31590000
                                                               <<04624>>31595000
      BEGIN                                                    <<04624>>31600000
      GET'FCB'Q'LOC;                                           <<04624>>31605000
      LOCK'CB(0,0,FCBMQ,FCBV);                                 <<06514>>31610000
      TOS := TOS + 1;   << Copy to FCB(1) in control block. >> <<04624>>31615000
      ASSEMBLE(DXCH);   << Switch source and targer address.>> <<04624>>31620000
      TOS := TOS + 1;   << Copy from FCB(1) in stack.       >> <<04624>>31625000
      TOS := FCBSI -1 ; << Now copy the FCB back to CB table>> <<04624>>31630000
      MOVE'DS'5;                                               <<04624>>31635000
      DEL;              << Delete FLAGS parm. from LOCK'CB. >> <<04624>>31640000
      UNLOCK'CB(0,FCBV);                << Unlock it.       >> <<06514>>31645000
                                                               <<04624>>31650000
      END;                                                     <<04624>>31655000
$PAGE  " MPE-V  FILE SYSTEM - FOPENDA - INIT'AFT       "       <<06514>>31660000
SUBROUTINE INIT'AFT;                                           <<06514>>31665000
                                                               <<06514>>31670000
<<**********************************************************>> <<06514>>31675000
<< This subroutine initializes the AFT entry for the new    >> <<06514>>31680000
<< file.  It could be a global AFT entry or a local AFT.    >> <<06514>>31685000
<<**********************************************************>> <<06514>>31690000
                                                               <<06514>>31695000
BEGIN                                                          <<06514>>31700000
IF AOPGLOBALAFT THEN                                           <<06514>>31705000
   BEGIN                                                       <<06514>>31710000
   EXCHANGEDB(GLOBAL'AFT'DSTN);                                <<06514>>31715000
   @AFT := -(FILENUM)*AFTENTRY; ! Set pointer in extra DST.    <<06514>>31720000
   END                                                         <<06514>>31725000
ELSE                                                           <<06514>>31730000
   BEGIN                                                       <<06514>>31735000
   SETAFT;                      ! Set pointer in PXFILE area.  <<06514>>31740000
   END;                                                        <<06514>>31745000
                                                               <<06514>>31750000
IF MSGFILE AND NOT AOPCOPY                                     <<06514>>31755000
   THEN AFTTYPE := MSG'TYPE;                                   <<06514>>31760000
AFTPACBVDSTN := PACBV'DSTN;                                    <<06514>>31765000
AFTPACBVENTRY:= PACBV'ENTRY;                                   <<06514>>31770000
AFTLACBVDSTN := LACBV'DSTN;                                    <<06514>>31775000
AFTLACBVENTRY:= LACBV'ENTRY;                                   <<06514>>31780000
IF AOPGLOBALAFT                                                <<06514>>31785000
   THEN EXCHANGEDB(0);     << Back to stack for global.     >> <<06514>>31790000
END;                                                           <<06514>>31795000
                                                               <<06514>>31800000
                                                               <<06514>>31805000
SUBROUTINE CLEAR'GLOBAL'AFT;                                   <<06514>>31810000
                                                               <<06514>>31815000
<<**********************************************************>> <<06514>>31820000
<< Clears a reserved global AFT if an error occured.        >> <<06514>>31825000
<<**********************************************************>> <<06514>>31830000
                                                               <<06514>>31835000
BEGIN                                                          <<06514>>31840000
EXCHANGEDB(GLOBAL'AFT'DSTN);                                   <<06514>>31845000
@AFT := \FILENUM\ * AFTENTRY; << Set pointer to AFT.        >> <<06514>>31850000
AFTPACBVDSTN := 0;            << Was set to -1 to reserve.  >> <<06514>>31855000
EXCHANGEDB(0);                << DB back to the stack.      >> <<06514>>31860000
END;                                                           <<06514>>31865000
$PAGE  " MPE-V  FILE SYSTEM - FOPENDA - MAIN BLOCK     "       <<06272>>31870000
                                                                        31875000
$  IF X0 = ON                                                           31880000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               31885000
      BEGIN                                                             31890000
      TOS := "FO"; TOS := "PE"; TOS := "ND"; TOS := "A ";               31895000
      ASSEMBLE(DZRO,DZRO);                                              31900000
      FTITLE(*,*,*,*);                                                  31905000
      DEBUG                                                             31910000
      END;                                                              31915000
$  IF                                                                   31920000
                                                                        31925000
   <<* * * INITIALIZE PARAMETERS * * *>>                                31930000
                                                                        31935000
   CRIT := SETCRITICAL;                                                 31940000
   CHECKDB;  <<WHERE'S DB?>>                                            31945000
   IF <> THEN  <<DB NOT AT STACK?>>                                     31950000
      BEGIN                                                             31955000
      TOS := EXCHANGEDB(0);  <<SET DB TO STACK>>                        31960000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              31965000
      PXFFOPEN := ILLDB;                                                31970000
      ASSEMBLE(ZERO,XCH);                                               31975000
      EXCHANGEDB(*);  <<RESET DB TO ORIG.>>                             31980000
      TOS := CCL;                                                       31985000
      GO EXIT                                                           31990000
      END;                                                              31995000
                                                               <<04624>>32000000
   <<*******************************************************>> <<04624>>32005000
   << FOPEN will set bit zero of the DADDR if the PACB has  >> <<04624>>32010000
   << already been locked (what a kludge!).  Set PACBLOCKED >> <<04624>>32015000
   << based on this bit.                                    >> <<04624>>32020000
   <<*******************************************************>> <<04624>>32025000
                                                               <<04624>>32030000
   IF DADDR.(0:1) = 1 THEN                                     <<04624>>32035000
      BEGIN                                                    <<04624>>32040000
      DADDR.(0:1) := 0;                                        <<04624>>32045000
      PACBLOCKED := TRUE;                                      <<04624>>32050000
      END;                                                     <<04624>>32055000
   SPOOLF := FALSE;                                                     32060000
   IF DADDR = 0 THEN  <<SPOOLFILE ACCESS?>>                             32065000
      BEGIN                                                             32070000
      @PINFO := P2;                                                     32075000
      MOVE SPINFO := PINFO,(14);                                        32080000
                                                               <<04272>>32085000
      <<****************************************************>> <<04272>>32090000
      << Obtain disk address from XDD and extract the       >> <<04272>>32095000
      << LDEV (DADDR) and Disk Address.  %2 signifies give  >> <<04272>>32100000
      << me the Disk Address! XDDEP is the offset into the  >> <<04272>>32105000
      << XDD of the entry we are using.                     >> <<04272>>32110000
      <<****************************************************>> <<04272>>32115000
                                                               <<04272>>32120000
      DISKADR := XDDSPOOLINFO(0D,%2,XDDEP);                    <<04272>>32125000
      IF DISKADR = 0D THEN                                     <<04272>>32130000
         BEGIN            << Invalid XDD entry, FSERR 88    >> <<04272>>32135000
         TOS := SPOOFLEINVL;                                   <<04272>>32140000
         GO ERR;                                               <<04272>>32145000
         END;                                                  <<04272>>32150000
                                                               <<04272>>32155000
      SPDADDR := P1.(0:8);    << Extract LDEV from 1st. word>> <<04272>>32160000
      DADDR   := SPDADDR;                                      <<04272>>32165000
      P1.(0:8):= 0;           << Zero out LDEV field.       >> <<04272>>32170000
      SPDISKADDR := DISKADR;  << Rest is Disk Address only. >> <<04272>>32175000
      MOVE PINFO := SPINFO,(14)                                         32180000
      END;                                                              32185000
   TOS := PMAP;  <<PARAMETER BIT MAP>>                                  32190000
   IF NOT LS0.(8:1) THEN AOPTIONS := 0;                        <<HM.00>>32195000
   IF NOT LS0.(9:1) THEN NUMBUFFERS := DEFBUFFERS;             <<HM.00>>32200000
   IF NOT LS0.(10:1) THEN FILECODE := 0;                       <<HM.00>>32205000
   IF NOT LS0.(11:1) THEN ASEC := 0;                           <<HM.00>>32210000
   IF NOT LS0.(12:1) THEN DISP := 0;                           <<HM.00>>32215000
   IF NOT LS0.(14:1) THEN PVINFO := 0;                         <<HM.00>>32220000
   ATYPE := AOPACTYPE;  <<ACCESS TYPE>>                                 32225000
   EXCL := AOPACMODE;  <<ACCESS MODE>>                                  32230000
   IF = THEN                                                            32235000
      BEGIN                                                             32240000
      IF ATYPE = 0 THEN TOS := 3 ELSE TOS := 1;                         32245000
      EXCL := TOS   <<SET EXCLUSIVE OPTIONS>>                           32250000
      END;                                                              32255000
   CLID := ABSOLUTE(CLOADID);  <<COLD LOAD ID>>                         32260000
                                                                        32265000
   !---------------------------------------------------------- << 8543>>32270000
   ! If the file is multi-access, then FOPEN has already found << 8543>>32275000
   ! and locked the PACB, if it exists.  We must, however,     << 8543>>32280000
   ! obtain the PACBV to unlock in case an error occurs be-    << 8543>>32285000
   ! tween here and the call to SETACB.  SETACB, once it has   << 8543>>32290000
   ! been called, will determine if the PACB exists and create << 8543>>32295000
   ! one if not.  If the PACB already exist, as stated above,  << 8543>>32300000
   ! FOPEN will have already locked it and SETACB and our-     << 8543>>32305000
   ! selves will not have to lock it.                          << 8543>>32310000
   !---------------------------------------------------------- << 8543>>32315000
                                                               << 8543>>32320000
   IF AOPMULTAC <> 0 THEN                                      << 8543>>32325000
      BEGIN                                                    << 8543>>32330000
      FMAVT'FLAGS := 0;    ! Default job, disk, search.        << 8543>>32335000
      FMAVT'FLAGS.(12:1) := AOPGLOBALMULTAC;                   << 8543>>32340000
      P1.(0:8) := DADDR;   ! Disk file has LDEV in upper bits  << 8543>>32345000
      PACBV := SCANFMAVT(FMAVT'FLAGS,,P1,P2);                  << 8543>>32350000
      END;                                                     << 8543>>32355000
                                                                        32360000
   <<* * * ALLOCATE AFT ENTRY * * *>>                                   32365000
                                                                        32370000
   IF AOPGLOBALAFT                                             <<06514>>32375000
      THEN AFTX := FIND'GLOBAL'AFTENT                          <<06514>>32380000
      ELSE AFTX := FINDANYAFTENT;                              <<06514>>32385000
   IF < THEN GO E5;                 << PXFILE expansion?    >> <<06514>>32390000
   IF AOPGLOBALAFT                                             <<06514>>32395000
      THEN RESOURCES.GLOBAFT := 1;  << Global AFT reserved. >> <<06514>>32400000
                                                                        32405000
   <<* * * READ FILE LABEL * * *>>                                      32410000
                                                                        32415000
   ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>                           32420000
   A := GETSIR(FISIR);  <<GET FILE INTEGRITY SIR>>                      32425000
   RESOURCES.SIRLOCK := TRUE;  <<SET SIR LOCKED FLAG>>                  32430000
   P1.(0:8) := 0;  <<CLEAR FIRST BYTE OF SECTOR NR.>>                   32435000
   LABELIO(0);  <<READ FILE LABEL>>                                     32440000
                                                               <<06272>>32445000
   <<*******************************************************>> <<06272>>32450000
   << For message files, check to see if another job or     >> <<06272>>32455000
   << session alread has multi on the file by calling       >> <<06272>>32460000
   << SCANFMAVT.  If so, report error.                      >> <<06272>>32465000
   <<*******************************************************>> <<06272>>32470000
                                                               <<06272>>32475000
   IF FLMSGFILE AND (NOT AOPCOPY OR NOT AOPREAD) THEN          <<01675>>32480000
      BEGIN                                                    <<01675>>32485000
      FMAVT'FLAGS := 0;       << Default job, disk, search. >> <<06272>>32490000
      P1.(0:8) := DADDR;      << Disk files, LDEV upper bits>> <<06272>>32495000
      SCANFMAVT(FMAVT'FLAGS,,P1,P2);                           <<06272>>32500000
      IF < THEN                                                <<01675>>32505000
         BEGIN  <<ANOTHER JOB/SESSION HAS MULTI ON THE FILE>>  <<01675>>32510000
         TOS:=NAVAILDEV;                                       <<01675>>32515000
         GO ERR;                                               <<01675>>32520000
         END;                                                  <<01675>>32525000
      MSGFILE:=TRUE;                                           <<01675>>32530000
      P1.(0:8) := 0;          << Clear LDEV out.            >> <<06272>>32535000
      END;                                                     <<01675>>32540000
<<***********************************************************>><<F7504>>32545000
<< Now, make sure the domain from the FOPTIONS in the file   >><<F7504>>32550000
<< label indicate an old disc file.  If we got this far in   >><<F7504>>32555000
<< FOPENDA then we are assured an old disc file.  The only   >><<F7504>>32560000
<< case where the FOPTIONS in the file label would not       >><<F7504>>32565000
<< indicate an old disc file is if the system crashes while  >><<F7504>>32570000
<< closing a new file with DISP=1 after the directory entry  >><<F7504>>32575000
<< is created and before the file label is written to disc   >><<F7504>>32580000
<<***********************************************************>><<F7504>>32585000
                                                               <<F7504>>32590000
IF FOPTION'PASSED THEN                                         << 7580>>32595000
   FLDOMAIN := FOPDOMAIN;  << Note that FOPDOMAIN will be>>    <<F7504>>32600000
                        << properely set by calling proc >>    <<F7504>>32605000
                                                               <<F7504>>32610000
                                                               <<00630>>32615000
   IF ADJUSTOPS >= 0                                           <<06272>>32620000
      THEN GOTO ERR;                                           <<06272>>32625000
   DEL;                                                        <<00630>>32630000
                                                               <<00630>>32635000
   TOS := FLRECSIZE;  <<REC. SIZE>>                                     32640000
   IF < THEN  <<NEG. BYTES?>>                                           32645000
      TOS := -TOS                                                       32650000
   ELSE  <<POS. WORDS>>                                                 32655000
      TOS := TOS&LSL(1);                                                32660000
   RSIZE := TOS;  <<REC. SIZE - POS. BYTES>>                            32665000
   IF FLLASTEXTSIZE = 0 THEN  <<COMPUTE LAST EXTENT SIZE?>>             32670000
      BEGIN                                                             32675000
      TOS := FLFLIM;                                                    32680000
      X:=GETBLKFACTOR(FLBLKSIZE,RSIZE,FLFOPTIONS);             <<00630>>32685000
      DIVD;                                                             32690000
      IF TOS <> 0 THEN TOS := TOS+1D;                                   32695000
      X := (FLBLKSIZE+127)&LSR(7);                                      32700000
      MPYD;                                                             32705000
      TOS := TOS+DOUBLE(LOGICAL(FLSECTOFF));                            32710000
      TOS := FLEXTSIZE;                                                 32715000
      ASSEMBLE(LDIV,DELB; TEST);                                        32720000
      IF = THEN TOS := TOS+FLEXTSIZE;                                   32725000
      FLLASTEXTSIZE := TOS  <<LAST EXTENT SIZE>>                        32730000
      END;                                                              32735000
   TOS:=FLFOPTIONS;                                            <<HM.00>>32740000
   IF MSGFILE AND NOT AOPCOPY THEN                             <<HM.00>>32745000
      TOS.FOPFORMATF:=FOPFORMAT;                               <<HM.00>>32750000
   FOPTIONS:=TOS;                                              <<HM.00>>32755000
                                                                        32760000
   <<* * * GET DEVICE INFORMATION * * *>>                               32765000
                                                                        32770000
   VDADDR := FLVTAB;  <<VOLUME TABLE INDEX>>                            32775000
   IF FLDEVNAME = 0 THEN  <<MPE/20 FILE?>>                              32780000
      BEGIN                                                             32785000
      TOS := @FLDEVNAME&LSL(1);                                         32790000
      MOVE * := "DISC    "  <<DEFAULT DEVICE CLASS>>                    32795000
      END;                                                              32800000
   IF BYTE(FLDEVNAME.(0:8)) = NUMERIC THEN  <<LOGICAL DEV. NR.?>>       32805000
      BEGIN                                                             32810000
      TOS := @FCB(SIZEDFCB)&LSL(1);  <<LDEV STRING BUFFER>>    <<04624>>32815000
      BPS0 := " ";  <<STRING TERMINATOR>>                               32820000
      TOS := TOS-1;  <<ADJ. STRING POINTER>>                            32825000
      TOS := DADDR;  <<LOGICAL DEVICE NR.>>                             32830000
      DO BEGIN   << CONVERT LDEV TO STRING FOR GETDEVINFO >>   <<00117>>32835000
         TOS := 10;                                                     32840000
         ASSEMBLE(DIV);                                                 32845000
         BPS2 := TOS+"0";  <<DIGIT CHAR.>>                              32850000
         ASSEMBLE(DECB,TEST)                                            32855000
         END UNTIL =;                                                   32860000
      ASSEMBLE(XCH,INCA);  <<GETDEVINFO RESULT AND STRING POINTER>>     32865000
L2:   X := GETDEVINFO(*,DEVINFO);  <<GET DEVICE INFO>>                  32870000
      IF <> THEN  <<ERROR?>>                                            32875000
         BEGIN                                                          32880000
         TOS := UNDEFDEV;                                               32885000
         GO ERR                                                         32890000
         END                                                            32895000
      END                                                               32900000
   ELSE  <<DEVICE CLASS>>                                               32905000
      BEGIN                                                             32910000
      X := GETDEVINFO(FLDEVNAME,DEVINFO);  <<GET DEVICE INFO>>          32915000
      IF <> THEN  <<UNKNOWN DEVICE CLASS?>>                             32920000
         BEGIN                                                          32925000
         TOS := 0;  <<FOR RESULT OF GETDEVINFO>>                        32930000
         TOS := @FCB&LSL(1);  <<STRING BUFFER>>                <<04624>>32935000
         MOVE BPS0 := "DISC ";  <<TRY "DISC" FOR DEVICE CLASS>>         32940000
         GO L2                                                          32945000
         END                                                            32950000
      END;                                                              32955000
                                                                        32960000
   <<* * * DETERMINE IF ACCESS IS LEGITIMATE * * *>>                    32965000
                                                                        32970000
   IF CLID <> FLCLID THEN  <<DIFFERENT COLD LOAD ID?>>                  32975000
      BEGIN                                                             32980000
      FLLOCK := LOGICAL(FLLOCK) LAND %7774;  <<CLEAR LOCK BITS>>        32985000
      FLFCBVECT := 0D; <<CLEAR FCB VECTOR>>                    <<06514>>32990000
      END;                                                              32995000
   CASE ATYPE OF                                                        33000000
      BEGIN                                                             33005000
                                                                        33010000
      <<READ ONLY>>                                                     33015000
                                                                        33020000
      IF LOGICAL(FLRESTORE) THEN GO E1;                                 33025000
                                                                        33030000
      <<WRITE ONLY - DATA DELETED>>                                     33035000
                                                                        33040000
OUTING:                                                                 33045000
      IF INTEGER(LOGICAL(FLSRL) LAND 5) <> 0 THEN GO E1;                33050000
                                                                        33055000
      <<WRITE ONLY - NO DATA DELETED>>                                  33060000
                                                                        33065000
      GO OUTING;                                                        33070000
                                                                        33075000
      <<APPEND ONLY>>                                                   33080000
                                                                        33085000
      GO OUTING;                                                        33090000
                                                                        33095000
      <<READ/WRITE>>                                                    33100000
                                                                        33105000
INOUT:BEGIN                                                             33110000
      TEMP := INTEGER(LOGICAL(FLSRL) LAND 5) <> 0;                      33115000
      CASE INTEGER(LOGICAL(TEMP) LAND 2)+FLRESTORE OF                   33120000
         BEGIN                                                          33125000
         ;  << ALLOW INPUT/OUTPUT >>                                    33130000
         GO E1;                                                         33135000
         ATYPE := 0;  << INPUT ONLY >>                                  33140000
         GO E1;                                                         33145000
         END;                                                           33150000
      END;                                                              33155000
                                                                        33160000
      <<UPDATE>>                                                        33165000
                                                                        33170000
      GO INOUT;                                                         33175000
                                                                        33180000
      <<EXECUTE>>                                                       33185000
                                                                        33190000
EXECUTE:                                                                33195000
      BEGIN    << STORE-RESTORE >>                             <<+1.03>>33200000
      CASE FLSR OF                                                      33205000
         BEGIN                                                          33210000
         ;  << INPUT/OUTPUT >>                                          33215000
         GO E1;                                                         33220000
         ATYPE := 0;  << INPUT ONLY >>                                  33225000
         GO E1                                                          33230000
         END                                                            33235000
      END;                                                              33240000
                                                                        33245000
      <<LOAD PROGRAM>>                                                  33250000
                                                                        33255000
      GO EXECUTE                                                        33260000
                                                                        33265000
      END;                                                              33270000
   IF EXCL = 1 AND FLSRL <> 0 THEN GO E0;                               33275000
   AOPACTYPE := ATYPE;  <<ADJUST ACCESS TYPE>>                          33280000
                                                                        33285000
   <<* * * LOCATE OR CREATE LOCAL FCB * * *>>                           33290000
                                                                        33295000
   FCB(0) := 0;    << ZERO out the FCB buffer.              >> <<04624>>33300000
   MOVE FCB(1) := FCB(0),(SIZEDFCB - 1);                       <<04624>>33305000
   FCBV := FLFCBVECT;  <<FCB VECTOR FROM FILE LABEL>>                   33310000
$PAGE                                                          <<04624>>33315000
   <<*******************************************************>> <<04624>>33320000
   << Obtain the FCB vector from the file label. (It was    >> <<04624>>33325000
   << previously zeroed out if the cold load ID's didn't    >> <<04624>>33330000
   << match).  If the FCB vector is still non-zero then     >> <<04624>>33335000
   << another process already has the file open and the FCB >> <<04624>>33340000
   << exists.  First, lock and copy the FCB to stack via    >> <<04624>>33345000
   << LOCK'CB.                                              >> <<04624>>33350000
   <<*******************************************************>> <<04624>>33355000
                                                               <<04624>>33360000
   IF FCBV <> 0D THEN << Does the FCB exist already?        >> <<06514>>33365000
      BEGIN                                                             33370000
      PCBPT := CURPRC;     ! Set PCB defines variable.         <<07273>>33375000
      IF STACKCHECK(FCBV'DSTN) AND FCBV'DSTN <> SPCBSTKDST     <<07273>>33380000
         THEN GO TO E1;    ! FCB in another stack, IS excl.    <<07273>>33385000
      FCBPARMS := GETFCB'INFO(FCBV,0);    << Obtain size.   >> <<04624>>33390000
      FCBSI := FCB'0.SIZEF;                                    <<04624>>33395000
      GET'FCB'Q'LOC;                                           <<04624>>33400000
      LOCK'CB(0,0,FCBMQ,FCBV);                                 <<06514>>33405000
      TOS := FCBSI;                       << Copy the FCB.  >> <<04624>>33410000
      MOVE'DS'5;                          << Off they GO!   >> <<04624>>33415000
      DEL;                  << Delte FLAGS parameter.       >> <<04624>>33420000
      RESOURCES.FCBLOCK := TRUE;          << FCB is locked. >> <<04624>>33425000
                                                               <<04624>>33430000
                                                                        33435000
      <<* * * CHECK EXCLUSIVITY OF ACCESS * * *>>                       33440000
                                                                        33445000
      IF MSGFILE AND NOT AOPCOPY THEN                          <<HM.00>>33450000
         CHECKMSGEXCLSN                                        <<HM.00>>33455000
      ELSE                                                     <<HM.00>>33460000
         BEGIN                                                 <<HM.00>>33465000
         X := FCBEXCLSTAT;                                     <<HM.00>>33470000
         IF X = -1 THEN GO E1;  << SOMEONE WANTS EXCL ACCESS > <<HM.00>>33475000
         IF EXCL = 1 THEN GO E0;                               <<HM.00>>33480000
         CASE INTEGER(X>0 LAND 2)+INTEGER(EXCL = 2 LAND 1) OF  <<HM.00>>33485000
            BEGIN                                              <<HM.00>>33490000
                                                                        33495000
            <<SHARE VS. SHARE>>                                <<HM.00>>33500000
                                                                        33505000
            IF FCBCIRFILE THEN  <<CAN'T MIX RDRS AND WTRS>>    <<HM.00>>33510000
               BEGIN                                           <<HM.00>>33515000
               IF ATYPE = 0 AND FCBOCNTOUT <> 0                <<HM.00>>33520000
               OR ATYPE <> 0 AND FCBOCNTIN <> 0 THEN GO E1;    <<HM.00>>33525000
               END;                                            <<HM.00>>33530000
                                                                        33535000
            <<FILE-SHARE VS. CALLER EAR>>                      <<HM.00>>33540000
                                                                        33545000
            IF FCBOCNTOUT <> 0 THEN GO E0;                     <<HM.00>>33550000
                                                                        33555000
            <<FILE-EAR VS. CALLER SHARE>>                      <<HM.00>>33560000
                                                                        33565000
            BEGIN                                              <<HM.00>>33570000
L1:         IF (1 <= ATYPE <= 3) THEN GO E1;                   <<HM.00>>33575000
            AOPACTYPE := ATYPE := 0  <<MAKE INPUT ONLY>>       <<HM.00>>33580000
            END;                                               <<HM.00>>33585000
                                                                        33590000
         <<FILE-EAR VS. CALLER-EAR>>                                    33595000
                                                                        33600000
         BEGIN                                                          33605000
         IF FCBOCNTOUT <> 0 THEN GO E0;                                 33610000
            GO L1                                              <<HM.00>>33615000
            END                                                <<HM.00>>33620000
                                                                        33625000
            END;                                               <<HM.00>>33630000
         END;                                                  <<HM.00>>33635000
      SHFCB := TRUE;    << Set shared FCB flag.             >> <<04624>>33640000
      BF := FCBBLKFACT;  <<BLOCKING FACTOR>>                            33645000
      END  << OF FCB ALREADY EXISTS >>                         <<00300>>33650000
                                                               <<04624>>33655000
   <<*******************************************************>> <<04624>>33660000
   << Otherwise, the FCB does not yet exist.  Initialize the>> <<04624>>33665000
   << variables of the FCB based on the FLAB variables.     >> <<04624>>33670000
   <<*******************************************************>> <<04624>>33675000
                                                               <<04624>>33680000
   ELSE  <<CREATE LOCAL FCB FROM FILE LABEL>>                           33685000
      BEGIN                                                             33690000
                                                               <<04624>>33695000
      EMSI := (FLNUMEXTS+1)&LSL(1);  <<EXTENT MAP LENGTH>>              33700000
      FCBSI := SIZEBFCB+EMSI;  <<FCB LENGTH>>                           33705000
      IF NOT FLNEW THEN                                        <<06298>>33710000
         FLDESIGNATOR := 0;     << Make actual designator.  >> <<06298>>33715000
      FCBFOPTIONS := FLFOPTIONS;  <<FOPTIONS>>                          33720000
      IF FCBVARIABLE AND ATYPE = 3 THEN                        <<HM.00>>33725000
         IF AOPCOPY OR AOPINHIBITBUF THEN                      <<HM.00>>33730000
            BEGIN                                              <<HM.00>>33735000
            TOS := ACCVIOL;                                    <<HM.00>>33740000
            GO ERR                                             <<HM.00>>33745000
            END;                                               <<HM.00>>33750000
      FCBDEVICE := DEVINFO;  <<LDEV OR DEVICE CLASS INDEX>>             33755000
      FCBFLIM := FLFLIM;      <<CURRENT FILE LIMIT>>                    33760000
      IF ATYPE <> 1 OR FLSTATUS <> 0 THEN  <<SET EOF?>>        <<HM.00>>33765000
         BEGIN                                                 <<HM.00>>33770000
         FCBEOF:=FLEOF;                                        <<HM.00>>33775000
         FCBSTART:=FLSTART;                                    <<HM.00>>33780000
         FCBEND:=FLEND;                                        <<HM.00>>33785000
         FCBHDRECS:=FLHDRECS;                                  <<HM.00>>33790000
         END;                                                  <<HM.00>>33795000
      FCBUSERLBL := FLUSERLBL;  <<NR. USER LABELS>>                     33800000
      FCBEXTSIZE := FLEXTSIZE;  <<EXTENT SIZE>>                         33805000
      FCBLASTEXTSIZE := FLLASTEXTSIZE;  <<LAST EXTENT SIZE>>            33810000
      BF:=GETBLKFACTOR(FLBLKSIZE,RSIZE,FLFOPTIONS);            <<00630>>33815000
      FCBBLKFACT := BF;  <<BLOCKING FACTOR>>                            33820000
      FCBLKST := FLSTATUS;                                              33825000
      FCBDTYPE := FLDTYPE;  <<DEVICE TYPE NR.>>                         33830000
      FCBSUBTYPE := FLSUBTYPE;  <<DEVICE SUB-TYPE NR.>>                 33835000
      FCBSECTPBLK := (FLBLKSIZE+127)&LSR(7);  <<SECTORS PER BLOCK>>     33840000
      FCBSECTOFF := FLSECTOFF;                                          33845000
      FCBNUMEXTS := FLNUMEXTS;  <<NR. EXTENTS LESS 1>>                  33850000
      MOVE FCBGN := FLGRPNAME,(8);  <<GROUP NAME>>                      33855000
      IF MSGFILE THEN  <<MESSAGE FILE?>>                       <<HM.00>>33860000
         BEGIN                                                 <<HM.00>>33865000
         FILELIMIT:=FCBFLIM;                                   <<HM.00>>33870000
         NUMHEADEREC:=FCBHDRECS;                               <<HM.00>>33875000
         END;                                                  <<HM.00>>33880000
      FCBPVINFO := PVINFO;                                     <<RV.PV>>33885000
      VTABTOLDEV (FCBEXTMAP,FLEXTMAP,EMSI&LSR(1),FCBMVTABX);   <<RV.PV>>33890000
                                                                        33895000
      <<* * * BUMP EXTENT USE COUNTS * * *>>                            33900000
                                                                        33905000
      X := DISKALLOC(DADDR,-(FCBNUMEXTS+1),FCBEXTMAP,          <<RH.PV>>33910000
                     0);                                       <<RH.PV>>33915000
      IF <> THEN GOTO ALLOCERR;  << error on diskalloc  >>     <<07393>>33920000
                                 << error number in x   >>     <<07393>>33925000
$     IF                                                                33930000
      RESOURCES.DISKLOCK := TRUE;  <<SET DISKALLOC FLAG>>               33935000
      END;                                                              33940000
                                                               <<06514>>33945000
                                                               <<06514>>33950000
                                                               <<06514>>33955000
   !---------------------------------------------------------- <<06514>>33960000
   !                CREATE     AN      ACB                     <<06514>>33965000
   ! Create an ACB via SETACB.  SETACB will initialize most of <<06514>>33970000
   ! the ACB varialbes and will return with DB set to the data <<06514>>33975000
   ! segment containing the ACB.  The PACB may already exist,  <<06514>>33980000
   ! depending on the PACBLOCKED flag, set if SCANFMAVT found  <<06514>>33985000
   ! the file in the FMAVT, signifying that the file was open- <<06514>>33990000
   ! ed multi-access (see previous comment).   We set the      <<06514>>33995000
   ! PACBLOCKED flag in that kludgy manner so that it is al-   <<06514>>34000000
   ! ways set to FALSE upon returning from SETACB and will will<<06514>>34005000
   ! not upset the CC comming back from SETACB.  This flag is  <<06514>>34010000
   ! always set to FALSE for two reasons.  If an error occured <<06514>>34015000
   ! in SETACB, then it will properly unlock the ACB for us.   <<06514>>34020000
   ! If we return w/o an error, then we will set the ACBLOCKED <<06514>>34025000
   ! flag.  This will force a call to DELACB in the case of an <<06514>>34030000
   ! error and DELACB will unlock the ACB for us after prop-   <<06514>>34035000
   ! erly decrementing the ACB share counts.                   <<06514>>34040000
   !---------------------------------------------------------- <<06514>>34045000
                                                                        34050000
   IF INTEGER(SPOOLF) > 0                                      <<04624>>34055000
      THEN TOS := @SPFN                                        <<06514>>34060000
      ELSE TOS := @FLAB;                                       <<06514>>34065000
   PUSH(DL); FNAMEDL := TOS-TOS; << Get DL offset of name.  >> <<06514>>34070000
   TEMP := FLFOPTIONS;  <<SAVE FOPTIONS>>                               34075000
   TOS := FALSE; ! Reserved for PACBLOCKED flag.               <<06514>>34080000
   SETACB(DUM,0D,0D,PACBLOCKED,AFTX,AOPTIONS,FOPTIONS,         <<06514>>34085000
          FCBDTYPE,RSIZE,FLBLKSIZE,NUMBUFFERS,BF,DADDR,        <<06514>>34090000
          SPINFO,DISP,DISKADR,FLEND,FLEOF,MSGINFO);            <<06514>>34095000
                                                               <<06514>>34100000
   LACBF := TOS; << Flags return parm, has info on the ACB. >> <<06514>>34105000
   LACBV := TOS; PACBV := TOS; @ACB := TOS;                    <<06514>>34110000
   PACBLOCKED := TOS; ! Always set to FALSE, see above.        <<06514>>34115000
   IF < THEN GO E2;  <<ERROR?>>                                <<06514>>34120000
   IF > THEN GO NOFMAVT;      << Out of FMAVT entries.      >> <<06514>>34125000
   RESOURCES.ACBLOCK := TRUE; << Call DELACB on an error.   >> << 8485>>34130000
                                                               << 8485>>34135000
                                                               <<06514>>34140000
                                                               <<04624>>34145000
   <<*******************************************************>> <<04624>>34150000
   << Copy the file name from either the FLAB or SPFN (spool>> <<04624>>34155000
   << file name) to the ACB.  Below is a tricky way to per- >> <<06514>>34160000
   << for a Move DL to DB, to move name in split stack mode.>> <<06514>>34165000
   <<*******************************************************>> <<04624>>34170000
                                                               <<04624>>34175000
   TOS := @ACBNAME;              << DB relatative @ of name.>> <<06514>>34180000
   TOS := FNAMEDL;               << DL rel. @ of stack name.>> <<06514>>34185000
   TOS := 4;                     << Move 4 words, 8 chars.  >> <<06514>>34190000
   ASSEMBLE(MVLB 3);             << Move DL to DB, pop 3.   >> <<06514>>34195000
                                                               <<04624>>34200000
   ACBPRIV := (FILECODE < 0) LOR AOPGLOBALAFT;                 <<06514>>34205000
   ACBACCESS := ASEC;                                                   34210000
   ACBCARRIAGE := TEMP.FOPCONTROLF;                                     34215000
   IF INTEGER(SPOOLF) > 0 THEN                                 <<HM.00>>34220000
      ACBLSTATE := LOGICAL(ACBLSTATE) LOR LOGICAL(SPSTATE);    <<HM.00>>34225000
   IF INTEGER(SPOOLF) < 0 THEN                                 <<00.06>>34230000
      BEGIN  <<CHECK FOR SQUEEZE REQ>>                         <<00.06>>34235000
      IF SPOOLF.(14:1)=0 THEN ACBSPRSQ := 1;                   <<00.06>>34240000
      IF XDDSPOOLINFO(0D,%1000,XDDEP) = 1D THEN                <<00.06>>34245000
            ACBSPSQZ := 1;  <<TEST XDD SQZ BIT>>               <<00.06>>34250000
      END;                                                     <<00.06>>34255000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                34260000
                                                               <<06514>>34265000
   <<*******************************************************>> <<04624>>34270000
   <<            CREATE  A  NEW  FCB                        >> <<04624>>34275000
   << If the file was not opened already, then an FCB does  >> <<04624>>34280000
   << not yet exist and one must be created.  Create the FCB>> <<04624>>34285000
   << via FCREATECB.  If the file was opened exclusively,   >> <<04624>>34290000
   << than attempt to put the FCB in the stack.  For message>> <<04624>>34295000
   << files and shared files, the FCB always goes in an     >> <<04624>>34300000
   << extra data segment.  Shared FCB's ALWAYS go in an ex- >> <<04624>>34305000
   << tra data segment.  Shared FCB's are NEVER put in a    >> <<04624>>34310000
   << processes stack!!!                                    >> <<04624>>34315000
   <<*******************************************************>> <<04624>>34320000
                                                                        34325000
   IF NOT SHFCB THEN                                           <<04624>>34330000
      BEGIN                                                             34335000
      IF EXCL=1 AND NOT(MSGFILE LOR AOPGLOBALAFT)              <<06514>>34340000
         THEN STRATEGY := -4                                   <<06514>>34345000
         ELSE STRATEGY := -2;                                  <<06514>>34350000
      FCREATECB(DUM,0D,STRATEGY,FCBSI,CBFCB);                  <<06514>>34355000
      IF < THEN GO E2;  <<ERROR?>>                                      34360000
      FCBV := TOS;   << FCREATECB returns the new FCBV.     >> <<04624>>34365000
      DEL;                        << Delete @FCB,dont need. >> <<04624>>34370000
      RESOURCES.FCBLOCK := TRUE;  << FCB is now locked.     >> <<04624>>34375000
      NEWFCB := TRUE;             << New FCB was created.   >> <<04624>>34380000
      EXCHANGEDB(0);              << Back to stack from FCB.>> <<04624>>34385000
      END;                                                     <<04624>>34390000
                                                                        34395000
   <<*******************************************************>> <<04624>>34400000
   << Now check dynamic locking for the file. If a file was >> <<04624>>34405000
   << opened for locking than all others must open it for   >> <<04624>>34410000
   << locking and vise-versa.                               >> <<04624>>34415000
   <<*******************************************************>> <<04624>>34420000
                                                                        34425000
   IF AOPLOCKING THEN  << DYNAMIC LOCKING REQUESTED? >>        <<00300>>34430000
      BEGIN  << YES. ANY PRIOR ACCESS MUST BE LOCKING. >>      <<00300>>34435000
      IF FCBRIN = 0 THEN  <<ALLOCATE RIN?>>                             34440000
         BEGIN                                                          34445000
         IF SHFCB THEN GO MLTACC; <<EXIST ACCESS ISN'T LOCK>>  <<00300>>34450000
         TOS := ALLORIN(3);                                             34455000
         ASSEMBLE(TEST);                                                34460000
         FCBRIN := TOS;                                                 34465000
         IF = THEN                                                      34470000
            BEGIN                                                       34475000
            TOS := NORIN;                                               34480000
            GO ERR                                                      34485000
            END                                                         34490000
         END                                                            34495000
      END                                                               34500000
   ELSE  << DYNAMIC LOCKING NOT REQUESTED. >>                  <<00300>>34505000
      IF FCBRIN <> 0 THEN GO MLTACC;  <<OTHER USER IS LOCKING>><<00300>>34510000
                                                               <<06514>>34515000
   <<*******************************************************>> <<04624>>34520000
   << Bump the appropriate FCB counts: Open, output and/or  >> <<04624>>34525000
   << input counts.  NOW, copy the FCB from the local array >> <<04624>>34530000
   << back to the control block via UPDATE'FCB.             >> <<04624>>34535000
   <<*******************************************************>> <<04624>>34540000
                                                               <<04624>>34545000
   FCBOCNT := FCBOCNT+1;  <<BUMP OPEN COUNT>>                           34550000
   IF ATYPE <> 0 THEN FCBOCNTOUT := FCBOCNTOUT+1;                       34555000
   IF ATYPE = 0 OR ATYPE >= 4 THEN FCBOCNTIN := FCBOCNTIN+1;            34560000
   << IF REQ'D, INCREMENT COUNT OF REQUESTORS OF "READ-ONLY             34565000
             SIMULTANEOUS ACCESS >>                                     34570000
   IF EXCL = 1 THEN FCBEXCLSTAT := -1;                                  34575000
   IF EXCL = 2 THEN FCBEXCLSTAT := FCBEXCLSTAT+1;                       34580000
   UPDATE'FCB(FCBV);              << Copy FCB to the CB!    >> <<04624>>34585000
                                                                        34590000
   <<*******************************************************>> <<04624>>34595000
   << Re-find the ACB and complete ACB initialization.      >> <<04624>>34600000
   <<*******************************************************>> <<04624>>34605000
                                                                        34610000
   @ACB := FGET'CB(PACBV,0);                                   <<06514>>34615000
   IF PACB'IS'NEW THEN ACBFCB := FCBV;                         <<06272>>34620000
   IF MSGFILE AND NOT AOPCOPY AND NOT ACBREAD THEN             <<HM.00>>34625000
      BEGIN  <<WRITER, CHECK IF ACCESS:=APPEND>>               <<HM.00>>34630000
      IF ACBSHCNT > 1 OR ACBACTYPE > 1 THEN                    <<HM.00>>34635000
         ACBACTYPE:=3;                                         <<HM.00>>34640000
      END;                                                     <<HM.00>>34645000
   IF ACBCIRFILE AND ACBSHCNT <> 1 AND NOT ACBREAD THEN        <<HM.00>>34650000
      ACBACTYPE:=3;  <<SET TO APPEND IF NOT 1ST WRITER>>       <<HM.00>>34655000
                                                               <<04516>>34660000
   <<*******************************************************>> <<04516>>34665000
   << Copy the PACB to the LACB and unlock the ACB via the  >> <<04516>>34670000
   << procedure UPDATE'LACB and UNLOCK'CB.                  >> <<06514>>34675000
   <<*******************************************************>> <<04516>>34680000
                                                               <<04516>>34685000
   UPDATE'LACB(LACBV,PACBV);                                   <<06514>>34690000
   UNLOCK'CB(0,PACBV);                                         <<06514>>34695000
                                                                        34700000
   <<*******************************************************>> <<04624>>34705000
   << Update the file label and write the updated FLAB      >> <<04624>>34710000
   << back to disk.                                         >> <<04624>>34715000
   <<*******************************************************>> <<04624>>34720000
                                                                        34725000
   FLCLID := CLID;  <<UPDATE COLD LOAD ID>>                             34730000
   IF FLFCBVECT = 0D THEN FLFCBVECT := FCBV; << Update FCBV?>> <<06514>>34735000
   IF FLPVINFO = 0 THEN FLPVINFO := PVINFO;                    <<00188>>34740000
   TOS := FLSTATUS;  <<CURRENT READ/WRITE STATUS>>                      34745000
   IF ATYPE = 0 OR ATYPE > 3 THEN TOS := TOS LOR 1;  <<READ?>>          34750000
   IF ATYPE > 0 THEN TOS := TOS LOR 2;  <<WRITE?>>                      34755000
   FLSTATUS := TOS;  <<UPDATE READ/WRITE STATUS>>                       34760000
   FLEXCL := EXCL = 1;                                                  34765000
   TOS := CALENDAR;  <<DAY AND YEAR>>                                   34770000
   FLLASTACC := S0;  <<UPDATE LAST ACCESS DATE>>                        34775000
   IF (1 <= ATYPE <= 6) THEN                                   <<07227>>34780000
      BEGIN                                                    <<07227>>34785000
      FLLASTMOD := TOS;     ! File modify date.                <<07227>>34790000
      FLMODTIME := CLOCK;   ! File modify time.                <<07227>>34795000
      END                                                      <<07227>>34800000
   ELSE                                                        <<07227>>34805000
      DEL;                  ! Delete CALENDER on TOS.          <<07227>>34810000
   LABELIO(1);  <<WRITE FILE LABEL>>                                    34815000
   RELSIR(FISIR,A);  <<RELEASE FILE INTEGRITY SIR>>                     34820000
   UNLOCK'CB(0,FCBV);                                          <<06514>>34825000
                                                               <<+0.04>>34830000
   <<* * * MEASUREMENT DATA ON OLD DISC FILE OPEN * * *>>      <<+0.04>>34835000
                                                               <<+0.04>>34840000
$  IF X3 = ON                                                  <<+0.04>>34845000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>34850000
   TOS := EFOPEN;  <<EVENT CODE>>                              <<+0.04>>34855000
   TOS := AFTX;  <<FILE NR.>>                                  <<+0.04>>34860000
   TOS := SPOOLF;  <<SPOOLING FLAG>>                           <<+0.04>>34865000
   IF < THEN  <<SPOOLER ACCESS?>>                              <<+0.04>>34870000
      BEGIN                                                    <<+0.04>>34875000
      DEL;                                                     <<+0.04>>34880000
      TOS := 2                                                 <<+0.04>>34885000
      END;                                                     <<+0.04>>34890000
   TOS.(0:2) := TOS;  <<INSERT ACCESSOR CODE>>                 <<+0.04>>34895000
   MMSTAT'(*,*,AOPTIONS,FLFOPTIONS,RSIZE,FLBLKSIZE,NUMBUFFERS);<<06863>>34900000
   TOS := EFOPEN';  <<EVENT CODE>>                             <<+0.04>>34905000
   TOS := FLFLIM;                                              <<+0.04>>34910000
   MMSTAT'(*,*,*,FLNUMEXTS+1,0,0,0);                           <<06863>>34915000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>34920000
$  IF                                                          <<+0.04>>34925000
                                                                        34930000
   <<* * * CONSTRUCT AFT ENTRY * * *>>                                  34935000
                                                                        34940000
   INIT'AFT;    << Initialize AFT entry.                    >> <<06514>>34945000
   FOPENDA := AFTX;                                            <<06514>>34950000
   TOS := CCE;  <<OK CONDITION CODE>>                                   34955000
   GO EXIT;                                                             34960000
                                                                        34965000
   <<* * * ERROR RECOVERY * * *>>                                       34970000
                                                                        34975000
E0:  << EXCL/SHR VIOLATION - THIS ACCESSOR >>                           34980000
   TOS := EXSHERR1;                                                     34985000
   GO ERR;                                                              34990000
                                                                        34995000
E1:  << EXCL VIOLATION - PREVIOUS ACCESSOR >>                           35000000
   TOS := EXSHERR2;                                                     35005000
   GO ERR;                                                              35010000
                                                                        35015000
E2:  << INSUFFICIENT MEMORY >>                                          35020000
   TOS := MEMPROB;                                                      35025000
   GO ERR;                                                              35030000
                                                                        35035000
E3:  << FILE CODE VIOLATION >>                                          35040000
   TOS := PRIVVIOL;                                                     35045000
   GO ERR;                                                              35050000
                                                                        35055000
E4:  << TOO MANY FILES OPEN BY THIS PROCESS >>                          35060000
   TOS := TMFP;                                                         35065000
   GO ERR;                                                              35070000
E5:  << No room left for PXFILE expansion   >>                 <<02357>>35075000
   TOS := NOROOMLEFT;                                          <<02357>>35080000
   GO ERR;                                                     <<02357>>35085000
                                                               <<02357>>35090000
NOFMAVT:                                                       <<04519>>35095000
   TOS := OUTFMAVT;           << Out of FMAVT entries.      >> <<04519>>35100000
   GO ERR;                                                     <<04519>>35105000
                                                               <<07393>>35110000
ALLOCERR:                                                      <<07393>>35115000
   IF SPOOLF THEN                                              <<07393>>35120000
      TOS := SPALLOCERR(X).(0:8)                               <<07393>>35125000
   ELSE                                                        <<07393>>35130000
      TOS := FALLOCERR(X).(0:8);                               <<07393>>35135000
   GO ERR;                                                     <<07393>>35140000
                                                               <<07393>>35145000
                                                               <<04519>>35150000
                                                                        35155000
MLTACC:                                                                 35160000
   TOS := MLTIACCERR;                                                   35165000
                                                                        35170000
   !---------------------------------------------------------- <<06514>>35175000
   ! Release resources on an error.  If the PACBLOCKED flag is <<06514>>35180000
   ! set, then an error occured before SETACB and the PACB was <<06514>>35185000
   ! locked by FOPEN only, not by us. If an error occured      << 8543>>35190000
   ! after the call to SETACB, then ACBLOCK will be set and we <<06514>>35195000
   ! must call DELACB to decrement the share counts and either <<06514>>35200000
   ! unlock the ACB for us or purge it if it was just created. <<06514>>35205000
   !---------------------------------------------------------- <<06514>>35210000
                                                                        35215000
ERR:                                                                    35220000
   EXCHANGEDB(0);  <<SET DB TO STACK>>                                  35225000
   IF PACBLOCKED                                               <<06514>>35230000
      THEN UNLOCK'CB(0,PACBV);                                 <<06514>>35235000
   TOS := RESOURCES;                                                    35240000
   IF LS0.GLOBAFT THEN CLEAR'GLOBAL'AFT;                       <<06514>>35245000
   IF LS0.ACBLOCK THEN DELACB(PACBV,LACBV,AOPACTYPE);          <<06509>>35250000
   IF LS0.FCBLOCK THEN  <<UNLOCK FCB?>>                                 35255000
      IF NEWFCB                                                <<06514>>35260000
         THEN FDELETECB(FCBV)                                  <<06514>>35265000
         ELSE UNLOCK'CB(0,FCBV);                               <<06514>>35270000
   IF LS0.SIRLOCK THEN RELSIR(FISIR,A);  <<RELEASE SIR>>                35275000
                                                               << 8543>>35280000
   IF TOS.DISKLOCK THEN  <<USE COUNTS BUMPED?>>                         35285000
      BEGIN                                                             35290000
                                                               <<04624>>35295000
      X := DISKDEALLOC(0,0,-(FCBNUMEXTS+1),FCBEXTMAP);  <<DECREMENT>>   35300000
$     IF X1 = ON                                                        35305000
      IF <> THEN FTROUBLE(469);  <<ERROR?>>                    <<KJ.03>>35310000
$     IF                                                                35315000
      END;                                                              35320000
                                                                        35325000
   SETPXFILE;  <<INIT. PXFILE POINTER>>                                 35330000
                                                               <<06514>>35335000
   PXFFOPEN := TOS;  <<ERROR NR.>>                                      35340000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                35345000
                                                                        35350000
EXIT:                                                                   35355000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           35360000
   RESETCRITICAL(CRIT)                                                  35365000
   END;        << procedure FOPENDA >>                                  35370000
$ PAGE " MPE-V  FILE SYSTEM - MORE UNCALLABLES - FRELSPACE "   <<06272>>35375000
$ CONTROL SEGMENT = FILESYS7                                            35380000
DOUBLE PROCEDURE FRELSPACE (LDEV,FADDR,MVTABX);                <<00300>>35385000
   <<RELEASES THE DISC SPACE OF THE SPECIFIED FILE.            ((00630))35390000
                                                                        35395000
     INPUT PARAMETERS:                                                  35400000
         LDEV - LOGICAL DEVICE NUMBER                                   35405000
         FADDR - FILE LABEL SECTOR NUMBER                               35410000
         MVTABX - MOUNTED VOLUME TABLE INDEX                     RV.PV  35415000
                                                                        35420000
     OUTPUT PARAMETERS:                                                 35425000
         FRELSPACE - NUMBER OF SECTORS RELEASED (0 IF ERROR)   ((00630))35430000
                                                                        35435000
     NOTE THAT THIS PROCEDURE IS USED BY THE DIRECTORY SYSTEM  ((00630))35440000
     AS WELL AS BY THE FILE SYSTEM.  ALSO, DB MUST BE SET TO   ((00630))35445000
     THE STACK WHEN THIS PROCEDURE IS CALLED>>                 <<00630>>35450000
   VALUE LDEV,FADDR,MVTABX;                                    <<RV.PV>>35455000
   INTEGER LDEV,MVTABX;                                        <<RV.PV>>35460000
   DOUBLE FADDR;                                                        35465000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                      <<RV.PV>>35470000
   BEGIN                                                                35475000
   LOGICAL PMASK = Q-4;                                        <<RV.PV>>35480000
   DOUBLE RESULT = FRELSPACE;                                  <<00300>>35485000
   INTEGER PCBGLOBLOC;     ! PCBX Q-relative offset.           <<06513>>35490000
   INTEGER CLID;  <<COLD LOAD ID>>                                      35495000
   LOGICAL A;  <<FOR GETSIR>>                                           35500000
   INTEGER count;                                              <<03509>>35505000
   POINTER ext'map'ptr;   << Pointer into extent map >>        <<03509>>35510000
   INTEGER POINTER FLAB;  <<FILE LABEL BUFFER>>                         35515000
   DOUBLE POINTER FLABDBL = FLAB;                              <<06514>>35520000
                                                                        35525000
   SUBROUTINE LABELIO (RW);                                             35530000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           35535000
                                                                        35540000
        INPUT VARIABLES:                                                35545000
            RW - I/O MODE                                               35550000
               0 - READ                                                 35555000
               1 - WRITE                                                35560000
                                                                        35565000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE      35570000
        IS CALLED AND THAT I/O ERRORS ARE NOT DETECTED ON A WRITE       35575000
        REQUEST>>                                                       35580000
      VALUE RW;                                                         35585000
      INTEGER RW;                                                       35590000
      BEGIN                                                             35595000
      X := FLABIO(LDEV,FADDR,RW,FLAB);  <<R/W LABEL>>                   35600000
      IF <> THEN  <<ERROR?>>                                            35605000
         BEGIN                                                          35610000
         IF NOT LOGICAL(RW) THEN  <<READ?>>                             35615000
            FLABIOERR(X,0)  <<HANDLE ERROR>>                            35620000
         ELSE  <<WRITE>>                                                35625000
            BEGIN                                                       35630000
            FLABIOERR(X,0,@FLLOCNAME);  <<REPORT ERROR>>                35635000
            TOS := 0D;  <<0D TO BE INSERTED INTO JIT>>                  35640000
            TOS := PXG'JITDST; TOS := JITPFP&LSL(1);           <<06513>>35645000
            TOS := @S3;                                                 35650000
            TOS := 2;                                                   35655000
            ASSEMBLE(MTDS 4);  <<CLEAR JIT PASSED FILE CELL>>           35660000
            DDEL                                                        35665000
            END;                                                        35670000
         GO EXIT                                                        35675000
         END                                                            35680000
      END;                                                              35685000
                                                                        35690000
$  IF X0 = ON                                                           35695000
   IF MONUNCALLABLE THEN  <<MONITORING?>>                               35700000
      BEGIN                                                             35705000
      TOS := "FD"; TOS := "EL"; TOS := "ET"; TOS := "E ";               35710000
      ASSEMBLE(DZRO,DZRO);                                              35715000
      FTITLE(*,*,*,*);                                                  35720000
      DEBUG                                                             35725000
      END;                                                              35730000
$  IF                                                                   35735000
                                                                        35740000
   <<* * * READ FILE LABEL * * *>>                                      35745000
                                                                        35750000
   PXGLOBAL;               ! Set PCBGLOBLOC.                   <<06513>>35755000
   A := GETSIR(FISIR);  <<GET FILE INTEGRITY SIR>>                      35760000
   ALLOCFLAB;  <<ALLOCATE BUFFER>>                                      35765000
   LABELIO(0);  <<READ LABEL>>                                          35770000
                                                                        35775000
   <<* * * CHECK COLD LOAD ID OF FILE * * *>>                           35780000
                                                                        35785000
   IF FLFCBVECT <> 0D OR                                       <<06514>>35790000
      INTEGER(LOGICAL(FLLOCK) LAND %160003) <> 0 THEN                   35795000
      BEGIN                                                             35800000
      CLID := ABSOLUTE(CLOADID);  <<COLD LOAD ID>>                      35805000
      IF CLID = FLCLID THEN  <<SAME COLD LOAD ID'S?>>                   35810000
         BEGIN                                                          35815000
         IF (2 <= FLDESIGNATOR <= 3) THEN  <<PASSED FILE?>>             35820000
            BEGIN                                                       35825000
            FLDESIGNATOR := 0;  <<MAKE ACTUAL>>                         35830000
            LABELIO(1);  <<WRITE LABEL>>                                35835000
            FRELSPACE := 1D                                    <<00300>>35840000
            END;                                                        35845000
         GO EXIT                                                        35850000
         END                                                            35855000
      END;                                                              35860000
                                                                        35865000
   <<* * * SET UP MVTABX * * *>>                               <<RV.PV>>35870000
   IF NOT PMASK THEN                                           <<RV.PV>>35875000
   BEGIN <<MVTABX NOT SUPPLIED>>                               <<RV.PV>>35880000
       MVTABX := 0;                                            <<RV.PV>>35885000
   END;                                                        <<RV.PV>>35890000
                                                               <<RV.PV>>35895000
   <<* * * DEALLOCATE DISC SPACE * * *>>                                35900000
                                                                        35905000
   VTABTOLDEV (FLEXTMAP,FLEXTMAP,FLNUMEXTS+1,MVTABX);          <<RV.PV>>35910000
    count := flnumexts;          << Number of extents - 1 >>   <<03509>>35915000
    @ext'map'ptr := @flextmap;   << Pointer to extent map >>   <<03509>>35920000
                                                               <<03509>>35925000
    WHILE count >= 0 DO                                        <<04137>>35930000
       BEGIN  << Run through extent map >>                     <<03509>>35935000
        IF ext'map'ptr <> 0                                    <<04137>>35940000
         THEN BEGIN                                            <<04137>>35945000
                                                               <<03509>>35950000
          << Get get ldev and disc address out of map >>       <<03509>>35955000
                                                               <<03509>>35960000
          TOS := ext'map'ptr.(0:8);   << Ldev >>               <<03509>>35965000
          TOS := ext'map'ptr.(8:8);   << High order address >> <<03509>>35970000
          TOS := ext'map'ptr(1);      << Low order address  >> <<03509>>35975000
                                                               <<03509>>35980000
          << Set size of extent, depending on if it is the >>  <<03509>>35985000
          << last extent.                                  >>  <<03509>>35990000
                                                               <<03509>>35995000
          IF count = 0 THEN    << Size of last extent >>       <<*9069>>36000000
             TOS := DOUBLE(LOGICAL (fllastextsize))            <<*9069>>36005000
          ELSE      << size of all other extents >>            <<*9069>>36010000
             TOS := DOUBLE(LOGICAL (flextsize));               <<*9069>>36015000
                                                               <<03509>>36020000
          result := result + DS1;      << Add to total >>      <<03509>>36025000
                                       << of sectors.  >>      <<03509>>36030000
                                                               <<03509>>36035000
          Return'Disc'Space (*, *, *);                         <<03509>>36040000
         END;                                                  <<04137>>36045000
                                                               <<03509>>36050000
          << Increment ptr and decrement count. >>             <<03509>>36055000
                                                               <<03509>>36060000
          @ext'map'ptr := @ext'map'ptr + 2;                    <<03509>>36065000
          count := count - 1;                                  <<03509>>36070000
                                                               <<03509>>36075000
       END;  << Run through extent map >>                      <<03509>>36080000
                                                               <<03509>>36085000
                                                                        36090000
EXIT:                                                                   36095000
   RELSIR(FISIR,A)  <<RELEASE FILE INTEGRITY SIR>>                      36100000
   END;        << procedure FRELSPACE >>                                36105000
$ PAGE " MPE-V  FILE SYSTEM - MORE UNCALLABLES - FPROCTERM "   <<06272>>36110000
$ CONTROL SEGMENT = FILESYS7                                            36115000
PROCEDURE FPROCTERM;                                                    36120000
OPTION PRIVILEGED,UNCALLABLE;                                           36125000
                                                                        36130000
!-------------------------------------------------------------          36135000
! Closes all currently opened files.  It scans the AFT for              36140000
! each type of file to close, performing the appropriate oper-          36145000
! ation to attept to close the file.  This procedure is called          36150000
! from MORGUE when a process is terminating.                            36155000
!                                                                       36160000
! Special entry point:                                                  36165000
!    FPROCTERJOB - This is used by the CI.  For this entry              36170000
!    point, we begin closing the files at file number 3,                36175000
!    skipping $STDIN/LIST.  The CI will close these via                 36180000
!    FJCLOSE for a job or session.                                      36185000
!                                                                       36190000
! NOTE:  DB must be set to the stack upon entrance.                     36195000
! FPROCTERM was completed rewritten with this fix number:      << 8485>>36200000
!-------------------------------------------------------------          36205000
                                                                        36210000
BEGIN                                                                   36215000
ENTRY FPROCTERMJOB;                                                     36220000
INTEGER                                                                 36225000
   FILENUM,           ! Current file number to close.                   36230000
   PLABEL,            ! For closing CS, DS & emulated 3270's.           36235000
   NUM'FILES,         ! Number of files in the AFt.                     36240000
   STARTNUM;          ! Starting at file 1 or 3?                        36245000
INTEGER POINTER                                                         36250000
   AFT,               ! Pointer to current AFT entry.                   36255000
   PXFILE;            ! Used to obtain AFT size.                        36260000
DOUBLE POINTER                                                          36265000
   AFTDBL = AFT;                                                        36270000
$ PAGE " MPE-V  FILE SYSTEM - FPROCTERM - Subroutines "                 36275000
SUBROUTINE CLOSE'CS'DS'TYPE;                                            36280000
BEGIN                                                                   36285000
TOS := FILENUM;        ! DS/CS line number.                             36290000
TOS := PLABEL;         ! DS/CS close program label.                     36295000
ASMB(PCAL 0);                                                           36300000
END;                                                                    36305000
                                                                        36310000
                                                                        36315000
                                                                        36320000
                                                                        36325000
                                                                        36330000
                                                                        36335000
SUBROUTINE CLOSE'NORMAL'FILE'TYPE;                                      36340000
BEGIN                                                                   36345000
FCLOSE(FILENUM,0,0);     ! Attempt to close normally.                   36350000
IF <> THEN                                                              36355000
   FCLOSE(FILENUM,-1,0); ! Failure, perform MUSTCLOSE.                  36360000
END;                                                                    36365000
                                                                        36370000
                                                                        36375000
                                                                        36380000
                                                                        36385000
                                                                        36390000
                                                                        36395000
SUBROUTINE CLOSE'FILES(CLOSE'TYPE);                                     36400000
VALUE   CLOSE'TYPE;                                                     36405000
INTEGER CLOSE'TYPE;                                                     36410000
                                                                        36415000
!-------------------------------------------------------------          36420000
! Closes all the files with the AFT type sent.  As noted in             36425000
! the CASE statement, different types are closed in different           36430000
! ways.                                                                 36435000
!-------------------------------------------------------------          36440000
                                                                        36445000
BEGIN                                                                   36450000
FILENUM := STARTNUM;   ! Start at file 1 or 3.                          36455000
SETAFT;                ! Set AFT pointer to STARNUM AFT entry.          36460000
SETPXFILE;             ! Calculate how many files to close.             36465000
NUM'FILES := PXFAFTSIZE/AFTENTRY;                                       36470000
                                                                        36475000
FOR FILENUM := STARTNUM UNTIL NUM'FILES DO                              36480000
   BEGIN   ! For each entry in the AFT that matches.                    36485000
   IF AFTTYPE = CLOSE'TYPE THEN                                         36490000
      CASE CLOSE'TYPE OF                                                36495000
         BEGIN                                                          36500000
                                                                        36505000
         ! Type = 0; Normal file system type files.                     36510000
         IF AFTDBL <> 0D THEN                                           36515000
            CLOSE'NORMAL'FILE'TYPE;                                     36520000
                                                                        36525000
         ! Type = 1; Remote file access.                                36530000
         CLOSE'NORMAL'FILE'TYPE;                                        36535000
                                                                        36540000
         ! Type = 2; DS type.                                           36545000
         CLOSE'CS'DS'TYPE;                                              36550000
                                                                        36555000
         ! Type = 3; Second DS type.                                    36560000
         CLOSE'CS'DS'TYPE;                                              36565000
                                                                        36570000
         ! Type = 4; CS type.                                           36575000
         CLOSE'CS'DS'TYPE;                                              36580000
                                                                        36585000
         ! Type = 5; Autodialer CS type.                                36590000
         CLOSE'CS'DS'TYPE;                                              36595000
                                                                        36600000
         ! Type = 6; KSAM type.  Don't do MUSTCLOSE.                    36605000
         FCLOSE(FILENUM,0,0);                                           36610000
                                                                        36615000
         ! Type = 7; An emulated 3270.                                  36620000
         BEGIN                                                          36625000
         TOS := 0;       ! Typed procedure.                             36630000
         TOS := 1;       ! Select close.                                36635000
         TOS := FILENUM;                                                36640000
         TOS := PLABEL;                                                 36645000
         ASMB(PCAL 0);   ! CLOSE3270 procedure.                         36650000
         DEL;            ! Delete return parm.                          36655000
         END;                                                           36660000
                                                                        36665000
         ! Type = 8; Message file access.                               36670000
         CLOSE'NORMAL'FILE'TYPE;                                        36675000
                                                                        36680000
         END;   ! Of CASE statement.                                    36685000
                                                                        36690000
   @AFT := @AFT - AFTENTRY;   ! Points to next AFT entry.               36695000
   END;   ! Of FOR loop.                                                36700000
END;   ! Of SUBROUTINE CLOSE'FILES.                                     36705000
$ PAGE " MPE-V  FILE SYSTEM - FPROCTERM - Outer block "                 36710000
STARTNUM := 1;        ! Close $STDIN and $STDLIST.                      36715000
IF FALSE THEN                                                           36720000
   BEGIN                                                                36725000
FPROCTERMJOB:         ! Entry point for CI job or session.              36730000
   STARTNUM := 3;     ! Skip over $STDIN and $STDLIST.                  36735000
   END;                                                                 36740000
                                                                        36745000
$  IF X0 = ON                                                           36750000
IF MONUNCALLABLE THEN ! Monitoring?                                     36755000
   BEGIN                                                                36760000
   TOS := "FP"; TOS := "RO"; TOS := "CT"; TOS := "ER";                  36765000
   TOS := "M ";                                                         36770000
   ASSEMBLE(ZERO,DZRO);                                                 36775000
   FTITLE(*,*,*,*);                                                     36780000
   DEBUG                                                                36785000
   END;                                                                 36790000
$  IF                                                                   36795000
                                                                        36800000
!-------------------------------------------------------------          36805000
! Now close all the files in the AFT.  We close the files in            36810000
! a specific, pre-defined order.  The order is very important.          36815000
! KSAM files must be closed first, since the AFT entries for            36820000
! the KEY and DATA files are stored in the KSAM AFT.  Next,             36825000
! the data comm files must be closed in the order of remote             36830000
! files, DS lines and then CS lines.  Finally, close message            36835000
! and standard files.                                                   36840000
!-------------------------------------------------------------          36845000
                                                                        36850000
! Close all KSAM files first.                                           36855000
                                                                        36860000
CLOSE'FILES(KS'TYPE);                                                   36865000
                                                                        36870000
! Next, close all remote files.                                         36875000
                                                                        36880000
CLOSE'FILES(RF'TYPE);                                                   36885000
                                                                        36890000
! Close all DS lines now that the remote files are closed.              36895000
                                                                        36900000
PLABEL := ABS(DSCLOSEPLABL);                                            36905000
CLOSE'FILES(DS'TYPE2);                                                  36910000
CLOSE'FILES(DS'TYPE3);                                                  36915000
                                                                        36920000
! Close all datacomm IOWAIT ports.  Type = 9 files.                     36925000
                                                                        36930000
IOWAITPORT'EXPIRE;                                                      36935000
                                                                        36940000
! Close all emulated 3270's. (What's an emulated 3270?)                 36945000
                                                                        36950000
PLABEL := PLABEL3270;                                                   36955000
CLOSE'FILES(TTS'TYPE);                                                  36960000
                                                                        36965000
! Now close all the CS lines now that the others are closed.            36970000
                                                                        36975000
PLABEL := ABS(CCLOSEPLABL);                                             36980000
CLOSE'FILES(CS'TYPE4);                                                  36985000
CLOSE'FILES(CS'TYPE5);                                                  36990000
                                                                        36995000
! Now close all message files.                                          37000000
                                                                        37005000
CLOSE'FILES(MSG'TYPE);                                                  37010000
                                                                        37015000
! Finally, close normal file system type.                               37020000
                                                                        37025000
CLOSE'FILES(FS'TYPE);                                                   37030000
                                                                        37035000
!----------------------------------------------------------             37040000
! Release the CBT pre-allocated for jobs by UCOP.  If it was            37045000
! never used, then it would not have been released.                     37050000
!----------------------------------------------------------             37055000
                                                                        37060000
IF PXFCBT1 <> 0 THEN                                                    37065000
   BEGIN                                                                37070000
   RELDATASEG(PXFCBT1);   ! Release the CBT DST.                        37075000
   PXFCBT1 := 0;          ! Clear the entry in PXFILE.                  37080000
   END;                                                                 37085000
END; ! Procedure FPROCTERM                                              37090000
$PAGE " MPE-V FILE SYSTEM - CLOSE'GLOBAL'FILES "               <<06869>>37095000
$CONTROL SEGMENT=FILESYS7                                      <<06869>>37100000
PROCEDURE CLOSE'GLOBAL'FILES;                                  <<06869>>37105000
OPTION PRIVILEGED,UNCALLABLE;                                  <<06869>>37110000
                                                               <<06869>>37115000
!------------------------------------------------------------- <<06869>>37120000
! This procedure is called when a CNRL-A =SHUTDOWN occurs to   <<06869>>37125000
! close all Global AFT files.  It simply goes through the      <<06869>>37130000
! Global AFT DST, looking for any global files that have not   <<06869>>37135000
! been closed.  It first attempts to close the files with      <<06869>>37140000
! the default disposition of 0.  If that fails, it tries to    <<06869>>37145000
! close the file with the MUSTCLOSE disposition.               <<06869>>37150000
! NOTE: DB can be anywhere upon entering this procedure.       <<06869>>37155000
!------------------------------------------------------------- <<06869>>37160000
                                                               <<06869>>37165000
BEGIN                                                          <<06869>>37170000
INTEGER                                                        <<06869>>37175000
   DSTX,              ! DST number of current DB.              <<06869>>37180000
   AFT'SIZE,          ! Size, in words, of global AFT DST.     <<06869>>37185000
   FILENUM;           ! Global file number to FCLOSE.          <<06869>>37190000
INTEGER POINTER AFT;  ! Used to traverse the global AFT.       <<06869>>37195000
DOUBLE POINTER AFTDBL=AFT;                                     <<06869>>37200000
EQUATE                                                         <<06869>>37205000
   DEFAULT'DISP = 0,  ! Default FCLOSE disposition.            <<06869>>37210000
   MUSTCLOSE    = -1; ! MUSTCLOSE FCLOSE disposition.          <<06869>>37215000
DEFINE                                                         <<06869>>37220000
   DST'SIZE = (ABS(ABS(DSTP)+GLOBAL'AFT'DSTN*4).(3:13))*4#;    <<06869>>37225000
                                                               <<06869>>37230000
IF GLOBAL'AFT'DSTN <> 0 THEN                                   <<06869>>37235000
   BEGIN              ! At least one file was opened.          <<06869>>37240000
   DSTX := EXCHANGEDB(GLOBAL'AFT'DSTN);                        <<06869>>37245000
   AFT'SIZE := DST'SIZE;                                       <<06869>>37250000
   @AFT := AFTENTRY;  ! We will start at AFT 1.                <<06869>>37255000
                                                               <<06869>>37260000
   DO BEGIN                                                    <<06869>>37265000
      IF AFTDBL <> 0D THEN                                     <<06869>>37270000
         BEGIN        ! We found an open file.                 <<06869>>37275000
         FILENUM := -(@AFT/AFTENTRY);                          <<06869>>37280000
         FCLOSE(FILENUM,DEFAULT'DISP,0);                       <<06869>>37285000
         IF <>                                                 <<06869>>37290000
            THEN FCLOSE(FILENUM,MUSTCLOSE,0);                  <<06869>>37295000
         END;                                                  <<06869>>37300000
      @AFT := @AFT + AFTENTRY;                                 <<06869>>37305000
      END                                                      <<06869>>37310000
   UNTIL @AFT + AFTENTRY > AFT'SIZE;                           <<06869>>37315000
   EXCHANGEDB(DSTX);                                           <<06869>>37320000
   END;                                                        <<06869>>37325000
END;                                                           <<06869>>37330000
$PAGE "FILEACCESS    MPE-IV FILE SYSTEM - FGETLOCKWORD"        <<04867>>37335000
$CONTROL PRIVILEGED                                            <<04867>>37340000
$CONTROL SEGMENT=FILESYS6A                                     <<04867>>37345000
INTEGER PROCEDURE FGETLOCKWORD(FILENUM,LOCKWORD,LENGTH);       <<04867>>37350000
VALUE FILENUM;                                                 <<04867>>37355000
                                                               <<04867>>37360000
INTEGER FILENUM,LENGTH;                                        <<04867>>37365000
BYTE ARRAY LOCKWORD;                                           <<04867>>37370000
OPTION UNCALLABLE,PRIVILEGED;                                  <<04867>>37375000
                                                               <<04867>>37380000
COMMENT                                                        <<04867>>37385000
                                                               <<04867>>37390000
    FGETLOCKWORD will get the LOCKWORD from the OPEN file.     <<04867>>37395000
  It is used by the CI to get the lockword for the UDC file for<<04867>>37400000
  COMMAND.PUB.SYS, so that during logon users will not be      <<04867>>37405000
  prompted for the lockword.                                   <<04867>>37410000
                                                               <<04867>>37415000
  File must be open EXR or EXL.                                <<04867>>37420000
                                                               <<04867>>37425000
  DB must be at the stack.                                     <<04867>>37430000
                                                               <<06285>>37435000
                                                               <<04867>>37440000
  Algorithm:                                                   <<04867>>37445000
    Make sure at stack                                         <<04867>>37450000
    Get the ACB for the file                                   <<04867>>37455000
    Make sure the file is opened exl or semi                   <<04867>>37460000
    Get the extent map from FCB of the file                    <<04867>>37465000
    Read the file label                                        <<04867>>37470000
    Extract the lockword                                       <<04867>>37475000
    Release ACB                                                <<04867>>37480000
                                                               <<04867>>37485000
  Returns: in                                                  <<04867>>37490000
    Function return: 0 if everything went fine otherwise the   <<04867>>37495000
                     file system error number.                 <<04867>>37500000
    LOCKWORD: (for eight bytes) the lockword (padded by        <<04867>>37505000
              blanks.  N.B.  If length = 0 this is undefined.  <<04867>>37510000
    LENGTH:    Length in bytes of the lockword, 0 if           <<04867>>37515000
               no lockword.                                    <<04867>>37520000
                                                               <<04867>>37525000
;                                                              <<04867>>37530000
                                                               <<04867>>37535000
BEGIN                                                          <<04867>>37540000
                                                               <<04867>>37545000
<<  Local declares >>                                          <<04867>>37550000
                                                               <<04867>>37555000
EQUATE READ = 0;                                               <<04867>>37560000
EQUATE EXTENT = 36;  <<Word in FLAB that is first extent map>> <<04867>>37565000
INTEGER ERR,LDEV;                                              <<04867>>37570000
DEFINE DEVICE = (0:8)#;                                        <<04867>>37575000
DEFINE ERRORCODE = FGETLOCKWORD#;                              <<04867>>37580000
                                                               <<04867>>37585000
DOUBLE EXTENT'MAP'D;                                           <<04867>>37590000
INTEGER EXTENT'MAP=EXTENT'MAP'D;                               <<04867>>37595000
LOGICAL BLANK := "  ";                                         <<04867>>37600000
INTEGER ARRAY FLAB(0:127);                                     <<04867>>37605000
LOGICAL ARRAY L'LOCKWORD(0:4);                                 <<04867>>37610000
BYTE ARRAY T'LOCKWORD(*)=L'LOCKWORD;                           <<04867>>37615000
                                                               <<04867>>37620000
<< The following variables must be in order >>                 <<04867>>37625000
                                                               <<04867>>37630000
INTEGER ACBMQ;                                                 <<04867>>37635000
INTEGER AFTE;                                                  <<04867>>37640000
DOUBLE  PACBV;                                                 <<06514>>37645000
DOUBLE  LACBV;                                                 <<06514>>37650000
INTEGER IOQX;                                                  <<04867>>37655000
INTEGER ARRAY ACB(0:SIZEXACB-1)=Q;                             <<04867>>37660000
DOUBLE ARRAY ACBDBL(*)=ACB;                                    <<06514>>37665000
INTEGER DSTX;                                                  <<04867>>37670000
                                                               <<04867>>37675000
ERRORCODE := 0;  << Default - everything went OK >>            <<04867>>37680000
CHECKDB;                                                       <<04867>>37685000
IF <> THEN                                                     <<04867>>37690000
  ERRORCODE := ILLDB                                           <<04867>>37695000
ELSE        << Stack OK - Process >>                           <<04867>>37700000
  BEGIN                                                        <<04867>>37705000
  GET'ACB'Q'LOC;                                               <<04867>>37710000
  LOC'ACB(0,ACBMQ,FILENUM,PMODE);                              <<04867>>37715000
  DSTX := TOS;                                                 <<04867>>37720000
  IF <> OR NOT FSTYPE THEN                                     <<06364>>37725000
    BEGIN                                                      <<04867>>37730000
    ERRORCODE := 72 <<INVFL replaces 72 when include is avail>><<04867>>37735000
    END                                                        <<04867>>37740000
  ELSE                                                         <<04867>>37745000
    BEGIN                                                      <<04867>>37750000
    IF NOT (ACBEXCLUSIVE LOR ACBSEMI) THEN                     <<04867>>37755000
      BEGIN                                                    <<04867>>37760000
      ERRORCODE := ACCVIOL;                                    <<04867>>37765000
      END                                                      <<04867>>37770000
    ELSE            << Got ACB and have exclusive (with >>     <<04867>>37775000
      BEGIN                << read?) access                    <<04867>>37780000
      EXTENT'MAP'D := GETFCB'INFO(ACBFCB,EXTENT);              <<04867>>37785000
      LDEV := EXTENT'MAP.DEVICE;                               <<04867>>37790000
      EXTENT'MAP.DEVICE := 0;  << Clear out LDEV part >>       <<04867>>37795000
      ERR := FLABIO(LDEV,EXTENT'MAP'D,READ,FLAB);              <<04867>>37800000
      IF ERR <> 0 THEN << ERR will be 1 or 2 if error >>       <<04867>>37805000
        BEGIN                                                  <<04867>>37810000
        FLABIOERR(ERR,FILENUM);                                <<04867>>37815000
        ERRORCODE := LBLIOERR;                                 <<04867>>37820000
        END                                                    <<04867>>37825000
      ELSE                                                     <<04867>>37830000
        BEGIN                                                  <<04867>>37835000
        MOVE T'LOCKWORD := "         ";                        <<04867>>37840000
                                                               <<04867>>37845000
      << Move the file label's lockword into temp area >>      <<04867>>37850000
                                                               <<04867>>37855000
        MOVE L'LOCKWORD := FLLOCKWORD,(4);                     <<04867>>37860000
        SCAN T'LOCKWORD UNTIL BLANK,1;                         <<04867>>37865000
        LENGTH := TOS - @T'LOCKWORD;                           <<04867>>37870000
        MOVE LOCKWORD := T'LOCKWORD,(8);                       <<04867>>37875000
        END                                                    <<04867>>37880000
      END;                                                     <<04867>>37885000
                                                               <<04867>>37890000
      <<  Unlock to ACB  >>                                    <<04867>>37895000
                                                               <<04867>>37900000
      UNLOC'ACB(ACBMQ,0);                                      <<04867>>37905000
                                                               <<04867>>37910000
    END                                                        <<04867>>37915000
  END                                                          <<04867>>37920000
END;  << FGETLOCKWORD >>                                       <<04867>>37925000
$PAGE "       MPE-IV FILE SYSTEM - WRITE'FOPEN'RECORD"         <<04515>>37930000
$ CONTROL SEGMENT = FILESYS6A                                  << 8562>>37935000
PROCEDURE WRITE'FOPEN'RECORD(RECSIZE,FORMMSG,SP'ACBBLK,        << 8562>>37940000
                             FILENUM);                         << 8562>>37945000
VALUE RECSIZE,FILENUM;                                         << 8562>>37950000
INTEGER RECSIZE,FILENUM;                                       << 8562>>37955000
DOUBLE SP'ACBBLK;                                              << 8562>>37960000
BYTE ARRAY FORMMSG;                                            << 8562>>37965000
OPTION PRIVILEGED,UNCALLABLE;                                  << 8562>>37970000
                                                               << 8562>>37975000
<<---------------------------------------------------------->> << 8562>>37980000
<< This procedure writes a special FOPEN SPOOLFILE record   >> << 8562>>37985000
<< with a forms message if one has been supplied.  It is    >> << 8562>>37990000
<< called by FOPEN for every spoolfile.                     >> << 8562>>37995000
<<                                                          >> << 8562>>38000000
<< Input variables:                                         >> << 8562>>38005000
<<    FORMMSG - An array containing the forms message for   >> << 8562>>38010000
<<              the spoolfile, if one is given.             >> << 8562>>38015000
<<    RECSIZE - The size in words of the forms message.  If >> << 8562>>38020000
<<              no forms messages is to be written, than    >> << 8562>>38025000
<<              this value is zero (0).                     >> << 8562>>38030000
<<                                                          >> << 8562>>38035000
<< OUTPUT VARIABLES:                                        >> << 8562>>38040000
<<    SP'ACBBLK - The current block number for the spool-   >> << 8562>>38045000
<<                file.  Retrieved from ACB double (9).     >> << 8562>>38050000
<<                                                          >> << 8562>>38055000
<< NOTE: DB must be set to the stack upon entrance into     >> << 8562>>38060000
<<       this procedure.                                    >> << 8562>>38065000
<<---------------------------------------------------------->> << 8562>>38070000
                                                               << 8562>>38075000
BEGIN                                                          << 8562>>38080000
<< These declarations must be last and in order!.           >> << 8562>>38085000
INTEGER ACBMQ;                                                 << 8562>>38090000
INTEGER AFTE;      << AFT entry word 0, type and $NULL bit  >> << 8562>>38095000
DOUBLE  PACBV;     << Physical ACB Vector                   >> << 8562>>38100000
DOUBLE  LACBV;     << Logical  ACB Vector                   >> << 8562>>38105000
INTEGER IOQX;      << No-Wait I/O pending Queue Index       >> << 8562>>38110000
INTEGER ARRAY ACB(0:SIZEXACB-1) = Q;                           << 8562>>38115000
DOUBLE ARRAY ACBDBL(*)=ACB;                                    << 8562>>38120000
LOGICAL DSTX;  <<DSTX returned by LOC'ACB, used by IOMOVE   >> << 8562>>38125000
                                                               << 8562>>38130000
$  IF X0 = ON                                                  << 8562>>38135000
IF MONCALLABLE THEN << Monitoring? >>                          << 8562>>38140000
   BEGIN                                                       << 8562>>38145000
      TOS := "WR"; TOS := "IT"; TOS := "E'"; TOS := "FO";      << 8562>>38150000
      TOS := "PE"; TOS := "N'"; TOS := "RE"; TOS := "CO";      << 8562>>38155000
      FTITLE(*,*,*,*);                                         << 8562>>38160000
      DEBUG;                                                   << 8562>>38165000
   END;                                                        << 8562>>38170000
$  IF                                                          << 8562>>38175000
                                                               << 8562>>38180000
GET'ACB'Q'LOC;                                                 << 8562>>38185000
LOC'ACB(DSTX,ACBMQ,FILENUM,%100000);                           << 8562>>38190000
DSTX := TOS;   << LOC'ACB returns DSTX on top of stack!     >> << 8562>>38195000
                                                               << 8562>>38200000
ACBCTL := 0;                                                   << 8562>>38205000
ACBNEWEOF := 1;                                                << 8562>>38210000
TOS := 3;                 <<Mode, 3 signifies FOPEN record. >> << 8562>>38215000
TOS := @FORMMSG&LSR(1);   << Convert byte to word address.  >> << 8562>>38220000
IF S0 > @S0               << Tricky way to take care of     >> << 8562>>38225000
   THEN TOS.(0:1) := 1;   << negative byte addresses.       >> << 8562>>38230000
TOS := RECSIZE;           << Word count of forms message.   >> << 8562>>38235000
IOMOVE(*,*,*);            << Write FOPEN spoolfile record.  >> << 8562>>38240000
SP'ACBBLK := ACBBLK;      << Return current block number.   >> << 8562>>38245000
UNLOC'ACB(ACBMQ,0);       << Release that ACB !!!!          >> << 8562>>38250000
END;                                                           << 8562>>38255000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN THAT FILE! - DECLARATIONS" <<06272>>38260000
<<----------------------------------------------------------------------38265000
*                                                                      *38270000
*  CALLABLE INTRINSICS                                                 *38275000
*                                                                      *38280000
---------------------------------------------------------------------->>38285000
                                                               <<04713>>38290000
$ CONTROL SEGMENT = FILESYS6A                                           38295000
INTEGER PROCEDURE FOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,      <<KS.00>>38300000
   RECSIZE,                                                    <<KS.00>>38305000
   DEVICE,FORMMSG,USERLABELS,BLOCKFACTOR,PRICOPBUFS,FILESIZE,           38310000
   NUMEXTENTS,INITALLOC,FILECODE);                                      38315000
   <<MUST BE CALLED WITH DB SET TO THE STACK>>                          38320000
   VALUE FOPTIONS,AOPTIONS,RECSIZE,USERLABELS,BLOCKFACTOR,PRICOPBUFS,   38325000
   FILESIZE,NUMEXTENTS,INITALLOC,FILECODE;                              38330000
   BYTE ARRAY FORMDESIGNATOR,DEVICE,FORMMSG;                            38335000
   LOGICAL FOPTIONS,AOPTIONS;                                           38340000
   INTEGER RECSIZE,USERLABELS,BLOCKFACTOR,PRICOPBUFS,NUMEXTENTS,        38345000
   INITALLOC,FILECODE;                                                  38350000
   DOUBLE FILESIZE;                                                     38355000
   OPTION VARIABLE,PRIVILEGED;                                          38360000
   BEGIN                                                                38365000
   << >>                                                                38370000
   ENTRY DFOPEN;  <<DIRECT ACCESS FILE ONLY ENTRY POINT>>      <<00199>>38375000
   ENTRY FSOPEN;  << Open spoolfile as a disc file.         >> << 8485>>38380000
   ENTRY FJOPEN;  << JOB/CI $STDXX SEC ENTRY POINT >>                   38385000
   ENTRY KSOPEN; <<KSAM SPECIAL ENTRY POINT>>                  <<KS.00>>38390000
   ENTRY PVOPEN;  << CONDITIONAL MOUNT ENTRY POINT >>          <<RV.PV>>38395000
   ENTRY MUSTOPEN;<< ENTRY POINT TO BYPASS LOCKWORD CHECK>>    <<RV.PV>>38400000
   ENTRY ROPEN;   ! Used by RECOVER5 to kludge ACB/FCB info.   <<*8508>>38405000
   << >>                                                                38410000
   ARRAY fcreateerr (*) = PB := nospace, discioerr,            <<03509>>38415000
   disc'space'allocation'disabled, navaildev,                  <<03509>>38420000
   undefdev, badextent, badoffset;                             <<03509>>38425000
   ARRAY SPCREATEERR(*)=PB := SPOOLBADEXT,SPOOLDEVDOWN,SPOOLNOSPACE,    38430000
      SPOOLERROR,SPOOLNOCLASS,SPOOLBADOFF;                              38435000
   ARRAY DP'PARM'ERRORS(*)=PB := 0,DP'EXPECT'EQUAL,            << 8485>>38440000
      DP'UNDEFINED'KEYWORD,DP'EXPECT'SEMI'CR,DP'OVERFLOW,      << 8485>>38445000
      DP'MISSING'CR;                                           << 8485>>38450000
   ARRAY DP'ENV'ERRORS(*)=PB := 0,DP'ENV'OPEN'FAIL,            << 8485>>38455000
      DP'ENV'BADFILE,DP'ENV'HDR'FAIL,DP'ENV'NOT'COMPILE,0,     << 8485>>38460000
      DP'ENV'READ'ERR,DP'ENV'READ'ERR,DP'ENV'FCLOSE,0,         << 8485>>38465000
      DP'ENV'FDEVICECONTROL,DP'ENV'FEQ'ERR;                    << 8485>>38470000
   INTEGER RESULT = FOPEN;                                              38475000
   LOGICAL PMAP = Q-4;  <<PARAMETER BIT MAP>>                           38480000
   DEFINE P'AOPS= PMAP.(5:1) #;                                <<00107>>38485000
   LOGICAL CHECKSEC := TRUE; <<FALSE ==> NO ASEC CHECK>>       <<00107>>38490000
   LOGICAL KSF; <<ONLY TRUE IF KSOPEN ENTRY POINT USED>>       <<KS.00>>38495000
   LOGICAL REMOTE:=FALSE;          <<REMOTE FILE FLAG>>        <<KS.00>>38500000
   LOGICAL MUSTOPEN'; <<TRUE IF MUSTOPEN ENTRY POINT USED>>    <<RV.PV>>38505000
   LOGICAL REOPENSTD := FALSE;  << REOPEN STDIN OR STDLIST >>  <<04133>>38510000
   LOGICAL DIRACCF; <<ONLY TRUE IF DFOPEN ENTRY USED>>         <<00199>>38515000
   INTEGER POINTER ANPTR;                                               38520000
   INTEGER POINTER GNPTR;                                               38525000
   INTEGER DISP := 0;                                                   38530000
   DOUBLE LINKAGE'INDEXP := 0D;                                <<38.PV>>38535000
   INTEGER                                                     <<38.PV>>38540000
       LINKAGE = LINKAGE'INDEXP;                               <<38.PV>>38545000
   INTEGER JNUM;  <<JOB NUMBER>>                                        38550000
   LOGICAL SAVECHARS;  << Used in FSPOOLOPEN form FORMMSG.  >> <<04515>>38555000
   INTEGER SAVFOPNEQ;<< PRESERVE NO-EQUATE BIT >>              <<KJ.03>>38560000
   INTEGER SAVAOPS=REOPENSTD;                         <<01882>><<04133>>38565000
                                                               <<00630>>38570000
   EQUATE NEWDIRFILE = 0,    <<ADJUSTOPS PARAMS>>              <<00630>>38575000
          SERIALFILE = 1,                                      <<HM.00>>38580000
          MSGFILE    = 2;                                      <<HM.00>>38585000
                                                                        38590000
   <<MISC. FILE PARAMETERS>>                                            38595000
                                                                        38600000
   INTEGER ARRAY FIDS (0:32);  <<FILE DESIGNATOR COPY>>                 38605000
   BYTE ARRAY FD (*) = FIDS;                                            38610000
   ARRAY FNAMES (0:15);  <<PARSED FILE NAMES>>                          38615000
   ARRAY FN (*) = FNAMES;  <<LOCAL FILE NAME>>                          38620000
   ARRAY GN (*) = FNAMES(4);  <<GROUP NAME>>                            38625000
   ARRAY AN (*) = FNAMES(8);  <<ACCOUNT NAME>>                          38630000
   ARRAY LW (*) = FNAMES(12);  <<LOCKWORD>>                             38635000
   BYTE ARRAY LWB(*) = LW;                                     <<DS.00>>38640000
   ARRAY XDD'SUBENTRY(*) = FIDS;  ! Use file name array.       <<06862>>38645000
   DOUBLE ARRAY XDD'DSUBENTRY(*) = XDD'SUBENTRY;               <<06862>>38650000
   << Device specification copy >>                             <<02555>>38655000
   BYTE ARRAY DEVL(0:MAXDEVLEN);                               <<02555>>38660000
   INTEGER ARRAY WFMSG(0:85);                                  <<TL.02>>38665000
   BYTE ARRAY FMSG(*)=WFMSG;<<FILE EQUATION FORMS MSG>>        <<TL.02>>38670000
   BYTE ARRAY NOFORMS(0:1);                                    <<01139>>38675000
   LOGICAL FCOMTRIED := FALSE;  <<FILE EQUATION ATTEMPTED?>>            38680000
   LOGICAL DNTYPE := 0;  <<DESIGNATOR NAME TYPE>>                       38685000
INTEGER ARRAY MISC(0:3);  << for various local vars >>                  38690000
   DEFINE                                                               38695000
     DOMAIN =MISC(0)#,    << file domain from FOPS >>                   38700000
     BSIZE  =MISC(1)#,    << block size, words >>                       38705000
     DEFRS  =MISC(2)#,    << default rec. size, +words >>               38710000
     USECNT =MISC(3)#;    << device use count >>                        38715000
                                                                        38720000
                                                                        38725000
   <<MISC. DEVICE PARAMETERS>>                                          38730000
                                                                        38735000
   INTEGER DADDR := 0;  <<LOGICAL DEVICE NR.>>                          38740000
   LOGICAL VDADDR := 0;  <<VOLUME TABLE INDEX>>                         38745000
   INTEGER DTYPE := 0;  <<DEVICE TYPE>>                                 38750000
   DEFINE DACCCL = DTYPE.(10:3)#;  <<device access class>>     <<03578>>38755000
   ARRAY DEVINFO (0:12);  ! Device information array.          <<06515>>38760000
   LOGICAL POINTER LDT;                                        <<06515>>38765000
   DOUBLE DISKADR;  <<DISC FILE SECTOR ADR.>>                           38770000
   INTEGER P1 = DISKADR;  <<SECTOR NR. - FIRST HALF>>                   38775000
   INTEGER P2 = DISKADR+1;  <<SECTOR NR. - SECOND HALF>>                38780000
   DOUBLE FADDR;  <<DISC FILE SECTOR NR.>>                              38785000
   INTEGER FADDRW1 = FADDR;  <<FILE ADDRESS - FIRST HALF>>              38790000
   INTEGER FADDRW2 = FADDR+1;  <<FILE ADDRESS - SECOND HALF>>           38795000
   INTEGER ACCESSW;  <<ALLOCATE ACCESS>>                                38800000
                                                                        38805000
   << DEVICEPARMS arrays >>                                    <<02524>>38810000
   BUILD'DEVPARMS;                                             <<02524>>38815000
                                                               <<02524>>38820000
   LOGICAL DEV'PARMS'LEN = S - 1;                              <<02524>>38825000
                                                               <<02555>>38830000
   LOGICAL REM'SPOOL'ID;      <<Return from FFILEINFO>>        <<02555>>38835000
                                                               <<02555>>38840000
   DEFINE                                                      <<02555>>38845000
     REMOTE'ACCESS'ERROR =                                     <<02555>>38850000
      BEGIN                                                    <<02555>>38855000
      FINDAFT;               <<Find AFT>>                      <<02555>>38860000
      TOS := 0D;                                               <<02555>>38865000
      DPS2 := TOS;                                             <<02555>>38870000
      DEL;                                                     <<02555>>38875000
      CONDCODE := CCL;                                         <<02555>>38880000
      SETPXFILE;                                               <<02555>>38885000
      PXFFOPEN := DP'REMOTE'ACCESS;                            <<02555>>38890000
      TOS := DP'REMOTE'ACCESS;                                 <<02555>>38895000
      GO BUM;                                                  <<02555>>38900000
      END#;                                                    <<02555>>38905000
DEFINE                                                         <<02555>>38910000
     ERR'SPULAB =                                              <<02555>>38915000
      BEGIN                                                    <<02555>>38920000
      CONDCODE := CCL;                                         <<02555>>38925000
      SETPXFILE;                                               <<02555>>38930000
      PXFFOPEN := DP'ENV'SPULAB'ERR;                           <<02555>>38935000
      TOS := DP'ENV'SPULAB'ERR;                                <<02555>>38940000
      RESULT := 0;      << Reset spool open to fail >>         <<02555>>38945000
      GO BUM;                                                  <<02555>>38950000
      END#;                                                    <<02555>>38955000
                                                               <<02555>>38960000
   <<JIT PARAMETERS>>                                                   38965000
                                                                        38970000
   INTEGER ARRAY JITINFO (0:23) = Q; ! JIT info buffer.        <<06868>>38975000
   INTEGER JID = JITINFO + 1;        ! Job main PIN number.    <<06868>>38980000
   LOGICAL ASEC = JITINFO+3; ! Account securiy bit map.        <<06868>>38985000
   DOUBLE GSEC = JITINFO+4;  ! Group security bit map.         <<06868>>38990000
   ARRAY HANAME (*) = JITINFO(6);    ! Home account name.      <<06868>>38995000
   ARRAY HGNAME (*) = JITINFO(10);   ! Home group name.        <<06868>>39000000
   ARRAY LGNAME (*) = JITINFO(14);   ! Logon group name.       <<06868>>39005000
   ARRAY USERID (*) = JITINFO(18);   ! User name.              <<06868>>39010000
   INTEGER ACCTINXPTR = JITINFO+22;  ! Account index pointer.  <<06868>>39015000
   INTEGER GRPINXPTRWD = JITINFO+23;                           <<38.PV>>39020000
   DEFINE                                                      <<38.PV>>39025000
       JITPVF = (0:1) #,                                       <<38.PV>>39030000
       JITMTFFF = (1:1) #, <<INDEX TO APPROPRIATE DOUBLE>>     <<38.PV>>39035000
       GRPINXPTRF = (8:8) #,                                   <<38.PV>>39040000
       HVSPV = GRPINXPTRWD.JITPVF = 1 #,                       <<38.PV>>39045000
       JITMTFF = GRPINXPTRWD.JITMTFFF #,                       <<38.PV>>39050000
       GRPINXPTR = GRPINXPTRWD.GRPINXPTRF #;                   <<38.PV>>39055000
   DOUBLE                                                      <<38.PV>>39060000
       ACCTINDEX,                                              <<38.PV>>39065000
       GRPINDEX;                                               <<38.PV>>39070000
                                                                        39075000
   <<PCBX PARAMETERS>>                                                  39080000
                                                                        39085000
   INTEGER PCBGLOBLOC;     ! PCBX Q-relative offset.           <<06513>>39090000
   INTEGER POINTER PXFILE;  <<PXFILE POINTER>>                          39095000
                                                                        39100000
   <<AFT PARAMETERS>>                                                   39105000
                                                                        39110000
   INTEGER AFTX;  <<AFT ENTRY INDEX>>                                   39115000
   INTEGER FILENUM = AFTX;  <<FILE NR.>>                                39120000
   INTEGER POINTER AFT;                                        <<06514>>39125000
                                                                        39130000
   <<ACB PARAMETERS>>                                                   39135000
                                                                        39140000
   DOUBLE                                                      <<06514>>39145000
       PACBV := 0D,                                            <<06514>>39150000
       LACBV := 0D;                                            <<06514>>39155000
   INTEGER                                                     <<06514>>39160000
      PACBV'DSTN = PACBV + 0,                                  <<06514>>39165000
      PACBV'ENTRY= PACBV + 1,                                  <<06514>>39170000
      LACBV'DSTN = LACBV + 0,                                  <<06514>>39175000
      LACBV'ENTRY= LACBV + 1;                                  <<06514>>39180000
   INTEGER POINTER ACB;                                        <<06514>>39185000
   DOUBLE POINTER ACBDBL = ACB;                                <<06514>>39190000
   INTEGER FNAMEMQ;   << Q relative location of FNAME.      >> <<04624>>39195000
   LOGICAL STATE := [1/0,1/0,4/OTHERRD,1/0];  <<PARTIAL ACBSTATE>>      39200000
                                                                        39205000
   <<FCB PARAMETERS>>                                                   39210000
                                                                        39215000
   INTEGER POINTER FCB;  <<FCB POINTER>>                                39220000
   DOUBLE POINTER FCBDBL = FCB;                                         39225000
   DOUBLE FCBV := 0D; << FCB vector (no kidding!)           >> <<06514>>39230000
   INTEGER                                                     <<06514>>39235000
      FCBMQ,          << Q relative location of FCB.        >> <<06514>>39240000
      FCBSI := 0;     << Exact size of the FCB.             >> <<06514>>39245000
                                                               <<04624>>39250000
                                                                        39255000
   <<FILE LABEL PARAMETERS>>                                            39260000
                                                                        39265000
   INTEGER POINTER FLAB;  <<FILE LABEL POINTER>>                        39270000
   DOUBLE POINTER FLABDBL = FLAB;                                       39275000
   BYTE POINTER BFLAB;                                         <<02571>>39280000
                                                                        39285000
   <<SPOOLFILE USER LABEL 0>>                                  <<SP.11>>39290000
                                                               <<SP.11>>39295000
DEFINE                                                         <<SP.11>>39300000
   SPULAB'LDEV = FLAB       #,  << LDEV of active device >>             39305000
   SPULAB'CURREXT = FLAB(1) #,  << current extent being printed >>      39310000
   SPULAB'LASTBLOCK = FLAB(2)#, << last block actively printing >>      39315000
   SPULAB'LASTREC = FLAB(4)#,   << last record printing >>              39320000
   SPULAB'LASTULAB = FLAB(6).(0:8) #, << last used circular queue >>    39325000
   SPULAB'ULABENTRY = FLAB(6).(8:8)#, << last circ queue entry >>       39330000
   SPULAB'CHNSKIP = FLAB(7).(0:8)#,   << page eject channel >>          39335000
   SPULAB'LINESPERPAGE = FLAB(7).(8:8)#, <<# lines/page>>               39340000
   SPULAB'LASTFOPEN = FLAB(8).(0:8)#, << last FOPEN ulab >>             39345000
   SPULAB'FOPENENTRY = FLAB(8).(8:8)#, << last FOPEN entry >>           39350000
   SPULAB'TOTULAB = FLAB(9)#,    << total user labels alloc >><<SP.ENV>>39355000
   SPULAB'LASTPAGE = FLAB(10)#,  << last page printed >>      <<SP.ENV>>39360000
   SPULAB'LAST'ENV = FLAB(11)#,<<last used environment file>> <<SP.ENV>>39365000
                                 << name (36 bytes)   >>      <<SP.ENV>>39370000
   SPULAB'END      = FLAB(127)#; << end of user label 0>>     <<SP.ENV>>39375000
                                                               <<SP.11>>39380000
EQUATE                                                         <<SP.11>>39385000
   FOPENULABSIZE = 4,   << FOPEN entry size in u-label >>      <<SP.11>>39390000
   NUMSPULABS    = 27,  << number of spooler u-labels >>       <<SP.11>>39395000
   MAXFOPENULAB = 10,   << user labels used for FOPENS >>      <<SP.11>>39400000
   MAXFOPENENTRY = 31;  << nr. of 4-word entries per u-label >><<SP.11>>39405000
                                                               <<SP.11>>39410000
   INTEGER ULAB,ULABENTRY;                                     <<SP.11>>39415000
   DOUBLE SP'ACBBLK;  <<VARIABLE BLOCK COUNT>>                 <<SP.11>>39420000
                                                               <<SP.11>>39425000
   LOGICAL ALLOC'RESULT;                                       <<00635>>39430000
   <<RESOURCE FLAGS>>                                                   39435000
                                                                        39440000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   39445000
   INTEGER A := -1;  <<USED BY GETSIR>>                                 39450000
   INTEGER B:= -1;  <<USED BY FMAVTSIR>>                                39455000
   LOGICAL PACBLOCKED := FALSE;  <<SPECIAL PACB LOCK FLAG>>             39460000
   LOGICAL RESOURCES := FALSE;  <<FOR ERROR RECOVERY>>                  39465000
   DEFINE DISKLOCK = (15:1)#,  <<DISC SPACE ALLOCATED?>>                39470000
          DEVICELOCK = (14:1)#,  <<DEVICE ALLOCATED?>>                  39475000
          ACBLOCK = (13:1)#,  <<ACB CREATED?>>                          39480000
          FCBLOCK  = (12:1)#,  <<FCB CREATED>>                 <<RV.PV>>39485000
          DSLOCK   = (11:1)#,  <<DS LINE OPENED>>              <<RV.PV>>39490000
          DMOUNT   = (10:1) #, << Volume set was mounted.   >> <<06514>>39495000
          GLOBAFT  = (9:1)  #; << Global AFT reserved.      >> <<06514>>39500000
                                                                        39505000
   <<JOB/CI $STDXX ACCESS>>                                             39510000
                                                                        39515000
   LOGICAL JOBF;                                                        39520000
                                                                        39525000
   <<SPOOLFILE ACCESS>>                                                 39530000
                                                                        39535000
   INTEGER XDDX = RECSIZE;                                              39540000
   ARRAY SPINFO(0:13) = Q;                                              39545000
   LOGICAL SPOOLF = SPINFO+0;                                           39550000
   INTEGER POINTER XDDEP = SPINFO+1;                                    39555000
   INTEGER SPDADDR       = SPINFO+2;                                    39560000
   DOUBLE  SPDISKADDR    = SPINFO+3;                                    39565000
   INTEGER SPDISK1 = SPDISKADDR + 0;                                    39570000
   INTEGER SPDISK2 = SPDISKADDR + 1;                                    39575000
   INTEGER SPVDEV  = SPINFO+5;                                          39580000
   INTEGER SPFOPT  = SPINFO+6;                                          39585000
   INTEGER SPAOPT  = SPINFO+7;                                          39590000
   INTEGER SPREC   = SPINFO+8;                                          39595000
   INTEGER SPSTATE= SPINFO+9;                                           39600000
   ARRAY SPFN(*) = SPINFO+10;                                           39605000
   EQUATE                                                      << 8485>>39610000
      SPOOLEDCLASS = -3,     << Device class is spooled.    >> << 8485>>39615000
      USER'SPOOLF'FLAG = 1;  << Normal user spoolfile.      >> << 8485>>39620000
   DEFINE                                                      << 8485>>39625000
      FSOPEN'SPOOLF = (INTEGER(SPOOLF) < 0)#,                  << 8485>>39630000
      USER'SPOOLF   = (INTEGER(SPOOLF) > 0)#;                  << 8485>>39635000
                                                                        39640000
   << RFA ACCESS >>                                            <<DS.00>>39645000
                                                               <<DS.00>>39650000
   INTEGER POINTER RFAPTR; << STACK APPENDAGE POINTER >>       <<DS.00>>39655000
   INTEGER RFALEN; << APPENDAGE LENGTH >>                      <<DS.00>>39660000
   INTEGER RFALINENUM; << FILE NUMBER OF REMOTE LINE >>        <<DS.00>>39665000
   INTEGER RFAFILENUM; << FILE NUM. OF REMOTE FILE >>          <<DS.00>>39670000
   EQUATE RFAAFTOP = %010000; << RFA AFT(0) ENTRY >>           <<DS.00>>39675000
   INTEGER PCBPT; ! Pointer to a PCB for PCB defines           <<06514>>39680000
   BYTE ARRAY LOGICAL'DEV(0:3); << MASTER CPU LOGICAL DEV >>   <<DS.04>>39685000
                                                               <<DS.00>>39690000
   << Redirection of $STDIN and $STDLIST declarations >>       <<01425>>39695000
                                                               <<01425>>39700000
   LOGICAL ARRAY REDIRECT'INFO(0:24);                          <<01425>>39705000
                                                               <<01425>>39710000
   DEFINE REDIRECT'FOPTS  = REDIRECT'INFO#,                    <<01425>>39715000
          REDIRECT'AOPTS  = REDIRECT'INFO(1)#,                 <<01425>>39720000
          REDIRECT'DVTYPE = REDIRECT'INFO(2)#,                 <<01425>>39725000
          REDIRECT'LDEV   = REDIRECT'INFO(3)#,                 <<01425>>39730000
          REDIRECT'HDADDR = REDIRECT'INFO(4)#,                 <<01425>>39735000
          REDIRECT'FDESIG = REDIRECT'INFO(5)#,                 <<01425>>39740000
          REDIRECT'ASCDEV = REDIRECT'INFO(23)#;                <<01425>>39745000
          <<       ASCDEV = REDIRECT'INFO(24)  also >>         <<01425>>39750000
                                                               <<01425>>39755000
      INTEGER ERRORCODE;   << FCHECK PARM >>                   <<03091>>39760000
                                                               <<03091>>39765000
   EQUATE STDIN'FOPCODE   = 4,        << $STDIN foption code >><<01425>>39770000
          STDLIST'FOPCODE = 1,        << $STDLIST code >>      <<01425>>39775000
          NULL'FOPCODE    = 6,        << $NULL code >>         <<01490>>39780000
          NEWFILE         = 0,        << New file type >>      <<01425>>39785000
          DEFLT'MODE      = 0,        << Default Access >>     <<01425>>39790000
          EXCL'MODE       = 1,        << Exclusive Access >>   <<01425>>39795000
          READACC         = 0;        << Read Only Access >>   <<01425>>39800000
                                                               <<01425>>39805000
INTEGER CTFLAGS;                                               <<TL.02>>39810000
   DEFINE OUTPRI      = PRICOPBUFS.(0:4)#,                              39815000
          NUMCOPIES   = PRICOPBUFS.(4:7)#,                              39820000
          NUMBUFFERS  = PRICOPBUFS.(11:5)#;                             39825000
                                                                        39830000
   << PRIVATE VOLUME DECLARATIONS >>                           <<RV.PV>>39835000
   EQUATE                                                      <<RV.PV>>39840000
       UNCONDDISMOUNT = 2,                                     <<RV.PV>>39845000
       UNCONDMOUNT = 2,                                        <<RV.PV>>39850000
       CONDMOUNT = -3,                                         <<RV.PV>>39855000
       CONDDISMOUNT = -3;                                      <<RV.PV>>39860000
   INTEGER                                                     <<RV.PV>>39865000
       HVSIND := [8/"*", 8/" "],                               <<RV.PV>>39870000
       REQTYPE := UNCONDMOUNT,                                 <<RV.PV>>39875000
       PVINFO := 0;                                            <<RV.PV>>39880000
   LOGICAL                                                     <<RV.PV>>39885000
       PVOPEN';                                                <<RV.PV>>39890000
   DEFINE                                                      <<RV.PV>>39895000
       CLASSFLG = PVINFO.(0:1) #,                              <<RV.PV>>39900000
       MVTABX   = PVINFO.(4:4) #,                              <<RV.PV>>39905000
       VMASK  = PVINFO.(8:8) #;                                <<RV.PV>>39910000
   ARRAY                                                       <<RV.PV>>39915000
       GENTRY (0:GSIZE-1);                                     <<RV.PV>>39920000
                                                               <<HM.00>>39925000
                                                               <<HM.00>>39930000
   << IPC ACCESS >>                                            <<HM.00>>39935000
                                                               <<HM.00>>39940000
   <<*******************************************************>> <<04515>>39945000
   <<  ATTENTION!!!   ATTENTION!!!   ATTENTION!!!           >> <<04515>>39950000
   <<  If any variables are needed to be added, please use  >> <<04515>>39955000
   <<  the storage space in the direct Q relative array     >> <<04515>>39960000
   <<  EXTRA'QSPACE as used below.                          >> <<04515>>39965000
   <<*******************************************************>> <<04515>>39970000
                                                               <<04515>>39975000
  ARRAY EXTRA'QSPACE (0:10) = Q;                               <<04311>>39980000
  ARRAY IPCINFO(*) = EXTRA'QSPACE;                             <<04311>>39985000
  DOUBLE ARRAY IPCINFOD(*) = IPCINFO;                          <<04311>>39990000
   DEFINE  FILELIMIT    =IPCINFOD#,                            <<HM.00>>39995000
           EXTRECORDS   =IPCINFOD(1)#,                         <<HM.00>>40000000
           USERAOPTIONS =IPCINFO(4)#,                          <<HM.00>>40005000
           USERBLKFACTOR=IPCINFO(5)#;                          <<HM.00>>40010000
                                                               <<04515>>40015000
                                                               <<04311>>40020000
  DEFINE                                                       <<04311>>40025000
           RECOVER5    = EXTRA'QSPACE(6)#, ! Entry point flag. <<*8508>>40030000
           STRATEGY    = EXTRA'QSPACE(7)#, << FCB strategy. >> <<06514>>40035000
           FMAVT'FLAGS = EXTRA'QSPACE(8)#,                     <<06272>>40040000
           REM'FOPT      = EXTRA'QSPACE(9)#,                   <<04311>>40045000
           REM'FCODE     = EXTRA'QSPACE(10)#,                  <<04311>>40050000
           REM'KSAM'FOPT = (REM'FOPT.(2:3) =1)#,               <<04311>>40055000
           REM'KSAM'FCODE= (REM'FCODE = 1080)#;                <<04311>>40060000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - DEV'PARMS'LEN "          <<06272>>40065000
LOGICAL SUBROUTINE DEV'PARMS'LEN';                             <<02524>>40070000
COMMENT                                                        <<02524>>40075000
The DEVPARMS entry for each token contains the length of       <<02524>>40080000
the parameter plus one for a terminator. Also space has        <<02524>>40085000
to be provided for a terminator for the list of parameters.    <<02524>>40090000
;                                                              <<02524>>40095000
   BEGIN                                                       <<02524>>40100000
   DEV'PARMS'LEN := 0;                                         <<02524>>40105000
   IF GET'DEV'PARM(OUTQ'TOKEN, DEVPARMS, DP'INDEX) THEN        <<02524>>40110000
      DEV'PARMS'LEN := DEV'PARMS'LEN + DEVPARMS(DP'INDEX) + 5; <<02524>>40115000
   IF GET'DEV'PARM(DEN'TOKEN, DEVPARMS, DP'INDEX) THEN         <<02524>>40120000
      DEV'PARMS'LEN := DEV'PARMS'LEN + DEVPARMS(DP'INDEX) + 4; <<02524>>40125000
   IF DEV'PARMS'LEN <> 0 THEN                                  <<02524>>40130000
      BEGIN                                                    <<02524>>40135000
      DEV'PARMS'LEN := DEV'PARMS'LEN + 1; << terminator >>     <<02524>>40140000
      IF DEV'PARMS'LEN THEN  << odd count >>                   <<02524>>40145000
         DEV'PARMS'LEN := DEV'PARMS'LEN + 1;                   <<02524>>40150000
      END;                                                     <<02524>>40155000
   END; << subroutine DEV'PARMS'LEN >>                         <<02524>>40160000
                                                               <<00630>>40165000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - REDIRECT'IT    "         <<06272>>40170000
   LOGICAL SUBROUTINE REDIRECT'IT (STDX'NUM, FOPT'CODE);       <<01425>>40175000
      VALUE STDX'NUM, FOPT'CODE;                               <<01425>>40180000
      INTEGER STDX'NUM, FOPT'CODE;                             <<01425>>40185000
   BEGIN                                                       <<01425>>40190000
      COMMENT:                                                 <<01425>>40195000
         Determines whether an FOPEN of '$STDIN', '$STDINX',   <<01425>>40200000
         or '$STDLIST' other than the original FOPEN (in       <<01425>>40205000
         INITIATE) should be redirected to the non-standard    <<01425>>40210000
         $STDIN or $STDLIST.                                   <<01425>>40215000
                                                               <<01425>>40220000
         Returns TRUE if the FOPEN should be redirected and    <<01425>>40225000
         sets the parameter values appropriately so that the   <<01425>>40230000
         FOPEN can be started over again with the correct      <<01425>>40235000
         parameter values.                                     <<01425>>40240000
      ;                                                        <<01425>>40245000
                                                               <<01425>>40250000
      REDIRECT'INFO := "  ";                                   <<01425>>40255000
      MOVE REDIRECT'INFO(1) := REDIRECT'INFO, (24);            <<01425>>40260000
                                                               <<01425>>40265000
      FFILEINFO (STDX'NUM, 1, REDIRECT'FDESIG,                 <<01425>>40270000
                 2, REDIRECT'FOPTS, 3, REDIRECT'AOPTS,         <<01425>>40275000
                 5, REDIRECT'DVTYPE, 6, REDIRECT'LDEV);        <<01425>>40280000
      FFILEINFO (STDX'NUM, 7, REDIRECT'HDADDR);                <<01425>>40285000
      IF <> THEN      << TOO BIG DRT NUMBER? >>                <<03091>>40290000
         BEGIN                                                 <<03091>>40295000
         FCHECK(STDX'NUM, ERRORCODE);                          <<03091>>40300000
         IF ERRORCODE = TOOBIGDRT THEN                         <<03091>>40305000
            REDIRECT'HDADDR.(0:8) := 255; <<ARBITRARY NON-ZERO><<03091>>40310000
         END;                                                  <<03091>>40315000
                                                               <<04765>>40320000
      IF REDIRECT'FOPTS.(2:3)=1 THEN                           <<04765>>40325000
         BEGIN << KSAM file not allowed for re-direction.   >> <<04765>>40330000
         TOS := KSAMSTD;                                       <<04765>>40335000
         GO ERR;                                               <<04765>>40340000
         END;                                                  <<04765>>40345000
                                                               <<04765>>40350000
                                                               <<01425>>40355000
<< Don't redirect the FOPEN if the file  is  redirected  to >> <<02309>>40360000
<< itself. For the purpose of this test, $STDIN and $STDINX >> <<02309>>40365000
<< are considered to be the same file, that is, REDIRECT'IT >> <<02309>>40370000
<< is returned false if the caller is  trying  to  redirect >> <<02309>>40375000
<< $STDIN to $STDINX or vice versa.                         >> <<02309>>40380000
                                                               <<02309>>40385000
      IF REDIRECT'FOPTS.FOPDESIGNATORF = LOGICAL (FOPT'CODE)   <<02309>>40390000
        OR (REDIRECT'FOPTS.FOPDESIGNATORF LAND 6) =            <<02309>>40395000
             STDIN'FOPCODE                                     <<02309>>40400000
          AND (LOGICAL(FOPT'CODE) LAND 6) = STDIN'FOPCODE THEN <<02309>>40405000
         REDIRECT'IT := FALSE   << Don't redirect the open >>  <<01425>>40410000
      ELSE IF REDIRECT'AOPTS.(8:2) = EXCL'MODE OR              <<01425>>40415000
              (REDIRECT'FOPTS.(14:2) = NEWFILE LAND            <<01425>>40420000
               FOPT'CODE = 4  LAND <<$STDIN>>                  <<04518>>40425000
               REDIRECT'DVTYPE.(8:8) <= FHDISK LAND            <<01490>>40430000
               REDIRECT'FOPTS.(10:3) <> NULL'FOPCODE) THEN     <<01490>>40435000
         BEGIN  << Exclusive Access Violation >>               <<01425>>40440000
         TOS := EXSHERR2;   << Excl. Access Err - FSERR91 >>   <<01425>>40445000
         GO ERR;                                               <<01425>>40450000
         END                                                   <<01425>>40455000
      ELSE                                                     <<01425>>40460000
         BEGIN  << Redirect the file open >>                   <<01425>>40465000
         REDIRECT'IT := TRUE;                                  <<01425>>40470000
         << Set bits in FOPEN's option variable mask to     >> <<01425>>40475000
         << indicate only formal desig, fopts, and aopts.   >> <<01425>>40480000
         PMAP := %16000;                                       <<01425>>40485000
         FOPTIONS := REDIRECT'FOPTS;                           <<01425>>40490000
         AOPTIONS := REDIRECT'AOPTS;                           <<01425>>40495000
         @FORMDESIGNATOR := @REDIRECT'FDESIG & LSL(1);         <<01425>>40500000
         << Reset to do name check if file is not spooled   >> <<01490>>40505000
         << or if file is $NULL.                            >> <<01490>>40510000
         IF REDIRECT'HDADDR.(0:8) <> 0 OR                      <<01490>>40515000
            REDIRECT'FOPTS.(10:3) = NULL'FOPCODE THEN          <<01490>>40520000
            DNTYPE := 0;                                       <<01490>>40525000
                                                               <<01425>>40530000
         IF REDIRECT'DVTYPE.(8:8) <= FHDISK THEN               <<01425>>40535000
            PMAP.(7:1) := 0   << Default to DISC >>            <<01425>>40540000
         ELSE                                                  <<01425>>40545000
            BEGIN  << Non-DISC device >>                       <<01425>>40550000
            X := ASCII (REDIRECT'LDEV, -10, REDIRECT'INFO(24));<<01425>>40555000
            CASE X-1 OF                                        <<01425>>40560000
               BEGIN  << Add ldev leading zeros as needed >>   <<01425>>40565000
               << 1 >>   REDIRECT'ASCDEV := "00";              <<01425>>40570000
               << 2 >>   REDIRECT'ASCDEV.(0:8) := "0";         <<01425>>40575000
               << 3 >>   ;                                     <<01425>>40580000
               END;                                            <<01425>>40585000
            @DEVICE := @REDIRECT'ASCDEV & LSL(1);              <<01425>>40590000
            PMAP.(7:1) := 1;                                   <<01425>>40595000
            END;                                               <<01425>>40600000
         END << Redirect the open >>;                          <<01425>>40605000
      END << REDIRECT'IT >>;                                   <<01425>>40610000
                                                               <<01425>>40615000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - MESSAGEAOPOTIONS"        <<06272>>40620000
                                                               <<00630>>40625000
   SUBROUTINE MASSAGEAOPTIONS;                                 <<HM.01>>40630000
      BEGIN                                                    <<HM.01>>40635000
      IF AOPREAD THEN                                          <<HM.01>>40640000
         BEGIN  <<MINIMUM OF EAR>>                             <<HM.01>>40645000
         IF AOPACMODE <> 1 THEN AOPACMODE:=2;                  <<HM.01>>40650000
         END                                                   <<HM.01>>40655000
      ELSE                                                     <<HM.01>>40660000
         BEGIN                                                 <<HM.01>>40665000
         AOPACTYPE:=1;                                         <<HM.01>>40670000
         AOPACMODE:=1;  <<WRITER GETS EXCLUSIVE ACCESS>>       <<HM.01>>40675000
         END;                                                  <<HM.01>>40680000
      END;  <<MASSAGEAOPTIONS>>                                <<HM.01>>40685000
                                                               <<HM.01>>40690000
                                                               <<HM.01>>40695000
   INTEGER SUBROUTINE ADJUSTMSGPARMS;                          <<HM.00>>40700000
      BEGIN                                                    <<HM.00>>40705000
      FILELIMIT:=FILESIZE;                                     <<HM.00>>40710000
      EXTRECORDS:=0D;                                          <<HM.00>>40715000
      BLOCKFACTOR:=USERBLKFACTOR;                              <<HM.00>>40720000
      ADJUSTMSGPARMS:=-1;                                      <<HM.00>>40725000
      IF AOPCOPY THEN                                          <<HM.00>>40730000
         BEGIN  <<REPLICATE A MSG FILE>>                       <<HM.00>>40735000
         AOPACMODE := 1;  << Exclusive access >>               <<01882>>40740000
         IF NOT AOPREAD THEN AOPACTYPE:=1;  <<only Read/Write>><<03035>>40745000
         FOPFORMAT:=1;                                         <<HM.00>>40750000
         IF AOPWRITE AND NOT AOPINHIBITBUF THEN                <<HM.00>>40755000
            ADJUSTMSGPARMS:=ACCVIOL;                           <<HM.00>>40760000
         END                                                   <<HM.00>>40765000
      ELSE                                                     <<HM.00>>40770000
         BEGIN  <<MSG ACCESS MODE>>                            <<HM.00>>40775000
         AOPTIONS:=USERAOPTIONS;                               <<HM.00>>40780000
         IF AOPACTYPE > 3 THEN                                 <<HM.00>>40785000
            ADJUSTMSGPARMS:=ACCVIOL                            <<HM.00>>40790000
         ELSE                                                  <<HM.00>>40795000
            BEGIN                                              <<HM.00>>40800000
            IF AOPACTYPE = 2 THEN AOPACTYPE:=3;                <<HM.00>>40805000
            IF AOPMULTAC = 0 THEN AOPMULTAC:=2;                <<HM.00>>40810000
            IF AOPACMODE = 0 THEN AOPACMODE:=1;                <<HM.00>>40815000
            AOPINHIBITBUF:=0;                                  <<HM.00>>40820000
            AOPMULTIREC:=0;                                    <<HM.00>>40825000
            IF FOPFORMAT > 1 THEN FOPFORMAT:=1;                <<HM.00>>40830000
            END;                                               <<HM.00>>40835000
         END;                                                  <<HM.00>>40840000
      END  <<ADJUSTMSGPARMS>>;                                 <<HM.00>>40845000
                                                               <<06514>>40850000
                                                               <<06514>>40855000
<<                ADJUSTCIRPARMS                            >> <<06514>>40860000
                                                               <<06514>>40865000
                                                               <<HM.00>>40870000
   INTEGER SUBROUTINE ADJUSTCIRPARMS;                          <<HM.00>>40875000
      BEGIN                                                    <<HM.00>>40880000
      ADJUSTCIRPARMS:=-1;                                      <<HM.00>>40885000
      IF AOPCOPY THEN                                          <<HM.01>>40890000
         MASSAGEAOPTIONS                                       <<HM.01>>40895000
      ELSE IF NOT AOPREAD THEN                                 <<HM.01>>40900000
         AOPINHIBITBUF:=0;                                     <<HM.00>>40905000
      IF NOT AOPINHIBITBUF THEN AOPMULTIREC:=0;                <<HM.00>>40910000
      IF AOPSEMI THEN                                          <<HM.00>>40915000
         AOPACMODE:=IF AOPREAD THEN 3 ELSE 1;                  <<HM.00>>40920000
      IF NOT AOPREAD THEN                                      <<HM.00>>40925000
         BEGIN                                                 <<HM.00>>40930000
         IF AOPMULTAC = 0 THEN AOPMULTAC:=2;                   <<HM.00>>40935000
         IF AOPWRITESAVE THEN                                  <<HM.00>>40940000
            AOPACTYPE:=3  <<SET IT TO APPEND>>                 <<HM.00>>40945000
         ELSE IF AOPACTYPE > 3 THEN                            <<HM.00>>40950000
            ADJUSTCIRPARMS:=ACCVIOL;                           <<HM.00>>40955000
         END;                                                  <<HM.00>>40960000
      END;  <<ADJUSTCIRPARMS>>                                 <<HM.00>>40965000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - ADJUSTOPS       "        <<06272>>40970000
   INTEGER SUBROUTINE ADJUSTOPS(ADJTYPE);                      <<00630>>40975000
      VALUE ADJTYPE;                                           <<00630>>40980000
      INTEGER ADJTYPE;                                         <<00630>>40985000
   BEGIN                                                       <<00630>>40990000
      COMMENT:                                                 <<00630>>40995000
         RESOLVE ANY INCONSISTENCIES VIS-A-VIS FOPS AND AOPS.  <<00630>>41000000
         RETURN ERROR CODE (>=0), OR -1 IF NO ERRORS.          <<00630>>41005000
                                                               <<00630>>41010000
         NOTE THAT ADJUSTMENTS TO OLD FILES ARE HANDLED IN     <<00630>>41015000
         "FOPENDA".                                            <<00630>>41020000
         ;                                                     <<00630>>41025000
                                                               <<00630>>41030000
      ADJUSTOPS := -1;                                         <<00630>>41035000
      CASE ADJTYPE OF                                          <<00630>>41040000
         BEGIN                                                 <<00630>>41045000
         <<0>> BEGIN <<NEW FILE,$NEWPASS,$NULL,NO-NAME>>       <<00630>>41050000
               IF FOPMSGFILE THEN                              <<01717>>41055000
                  ADJUSTOPS:=ADJUSTMSGPARMS                    <<HM.00>>41060000
               ELSE IF FOPCIRFILE THEN                         <<HM.00>>41065000
                  ADJUSTOPS:=ADJUSTCIRPARMS                    <<07392>>41070000
               ELSE IF FOPRIO THEN                             <<00630>>41075000
                  BEGIN                                        <<00630>>41080000
                  FOPFORMAT := 0;  <<FIXED>>                   <<00630>>41085000
                  AOPCOPY := 0;                                <<HM.00>>41090000
                  IF NOT AOPINHIBITBUF THEN                    <<00630>>41095000
                     BEGIN                                     <<00630>>41100000
                     AOPMULTIREC := 0;                         <<00630>>41105000
                     AOPNOWAIT := 0;                           <<00630>>41110000
                     END;                                      <<00630>>41115000
                  END;                                         <<00630>>41120000
               END; <<0>>                                      <<00630>>41125000
                                                               <<00630>>41130000
          <<1>> BEGIN <<NON-DIRECT DEV,$STDIN(X),$STDLIST>>    <<00630>>41135000
                FOPFILETYPE := 0;                              <<HM.00>>41140000
                END;                                           <<00630>>41145000
          <<2>> ADJUSTOPS:=ADJUSTMSGPARMS;  <<MSG FILE>>       <<HM.00>>41150000
          END; <<CASES>>                                       <<00630>>41155000
   END; <<SUBROUTINE ADJUSTOPS>>                               <<00630>>41160000
                                                               <<06514>>41165000
                                                               <<06514>>41170000
<<                     RBSIZE                               >> <<06514>>41175000
                                                               <<06514>>41180000
                                                               <<00630>>41185000
   SUBROUTINE RBSIZE;                                                   41190000
      <<COMPUTES THE RECORD SIZE, BLOCK SIZE AND, IF DEFAULT            41195000
        BLOCKING IS SPECIFIED, THE BLOCKING FACTOR>>                    41200000
      BEGIN                                                             41205000
      IF DTYPE=FDISC THEN <<FOREIGN DISC>>                     <<01115>>41210000
        BEGIN                                                  <<01115>>41215000
        RECSIZE:=128;  <<EXCEPT FOR IBM FLOPPIES>>             <<01115>>41220000
        IF LDEVTOTYPE(DADDR)=2 THEN <<IT'S A FLOPPY>>          <<01115>>41225000
          BEGIN <<CHECK FOR IBM>>                              <<01115>>41230000
          TOS:=REQSTATUS(DADDR);  <<DEVICE STATUS>>            <<01115>>41235000
          ASSEMBLE(XCH; DEL; EXF 3:4); <<TTTT FIELD>>          <<01115>>41240000
          IF TOS=8 THEN RECSIZE:=64; <<IT IS IBM>>             <<01115>>41245000
          END;                                                 <<01115>>41250000
        END;                                                   <<01115>>41255000
      TOS := RECSIZE;  <<REC. SIZE>>                                    41260000
      IF = THEN TOS := TOS+DEFRS;  <<USE DEFAULT RECORD SIZE?>>         41265000
      IF < THEN  <<REC. SIZE IN (NEG.) BYTES?>>                         41270000
         TOS := -TOS  <<POS. BYTES>>                                    41275000
      ELSE  <<REC. SIZE IN (POS.) WORDS>>                               41280000
         BEGIN                                                 <<01.01>>41285000
         TOS := TOS&LSL(1);  <<POS. BYTES>>                             41290000
         IF < THEN        <<OVERSIZE RECORD>>                  <<RV.RV>>41295000
         BEGIN                                                 <<RV.RV>>41300000
             TOS := INVDRECSIZE;                               <<RV.RV>>41305000
             GO TO ERR;                                        <<RV.RV>>41310000
         END;                                                  <<RV.RV>>41315000
         END;                                                  <<01.01>>41320000
      IF NOT SPOOLF THEN                                                41325000
         IF FOPCONTROL THEN TOS := TOS+1;  <<CARRIAGE CONTROL?>>        41330000
      IF NOT FOPASCII THEN TOS := (TOS+1)&LSR(1)&LSL(1);  <<EVEN BYTES>>41335000
      RECSIZE := TOS;  <<REC. SIZE IN BYTES>>                           41340000
      IF NOT AOPINHIBITBUF AND STATE.DEFAULTBF THEN  <<DEFAULT?>>       41345000
         BEGIN                                                          41350000
         BLOCKFACTOR := (DEFRS&LSL(1)/RECSIZE);                <<01968>>41355000
         IF = THEN BLOCKFACTOR := 1                                     41360000
         ELSE IF BLOCKFACTOR > 255 THEN BLOCKFACTOR := 255;    <<01968>>41365000
         END;                                                           41370000
      BSIZE:=GETBLKSIZE(RECSIZE,BLOCKFACTOR,FOPTIONS);         <<00630>>41375000
      IF OVERFLOW THEN                                         <<00630>>41380000
      BEGIN                                                    <<RV.PV>>41385000
          TOS := INVDBLKSIZE;                                  <<RV.PV>>41390000
          GO TO ERR;                                           <<RV.PV>>41395000
      END;                                                     <<RV.PV>>41400000
      END;                                                              41405000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - LABELIO         "        <<06272>>41410000
   SUBROUTINE LABELIO (RW,FLAG);                                        41415000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           41420000
                                                                        41425000
        INPUT VARIABLES:                                                41430000
            RW - I/O MODE                                               41435000
               0 - READ                                                 41440000
               1 - WRITE                                                41445000
            FLAG - ERROR RECOVERY STRATEGY                              41450000
               0 - CALL FLABIOERR WITH A ZERO FILE NUMBER               41455000
               1 - CALL FLABIOERR WITH A FILE NAME ARRAY                41460000
               2 - CLEAR $OLDPASS REFERENCE IN JIT                      41465000
                                                                        41470000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE IS   41475000
        CALLED>>                                                        41480000
      VALUE RW,FLAG;                                                    41485000
      INTEGER RW,FLAG;                                                  41490000
      BEGIN                                                             41495000
      X := FLABIO(DADDR,DISKADR,RW,FLAB);  <<R/W LABEL>>                41500000
      IF <> THEN  <<ERROR?>>                                            41505000
         BEGIN                                                          41510000
         IF FLAG = 0 THEN  <<FILE NUMBER NOT AVAILABLE?>>               41515000
            FLABIOERR(X,0)                                              41520000
         ELSE IF FLAG = 1 THEN  <<FILE NAME AVAILABLE?>>                41525000
            FLABIOERR(X,0,@FN)                                          41530000
         ELSE  <<SPECIAL CASE FOR $OLDPASS>>                            41535000
            BEGIN                                                       41540000
            FLABIOERR(X,0);                                             41545000
            FADDR := 0D;  <<TEMP CELL FOR 0D>>                          41550000
            TOS := PXG'JITDST; TOS := JITPFP&LSL(1);           <<06513>>41555000
            TOS := @FADDR;                                              41560000
            TOS := 2;                                                   41565000
            ASSEMBLE(MTDS 4)  <<CLEAR $OLDPASS CELL IN JIT>>            41570000
            END;                                                        41575000
         TOS := LBLIOERR;                                               41580000
         GO ERR                                                         41585000
         END                                                            41590000
      END;                                                              41595000
                                                               <<07392>>41600000
<< ---------------------------------------------- >>           <<07392>>41605000
                                                               <<07392>>41610000
DOUBLE SUBROUTINE CIRFILESIZE(OLDFILESIZE,BLOCKFACTOR);        <<07392>>41615000
<< computes file limit for circular files, circular >>         <<07392>>41620000
<<   file must fill the last block                  >>         <<07392>>41625000
<< RETURNS: new circular file size                  >>         <<07392>>41630000
<< PARAMETERS: oldfilesize (input) default or input >>         <<07392>>41635000
<<             file size                            >>         <<07392>>41640000
<<             blockfactor (input) blocking factor  >>         <<07392>>41645000
<<-------------------------------------------------->>         <<07392>>41650000
   VALUE  OLDFILESIZE, BLOCKFACTOR;                            <<07392>>41655000
   DOUBLE OLDFILESIZE;                                         <<07392>>41660000
   INTEGER BLOCKFACTOR;                                        <<07392>>41665000
                                                               <<07392>>41670000
BEGIN                                                          <<07392>>41675000
   IF (OLDFILESIZE MOD DOUBLE(BLOCKFACTOR)) = 0D THEN          <<07392>>41680000
      CIRFILESIZE := OLDFILESIZE  << already ok >>             <<07392>>41685000
   ELSE                           << round up to next block >> <<07392>>41690000
      CIRFILESIZE := OLDFILESIZE + DOUBLE(BLOCKFACTOR) -       <<07392>>41695000
                      (FILESIZE MOD DOUBLE(BLOCKFACTOR));      <<07392>>41700000
END;  << cirfilesize >>                                        <<07392>>41705000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - SPOOLFOPEN      "        <<06272>>41710000
   SUBROUTINE SPOOLFOPEN;                                               41715000
      <<WRITES FOPEN CONTROL + FORMS MSG IF OUTPUT SPOOLFILE            41720000
        DB MUST BE SET TO STACK >>                                      41725000
      BEGIN                                                             41730000
      IF AOPWRITE AND (FOPDOMAIN = 0 OR  RESULT > 2 OR         <<*8802>>41735000
         GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX)) THEN       <<01882>>41740000
         BEGIN                                                          41745000
                                                               <<04515>>41750000
         <<*************************************************>> <<04515>>41755000
         << If FORMMSG is specified, set up RECSIZE length. >> <<04515>>41760000
         << If the FORMMGS is on an odd byte count, we must >> <<04515>>41765000
         << place a blank in front of the byte pointed to   >> <<04515>>41770000
         << by FORMMSG and start from FORMMSG(-1).          >> <<04515>>41775000
         <<*************************************************>> <<04515>>41780000
                                                               <<04515>>41785000
          SAVECHARS := "  ";     << Initialize save characs.>> <<04515>>41790000
          IF NOT PMAP.(8:1) THEN                               <<04515>>41795000
             BEGIN                                             <<04935>>41800000
             RECSIZE := 0;  << No forms message             >> <<04935>>41805000
             @FORMMSG := 0; << Initialize for IOMOVE.       >> <<04935>>41810000
             END                                               <<04935>>41815000
           ELSE                  << Forms message specified >> <<04935>>41820000
               BEGIN                                           <<04515>>41825000
               SAVECHARS.(0:8) := FORMMSG(49); << Place "." >> <<04515>>41830000
               FORMMSG(49) := "."; << to insure termination >> <<04515>>41835000
               IF @FORMMSG.(15:1) = 0 THEN                     <<04515>>41840000
                  BEGIN  << Even byte count, easy case.     >> <<04515>>41845000
                  SCAN FORMMSG UNTIL "..",1;                   <<04515>>41850000
                  RECSIZE := - (TOS - @FORMMSG);               <<04515>>41855000
                  END                                          <<04515>>41860000
               ELSE                                            <<04515>>41865000
                  BEGIN  <<Odd byte count, hard case.       >> <<04515>>41870000
                  SAVECHARS.(8:8) := FORMMSG(-1);              <<04515>>41875000
                  FORMMSG(-1) := " ";  << Leading blank     >> <<04515>>41880000
                  SCAN FORMMSG(-1) UNTIL "..",1;               <<04515>>41885000
                  RECSIZE := - (TOS - @FORMMSG(-1));           <<04515>>41890000
                  END;                                         <<04515>>41895000
               FORMMSG(49) := SAVECHARS.(0:8);                 <<04515>>41900000
               END;                                            <<04515>>41905000
                                                               <<04515>>41910000
         << Write special spoolfile FOPEN record.           >> <<04515>>41915000
                                                               <<04515>>41920000
         WRITE'FOPEN'RECORD(RECSIZE,FORMMSG,SP'ACBBLK,AFTX);   <<04515>>41925000
                                                               <<04515>>41930000
         << Place character back in case of odd byte address>> <<04515>>41935000
         IF SAVECHARS.(8:8) <> " "                             <<04515>>41940000
            THEN FORMMSG(-1) := SAVECHARS.(8:8);               <<04515>>41945000
                                                               <<04515>>41950000
         ALLOCFLAB;  << allot stack buffer of 128 words >>     <<SP.11>>41955000
         FREADLABEL(AFTX, FLAB); << read u-label 0 >>          <<SP.11>>41960000
         IF > THEN                                             <<SP.11>>41965000
            BEGIN  << must initialize first u-label to 0. >>   <<SP.11>>41970000
            FLAB := 0;                                         <<SP.11>>41975000
            MOVE FLAB(1) := FLAB, (127); << zero the buffer >> <<SP.11>>41980000
            SPULAB'LASTFOPEN := 1;                             <<SP.11>>41985000
            SPULAB'FOPENENTRY := -1; << initialize >>          <<SP.11>>41990000
            SPULAB'TOTULAB := NUMSPULABS;                      <<SP.11>>41995000
           << Initialize to CR in case there's no env file >>  <<02555>>42000000
           SPULAB'LAST'ENV := %006415;                         <<02555>>42005000
            END;                                               <<SP.11>>42010000
         IF SPULAB'LASTFOPEN = MAXFOPENULAB AND                <<SP.11>>42015000
            SPULAB'FOPENENTRY = MAXFOPENENTRY THEN             <<SP.11>>42020000
   << filled up u-label with > 320 FOPENS >>                   <<SP.11>>42025000
         ELSE                                                  <<SP.11>>42030000
            BEGIN                                              <<SP.11>>42035000
            IF SPULAB'FOPENENTRY = MAXFOPENENTRY THEN          <<SP.11>>42040000
               BEGIN                                           <<SP.11>>42045000
               SPULAB'FOPENENTRY := 0;                         <<SP.11>>42050000
               SPULAB'LASTFOPEN := SPULAB'LASTFOPEN+1;         <<SP.11>>42055000
               END                                             <<SP.11>>42060000
            ELSE                                               <<SP.11>>42065000
               SPULAB'FOPENENTRY := SPULAB'FOPENENTRY+1;       <<SP.11>>42070000
            DP'INDEX := 0;                                    <<SP.ENV>>42075000
            IF DEVPARMS <> 0 THEN                             <<SP.ENV>>42080000
               GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX);      <<02555>>42085000
            FWRITELABEL(AFTX, FLAB);                           <<SP.11>>42090000
            ULAB := SPULAB'LASTFOPEN;                          <<SP.11>>42095000
            ULABENTRY := SPULAB'FOPENENTRY; << save current info >>     42100000
            FREADLABEL(AFTX, FLAB,,ULAB);                      <<SP.11>>42105000
            IF > THEN                                          <<SP.11>>42110000
               BEGIN  << initialize u-label >>                 <<SP.11>>42115000
               FLAB := 0;                                      <<SP.11>>42120000
               MOVE FLAB(1) := FLAB, (127);                    <<SP.11>>42125000
               END;                                            <<SP.11>>42130000
            FLABDBL(ULABENTRY*2) := SP'ACBBLK; << store var blk nr. >>  42135000
            FLABDBL(ULABENTRY*2+1) := 0D; << store FCLOSE dblword >>    42140000
            FWRITELABEL(AFTX, FLAB,,ULAB); << write u-label >> <<SP.11>>42145000
            END;                                               <<SP.11>>42150000
         ASSEMBLE(SUBS 128);   << deallocate stack buffer >>   <<SP.11>>42155000
         END;                                                           42160000
      END;                                                              42165000
                                                                        42170000
                                                               <<04679>>42175000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - SPOOLFILE'PURGE "        <<06272>>42180000
SUBROUTINE SPOOLFILE'PURGE(AFTX,ODDX,INDEX,A);                 <<04679>>42185000
VALUE AFTX,ODDX,INDEX,A;                                       <<04679>>42190000
INTEGER AFTX,ODDX,INDEX,A;                                     <<04679>>42195000
                                                               <<04679>>42200000
<<**********************************************************>> <<04679>>42205000
<< This subroutine is used to lock and purge an open spool- >> <<04679>>42210000
<< file when encountering an error reading the environment  >> <<04679>>42215000
<< file.                                                    >> <<04679>>42220000
<<                                                          >> <<04679>>42225000
<< Input variables:                                         >> <<04679>>42230000
<<    AFTX - File number of currently open file.            >> <<04679>>42235000
<<    ODDX - Word index into ODD of the spoolfile. Bit 1 is >> <<04679>>42240000
<<           on to indicate output spoolfile.               >> <<04679>>42245000
<<    INDEX- A zero is passed in to reserve space for a     >> <<04679>>42250000
<<           local variable.  It is the word index into     >> <<04679>>42255000
<<           the ODD without the top bit on.                >> <<04679>>42260000
<<    A    - Also used as a local variable for GETSIR.      >> <<04679>>42265000
<<**********************************************************>> <<04679>>42270000
                                                               <<04679>>42275000
BEGIN                                                          <<04679>>42280000
FCLOSE(AFTX,0,0);          << First, close it out.          >> <<04679>>42285000
IF ODDX = 0 THEN RETURN;   << Not actually a spoolfile.     >> <<06080>>42290000
INDEX := ODDX.(1:15);      << Word index w/o top bit on.    >> <<04679>>42295000
<< Next  lock the ODD entry so it won't print.              >> <<04679>>42300000
A := GETSIR(ODDSIR);       << First, obtain the ODD SIR.    >> <<04679>>42305000
EXCHANGEDB(ODDDST);        << Get to ODD.                   >> <<04679>>42310000
IF ADB0(INDEX).(2:1) = 0 THEN                                  <<04679>>42315000
   BEGIN                   << Already printed, goodbye!     >> <<04679>>42320000
   EXCHANGEDB(0);          << Back to stack.                >> <<04679>>42325000
   RELSIR(ODDSIR,A)        << elease ODD SIR.               >> <<04679>>42330000
   END                                                         <<04679>>42335000
ELSE                                                           <<04679>>42340000
   BEGIN                   << It didn't print yet.          >> <<04679>>42345000
   ADB0(INDEX).(1:2) := 3; << Lock the ODD entry, 3 is lock.>> <<04679>>42350000
   EXCHANGEDB(0);          << Back to the stack.            >> <<04679>>42355000
   RELSIR(ODDSIR,A);       << Release the ODD SIR now.      >> <<04679>>42360000
   AFTX := FSOPEN(,%305,%400,ODDX); << FOPEN as spoolfle.   >> <<04679>>42365000
   IF = THEN               << If it failed, then forget it! >> <<04679>>42370000
      FSCLOSE(AFTX,4,0);   << Purge it, don't check CC!     >> <<04679>>42375000
   END;                                                        <<04679>>42380000
END;                                                           <<04679>>42385000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - ALLOC           "        <<06272>>42390000
   LOGICAL SUBROUTINE ALLOC (OLD);                                      42395000
      <<ALLOCATES NON-SHARABLE (NON-DISC) DEVICES.                      42400000
                                                                        42405000
        INPUT PARAMETERS:                                               42410000
            OLD - OLD FILE FLAG                                         42415000
               TRUE - OLD FILE                                          42420000
               FALSE - NEW FILE                                         42425000
      >>                                                                42430000
      VALUE OLD;                                                        42435000
      INTEGER OLD;                                                      42440000
      BEGIN                                                             42445000
      IF NOT JOBF THEN  <<ALLOCATE DEVICE?>>                            42450000
         BEGIN                                                          42455000
         @FIDS := @FD&LSR(1);                                           42460000
         MOVE FIDS := USERID,(4),2;  <<USER NAME>>                      42465000
         MOVE * := HANAME,(4),2;  <<HOME ACCOUNT NAME>>                 42470000
         TOS := PXG'JITDST; TOS := JITJN;                      <<06513>>42475000
         TOS := 4;                                                      42480000
         ASSEMBLE(MFDS 3);  <<JOB NAME>>                                42485000
         MOVE * := FN,(4);  <<LOCAL FILE NAME>>                         42490000
         TOS := @JNUM;                                                  42495000
         TOS := PXG'JITDST; TOS := JITJNUM;                    <<06513>>42500000
         TOS := 1;                                                      42505000
         ASSEMBLE(MFDS 4);  <<GET JOB NUMBER TO STACK>>        <<00300>>42510000
         MOVE NOFORMS := ". ";                                 <<01139>>42515000
         IF NOT PMAP.(8:1) THEN @FORMMSG := @NOFORMS;          <<01139>>42520000
                                                                        42525000
         TOS := IF (X := AOPACTYPE) = 0 THEN 0                          42530000
                   ELSE IF X < 4 THEN 1 ELSE 2;                         42535000
         ACCESSW := TOS LOR (FOPFORMAT&LSL(2))                          42540000
                        LOR (FOPASCII&LSL(4));                          42545000
         CTFLAGS := ACCESSW;                                   <<TL.02>>42550000
         CTFLAGS.(7:1) := FOPLABELLED;                         <<TL.02>>42555000
         << Indicate $STDIN/LIST for use by ND cap. check.  >> <<04993>>42560000
         IF FOPSTDIN OR FOPSTDLIST OR FOPSTDINX OR             <<S7701>>42565000
            DEVINFO'LDEV = LOG(PXG'INPUTLDEV) OR               <<S7701>>42570000
            DEVINFO'LDEV = LOG(PXG'OUTPUTLDEV)                 <<S7701>>42575000
            THEN CTFLAGS.(13:1) := 1;                          <<S7701>>42580000
         X := ALLOCATE(DEVINFO,OLD,OUTPRI,FIDS,JID,FORMMSG,             42585000
            JNUM,NUMCOPIES,DEVINFO,XDDEP,CTFLAGS);             <<TL.02>>42590000
         IF > THEN  <<ERROR?>>                                          42595000
            BEGIN                                                       42600000
            IF X = 3 THEN TOS := NONSHAR                       <<*****>>42605000
            ELSE TOS := NAVAILDEV;                                      42610000
            GO ERR                                                      42615000
            END;                                                        42620000
         ACCESSW.(14:2) := CTFLAGS.(14:2);                     <<01815>>42625000
         ALLOC := ALLOC'RESULT := X;                           <<00635>>42630000
         RESOURCES.DEVICELOCK := TRUE  <<SET ALLOCATION FLAG>>          42635000
         END                                                            42640000
      ELSE  <<DEVICE PRE-ALLOCATED>>                                    42645000
         BEGIN                                                          42650000
         ALLOC'RESULT := 0; << get that initialized >>         <<02381>>42655000
         TOS := @XDD'SUBENTRY;                                 <<06862>>42660000
         TOS := @XDDEP;                                                 42665000
         TOS.(0:1) := 0;                                                42670000
         IF = THEN BEGIN ACCESSW := 0; TOS := IDDDST; END               42675000
              ELSE BEGIN ACCESSW := 1; TOS := ODDDST; END;              42680000
         ASSEMBLE(XCH);                                                 42685000
         TOS := SIZE'OF'XDD'SUBENTRY;                          <<06862>>42690000
         ASSEMBLE(MFDS 4);  ! Copy XDD entry to stack.         <<06862>>42695000
         TOS := XDDSD'DISC'LABEL;                              <<06862>>42700000
         BS1 := 0;          ! Clear out volume table index.    <<06862>>42705000
         SPDISKADDR := TOS; ! Set spoolfile disk address.      <<06862>>42710000
         SPDADDR := LUN(XDDS'SPOOFLE'VT'INDEX,0);              <<06862>>42715000
         IF XDDS'VIRTUAL'LDEV <> 0  ! Get LDEV, virtual/real.  <<06862>>42720000
            THEN DEVINFO'LDEV := XDDS'VIRTUAL'LDEV             <<06862>>42725000
            ELSE DEVINFO'LDEV := XDDS'DEVICE;                  <<06862>>42730000
         TOS := @DEVINFO(1);                                            42735000
         TOS := LPDTDST; TOS := DEVINFO'LDEV*LPDTENTRY;        <<06515>>42740000
         TOS := LPDTENTRY;                                              42745000
         ASSEMBLE(MFDS 3);                                              42750000
         TOS := LDTDST; TOS := DEVINFO'LDEV*LDTENTRY;          <<06515>>42755000
         TOS := LDTENTRY;                                               42760000
         ASSEMBLE(MFDS 4)                                               42765000
         END;                                                           42770000
                                                               <<06306>>42775000
      <<****************************************************>> <<06306>>42780000
      << If the device is in a spoolclass, then set spool   >> <<06306>>42785000
      << flag.  Otherwise, it could be a spooled device but >> <<06306>>42790000
      << not in a spooled class, set flag based on LDT bit. >> <<06306>>42795000
      <<****************************************************>> <<06306>>42800000
                                                               <<06306>>42805000
      @LDT := @DEVINFO(5); ! Set LDT pointer within array.     <<06515>>42810000
      IF ALLOC'RESULT = SPOOLEDCLASS                           <<06306>>42815000
         THEN SPOOLF := USER'SPOOLF'FLAG                       << 8485>>42820000
         ELSE SPOOLF := DEVINFO'VIRTUAL'DEVICE;                <<06515>>42825000
      AOPTIONS.(13:1) := AOPTIONS.(13:1) LAND ACCESSW.(14:2)=2;         42830000
      IF ACCESSW.(14:2) = 0 THEN AOPTIONS.(14:2) := 0;                  42835000
      USECNT := LDT'FILE'USE'CNT;                              <<06515>>42840000
      VDADDR := LDT'VOLUME'TBL'INDEX;                          <<06515>>42845000
      DADDR := DEVINFO'LDEV;                                   <<06515>>42850000
      DEFRS := LDT'RECORD'WIDTH;                               <<06515>>42855000
      DTYPE := LDT'DEVICE'TYPE;                                <<06515>>42860000
      END;                                                              42865000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - UPDATE'FCB      "        <<06272>>42870000
   SUBROUTINE UPDATE'FCB(FCBV);                                <<04624>>42875000
   VALUE FCBV;DOUBLE FCBV;                                     <<06514>>42880000
                                                               <<04624>>42885000
      <<****************************************************>> <<04624>>42890000
      << Updates the actual FCB in the control block (where >> <<04624>>42895000
      << ever it may be) by overlaying  it with the updated >> <<04624>>42900000
      << FCB that exists on the stack. Do not copy FCB(0).  >> <<04624>>42905000
      << The FCB is actually already locked, we use LOCK'CB >> <<06514>>42910000
      << for convienience since it calculated the offsets   >> <<06514>>42915000
      << for the MDS to the FCB for us.                     >> <<06514>>42920000
      <<****************************************************>> <<04624>>42925000
                                                               <<04624>>42930000
      BEGIN                                                    <<04624>>42935000
      GET'FCB'Q'LOC;                                           <<04624>>42940000
      LOCK'CB(0,0,FCBMQ,FCBV);                                 <<06514>>42945000
      TOS := TOS + 1;   << Copy to FCB(1) in control block. >> <<04624>>42950000
      ASSEMBLE(DXCH);   << Switch source and targer address.>> <<04624>>42955000
      TOS := TOS + 1;   << Copy starting FCB(1) in stack.   >> <<04624>>42960000
      TOS := FCBSI-1;   << Now copy the FCB back to CB table>> <<04624>>42965000
      MOVE'DS'5;                                               <<04624>>42970000
      DEL;              << Delete FLAGS parm. from LOCK'CB. >> <<04624>>42975000
      UNLOCK'CB(0,FCBV);                << Unlock it.       >> <<06514>>42980000
                                                               <<04624>>42985000
      END;                                                     <<04624>>42990000
                                                               <<06514>>42995000
                                                               <<06514>>43000000
<<                     INIT'AFT                             >> <<06514>>43005000
                                                               <<06514>>43010000
                                                               <<06514>>43015000
SUBROUTINE INIT'AFT;                                           <<06514>>43020000
                                                               <<06514>>43025000
<<**********************************************************>> <<06514>>43030000
<< This subroutine initializes the AFT entry for the new    >> <<06514>>43035000
<< file.  It could be a global AFT entry or a local AFT.    >> <<06514>>43040000
<<**********************************************************>> <<06514>>43045000
                                                               <<06514>>43050000
BEGIN                                                          <<06514>>43055000
IF AOPGLOBALAFT THEN                                           <<06514>>43060000
   BEGIN                                                       <<06514>>43065000
   EXCHANGEDB(GLOBAL'AFT'DSTN);                                <<06514>>43070000
   @AFT := \FILENUM\*AFTENTRY;<< Set pointer in extra DST.  >> <<06514>>43075000
   END                                                         <<06514>>43080000
ELSE                                                           <<06514>>43085000
   BEGIN                                                       <<06514>>43090000
   SETAFT;                    << Set pointer to PXFILE area.>> <<06514>>43095000
   END;                                                        <<06514>>43100000
                                                               <<06514>>43105000
IF FOPNULL THEN                                                <<06514>>43110000
   BEGIN                                                       <<06514>>43115000
   AFTPACBVDSTN := 0;         << Clear DSTN global reserve? >> <<06514>>43120000
   AFTNULL := 1;              << $NULL AFTE, only 1 bit set.>> <<06514>>43125000
   END                                                         <<06514>>43130000
ELSE                                                           <<06514>>43135000
   BEGIN                                                       <<06514>>43140000
   IF FOPMSGFILE AND NOT AOPCOPY                               <<06514>>43145000
      THEN AFTTYPE := MSG'TYPE;                                <<06514>>43150000
   AFTPACBVDSTN := PACBV'DSTN;                                 <<06514>>43155000
   AFTPACBVENTRY:= PACBV'ENTRY;                                <<06514>>43160000
   AFTLACBVDSTN := LACBV'DSTN;                                 <<06514>>43165000
   AFTLACBVENTRY:= LACBV'ENTRY;                                <<06514>>43170000
   END;                                                        <<06514>>43175000
IF AOPGLOBALAFT                                                <<06514>>43180000
   THEN EXCHANGEDB(0);     << Back to stack for global.     >> <<06514>>43185000
END;                                                           <<06514>>43190000
                                                               <<06514>>43195000
                                                               <<06514>>43200000
SUBROUTINE CLEAR'GLOBAL'AFT;                                   <<06514>>43205000
                                                               <<06514>>43210000
<<**********************************************************>> <<06514>>43215000
<< Clears a reserved global AFT if an error occured or if   >> <<06514>>43220000
<< FOPENDA is called.  FOPENDA will allocate his own.       >> <<06514>>43225000
<<**********************************************************>> <<06514>>43230000
                                                               <<06514>>43235000
BEGIN                                                          <<06514>>43240000
EXCHANGEDB(GLOBAL'AFT'DSTN);                                   <<06514>>43245000
@AFT := \FILENUM\ * AFTENTRY; << Set pointer to AFT.        >> <<06514>>43250000
AFTPACBVDSTN := 0;            << Was set to -1 to reserve.  >> <<06514>>43255000
EXCHANGEDB(0);                << DB back to the stack.      >> <<06514>>43260000
END;                                                           <<06514>>43265000
$PAGE " MPE-V FILE SYSTEM - FOPEN - CHECK'MULTI'ACCESS "       << 8543>>43270000
SUBROUTINE CHECK'MULTI'ACCESS;                                 << 8543>>43275000
                                                               << 8543>>43280000
!------------------------------------------------------------- << 8543>>43285000
! This subroutine checks to see if the file is multi-access.   << 8543>>43290000
! If the file is to be opened for multi-acc., then scan the    << 8543>>43295000
! FMAVT.  If an entry exists for the file, then the  file was  << 8543>>43300000
! previously opened multi-access and the PACB exists already.  << 8543>>43305000
! SCANFMAVT will return the PACBV.  We then lock the  PACB     << 8543>>43310000
! via COND'LOCK'ACB and set the PACB locked flag.  We send the << 8543>>43315000
! SIR's so that we will release them if we must impede on the  << 8543>>43320000
! ACB to insure that the locking conventions set up by our     << 8543>>43325000
! mighty and nobel MPE forefathers are followed and so that we << 8543>>43330000
! do not tie up the SIR's while impeding on the ACB.  FOPENDA  << 8543>>43335000
! and subsequently SETACB will heed the PACBLOCKED flag and    << 8543>>43340000
! will not bother to lock the PACB themselves.                 << 8543>>43345000
!------------------------------------------------------------- << 8543>>43350000
                                                               << 8543>>43355000
BEGIN                                                          << 8543>>43360000
IF AOPMULTAC <> 0 THEN                                         << 8543>>43365000
   BEGIN                                                       << 8543>>43370000
   FMAVT'FLAGS := 0;       ! Default job, disk, search.        << 8543>>43375000
   FMAVT'FLAGS.(12:1) := AOPGLOBALMULTAC;                      << 8543>>43380000
   FADDRW1.(0:8) := DADDR; ! Upper 8 bits needs LDEV.          << 8543>>43385000
   PACBV := SCANFMAVT(FMAVT'FLAGS,,FADDRW1,FADDRW2);           << 8543>>43390000
   IF PACBV <> 0D THEN                                         << 8543>>43395000
      BEGIN                ! Found one, lock it.               << 8543>>43400000
      COND'LOCK'ACB(PACBV,B,A);                                << 8543>>43405000
      PACBLOCKED := TRUE;  <<SET PACB LOCKED FLAG>>            << 8543>>43410000
      END                                                      << 8543>>43415000
   END;                                                        << 8543>>43420000
END;                                                           << 8543>>43425000
$PAGE "  MPE-V  FILE SYSTEM - FOPEN - MAIN BLOCK      "        <<06272>>43430000
                                                                        43435000
   <<* * * INITIALIZE PARAMETERS * * *>>                                43440000
                                                                        43445000
   IF (SPOOLF := FALSE) THEN                                            43450000
      BEGIN                                                             43455000
FSOPEN:             <<SPOOLFILE SEC ENTRY POINT>>                       43460000
      SPOOLF := TRUE;                                                   43465000
      END;                                                              43470000
   IF (JOBF := FALSE) THEN                                              43475000
      BEGIN         <<JOB/CI $STDXX SEC ENTRY POINT>>                   43480000
FJOPEN:                                                                 43485000
      JOBF := TRUE;                                                     43490000
      SPOOLF := FALSE;                                                  43495000
      END;                                                              43500000
   IF (KSF:=FALSE) THEN                                        <<KS.00>>43505000
   BEGIN << KSAM SECONDARY ENTRY POINT>>                       <<KS.00>>43510000
KSOPEN:                                                        <<KS.00>>43515000
      KSF:=TRUE;                                               <<KS.00>>43520000
      SPOOLF:=JOBF:=FALSE;                                     <<KS.00>>43525000
   END; <<KSAM SECONDARY ENTRY POINT>>                         <<KS.00>>43530000
   IF (PVOPEN' := FALSE) THEN                                  <<RV.PV>>43535000
   BEGIN  <<ENTRY POINT FOR CONDITIONAL MOUNTS>>               <<RV.PV>>43540000
PVOPEN:                                                        <<RV.PV>>43545000
       PVOPEN' := TRUE;                                        <<RV.PV>>43550000
       KSF := SPOOLF := JOBF := FALSE;                         <<RV.PV>>43555000
   END;                                                        <<RV.PV>>43560000
   IF (MUSTOPEN' := FALSE) THEN                                <<RV.PV>>43565000
   BEGIN  <<ENTRY TO BYPASS LOCKWORD/ACCESS CHECK>>            <<00097>>43570000
MUSTOPEN:                                                      <<RV.PV>>43575000
       MUSTOPEN' := TRUE;                                      <<RV.PV>>43580000
       PVOPEN' := KSF := SPOOLF := JOBF := FALSE;              <<RV.PV>>43585000
   END;                                                        <<RV.PV>>43590000
   IF (DIRACCF:=FALSE) THEN                                    <<00199>>43595000
      BEGIN                                                    <<00199>>43600000
DFOPEN:                                                        <<00199>>43605000
      DIRACCF:=TRUE;                                           <<00199>>43610000
      MUSTOPEN':=PVOPEN':=KSF:=SPOOLF:=JOBF:=FALSE;            <<00199>>43615000
      END;                                                     <<00199>>43620000
   IF (RECOVER5 := FALSE) THEN                                 <<*8508>>43625000
      BEGIN                                                    <<*8508>>43630000
ROPEN:                                                         <<*8508>>43635000
      RECOVER5 := TRUE;                                        <<*8508>>43640000
      DIRACCF:=PVOPEN':=MUSTOPEN':=KSF:=SPOOLF:=JOBF:=FALSE;   <<*8508>>43645000
      END;                                                     <<*8508>>43650000
                                                                        43655000
$  IF X0 = ON                                                           43660000
   IF MONCALLABLE THEN  <<MONITORING?>>                                 43665000
      BEGIN                                                             43670000
      TOS := "FO"; TOS := "PE"; TOS := "N ";                            43675000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        43680000
      FTITLE(*,*,*,*);                                                  43685000
      DEBUG                                                             43690000
      END;                                                              43695000
$  IF                                                                   43700000
                                                                        43705000
   ERRORON;                                                             43710000
   IPCINFO:=0; MOVE IPCINFO(1):=IPCINFO,(5);                   <<HM.00>>43715000
                                                               <<03509>>43720000
   <<*******************************************************>> <<06052>>43725000
   << Insure that there will be enough stack space while    >> <<06052>>43730000
   << FOPEN is critical. If the process is already critical >> <<06052>>43735000
   << then don't perform the ADDS, we'll just have to take  >> <<06052>>43740000
   << our chances since we are critical anyway.             >> <<06052>>43745000
   <<*******************************************************>> <<06052>>43750000
                                                               <<03509>>43755000
   PCBPT := CURPRC;      << Obtain our process number.      >> <<06514>>43760000
   IF NOT SPCBCRIT THEN                                        <<06514>>43765000
      BEGIN                                                    <<06052>>43770000
      TOS := %1130;                                            <<06372>>43775000
      ASSEMBLE (ADDS 0);                                       <<06052>>43780000
      TOS := %1130;                                            <<06372>>43785000
      ASSEMBLE (SUBS 0);                                       <<06052>>43790000
      END;                                                     <<06052>>43795000
                                                               <<03509>>43800000
   CRIT := SETCRITICAL;  <<GET INTO CRITICAL MODE>>                     43805000
   @XDDEP := 0; SPVDEV := 0;                                   <<06311>>43810000
   IF AOPACTYPE=%(2)1111 AND P'AOPS THEN                       <<00107>>43815000
      BEGIN                                                    <<00107>>43820000
      COMMENT:                                                 <<00107>>43825000
        INPUT-ONLY ACCESS WITHOUT SECURITY CHECK.  NOTE        <<00107>>43830000
        THAT LOCKWORD CHECK IS STILL PERFORMED UNLESS          <<00107>>43835000
        "MUSTOPEN" IS CALLED.  ADDED FOR C.I. TO IMPLEMENT     <<00107>>43840000
        :ALTSEC, :RELEASE AND :SECURE COMMANDS;                <<00107>>43845000
                                                               <<00107>>43850000
      IF NOT PRIVMODE THEN                                     <<00107>>43855000
         BEGIN                                                 <<00107>>43860000
         TOS := ILLCAP;                                        <<00107>>43865000
         GOTO ERR;                                             <<00107>>43870000
         END;                                                  <<00107>>43875000
      AOPACTYPE := 0; <<INONLY>>                               <<00107>>43880000
      CHECKSEC := FALSE; <<NO ASEC CHECK>>                     <<00107>>43885000
      END;                                                     <<00107>>43890000
   IF SPOOLF OR JOBF THEN                                               43895000
      BEGIN                                                             43900000
      IF NOT PRIVMODE THEN                                              43905000
         BEGIN                                                          43910000
         TOS := ILLCAP;                                                 43915000
         GO ERR                                                         43920000
         END;                                                           43925000
      IF PMAP <> %7000 THEN                                             43930000
         BEGIN                                                          43935000
         TOS := ILLPARM;                                                43940000
         GO ERR                                                         43945000
         END;                                                           43950000
      @XDDEP := XDDX;                                                   43955000
      PMAP.(6:1) := 0                                                   43960000
      END;                                                              43965000
   CHECKDB;  <<WHERE'S DB?>>                                            43970000
   IF <> THEN  <<DB NOT AT STACK?>>                                     43975000
      BEGIN                                                             43980000
      TOS := EXCHANGEDB(0);  <<SET DB TO STACK>>                        43985000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              43990000
      PXFFOPEN := ILLDB;  <<ERROR NR.>>                                 43995000
      ASSEMBLE(ZERO,XCH);                                               44000000
      EXCHANGEDB(*);  <<RESET DB TO ORIG.>>                             44005000
      TOS := ILLDB;                                                     44010000
      GO ERR                                                            44015000
      END;                                                              44020000
                                                               <<00300>>44025000
   <<* * * ALLOCATE AFT ENTRY * * *>>                          <<00300>>44030000
                                                               <<00300>>44035000
   IF NOT PMAP.(5:1) THEN AOPTIONS := 0;                       <<06514>>44040000
   IF AOPGLOBALAFT                                             <<06514>>44045000
      THEN AFTX := FIND'GLOBAL'AFTENT                          <<06514>>44050000
      ELSE AFTX := FINDANYAFTENT;                              <<06514>>44055000
   IF < THEN GO E4';             << PXFILE expansion failed.>> << 8543>>44060000
   IF AOPGLOBALAFT                                             <<06514>>44065000
      THEN RESOURCES.GLOBAFT:=1; << Global AFT reserved.    >> <<06514>>44070000
                                                               <<00300>>44075000
   DEVPARMS(0) := 0;      << initialize array >>              <<SP.ENV>>44080000
   IF USER'SPOOLF THEN                                         << 8485>>44085000
      BEGIN                                                             44090000
SPOOLL:          <<SPOOLED DEV RESTART>>                                44095000
      SPVDEV := DADDR;                                                  44100000
      SPFOPT := FOPTIONS;                                               44105000
      SPAOPT := AOPTIONS;                                               44110000
      IF RECSIZE > 1012 THEN RECSIZE := 1012;                  <<01.03>>44115000
      SPREC := DTYPE&LSL(10)+RECSIZE;                                   44120000
      SPSTATE := STATE;                                                 44125000
      MOVE SPFN := FN, (4);                                             44130000
      TOS := (FOPTIONS LAND %407) LOR %300;                             44135000
      TOS.(14:1) := 0;                                                  44140000
      IF <> THEN TOS.(15:1) := 1;                                       44145000
      IF (JOBF LAND AOPREAD) OR (NOT JOBF LAND USECNT > 1) THEN         44150000
         TOS.(15:1) := 1;  <<FORCE "OLD" >>                             44155000
      FOPTIONS := TOS;                                                  44160000
      AOPTIONS := (AOPTIONS LAND %3317) LOR %1300;                      44165000
      IF DTYPE = TERMINAL THEN <<IF TERMINAL THEN OUTPUT SPOOLE<<00552>>44170000
         FOPDOMAIN := 0;  <<NEW FILE>>                         <<00552>>44175000
      PMAP := (PMAP LAND %200) LOR %6100;                      <<SP.13>>44180000
      IF FOPDOMAIN = 0 THEN     << is it new file? >>          <<SP.11>>44185000
         USERLABELS := NUMSPULABS;    << 0 is reference >>     <<SP.11>>44190000
        << Labels 1-10 are for FOPEN/FCLOSE pointers. >>       <<SP.11>>44195000
        << Labels 11-27 are for circular queue page ejects. >> <<SP.11>>44200000
      <<STATE : INIT ALREADY>>                                          44205000
      END;                                                              44210000
   PXGLOBAL;               ! Set PCBGLOBLOC.                   <<06513>>44215000
   TOS := @JITINFO;                                                     44220000
   TOS := PXG'JITDST; TOS := JITEOF;                           <<06868>>44225000
   TOS := 24;                                                           44230000
   ASSEMBLE(MFDS 4);  <<COPY JIT INFO>>                                 44235000
                                                               <<06868>>44240000
   SETPXFILE;  <<PXFILE POINTER>>                                       44245000
   TOS := @ACCTINDEX;                                          <<38.PV>>44250000
   TOS := PXG'JITDST;                                          <<06513>>44255000
   TOS := ACCTINXPTR;                                          <<38.PV>>44260000
   TOS := 2;                                                   <<38.PV>>44265000
   ASSEMBLE (MFDS 4);  <<ACCT INDEX DOUBLE WORD>>              <<38.PV>>44270000
   TOS := @GRPINDEX;                                           <<38.PV>>44275000
   TOS := PXG'JITDST;                                          <<06513>>44280000
   TOS := GRPINXPTR+(JITMTFF & LSL (1));                       <<38.PV>>44285000
   TOS := 2;                                                   <<38.PV>>44290000
   ASSEMBLE (MFDS 4);  <<GRP INDEX DOUBLE WORD>>               <<38.PV>>44295000
   TOS := @FNAMES&LSL(1); BPS0 := " ";  <<CLEAR FILE NAMES>>            44300000
   ASSEMBLE(DUP,INCB); MOVE * := *,(31);                                44305000
                                                                        44310000
   <<* * * DEFAULT MISSING PARAMETERS * * *>>                           44315000
                                                                        44320000
STARTOVER:   << Restart FOPEN for opens of $STDIN and     >>   <<01425>>44325000
             << $STDLIST other than the initial opens.    >>   <<01425>>44330000
   TOS := PMAP;  <<PARAMETER BIT MAP>>                                  44335000
   IF NOT LS0.(3:1) THEN DNTYPE := 3;                                   44340000
   IF NOT LS0.(4:1) THEN FOPTIONS := 0;                                 44345000
   IF NOT LS0.(5:1) THEN AOPTIONS := 0;                                 44350000
   IF NOT LS0.(6:1) THEN RECSIZE := 0;                                  44355000
   IF NOT LS0.(7:1) OR DEVICE = ";" THEN                      <<SP.ENV>>44360000
      MOVE DEVL := "DISC "                                              44365000
   ELSE                                                                 44370000
      MOVE DEVL := DEVICE, (MAXDEVLEN+1);                      <<02524>>44375000
   IF LS0.(7:1) THEN                                          <<SP.ENV>>44380000
      BEGIN     << Process device parameters, if any >>       <<SP.ENV>>44385000
      DEVPARMFLAG := PARSE'DEV'PARMS(DEVICE,DEVPARMS);        <<SP.ENV>>44390000
      IF DEVPARMFLAG <> 0 THEN                                 << 8485>>44395000
         BEGIN                                                 << 8485>>44400000
         TOS := DP'PARM'ERRORS(DEVPARMFLAG);                   << 8485>>44405000
         GO TO ERR;                                            << 8485>>44410000
         END;                                                  << 8485>>44415000
      END;                                                    <<SP.ENV>>44420000
                                                              <<SP.ENV>>44425000
   IF NOT LS0.(9:1) THEN USERLABELS := 0;                               44430000
   IF NOT LS0.(10:1) OR BLOCKFACTOR <= 0 THEN                           44435000
      BEGIN                                                             44440000
      BLOCKFACTOR := 1;                                                 44445000
      STATE.DEFAULTBF := 1  <<SET DEFAULT BLOCKING FLAG>>               44450000
      END;                                                              44455000
   IF NOT LS0.(11:1) THEN                                               44460000
      PRICOPBUFS := [4/0,7/1,5/DEFBUFFERS]                     <<00.05>>44465000
   ELSE                                                                 44470000
      BEGIN                                                             44475000
      IF OUTPRI > 13 THEN OUTPRI := 13;                        <<06006>>44480000
      IF NUMBUFFERS = 0 THEN NUMBUFFERS := DEFBUFFERS;         <<00.05>>44485000
      IF NUMCOPIES = 0 THEN NUMCOPIES := 1                              44490000
      END;                                                              44495000
   IF NOT LS0.(12:1) OR FILESIZE <= 0D THEN FILESIZE := 1023D;          44500000
   IF NOT LS0.(13:1) OR NUMEXTENTS <= 0 THEN NUMEXTENTS := 8;           44505000
   IF NOT LS0.(14:1) THEN INITALLOC := 1;                               44510000
   IF NOT TOS THEN FILECODE := 0;                                       44515000
   IF SPOOLF THEN  <<SPOOLFILE ACCESS?>>                                44520000
      BEGIN                                                             44525000
      RECSIZE := SPOOLRSIZE; << words >>                       <<*****>>44530000
      NUMEXTENTS := MAXEXTENTS;                                         44535000
      TOS := NUMEXTENTS;                                                44540000
      TOS := ABS(EXTSSECT); << spoofle extent size (sectors) >><<*****>>44545000
      ASSEMBLE(MPYL);        << total sectors >>               <<*****>>44550000
      X := SPOOLRSECT;       << spoofle sectors/block >>       <<*****>>44555000
      DIVD'DEL;              << get nr. of blocks >>           <<*****>>44560000
<< Correct filesize by sector offset for labels. >>            <<SP.21>>44565000
      FILESIZE := TOS-DOUBLE(NUMSPULABS/SPOOLRSECT)-1D;        <<02055>>44570000
      NUMBUFFERS := 2;                                         <<06514>>44575000
      MOVE DEVL := "SPOOL "                                             44580000
      END;                                                              44585000
                                                                        44590000
   <<* * * PARSE DESIGNATOR AND DO FILE EQUATION * * *>>                44595000
                                                                        44600000
   IF DNTYPE <> 3 THEN  <<DESIGNATOR SPECIFIED?>>                       44605000
      BEGIN                                                             44610000
      WFMSG(0):=0;                                             <<TL.02>>44615000
      MOVE FD := FORMDESIGNATOR,(36);  <<COPY DESIGNATOR>>              44620000
NFORMAT:                                                                44625000
       SAVFOPNEQ:=FOPNOEQUATE;    <<PRESERVE NO-EQUATE BIT>>   <<KJ.03>>44630000
      IF NOT LOGICAL(FMLNAME(FD,GN,AN,FOPTIONS)) THEN                   44635000
         BEGIN  << DESIGNATOR WAS $STDIN, ETC. >>              <<00117>>44640000
         DNTYPE := 3;                                                   44645000
         FCOMTRIED := TRUE  <<SET FLAG>>                                44650000
         END                                                            44655000
      ELSE                                                              44660000
         BEGIN  << DESIGNATOR WAS NAME >>                      <<00117>>44665000
         DNTYPE := FNFORMAT(FD,FN,GN,AN,LW);                            44670000
         IF DNTYPE = 4 THEN GO E1  <<ILLEGAL NAME?>>                    44675000
         END;                                                           44680000
      IF NOT FOPNOEQUATE AND NOT FCOMTRIED THEN  <<DO FILE EQUATION?>>  44685000
         BEGIN                                                          44690000
         FCOMTRIED := TRUE;  <<SET FLAG>>                               44695000
         DEVPARMFLAG := 0;    << initialize >>                <<SP.ENV>>44700000
         IF FILECOMVALS(FN,GN,AN,FD,DEVL,FOPTIONS,AOPTIONS,             44705000
            PRICOPBUFS,DISP,RECSIZE,NUMEXTENTS,INITALLOC,               44710000
            BLOCKFACTOR,FILESIZE,FILECODE,STATE,PMAP,FMSG,    <<SP.ENV>>44715000
            DEVPARMS,DEVPARMFLAG) THEN                        <<SP.ENV>>44720000
         IF DEVPARMFLAG <> 0 THEN                              << 8485>>44725000
            BEGIN                                              << 8485>>44730000
            TOS := DP'PARM'ERRORS(DEVPARMFLAG);                << 8485>>44735000
            GO TO ERR;                                         << 8485>>44740000
            END                                                << 8485>>44745000
         ELSE                                                  << 8485>>44750000
            GO NFORMAT; << Used file equation.              >> << 8485>>44755000
         END;                                                  <<TL.02>>44760000
      IF WFMSG(0) <> 0 THEN @FORMMSG := @FMSG+2;               <<TL.02>>44765000
      IF WFMSG(0) <> 0 THEN PMAP.(8:1) := 1;                   <<TL.18>>44770000
      END;                                                              44775000
                                                              <<SP.ENV>>44780000
                                                              <<SP.ENV>>44785000
   DEVPARMFLAG := DP'INDEX := 0;                              <<SP.ENV>>44790000
   DP'DEN := DEN'DEFAULT;  << Initialize density >>            <<02568>>44795000
                                                               <<02568>>44800000
   IF DEVPARMS <> 0 THEN                                       <<02555>>44805000
   BEGIN                     <<device parameters present>>     <<02555>>44810000
      IF GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX) THEN        <<02555>>44815000
      BEGIN                                                    <<02555>>44820000
         PCHECKENV(BDEVPARMS((DP'INDEX+1)&LSL(1)),DEVPARMFLAG, <<02555>>44825000
                   ALLOC'RESULT);                              <<02555>>44830000
         PXGLOBAL;         ! Reset PCBGLOBLOC.                 <<06513>>44835000
         DP'FLAG := DP'ENV'ERRORS(DEVPARMFLAG);                << 8485>>44840000
                                                               <<02555>>44845000
         IF DP'FLAG <> 0 THEN                                  <<02555>>44850000
         BEGIN                                                 <<02555>>44855000
            TOS := DP'FLAG;                                    <<02555>>44860000
            GO ERR;                                            <<02555>>44865000
         END;                                                  <<02555>>44870000
      END;    << of ENVIRONMENT file check >>                  <<02568>>44875000
                                                               <<02568>>44880000
      IF GET'DEV'PARM(DEN'TOKEN,DEVPARMS,DP'INDEX) THEN        <<02568>>44885000
         BEGIN                                                 <<02568>>44890000
         IF NOT PARSE'DENSITY(BDEVPARMS( (DP'INDEX+1)&LSL(1) ),<<02568>>44895000
                              DEVPARMS(DP'INDEX)-1,DP'DEN) THEN<<02568>>44900000
            BEGIN                                              <<02568>>44905000
            TOS := DP'DEN'INVALID;                             <<02568>>44910000
            GOTO ERR;                                          <<02568>>44915000
            END;                                               <<02568>>44920000
         END;    << of density check >>                        <<02568>>44925000
                                                               <<02568>>44930000
   END;    << of device parameters present >>                  <<02568>>44935000
                                                               <<02568>>44940000
   <<* * * ADJUST FOPTIONS AND AOPTIONS * * *>>                         44945000
                                                               <<00.06>>44950000
   USERAOPTIONS:=AOPTIONS;                                     <<HM.00>>44955000
   IF FSOPEN'SPOOLF THEN                                       << 8485>>44960000
      BEGIN  <<ARE WE SQUEEZING?>>                             <<00.06>>44965000
      IF AOPACTYPE = %10 AND @XDDEP.(0:1) = 1 THEN             <<00.06>>44970000
         BEGIN                                                 <<00.06>>44975000
         SPOOLF.(14:1) := 0;                                   <<00.06>>44980000
         AOPACMODE := 1;                                       <<00.06>>44985000
         END;                                                  <<00.06>>44990000
      AOPTIONS := AOPTIONS LAND %177761;                       <<00.06>>44995000
      IF @XDDEP.(0:1) = 1 THEN USERLABELS := NUMSPULABS;       <<01863>>45000000
      END;                                                     <<00.06>>45005000
   BLOCKFACTOR := IF BLOCKFACTOR < 255 THEN BLOCKFACTOR        <<01968>>45010000
      ELSE 255;                                                <<01968>>45015000
   IF = THEN  <<DEFAULT BLOCKING WANTED?>>                              45020000
      BEGIN                                                             45025000
      BLOCKFACTOR := 1;                                                 45030000
      STATE.DEFAULTBF := 1  <<SET DEFAULT BLOCKING FLAG>>               45035000
      END;                                                              45040000
   USERBLKFACTOR:=BLOCKFACTOR;                                 <<HM.00>>45045000
   TOS := AOPMULTAC;                                                    45050000
   IF <> THEN  <<MULTI-ACCESS WANTED?>>                                 45055000
      BEGIN  <<CHANGED IF MSG FILE>>                           <<HM.00>>45060000
      IF S0 = 3 THEN                                           <<HM.00>>45065000
         BEGIN  <<UNDEFINED VALUE FOR MULTIACCESS>>            <<HM.00>>45070000
         TOS:=ACCVIOL;                                         <<HM.00>>45075000
         GO ERR;                                               <<HM.00>>45080000
         END;                                                  <<HM.00>>45085000
      CASE AOPACMODE OF                                                 45090000
         BEGIN                                                          45095000
         IF NOT AOPREAD THEN ASSEMBLE(DEL,ZERO);                        45100000
         ASSEMBLE(DEL,ZERO);                                            45105000
         IF AOPWRITEONLY THEN ASSEMBLE(DEL,ZERO);                       45110000
         ;                                                              45115000
         END                                                            45120000
      END;                                                              45125000
   AOPMULTAC := TOS;                                                    45130000
   IF AOPGLOBALAFT AND NOT PRIVMODE THEN                       <<06514>>45135000
      BEGIN                                                    <<06514>>45140000
      TOS := PRIVVIOL;                                         <<06514>>45145000
      GO ERR;                                                  <<06514>>45150000
      END;                                                     <<06514>>45155000
   IF AOPNOWAIT THEN  <<NO-WAIT I/O WANTED?>>                           45160000
      BEGIN  <<CHANGED IF MSG FILE>>                           <<HM.00>>45165000
      AOPINHIBITBUF := 1;  <<NO BUFFERING FOR NOW>>                     45170000
      AOPMULTIREC := 0;  <<DISALLOW MULTI-RECORD MODE>>                 45175000
      BLOCKFACTOR := 1;  <<DISALLOW BLOCKING>>                          45180000
      AOPMULTAC := 0  <<DISALLOW MULTI-ACCESS>>                         45185000
      END;                                                              45190000
   IF AOPMULTIREC THEN AOPINHIBITBUF := 1;                    <<SP.ENV>>45195000
   IF FOPFILETYPE=3 OR FOPFILETYPE=5 OR FOPFILETYPE=7 THEN     <<HM.00>>45200000
      BEGIN  <<UNDEFINED FILE TYPE>>                           <<HM.00>>45205000
      TOS:=FILETYPEVIOL;                                       <<HM.00>>45210000
      GO ERR;                                                  <<HM.00>>45215000
      END;                                                     <<HM.00>>45220000
   IF FOPVARIABLE AND NOT SPOOLF AND NOT PRIVMODE THEN         <<00.04>>45225000
      BEGIN                                                    <<00.04>>45230000
      FOPFORMAT := 1;  <<FORCE NORMAL FORMAT>>                 <<00.04>>45235000
      END;                                                     <<00.04>>45240000
   IF AOPINHIBITBUF THEN  <<NO BUFFERING?>>                             45245000
      BEGIN                                                             45250000
      AOPMULTAC := 0;                                                   45255000
      END;                                                              45260000
   IF FOPUNDEFINED THEN  <<UNDEFINED RECORD FORMAT?>>                   45265000
      BEGIN                                                             45270000
      BLOCKFACTOR := 1;                                                 45275000
      STATE.DEFAULTBF := 0  <<CLEAR DEFAULT BLOCKING FLAG>>             45280000
      END;                                                              45285000
   IF AOPEXECUTE AND NOT PRIVMODE THEN  <<ILLEGAL EXECUTE?>>            45290000
      BEGIN                                                             45295000
      TOS := ACCVIOL;                                                   45300000
      GO ERR                                                            45305000
      END;                                                              45310000
   IF NUMBUFFERS <= 0 THEN NUMBUFFERS := DEFBUFFERS;           <<+0.05>>45315000
                                                                        45320000
   <<* * * PROCESS ACCORDING TO DESIGNATOR * * *>>                      45325000
                                                                        45330000
   TOS := FOPDESIGNATOR;  <<DESIGNATOR>>                                45335000
   X := S0;  <<PLACE COPY IN X>>                                        45340000
   IF TOS > 6 THEN GO E1;  <<INVALID?>>                                 45345000
   CASE * X OF                                                          45350000
      BEGIN                                                             45355000
                                                                        45360000
      <<FORMAL DESIGNATOR>>                                             45365000
                                                                        45370000
      BEGIN                                                             45375000
              IF DEVL = "#" THEN   << BACK REFERENCE >>        <<DS.04>>45380000
                BEGIN              << TO THE REMOTE  >>        <<DS.04>>45385000
                TOS := 0;          << LINE CONNECTED  TO>>     <<DS.04>>45390000
                PCBPT := CURPRC;                               <<06514>>45395000
                WHILE SPCBPTYPE' <> USER'MAIN DO               <<06729>>45400000
                   PCBPT := SPCBFATHERINFO;                    <<06514>>45405000
                TOS := PCBPT/PCBSIZE;                          <<06514>>45410000
                TOS := SDSLDEVPLABEL;                          <<DS.04>>45415000
                IF = THEN                                      <<DS.04>>45420000
                  BEGIN            << DS NOT IN SYSTEM >>      <<DS.04>>45425000
                  TOS := UNIMPL;                               <<DS.04>>45430000
                  GO TO ERR;                                   <<DS.04>>45435000
                  END;                                         <<DS.04>>45440000
                ASSEMBLE(PCAL 0);  << SDSLDEV >>               <<DS.04>>45445000
                IF S0 = 0 THEN     << NOT A REMOTE >>          <<DS.04>>45450000
                  BEGIN                                        <<DS.04>>45455000
                  TOS := UNDEFDEV;                             <<DS.04>>45460000
                  GO TO ERR;                                   <<DS.04>>45465000
                  END;                                         <<DS.04>>45470000
                TOS := ASCII(LS0,10,LOGICAL'DEV);              <<DS.04>>45475000
                MOVE DEVL(9+S0) := DEVL(9),(-10);              <<02524>>45480000
                    << include terminating byte in move. >>    <<02524>>45485000
                MOVE DEVL := LOGICAL'DEV,(S0); <<INSERT>>      <<DS.04>>45490000
                DDEL;  << LOGICAL DEV AND LENGTH >>            <<DS.04>>45495000
                END;   << BACK FILE REFERENCE >>               <<DS.04>>45500000
      X := GETDEVINFO(DEVL,DEVINFO);  <<GET DEVICE INFO>>               45505000
      IF > THEN  <<ERROR?>>                                             45510000
         BEGIN                                                          45515000
         TOS := UNDEFDEV;                                               45520000
         GO ERR                                                         45525000
         END;                                                           45530000
      IF INT(DEVINFO'LDEV) > 0     ! Set LDT pointer within    <<06515>>45535000
         THEN @LDT := @DEVINFO(6)  ! DEVINFO array, by class   <<06515>>45540000
         ELSE @LDT := @DEVINFO(4); ! or by LDEV.               <<06515>>45545000
      IF LDT'CS'DEVICE THEN GO E8;                             <<06515>>45550000
      DTYPE := DEVINFO'DEVTYPE;                                <<06515>>45555000
      IF DTYPE = HPODIE THEN GO E8; <<Can't fopen odie dev >>  <<*8877>>45560000
      IF DTYPE=SDISC AND AOPNOWAIT THEN                        <<SD.00>>45565000
         BEGIN    << Serial disc - no NO-WAIT I/O. >>          <<01992>>45570000
         TOS := ACCVIOL;                                       <<01992>>45575000
         GOTO ERR;                                             <<SD.00>>45580000
         END;                                                  <<SD.00>>45585000
      DEFRS := LDT'RECORD'WIDTH;                               <<06515>>45590000
      END;                                                              45595000
                                                                        45600000
      <<$STDLIST DESIGNATOR>>                                           45605000
                                                                        45610000
      BEGIN                                                             45615000
      IF AFTX = 1 THEN                                                  45620000
         BEGIN                                                          45625000
         TOS := ACCVIOL;  << Can't open stdin as stdlist >>             45630000
         GO ERR                                                         45635000
         END;                                                           45640000
                                                                        45645000
      IF AFTX = 2 THEN                                         <<01425>>45650000
         BEGIN  << Initial FOPEN of $STDLIST >>                <<01425>>45655000
         DADDR := PXG'OUTPUTLDEV;                              <<06513>>45660000
         AOPACTYPE := 1;                                       <<01425>>45665000
         GO GETDEVCHAR;                                        <<01425>>45670000
         END                                                   <<01425>>45675000
      ELSE                                                     <<01425>>45680000
         BEGIN  << A subsequent FOPEN of $STDLIST >>           <<01425>>45685000
         IF REDIRECT'IT (2, STDLIST'FOPCODE) THEN              <<01425>>45690000
            BEGIN                                              <<04133>>45695000
SFLAG:      REOPENSTD := TRUE;                                 <<04133>>45700000
            GOTO STARTOVER;                                    <<04133>>45705000
            END                                                <<04133>>45710000
         ELSE                                                  <<01425>>45715000
            BEGIN  << $STDLIST was not redirected >>           <<01425>>45720000
            DADDR := PXG'OUTPUTLDEV;                           <<06513>>45725000
            AOPACTYPE := 1;                                    <<01425>>45730000
            GO GETDEVCHAR;                                     <<01425>>45735000
            END;                                               <<01425>>45740000
         END << Subsequent FOPEN >>;                           <<01425>>45745000
      END << $STDLIST case >>;                                 <<01425>>45750000
                                                                        45755000
      <<$NEWPASS DESIGNATOR>>                                           45760000
                                                                        45765000
      BEGIN                                                             45770000
      FOPDOMAIN := 0;  <<MAKE NEW>>                                     45775000
      MOVE DEVL := "DISC ";  <<MAKE DEVICE CLASS "DISC">>               45780000
      X := GETDEVINFO(DEVL,DEVINFO);  <<GET DEVICE INFO>>               45785000
      IF <> THEN  <<ERROR?>>                                            45790000
         BEGIN                                                          45795000
         TOS := UNDEFDEV;                                               45800000
         GO ERR                                                         45805000
         END;                                                           45810000
      @LDT := @DEVINFO(4); ! Set LDT pointer within array.     <<06515>>45815000
      @AN := @HANAME;  <<HOME ACCOUNT NAME>>                            45820000
      @GN := @LGNAME;  <<LOGON GROUP NAME>>                             45825000
      TOS := @FN&LSL(1);                                                45830000
      MOVE * := "$NEWPASS";  <<LOCAL FILE NAME>>                        45835000
      DTYPE := DEVINFO'DEVTYPE;                                <<06515>>45840000
      DEFRS := LDT'RECORD'WIDTH;                               <<06515>>45845000
      END;                                                              45850000
                                                                        45855000
      <<$OLDPASS DESIGNATOR>>                                           45860000
                                                                        45865000
      BEGIN                                                             45870000
      FOPDOMAIN := 0;  <<MAKE NEW>>                                     45875000
      CASE DNTYPE OF                                           <<RV.PV>>45880000
      BEGIN                                                    <<RV.PV>>45885000
          ;                                                    <<RV.PV>>45890000
          MOVE AN := HANAME, (4);                              <<RV.PV>>45895000
          BEGIN                                                <<RV.PV>>45900000
              MOVE GN := LGNAME, (4);                          <<RV.PV>>45905000
              MOVE AN := HANAME, (4);                          <<RV.PV>>45910000
          END;                                                 <<RV.PV>>45915000
          BEGIN                                                <<RV.PV>>45920000
              MOVE FN := "$OLDPASS";                           <<RV.PV>>45925000
              MOVE GN := LGNAME, (4);                          <<RV.PV>>45930000
              MOVE AN := HANAME, (4);                          <<RV.PV>>45935000
          END;                                                 <<RV.PV>>45940000
      END;<<OF DNTYPE CASE>>                                   <<RV.PV>>45945000
      END;                                                              45950000
                                                                        45955000
      <<$STDIN DESIGNATOR>>                                             45960000
                                                                        45965000
      BEGIN                                                             45970000
      IF AFTX <> 1   << Not first FOPEN of $STDIN.          >> <<02309>>45975000
        AND REDIRECT'IT (1, STDIN'FOPCODE) THEN                <<02309>>45980000
        GO SFLAG;                                              <<04133>>45985000
                                                               <<02309>>45990000
<< First FOPEN of $STDIN or $STDIN not redirected.          >> <<02309>>45995000
                                                               <<02309>>46000000
      STATE.READMODE := STDINRD;                               <<02309>>46005000
      GO STDINXD;                                              <<02309>>46010000
      END << $STDIN case >>;                                   <<01425>>46015000
                                                                        46020000
      <<$STDINX DESIGNATOR>>                                            46025000
                                                                        46030000
   BEGIN                                                       <<01425>>46035000
   IF AFTX <> 1   << Not first FOPEN of $STDINX.            >> <<02309>>46040000
     AND REDIRECT'IT (1, STDIN'FOPCODE) THEN                   <<02309>>46045000
     GO SFLAG                                                  <<04133>>46050000
   ELSE                                                        <<01425>>46055000
      BEGIN                                                             46060000
      STATE.READMODE := STDINXRD;                              <<02309>>46065000
STDINXD:                                                                46070000
      AOPACTYPE := 0;  <<MAKE READ ONLY>>                               46075000
      DADDR := PXG'INPUTLDEV;  ! $STDIN logical device number. <<06513>>46080000
GETDEVCHAR:                                                             46085000
      IF INTEGER(DNTYPE) = 3 THEN  <<ABSENT NAME?>>                     46090000
         BEGIN                                                          46095000
         DTYPE := FOPDESIGNATOR;  <<DESIGNATOR TYPE>>                   46100000
         TOS := @FN&LSL(1);                                             46105000
         IF DTYPE = 1 THEN                                              46110000
            MOVE * := "$STDLIST"                                        46115000
         ELSE IF DTYPE = 4 THEN                                         46120000
            MOVE * := "$STDIN  "                                        46125000
         ELSE IF DTYPE = 5 THEN                                         46130000
            MOVE * := "$STDINX "                                        46135000
         END;                                                           46140000
      DEVINFO := DADDR;  <<LOG. DEV. NR.>>                              46145000
      TOS := @DTYPE;                                                    46150000
      TOS := LDTDST; TOS := DADDR*LDTENTRY+2;                  <<06515>>46155000
      TOS := 1;                                                         46160000
      ASSEMBLE(MFDS 4);  <<GET DEVICE TYPE WORD FROM LDT>>              46165000
      DTYPE := DTYPE.(10:6);  <<DEVICE TYPE>>                  <<00630>>46170000
      END;                                                              46175000
   END << $STDINX case >>;                                     <<01425>>46180000
                                                                        46185000
      <<$NULL DESIGNATOR>>                                              46190000
                                                                        46195000
      BEGIN                                                             46200000
      TOS := ADJUSTOPS(NEWDIRFILE);                            <<00630>>46205000
      IF S0>=0 THEN GOTO ERR;                                  <<00630>>46210000
      DEL;                                                     <<00630>>46215000
      GO FINISH                                                         46220000
      END                                                               46225000
                                                                        46230000
      END;                                                              46235000
                                                                        46240000
   <<*******************************************************>> <<04624>>46245000
   <<         PROCESS ACCORDING TO DEVICE TYPE              >> <<04624>>46250000
   << The X register will get the access type of the file,  >> <<04624>>46255000
   << based on the top bits of the device type.  If it is   >> <<04624>>46260000
   << zero, than execute the THEN of this huge, disgusing   >> <<04624>>46265000
   << clause, signifying direct access file (disk file).    >> <<04624>>46270000
   <<*******************************************************>> <<04624>>46275000
                                                               <<04624>>46280000
   X := DTYPE&LSR(3);                                                   46285000
   IF = THEN  <<DIRECT ACCESS?>>                                        46290000
      BEGIN                                                             46295000
                                                                        46300000
      <<DIRECT ACCESS DEVICE>>                                          46305000
                                                                        46310000
      IF DTYPE=FDISC THEN GO L; <<FOREIGN DISC>>               <<01115>>46315000
                                                               <<01115>>46320000
      IF FILECODE < 0 AND NOT PRIVMODE AND CHECKSEC THEN       <<00433>>46325000
          GO FCODERR;                                          <<00309>>46330000
      @ANPTR := @AN;  <<ACCOUNT NAME>>                                  46335000
      @GNPTR := @GN;  <<GROUP NAME>>                                    46340000
      CASE DNTYPE OF                                           <<42.PV>>46345000
      BEGIN                                                    <<42.PV>>46350000
          ;       <<FULLY QUALIFIED NAME>>                     <<42.PV>>46355000
          BEGIN   <<ACCT NAME MISSING>>                        <<42.PV>>46360000
              MOVE AN := HANAME, (4); <<HOME ACCT NAME>>       <<42.PV>>46365000
              LINKAGE'INDEXP := ACCTINDEX;                     <<42.PV>>46370000
          END;                                                 <<42.PV>>46375000
          BEGIN   <<GROUP NAME MISSING>>                       <<42.PV>>46380000
              MOVE AN := HANAME, (4);                          <<42.PV>>46385000
              MOVE GN := LGNAME, (4); <<LOG-ON GROUP NAME>>    <<42.PV>>46390000
              IF HVSPV AND LINKAGE = 0 THEN                    <<42.PV>>46395000
              BEGIN <<NOT MOUNTED. START AT ACCT LEVEL>>       <<42.PV>>46400000
                  DNTYPE := 1;                                 <<42.PV>>46405000
                  LINKAGE'INDEXP := ACCTINDEX;                 <<42.PV>>46410000
              END ELSE                                         <<42.PV>>46415000
               LINKAGE'INDEXP := GRPINDEX;                     <<42.PV>>46420000
          END;                                                 <<42.PV>>46425000
          BEGIN   <<NAME MISSING>>                             <<42.PV>>46430000
              MOVE GN := LGNAME, (4);                          <<42.PV>>46435000
              MOVE AN := HANAME, (4);                          <<42.PV>>46440000
          END;                                                 <<42.PV>>46445000
          GO TO E1; <<ILLEGAL NAME>>                           <<42.PV>>46450000
      END;<<OF DNTYPE CASE>>                                   <<42.PV>>46455000
CONT1:                                                         <<42.PV>>46460000
      IF NOT SPOOLF THEN                                       <<RV.PV>>46465000
      BEGIN                                                    <<RV.PV>>46470000
          GENTRY (GLINKAGE).(PVF) := GRPINXPTRWD.JITPVF;       <<38.PV>>46475000
          TOS := @LGNAME & LSL (1);                            <<RV.PV>>46480000
          TOS := @GNPTR & LSL (1);                             <<RV.PV>>46485000
          TOS := @HANAME & LSL (1);                            <<RV.PV>>46490000
          TOS := @ANPTR & LSL (1);                             <<RV.PV>>46495000
          IF BPS3 <> BPS2, (8) OR BPS1 <> BPS0, (8) THEN       <<RV.PV>>46500000
          BEGIN <<NEED GROUP ENTRY TO DETERMINE IF HVS IS PV>> <<RV.PV>>46505000
              TOS := DIRECFIND (%10, 0D, ANPTR,                <<RV.PV>>46510000
                                GNPTR, FN, GENTRY);            <<38.PV>>46515000
              IF <> THEN                                       <<38.PV>>46520000
              BEGIN                                            <<38.PV>>46525000
                  IF < THEN X := DIRIOERR                      <<38.PV>>46530000
                       ELSE IF S0 = 2 THEN X := UNDEFFILESD-S1 <<38.PV>>46535000
                                   ELSE FTROUBLE (404);        <<04138>>46540000
                  DDEL; DDEL; DDEL;                            <<RV.PV>>46545000
                  TOS := X;                                    <<38.PV>>46550000
                  GO TO ERR;                                   <<38.PV>>46555000
              END;                                             <<38.PV>>46560000
              DDEL;                                            <<38.PV>>46565000
          END;                                                 <<38.PV>>46570000
          DDEL; DDEL; <<POINTERS>>                             <<38.PV>>46575000
          IF GENTRY (GLINKAGE).(PVF) = PV THEN                 <<23.PV>>46580000
          BEGIN << HVS IS A "PV" >>                            <<RV.PV>>46585000
              TOS := 0D;                                       <<RV.PV>>46590000
              WHO (, DS1);                                     <<RV.PV>>46595000
              DEL;                                             <<RV.PV>>46600000
              IF LOGICAL (TOS).(7:1) THEN                      <<RV.PV>>46605000
              BEGIN << HAS "UV" CAPABILITY >>                  <<RV.PV>>46610000
                  REQTYPE := IF PVOPEN' OR MUSTOPEN' THEN      <<RV.PV>>46615000
                              CONDMOUNT ELSE UNCONDMOUNT;      <<RV.PV>>46620000
                  MOUNT (HVSIND, GNPTR, ANPTR,                 <<23.PV>>46625000
                         REQTYPE, -1, PVINFO);                 <<rv.PV>>46630000
                  IF < THEN                                    <<23.PV>>46635000
                  BEGIN << SOME KIND OF MOUNT PROBLEM);        <<23.PV>>46640000
                      <<REQTYPE CONTAINS MOUNT ERROR NUMBER>>  <<23.PV>>46645000
                      <<NEED TO MAP TO FILESYS ERROR NUMBER>>  <<23.PV>>46650000
                      TOS := MOUNTPROB;                        <<23.PV>>46655000
                      GO TO ERR;                               <<RV.PV>>46660000
                  END;                                         <<RV.PV>>46665000
                  RESOURCES.DMOUNT := TRUE;                    <<RV.PV>>46670000
                  CLASSFLG := IF NOT PMAP.(7:1) OR             <<00705>>46675000
                              DEVL="DISC" AND DEVL(4)=SPECIAL  <<00705>>46680000
                              THEN 1 ELSE 0;                   <<00705>>46685000
              END ELSE                                         <<RV.PV>>46690000
              BEGIN << USER DOES NOT HAVE "UV" CAPABILITY>>    <<RV.PV>>46695000
                  TOS := UVCAP;                                <<RV.PV>>46700000
                  GO TO ERR;                                   <<RV.PV>>46705000
              END;                                             <<RV.PV>>46710000
          END;                                                 <<RV.PV>>46715000
      END;<< OF NOT SPOOLF >>                                  <<RV.PV>>46720000
      DOMAIN := FOPDOMAIN;  <<FILE DOMAIN>>                    <<RV.PV>>46725000
      IF DOMAIN = 0 AND NOT FOPOLDPASS THEN                    << 8543>>46730000
         BEGIN  << New file, a different approach.          >> << 8543>>46735000
         IF SPOOLF = FALSE OR FSOPEN'SPOOLF THEN               << 8485>>46740000
            AOPMULTAC := 0;                                    << 8485>>46745000
         GO NFILE                                                       46750000
         END;                                                           46755000
                                                               <<*8008>>46760000
                                                                        46765000
      !------------------------------------------------------- <<06514>>46770000
      ! Obtain the FMAVT SIR and the FISIR now.  Me MUST ob-   <<06514>>46775000
      ! tain both SIR's to maintain the locking conventions.   <<06514>>46780000
      ! We don't know if the file is to be opened multi-access <<06514>>46785000
      ! for a messge file until we read the FLAB.  Therefore,  <<06514>>46790000
      ! we must obtain both SIR's now.                         <<06514>>46795000
      !------------------------------------------------------- <<06514>>46800000
                                                               <<06514>>46805000
      B := GETSIR(FMAVTSIR);                                   <<HM.00>>46810000
      A := GETSIR(FISIR);                                      <<01084>>46815000
                                                               << 8543>>46820000
      !------------------------------------------------------- << 8543>>46825000
      ! If we are opening an old user spoolfile (like $STDLIST << 8543>>46830000
      ! in a job) then the PACB for the file alreay exists.    << 8543>>46835000
      ! Obtain the LDEV and disc address from the XDD for use  << 8543>>46840000
      ! by SCANFMAVT and call CHECK'MULTI'ACCESS to find and   << 8543>>46845000
      ! lock the PACB for us.  For FSOPEN spoolfiles, skip the << 8543>>46850000
      ! multiaccess code and simply jump to the FOPENDA.       << 8543>>46855000
      !------------------------------------------------------- << 8543>>46860000
                                                               << 8543>>46865000
      IF USER'SPOOLF THEN                                      << 8543>>46870000
         BEGIN                                                 << 8543>>46875000
         FADDR := XDDSPOOLINFO(0D,2,XDDEP);                    << 8543>>46880000
         IF FADDR = 0D THEN                                    << 8543>>46885000
            BEGIN ! FYI - this should never, ever happen.      << 8543>>46890000
            TOS := SPOOFLEINVL;                                << 8543>>46895000
            GO TO ERR;                                         << 8543>>46900000
            END;                                               << 8543>>46905000
         DADDR := FADDRW1.(0:8);  ! Pull LDEV from address.    << 8543>>46910000
         CHECK'MULTI'ACCESS;      ! Find and lock the PACB.    << 8543>>46915000
         END;                                                  << 8543>>46920000
                                                               << 8543>>46925000
      IF SPOOLF THEN                                           << 8543>>46930000
         BEGIN                                                 << 8543>>46935000
         DADDR := 0;                                           << 8543>>46940000
         FADDRW1 := 0;                                         << 8543>>46945000
         FADDRW2 := @SPINFO;                                   << 8543>>46950000
         GO OPEN'OLD'SPOOLFILE;                                << 8543>>46955000
         END;                                                  << 8543>>46960000
                                                                        46965000
      <<---------------------------------------------------->> << 8543>>46970000
      << Obtain $OLDPASS pointer from JIT at this point,    >> << 8543>>46975000
      << now that we have the proper SIR's.                 >> << 8543>>46980000
      <<---------------------------------------------------->> << 8543>>46985000
                                                               << 8543>>46990000
      IF FOPOLDPASS THEN                                       << 8543>>46995000
         BEGIN                                                 << 8543>>47000000
         TOS := @FADDR;                                        << 8543>>47005000
         TOS := PXG'JITDST;                                    << 8543>>47010000
         TOS := JITPFP*2;                                      << 8543>>47015000
         TOS := 2;                                             << 8543>>47020000
         ASSEMBLE(MFDS 4);     << Get label from the JIT.   >> << 8543>>47025000
         IF FADDR = 0D THEN                                    << 8543>>47030000
            BEGIN              << No $OLDPASS pointer.      >> << 8543>>47035000
            TOS := NOPASSD;                                    << 8543>>47040000
            GO ERR;                                            << 8543>>47045000
            END;                                               << 8543>>47050000
         VDADDR := FADDRW1.(0:8); << Obtain VTAB index.     >> << 8543>>47055000
         FADDRW1.(0:8) := 0;      << Clear VTABX            >> << 8543>>47060000
         DISKADR := FADDR;        << Save FLAB address.     >> << 8543>>47065000
         DADDR := LUN(VDADDR,MVTABX);                          << 8543>>47070000
         GO TO OPNOLD;                                         << 8543>>47075000
         END;                                                  << 8543>>47080000
      <<* * * SEARCH JOB TEMPORARY DIRECTORY * * *>>                    47085000
                                                                        47090000
      IF DOMAIN > 1 THEN  <<SEARCH JTFD?>>                              47095000
         BEGIN                                                          47100000
         JID := 2;                                                      47105000
         IF RETJTENTRY(FN,GNPTR,ANPTR,JID,FIDS) = 0 THEN  <<FOUND?>>    47110000
            BEGIN                                                       47115000
            TOS := FIDS;                                                47120000
            VDADDR := S0.(0:8);  <<VTABX>>                     <<RV.PV>>47125000
            DADDR := LUN (VDADDR,MVTABX);                      <<RV.PV>>47130000
            TOS := TOS.(8:8);    <<VTABX>>                     <<RV.PV>>47135000
            TOS := FIDS(1);                                             47140000
            FADDR := TOS;  <<FILE LABEL SECTOR NR.>>                    47145000
            FOPDOMAIN := 2;  << set to old temporary file >>   <<F7504>>47150000
            GO OPNOLD                                                   47155000
            END                                                         47160000
         END;                                                           47165000
      IF NOT LOGICAL(DOMAIN) THEN  <<NOT FOUND IN JTFD?>>               47170000
         BEGIN                                                          47175000
         TOS := UNDEFFILEJD;                                            47180000
         GO ERR                                                         47185000
         END;                                                           47190000
                                                                        47195000
      <<* * * SEARCH PERMANENT DIRECTORY * * *>>                        47200000
                                                                        47205000
      IF DNTYPE = 3 THEN GO E1;     << No designator >>                 47210000
      TOS := 0D; TOS := GSEC; TOS := ASEC;                              47215000
      DISKADR := DIRECFINDFILE (DNTYPE,LINKAGE'INDEXP,ANPTR,   <<38.PV>>47220000
                                GNPTR,FN,AS4);                 <<38.PV>>47225000
      IF <> THEN                                                        47230000
         BEGIN                                                          47235000
         IF < THEN TOS := DIRIOERR                                      47240000
         ELSE IF P2 = 2 THEN TOS := UNDEFFILESD-P1                      47245000
         ELSE FTROUBLE(484);  <<OTHER ERROR?>>                 <<KJ.03>>47250000
         GO ERR                                                         47255000
         END;                                                           47260000
      IF CARRY THEN  <<FILE FLAGGED - BAD LABEL?>>             <<+1.01>>47265000
         BEGIN                                                          47270000
         TOS := BADFILE;                                                47275000
         GO ERR                                                         47280000
         END;                                                           47285000
      ASEC := TOS; GSEC := TOS; FADDR := TOS;                           47290000
      VDADDR := FADDRW1&LSR(8);  <<VOLUME TABLE INDEX>>                 47295000
      DADDR := LUN (VDADDR,MVTABX);  <<LOGICAL UNIT NR.>>      <<RV.PV>>47300000
      DOMAIN := 1;  <<SET TO PERMANENT FILE>>                           47305000
      FOPDOMAIN := 1; << SET FOPTIONS TO OLD PERMANENT FILE >> <<F7504>>47310000
                                                               <<HM.00>>47315000
      <<****************************************************>> <<04624>>47320000
      <<                                                    >> <<04624>>47325000
      <<                 OLD        FILE                    >> <<04624>>47330000
      <<                                                    >> <<04624>>47335000
      << We have, in our infinite wisdom, determined that   >> <<04624>>47340000
      << this is indeed an old file.  Allocate the FLAB on  >> <<04624>>47345000
      << stack and read it in.  Do checking on the file type>> <<04624>>47350000
      <<****************************************************>> <<04624>>47355000
                                                               <<HM.00>>47360000
OPNOLD:                                                        <<HM.00>>47365000
      ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>               <<HM.00>>47370000
      IF FOPOLDPASS THEN                                       << 8543>>47375000
         BEGIN << Place new name in the FLAB for FCLOSE.    >> << 8543>>47380000
         LABELIO(0,2);                                         << 8543>>47385000
         MOVE FLLOCNAME  := FN,(4);                            << 8543>>47390000
         MOVE FLGRPNAME  := GN,(4);                            << 8543>>47395000
         MOVE FLACCTNAME := AN,(4);                            << 8543>>47400000
         LABELIO(1,2);                                         << 8543>>47405000
         END                                                   << 8543>>47410000
      ELSE     << Normal file, simply read the FLAB.        >> << 8543>>47415000
         BEGIN                                                 << 8543>>47420000
         DISKADR := FADDR;                                     << 8543>>47425000
         P1.(0:8) := 0;                                        << 8543>>47430000
         LABELIO(0,1);                                         << 8543>>47435000
         END;                                                  << 8543>>47440000
                                                               << 8543>>47445000
      IF FLMSGFILE THEN                                        <<HM.00>>47450000
         BEGIN  <<MSG FILE ACCESS>>                            <<HM.00>>47455000
         IF (TOS:=ADJUSTMSGPARMS) <> -1 THEN GO ERR;           <<HM.00>>47460000
         END                                                   <<HM.00>>47465000
      ELSE IF FLCIRFILE THEN                                   <<HM.00>>47470000
         BEGIN  <<CIRCULAR FILE ACCESS>>                       <<HM.00>>47475000
         IF (TOS:=ADJUSTCIRPARMS) <> -1 THEN GO ERR;           <<HM.00>>47480000
         END;                                                  <<HM.00>>47485000
      IF AOPNOWAIT AND AOPINHIBITBUF AND NOT PRIVMODE THEN     <<HM.00>>47490000
         BEGIN                                                 <<HM.00>>47495000
         TOS := ILLCAP;                                        <<HM.00>>47500000
         GO ERR                                                <<HM.00>>47505000
         END;                                                  <<HM.00>>47510000
                                                                        47515000
                                                               << 8543>>47520000
      ! Check for multi-access, do ACB stuff if so.            << 8543>>47525000
                                                               << 8543>>47530000
      CHECK'MULTI'ACCESS;                                      << 8543>>47535000
                                                               << 8543>>47540000
       << Must check for Priv File Code Match >>               <<02352>>47545000
       IF FLFILECODE < 0 OR FILECODE < 0 THEN                  <<01175>>47550000
        IF FILECODE <> FLFILECODE THEN GO FCODERR;<<MISMATCH?>><<01175>>47555000
                                                               <<04615>>47560000
      <<* * * CHECK FILE SECURITY * * *>>                      <<04615>>47565000
                                                               <<04615>>47570000
      IF DOMAIN=1 THEN                                         <<04615>>47575000
         BEGIN                                                 <<04615>>47580000
         IF NOT LOGICAL(FLSECURE) OR NOT CHECKSEC THEN         <<04615>>47585000
            ASEC := ASEC LOR %76  <<R,A,W,L,X BUT NO S>>       <<04615>>47590000
         ELSE  <<CHECK SECURITY>>                              <<04615>>47595000
            BEGIN                                              <<04615>>47600000
            ASEC := ACCCHECK(0,ANPTR,ASEC,GNPTR,GSEC,          <<04615>>47605000
                      FLUSERID,FLSECMX);                       <<04615>>47610000
            CASE AOPACTYPE OF  <<CHECK ACCESS>>                <<04615>>47615000
               BEGIN                                           <<04615>>47620000
                                                               <<04615>>47625000
               <<READ ONLY>>                                   <<04615>>47630000
                                                               <<04615>>47635000
               BEGIN                                           <<04615>>47640000
               IF NOT ASEC&LSR(5) THEN GO SECVIOL; <<NO READ?>><<04615>>47645000
               IF FLMSGFILE AND NOT AOPCOPY                    <<04615>>47650000
               AND NOT ASEC&LSR(3) THEN GO SECVIOL;            <<04615>>47655000
               END;                                            <<04615>>47660000
                                                               <<04615>>47665000
               <<WRITE ONLY - DELETE>>                         <<04615>>47670000
                                                               <<04615>>47675000
                             << No Write? >>                   <<04615>>47680000
OUT:           IF NOT ASEC&LSR(3) THEN GO SECVIOL;             <<04615>>47685000
                                                               <<04615>>47690000
               <<WRITE ONLY - SAVE>>                           <<04615>>47695000
                                                               <<04615>>47700000
               GO OUT;                                         <<04615>>47705000
                                                               <<04615>>47710000
               <<APPEND>>                                      <<04615>>47715000
                                                               <<04615>>47720000
                             << No A,W? >>                     <<04615>>47725000
               IF INTEGER(ASEC.(11:2)) = 0 THEN GO SECVIOL;    <<04615>>47730000
                                                               <<04615>>47735000
               <<READ OR WRITE>>                               <<04615>>47740000
                                                               <<04615>>47745000
               BEGIN                                           <<04615>>47750000
                             << R,W? >>                        <<04615>>47755000
INOUT:         IF INTEGER(ASEC LAND %50) = 0 THEN GO SECVIOL;  <<04615>>47760000
               IF NOT ASEC&LSR(5) THEN  <<NO R => W ONLY?>>    <<04615>>47765000
                  AOPACTYPE := 2                               <<04615>>47770000
               ELSE IF NOT ASEC&LSR(3) THEN <<NO W=>R ONLY?>>  <<04615>>47775000
                  AOPACTYPE := 0                               <<04615>>47780000
               END;                                            <<04615>>47785000
                                                               <<04615>>47790000
               <<UPDATE>>                                      <<04615>>47795000
                                                               <<04615>>47800000
               GO INOUT;                                       <<04615>>47805000
                                                               <<04615>>47810000
               <<MODIFY SL OR PROGRAM FILE>>                   <<04615>>47815000
                                                               <<04615>>47820000
               BEGIN                                           <<04615>>47825000
               << No Execute? >>                               <<04615>>47830000
EXECUTE:       IF NOT ASEC&LSR(1) THEN GO SECVIOL;             <<04615>>47835000
               ASEC := ASEC LOR 4  <<INCLUDE LOCKING>>         <<04615>>47840000
               END;                                            <<04615>>47845000
                                                               <<04615>>47850000
               <<LOAD A PROGRAM FILE>>                         <<04615>>47855000
                                                               <<04615>>47860000
               GO EXECUTE                                      <<04615>>47865000
                                                               <<04615>>47870000
               END;                                            <<04615>>47875000
            IF INTEGER(ASEC.(11:2)) <> 0                       <<04615>>47880000
               THEN ASEC := ASEC LOR 4;                        <<04615>>47885000
            IF AOPLOCKING OR AOPEXCLUSIVE OR AOPSEMI OR        <<04615>>47890000
                       <<  Exclusive Request? >>               <<04615>>47895000
               AOPDEFAULT AND NOT AOPREAD THEN                 <<04615>>47900000
                  IF NOT ASEC&LSR(2) THEN GO SECVIOL           <<04615>>47905000
            END                                                <<04615>>47910000
         END;                                                  <<04615>>47915000
                                                               <<04615>>47920000
      <<* * * CHECK LOCK WORD * * *>>                          <<04615>>47925000
                                                               <<04615>>47930000
      IF MUSTOPEN' AND PRIVMODE THEN ELSE                      <<04615>>47935000
      BEGIN                                                    <<04615>>47940000
      MOVE FIDS := LW,(4);  <<COPY LOCKWORD>>                  <<04615>>47945000
      TOS := FLOCKWORD(FD,FLAB,A,B,IF PACBLOCKED THEN PACBV    <<04615>>47950000
                     ELSE 0D);                                 <<06514>>47955000
      ASSEMBLE(TEST);                                          <<04615>>47960000
      IF = THEN  <<MISMATCH OR ERROR?>>                        <<04615>>47965000
         BEGIN                                                 <<04615>>47970000
         A := -1;  <<SIR WAS RELEASED>>                        <<04615>>47975000
         B := -1;  <<SIR WAS RELEASED>>                        <<04615>>47980000
         TOS := @FLLOCKWORD; PS0 := "  ";                      <<04615>>47985000
         ASSEMBLE (DUP,INCB);                                  <<04615>>47990000
         TOS := 3;                                             <<04615>>47995000
         ASSEMBLE (MOVE 3); <<CLEAR OUT PASSWORD>>             <<04615>>48000000
         PACBLOCKED := FALSE;  <<PACB WAS RELEASED>>           <<04615>>48005000
         TOS := LWVIOL;                                        <<04615>>48010000
         GO ERR                                                <<04615>>48015000
         END;                                                  <<04615>>48020000
      IF TOS = 2 THEN  <<PROMPTED LOCKWORD MATCH?>>            <<04615>>48025000
         BEGIN                                                 <<04615>>48030000
         MOVE LW := FIDS,(4);  <<MAKE LOCKWORD LOOK SUPPLIED>> <<04615>>48035000
         A := -1;  <<SIR WAS RELEASED>>                        <<04615>>48040000
         B := -1;  <<SIR WAS RELEASED>>                        <<04615>>48045000
         PACBLOCKED := FALSE;  <<PACB WAS RELEASED>>           <<04615>>48050000
         PXGLOBAL;         ! Restore ASEC since the previous   <<06444>>48055000
         TOS := @ASEC;     ! copy was destroyed checking the   <<06444>>48060000
         TOS := PXG'JITDST;! file security.                    <<06444>>48065000
         TOS := JITASEC;                                       <<06444>>48070000
         TOS := 1;                                             <<06444>>48075000
         ASSEMBLE(MFDS 4);                                     <<06444>>48080000
         GO CONT1                                              <<04615>>48085000
         END;                                                  <<04615>>48090000
      END;                                                     <<04615>>48095000
$PAGE                                                          <<04624>>48100000
      <<****************************************************>> <<04624>>48105000
      << Now call FOPENDA to open the disk file.  Turn bit  >> <<04624>>48110000
      << zero of the DADDR parameter on if the PACB has al- >> <<04624>>48115000
      << ready been locked.  FOPENDA will check this bit    >> <<04624>>48120000
      << upon entrance.                                     >> <<04624>>48125000
      <<****************************************************>> <<04624>>48130000
                                                               <<04624>>48135000
OPNOLDA:                                                                48140000
      ASSEMBLE(SUBS 128);  <<DEALLOCATE FILE LABEL BUFFER>>             48145000
OPEN'OLD'SPOOLFILE:                                            << 8543>>48150000
      IF RESOURCES.GLOBAFT      << Clear AFT, FOPENDA will  >> <<06514>>48155000
         THEN CLEAR'GLOBAL'AFT; << get its own.             >> <<06514>>48160000
      DISP.(0:8) := DNTYPE;                                             48165000
      DADDR.(0:1) := PACBLOCKED;                                        48170000
      FOPEN := FOPENDA(DADDR,FADDR,AOPTIONS,NUMBUFFERS,FILECODE,        48175000
         ASEC,DISP,FOPTIONS,PVINFO,IPCINFO);                   <<HM.00>>48180000
                        <<NOTE: LOCAL AOPS MAY BE INVALID>>    <<00630>>48185000
                        <<USE ACBAOPS (FGETINFO) INSTEAD >>    <<00630>>48190000
      PUSH(STATUS);                                                     48195000
      TOS := TOS.(6:2);                                                 48200000
      CONDCODE := TOS;  <<SET CONDITION CODE>>                          48205000
      DADDR.(0:1) := 0;                                                 48210000
      PACBLOCKED := FALSE;                                              48215000
      IF RESULT <> 0 THEN  <<OK?>>                                      48220000
         BEGIN                                                          48225000
         IF SPOOLF THEN DADDR := SPDADDR;                               48230000
         TOS := ATTACHIO(DADDR,0,0,0,2,0,0,0,BSFLAGS); <<O.F.>><<+0.05>>48235000
                                                               <<04624>>48240000
         IF S1.(8:8)<>1 THEN GO E0;          <<ERROR?>>        <<04624>>48245000
                                                               <<04624>>48250000
         END                                                            48255000
      ELSE  <<ERROR>>                                                   48260000
         IF USER'SPOOLF                                        << 8485>>48265000
            THEN DEALLOCATE(DBL(SPVDEV));                      <<06515>>48270000
      SETPXFILE;  <<INIT. PXFILE POINTER>>                              48275000
      TOS := PXFFOPEN;  <<ERROR NR.>>                                   48280000
      GO XIT;                                                           48285000
$PAGE                                                          <<04624>>48290000
      <<****************************************************>> <<04624>>48295000
      <<                                                    >> <<04624>>48300000
      <<                 NEW   DISC  FILE                   >> <<04624>>48305000
      <<                                                    >> <<04624>>48310000
      <<****************************************************>> <<04624>>48315000
                                                                        48320000
NFILE:                                                                  48325000
      IF LWB="/" THEN <<null format>> LWB:=" ";                <<02350>>48330000
      TOS := ADJUSTOPS(NEWDIRFILE);                            <<00630>>48335000
      IF S0>=0 THEN GOTO ERR;                                  <<00630>>48340000
      DEL;                                                     <<00630>>48345000
      IF FOPCONTROL AND NOT FOPASCII THEN  <<INCONSISTENT?>>            48350000
         BEGIN                                                          48355000
         TOS := ACCVIOL;                                                48360000
         GO ERR                                                         48365000
         END;                                                           48370000
      IF AOPNOWAIT AND AOPINHIBITBUF AND NOT PRIVMODE THEN     <<HM.00>>48375000
         BEGIN                                                 <<HM.00>>48380000
         TOS := ILLCAP;                                        <<HM.00>>48385000
         GO ERR                                                <<HM.00>>48390000
         END;                                                  <<HM.00>>48395000
      STATE.CARRIAGEF := FOPCONTROL;  <<CARRIAGE CONTROL?>>             48400000
      RBSIZE;  <<GET RECORD AND BLOCK SIZES>>                           48405000
      IF FOPCIRFILE THEN    << insure no partial last block >> <<07392>>48410000
         FILESIZE := CIRFILESIZE(FILESIZE,BLOCKFACTOR);        <<07392>>48415000
                                                                        48420000
      <<****************************************************>> <<04624>>48425000
      <<             ALLOCATE LOCAL FCB BUFFER              >> <<04624>>48430000
      << Allocate the FCB buffer on stack and check for     >> <<04624>>48435000
      << proper block and record size for variable files.   >> <<04624>>48440000
      <<****************************************************>> <<04624>>48445000
                                                                        48450000
      ALLOC'D'FCB;  << Allocate full FCB buffer.            >> <<06514>>48455000
                                                               <<04624>>48460000
      FCBFOPTIONS := FOPTIONS;  <<COPY FOPTIONS>>                       48465000
      IF FOPVARIABLE AND NOT FOPMSGFILE THEN  <<VAR RECS?>>    <<HM.00>>48470000
         BEGIN                                                          48475000
         IF FOPKSAM THEN <<KSAM FILE>>                         <<HM.00>>48480000
            BEGIN  <<KSAM HANDLE ITS OWN RECSIZE AND BSIZE>>   <<HM.00>>48485000
              <<BLOCKFACTOR NO CHANGE>>                        <<HM.00>>48490000
              BSIZE:=(RECSIZE+1)/2*BLOCKFACTOR;                <<HM.00>>48495000
              <<RECSIZE NO CHANGE EITHER>>                     <<HM.00>>48500000
            END                                                <<HM.00>>48505000
         ELSE                                                  <<HM.00>>48510000
            BEGIN  <<NOT KSAM FILE>>                           <<HM.00>>48515000
            TOS := BLOCKFACTOR;  << FOR SIZE WORDS >>          <<HM.00>>48520000
            IF NOT FOPNORMVAR THEN TOS := TOS*5; <<SPOOL INFO   *HM.00>>48525000
            BSIZE := TOS+BSIZE+1; <<ONE MORE FOR TERMINATOR>>  <<HM.00>>48530000
         IF BSIZE <= 0 THEN    <<BLOCK SIZE MUST BE A>>        <<01052>>48535000
            BEGIN              <<POSITIVE INTEGER    >>        <<01052>>48540000
            TOS:=BADVARBLK;    <<FOR VARIABLE LENGTH >>        <<01052>>48545000
            GO ERR             <<RECORDS             >>        <<01052>>48550000
            END;                                               <<01052>>48555000
            RECSIZE := BSIZE&LSL(1);                           <<HM.00>>48560000
         IF RECSIZE <= 0 THEN   <<RECORD SIZE MUST BE>>        <<01052>>48565000
            BEGIN               <<POSITIVE BYTES     >>        <<01052>>48570000
            TOS:=INVDRECSIZE;   <<FOR VARIABLE LENGTH>>        <<01052>>48575000
            GO ERR              <<RECORD             >>        <<01052>>48580000
            END;                                               <<01052>>48585000
            BLOCKFACTOR := 1;                                  <<HM.00>>48590000
            END;                                               <<HM.00>>48595000
         END;                                                  <<KS.00>>48600000
                                                                        48605000
      <<*****************************************************>><<04624>>48610000
      << Now, call FCREATE to allocate the extents and init- >><<04624>>48615000
      << ialize the FCB.  FCREATE will initialize most of the>><<04624>>48620000
      << FCB variables, including the extent map.  Finish    >><<04624>>48625000
      << initalizing what FCREATE did not.                   >><<04624>>48630000
      <<*****************************************************>><<04624>>48635000
                                                                        48640000
      X := FCREATE(DEVINFO'LDEV,FCB,FOPTIONS,RECSIZE,          <<06515>>48645000
                  BLOCKFACTOR,USERLABELS,NUMEXTENTS,FILESIZE,  <<06515>>48650000
                  INITALLOC,SPOOLF,@XDDEP,PVINFO);             <<06515>>48655000
      IF > THEN GO E3;  <<ERROR?>>                                      48660000
      FILELIMIT:=FCBFLIM;                                      <<HM.00>>48665000
      RESOURCES.DISKLOCK := TRUE;  <<SET DISC SPACE FLAG>>              48670000
      TOS := 0;  <<FOR LDEV>>                                           48675000
      TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                         48680000
      TOS := TOS&TASL(8)&DLSR(8);  <<SEPARATE LDEV>>                    48685000
      DISKADR := TOS;  <<FILE LABEL SECTOR NR.>>                        48690000
      DADDR := TOS;  <<FILE LABEL LDEV>>                                48695000
      VDADDR := VTABINX (DADDR,MVTABX<>0); <<VTABX>>           <<RV.PV>>48700000
      FCBUSERLBL := USERLABELS;  <<NR. USER LABELS>>                    48705000
      FCBEXCLSTAT := IF SPOOLF THEN 0 ELSE -1;                          48710000
      FCBOCNT := 1;  <<INIT. OPEN COUNT>>                               48715000
      IF NOT AOPREAD THEN FCBOCNTOUT := 1;  <<INIT. OUTPUT COUNT>>      48720000
      IF NOT AOPWRITEONLY THEN FCBOCNTIN := 1;  <<INIT. INPUT COUNT>>   48725000
      FCBSI := SIZEBFCB+(FCBNUMEXTS+1)&LSL(1)  <<FCB SIZE>>             48730000
      END                                                               48735000
$PAGE                                                          <<04624>>48740000
      <<****************************************************>> <<04624>>48745000
      <<                                                    >> <<04624>>48750000
      <<             NON   DIRECT  ACCESS  FILE             >> <<04624>>48755000
      <<                                                    >> <<04624>>48760000
      << Believe it or not, the X register contains the     >> <<04624>>48765000
      << access type (what a kludge).  Below is the ELSE of >> <<04624>>48770000
      << the HUGE IF DIRECT ACCESS clause.                  >> <<04624>>48775000
      <<****************************************************>> <<04624>>48780000
                                                               <<04624>>48785000
   ELSE                                                                 48790000
      BEGIN        << Non-direct access. >>                             48795000
                                                                        48800000
      IF LWB="/" THEN <<null format disc only>> LWB:=" ";      <<02350>>48805000
                                                               <<00199>>48810000
      IF DIRACCF AND X<>5 THEN GO E8; <<ONLY DA FILES OK>>     <<00469>>48815000
                                                               <<03035>>48820000
      IF AOPNOWAIT AND AOPINHIBITBUF AND NOT PRIVMODE THEN     <<03035>>48825000
         BEGIN                                                 <<03035>>48830000
         TOS := ILLCAP;                                        <<03035>>48835000
         GO ERR                                                <<03035>>48840000
         END;                                                  <<03035>>48845000
                                                               <<00199>>48850000
      <<****************************************************>> <<04624>>48855000
      << Do a case on the access type.  It will be one of   >> <<04624>>48860000
      << the following:  Serial Input, Parrallel Input/     >> <<04624>>48865000
      << Output, Serial Input/Output, Serial Output or DS.  >> <<04624>>48870000
      <<****************************************************>> <<04624>>48875000
                                                                        48880000
      CASE X-1 OF                                                       48885000
         BEGIN                                                          48890000
                                                                        48895000
         <<SERIAL INPUT DEVICE>>                                        48900000
                                                                        48905000
         BEGIN                                                          48910000
         IF (CARDR <= DTYPE <= PTREAD) THEN  <<CARD OR PAPER TAPE?>>    48915000
            BEGIN                                                       48920000
            FOPCONTROL := 0;  <<MAKE NO CARRIAGE CONTROL>>              48925000
            FOPFORMAT := 2;  <<MAKE UNDEFINED REC. FORMAT>>             48930000
            STATE.DEFAULTBF := 1;  <<SET DEFAULT BLOCKING FLAG>>        48935000
            BLOCKFACTOR := 1;                                           48940000
            FOPDOMAIN := 1;  <<MAKE OLD PERMANENT>>                     48945000
            IF NOT FOPASCII THEN AOPINHIBITBUF := 1  <<NO BUFFERING?>>  48950000
            END;                                                        48955000
         IF AOPWRITEONLY THEN  <<FORM OF WRITE ONLY?>>                  48960000
            BEGIN                                                       48965000
            TOS := ACCVIOL;                                             48970000
            GO ERR                                                      48975000
            END;                                                        48980000
         AOPACTYPE := 0;  <<MAKE INPUT ONLY>>                  <<00630>>48985000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>48990000
         IF S0>=0 THEN GOTO ERR;                               <<00630>>48995000
         DEL;                                                  <<00630>>49000000
         END;                                                           49005000
                                                                        49010000
         <<PARALLEL INPUT/OUTPUT DEVICE>>                               49015000
                                                                        49020000
         BEGIN                                                          49025000
         IF DTYPE = TERMINAL OR DTYPE = READERPUNCH THEN  <<T OR R/P?>> 49030000
            BEGIN                                                       49035000
            IF DTYPE = TERMINAL THEN FOPASCII := 1;  <<FORCE?>><<00.04>>49040000
            IF DTYPE = TERMINAL THEN AOPINHIBITBUF := 1;  <<MAKE NOBUF>>49045000
            IF DTYPE = READERPUNCH THEN  <<READER/PUNCH?>>              49050000
               BEGIN                                                    49055000
               FOPCONTROL := 0;  <<DISALLOW CCTL>>                      49060000
               IF AOPREADWRITE THEN AOPINHIBITBUF := 1;                 49065000
               IF AOPREAD THEN FOPDOMAIN := OLD'PERM'FILE;     <<04189>>49070000
               IF AOPWRITEONLY THEN                            <<04189>>49075000
                  BEGIN   << Write new, wrt save or append. >> <<04189>>49080000
                  AOPACTYPE := WRITE'NEW;   << Allow formsg >> <<04189>>49085000
                  FOPDOMAIN := NEW'FILE;                       <<04189>>49090000
                  END;                                         <<04189>>49095000
               END;                                                     49100000
            FOPFORMAT := 2;  <<MAKE UNDEFINED REC. FORMAT>>             49105000
            BLOCKFACTOR := 1;                                           49110000
            STATE.DEFAULTBF := 0  <<CLEAR DEFAULT BLOCKING FLAG>>       49115000
            END;                                               <<00630>>49120000
                                                               <<06866>>49125000
         IF DTYPE = NRJETYPE THEN                              <<06866>>49130000
            FOPDOMAIN := 0;  << Make it a new device.       >> <<06866>>49135000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>49140000
         IF S0>=0 THEN GOTO ERR;                               <<00630>>49145000
         DEL;                                                  <<00630>>49150000
         END;                                                           49155000
                                                                        49160000
         <<SERIAL INPUT/OUTPUT DEVICE>>                                 49165000
                                                                        49170000
         BEGIN                                                          49175000
         IF AOPWRITEONLY THEN FOPDOMAIN := 0   <<NEW>>         <<01.03>>49180000
         ELSE IF AOPREAD THEN FOPDOMAIN := 1;  <<OLD>>         <<01.03>>49185000
         IF ABSOLUTE(AVR) <> 1 THEN FOPTIONS.FOPLABELLEDF := 0;<<02549>>49190000
         IF DACCCL = SERIALIO AND FOPLABELLED THEN             <<03578>>49195000
            BEGIN                                              <<01863>>49200000
            TOS := CREATETLTENT(FORMMSG,FNAMES,FILENUM,        <<02549>>49205000
               AOPACTYPE,DP'DEN);                              <<02568>>49210000
            IF S0 <> 0 THEN GO ERR                             <<01863>>49215000
            ELSE DEL;                                          <<01863>>49220000
            END;                                               <<01863>>49225000
         STATE.CARRIAGEF := FOPCONTROL;  <<CARRIAGE CONTROL?>> <<00630>>49230000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>49235000
         IF S0 >= 0 THEN GOTO ERR;                             <<00630>>49240000
         DEL;                                                  <<00630>>49245000
         END;                                                           49250000
                                                                        49255000
         <<SERIAL OUTPUT DEVICE>>                                       49260000
                                                                        49265000
         BEGIN                                                          49270000
                                                               <<01.03>>49275000
                                                               <<01.03>>49280000
         IF DTYPE = LPTR THEN FOPASCII := 1;   <<MAKE ASCII?>> <<01.03>>49285000
         FOPFORMAT := 2;  <<MAKE RECORD FORMAT UNDEFINED>>     <<01.03>>49290000
         BLOCKFACTOR := 1;                                     <<01.03>>49295000
         STATE.DEFAULTBF := 0;  <<CLEAR DEFAULT BLOCKING FLAG>><<01.03>>49300000
         FOPDOMAIN := 0;   <<MAKE NEW>>                        <<01.03>>49305000
                                                               <<01.03>>49310000
         IF AOPREAD AND PMAP.(5:1) THEN  <<READ ONLY SPECIFIED?>>       49315000
            BEGIN                                                       49320000
            TOS := ACCVIOL;                                             49325000
            GO ERR                                                      49330000
            END;                                                        49335000
         AOPACTYPE := 1;  <<MAKE WRITE ONLY - DELETE>>         <<00630>>49340000
         TOS := ADJUSTOPS(SERIALFILE);                         <<00630>>49345000
         IF S0>=0 THEN GOTO ERR;                               <<00630>>49350000
         DEL;                                                  <<00630>>49355000
         END;                                                  <<DS.00>>49360000
                                                               <<DS.00>>49365000
         << DS TYPE DEVICE >>                                  <<DS.00>>49370000
                                                               <<DS.00>>49375000
         BEGIN                                                 <<DS.00>>49380000
            REMOTE:=TRUE;                                      <<KS.00>>49385000
            IF DTYPE = DSDUMMYDEV THEN                         <<DS.00>>49390000
            BEGIN << RFA FOPEN >>                              <<DS.00>>49395000
               IF AOPGLOBALAFT THEN                            <<06514>>49400000
                  BEGIN << Global AFT's not allowed for DS. >> <<06514>>49405000
                  TOS := DSGLOB;                               <<06514>>49410000
                  GO ERR;                                      <<06514>>49415000
                  END;                                         <<06514>>49420000
               SETAFT;  << Reserve AFT for the RFA entry.   >> <<06514>>49425000
               AFTPACBVDSTN := -1;                             <<06514>>49430000
               TOS := 0;                                       <<DS.00>>49435000
               TOS := @DEVL;                                   <<DS.00>>49440000
               TOS := 0D;    TOS := 0D;                        <<DS.00>>49445000
               TOS := %20;  << PMAP >>                         <<DS.00>>49450000
               TOS := DSOPENPLABEL;                            <<DS.00>>49455000
               IF = THEN                                       << 7923>>49460000
                  BEGIN   << DS is not on the system.       >> << 7923>>49465000
                  TOS := UNDEFDEV;                             << 7923>>49470000
                  GO TO RELAFT;                                << 7923>>49475000
                  END;                                         << 7923>>49480000
               ASMB(PCAL 0); << DS OPEN LINE >>                <<DS.00>>49485000
               RFALINENUM := TOS;                              <<DS.00>>49490000
               IF <> THEN                                      <<DS.00>>49495000
               BEGIN << DS OPEN FAILURE >>                     <<DS.00>>49500000
                  TOS := 0;                                    <<DS.00>>49505000
                  TOS := RFALINENUM;                           <<DS.00>>49510000
                  TOS := DSCHKPLABEL;                          <<DS.00>>49515000
                  IF = THEN SUDDENDEATH(52);                   <<DS.00>>49520000
                  ASMB(PCAL 0);                                <<DS.00>>49525000
$                 IF X1 = ON                                   <<DS.00>>49530000
                  IF <> THEN FTROUBLE(486);                    <<KJ.03>>49535000
$                 IF                                           <<DS.00>>49540000
RELAFT:                                                        <<DS.00>>49545000
                  SETAFT;  << Release RFA AFT on an error.  >> <<06514>>49550000
                  AFTPACBVDSTN := 0;                           <<06514>>49555000
                  GO ERR;                                      <<DS.00>>49560000
               END;                                            <<DS.00>>49565000
               RESOURCES.DSLOCK := 1;                          <<DS.00>>49570000
               ALLOCRFABUF; << BUILD AND SEND REMOTE FOPEN >>  <<DS.00>>49575000
               RFALEN := 41;                                   <<02524>>49580000
               TOS := "RFA ";                                  <<DS.00>>49585000
               TOS := 1; << FOPEN TYPE >>                      <<DS.00>>49590000
               TOS := 36; << FORMAL DESIGNATOR >>              <<DS.00>>49595000
               TOS := FOPTIONS;                                <<DS.00>>49600000
               TOS := AOPTIONS;                                <<DS.00>>49605000
               IF S0.AOPACTYPEF > 5 THEN                       <<DS.03>>49610000
               BEGIN << EXECUTE ACCESS NOT ALLOWED >>          <<DS.03>>49615000
                  TOS := ACCVIOL;                              <<DS.03>>49620000
                  GO RELAFT;                                   <<DS.03>>49625000
               END;                                            <<DS.03>>49630000
               TOS.(4:1) := 0; << DISALLOW NO-WAIT I/O >>      <<DS.00>>49635000
               TOS := RECSIZE;                                 <<DS.00>>49640000
               TOS := 72; << DEVICE TYPE >>                    <<DS.00>>49645000
               TOS := DEVPARMFLAG := DEV'PARMS'LEN';           <<02524>>49650000
               RFALEN:=RFALEN+INTEGER(DEVPARMFLAG&LSR(1));     <<02524>>49655000
               TOS := TOS + 82;                                <<02524>>49660000
               TOS := USERLABELS;                              <<DS.00>>49665000
               TOS := BLOCKFACTOR;                             <<DS.00>>49670000
               TOS := PRICOPBUFS;                              <<DS.00>>49675000
               TOS := FILESIZE;                                <<DS.00>>49680000
               TOS := NUMEXTENTS;                              <<DS.00>>49685000
               TOS := INITALLOC;                               <<DS.00>>49690000
               TOS := FILECODE;                                <<DS.00>>49695000
               TOS := PMAP LOR %007577;    << PMAP >>          <<DS.00>>49700000
               LS0.(0:1) := STATUS.(0:1); << PRIV CODE BIT>>   <<DS.04>>49705000
               LS0.(1:1) := KSF.(15:1); << KSAM ENRT POINT >>  <<DS.06>>49710000
               IF LS0.(3:1) AND LWB <> " " THEN                <<DS.00>>49715000
               BEGIN << CHECK FOR LOCKWORD INSERTION IN FD >>  <<DS.00>>49720000
                  MOVE FD := FD WHILE AN,1;                    <<DS.00>>49725000
                  IF BPS0 <> "/" THEN                          <<DS.00>>49730000
                  BEGIN << INSERTION REQUIRED >>               <<DS.00>>49735000
                     X := 0;                                   <<DS.00>>49740000
                     DO                                        <<DS.00>>49745000
                     BEGIN << DETERMINE LOCKWORD LENGTH >>     <<DS.00>>49750000
                        TOS := LWB(X);                         <<DS.00>>49755000
                        DEL;                                   <<DS.00>>49760000
                     END UNTIL < OR (X:=X+1) >= 8;             <<DS.00>>49765000
                     TOS := @FD+35;                            <<DS.00>>49770000
                     TOS := @FD+34-X;                          <<DS.00>>49775000
                     MOVE * := *,(S2 - @FD - 35 + X);          <<DS.00>>49780000
                     BPS0 := "/";                              <<DS.00>>49785000
                     TOS := TOS + 1;                           <<DS.00>>49790000
                     MOVE * := LWB,(X),2;                      <<DS.00>>49795000
                  END;                                         <<DS.00>>49800000
                  DEL;                                         <<DS.00>>49805000
               END;                                            <<DS.00>>49810000
               ALLOCBUF; << PUT ON FORMAL DESIGNATOR >>        <<DS.00>>49815000
               ASSEMBLE(ADDS 18);                              <<DS.00>>49820000
               TOS := X; << BUF PTR >>                         <<DS.00>>49825000
               MOVE * := FD,(36);                              <<DS.00>>49830000
               ALLOCBUF; << PUT ON DEVICE SPEC. >>             <<DS.00>>49835000
               ALLOC'RESULT := X;                              <<01882>>49840000
               TOS := DEVPARMFLAG&LSR(1) + 5;                  <<02524>>49845000
               ASSEMBLE(ADDS 0);                               <<01882>>49850000
               X := ALLOC'RESULT;                              <<01882>>49855000
               TOS := X;                                       <<DS.00>>49860000
               DEVL(MAXDEVLEN) := " ";                         <<02555>>49865000
               SCAN DEVL UNTIL " #",1; << LOCATE REMOTE DEV >> <<DS.00>>49870000
               IF CARRY THEN                                   <<DS.00>>49875000
               BEGIN << NO REMOTE DEVICE TYPE SPECIFIED >>     <<DS.00>>49880000
                  TOS := UNDEFDEV;                             <<DS.00>>49885000
                  GO RELAFT;                                   <<DS.00>>49890000
               END;                                            <<DS.00>>49895000
               TOS := TOS + 1; << SKIP OVER # >>               <<DS.00>>49900000
               TOS := BPS0;                                    <<DS.00>>49905000
               DEL;                                            <<DS.00>>49910000
               IF < THEN                                       <<DS.00>>49915000
               BEGIN << DEFAULT DEVICE CLASS >>                <<DS.00>>49920000
                  DEL; << DEVL POINTER >>                      <<DS.00>>49925000
                  MOVE * := "DISC ";                           <<DS.00>>49930000
               END ELSE                                        <<DS.00>>49935000
                  BEGIN                                        <<01882>>49940000
                  MOVE * := *,(8),2;   << insert dev spec >>   <<01882>>49945000
                  BPS0 := " ";                                 <<02524>>49950000
                  DEL;                                         <<02524>>49955000
                  END;                                         <<02524>>49960000
                  STUFF'DEV'PARMS(DEVPARMS,ALLOC'RESULT);      <<02524>>49965000
               IF PMAP.(8:1) THEN                              <<DS.00>>49970000
               BEGIN << FORMS MESSAGE INCLUDED >>              <<DS.00>>49975000
                  ALLOCBUF;                                    <<DS.00>>49980000
                  ASSEMBLE (ADDS 81); <<ALLOW 81 WORDS>>       <<DS.RW>>49985000
                  TOS := X;                                    <<DS.00>>49990000
                  MOVE * := FORMMSG,(162);                     <<DS.RW>>49995000
                  RFALEN:=RFALEN+81;                           <<DS.RW>>50000000
               END;                                            <<DS.00>>50005000
               TOS := 0;                                       <<DS.00>>50010000
               TOS := RFALINENUM;                              <<DS.00>>50015000
               TOS := RFAMSG;                                  <<DS.00>>50020000
               TOS := RFASTREAM;                               <<DS.00>>50025000
               TOS := RFASUBSTR;                               <<DS.00>>50030000
               TOS := @RFAPTR;                                 <<DS.00>>50035000
               TOS := RFALEN;                                  <<DS.00>>50040000
               TOS := 0D;  TOS := 0D;                          <<DS.00>>50045000
               TOS := MWCPLABEL;                               <<DS.00>>50050000
               IF = THEN SUDDENDEATH(52);                      <<DS.00>>50055000
               ASMB(PCAL 0); << SEND FOPEN ACROSS LINE >>      <<DS.00>>50060000
               DEL;                                            <<DS.00>>50065000
               IF <> THEN                                      <<DS.00>>50070000
               BEGIN << TRANSMISSION FAILURE >>                <<DS.00>>50075000
                  TOS := 0;                                             50080000
                  TOS := RFALINENUM;                                    50085000
                  TOS := DSCHKPLABEL;                                   50090000
                  IF = THEN SUDDENDEATH(52);                            50095000
                  ASMB(PCAL 0);                                         50100000
                  GO RELAFT;                                   <<DS.00>>50105000
               END;                                            <<DS.00>>50110000
               DELAPPENDAGE;                                   <<DS.00>>50115000
               RFAFILENUM := S0.(8:8); << REMOTE FILE NUM >>   <<DS.00>>50120000
               IF TOS.CC <> CCE THEN                           <<DS.00>>50125000
               BEGIN << REMOTE FOPEN FAILED ON SLAVE >>        <<DS.00>>50130000
                  ALLOCRFABUF; << DO FCHECK FOR ERR NR. >>     <<DS.00>>50135000
                  TOS := "RFA ";                               <<DS.00>>50140000
                  TOS := %16;  << FCHECK INDEX >>              <<DS.04>>50145000
                  TOS := RFAFILENUM;                           <<DS.00>>50150000
                  TOS := %30; << PARAMETER MASK >>             <<DS.00>>50155000
                  TOS := 0D; << FILL OUT BUFFER >>             <<DS.00>>50160000
                  RFALEN := 5;                                 <<DS.00>>50165000
                  TOS := 0;                                    <<DS.00>>50170000
                  TOS := RFALINENUM;                           <<DS.00>>50175000
                  TOS := RFAMSG;                               <<DS.00>>50180000
                  TOS := RFASTREAM;                            <<DS.00>>50185000
                  TOS := RFASUBSTR;                            <<DS.00>>50190000
                  TOS := @RFAPTR;                              <<DS.00>>50195000
                  TOS := RFALEN;                               <<DS.00>>50200000
                  TOS := 0D;  TOS := 0D;                       <<DS.00>>50205000
                  TOS := MWCPLABEL;                            <<DS.00>>50210000
                  IF = THEN SUDDENDEATH(52);                   <<DS.00>>50215000
                  ASMB(PCAL 0);                                <<DS.00>>50220000
                  DEL;                                         <<DS.00>>50225000
                  IF <> THEN                                   <<DS.00>>50230000
                  BEGIN << TRANSMISSION FAILURE >>             <<DS.00>>50235000
                     TOS := 0;                                 <<DS.00>>50240000
                     TOS := RFALINENUM;                        <<DS.00>>50245000
                     TOS := DSCHKPLABEL;                       <<DS.00>>50250000
                     IF = THEN SUDDENDEATH(52);                <<DS.00>>50255000
                     ASMB(PCAL 0);                             <<DS.00>>50260000
$                    IF X1 = ON                                <<DS.00>>50265000
                     IF <> THEN FTROUBLE(486);                 <<KJ.03>>50270000
$                    IF                                        <<DS.00>>50275000
                     GO RELAFT;                                <<DS.00>>50280000
                  END;                                         <<DS.00>>50285000
                  ASSEMBLE(SUBS 5);                            <<DS.00>>50290000
                   GO TO RELAFT;                               <<DS.04>>50295000
               END;                                            <<DS.00>>50300000
               SETAFT;                                         <<06514>>50305000
               AFTTYPE := RF'TYPE;                             <<06514>>50310000
               AFTRFAMR := AOPMULTIREC;                        <<06514>>50315000
               AFTRFAFNUM := RFAFILENUM;                       <<06514>>50320000
               AFTRFALINE := RFALINENUM;                       <<06514>>50325000
               AFTRFADISP := DISP.(13:3);                      <<06514>>50330000
               FOPEN := AFTX;                                  <<DS.00>>50335000
               CONDCODE := CCE;                                <<DS.00>>50340000
               TOS := 0;                                       <<DS.00>>50345000
               GO EXIT;                                        <<DS.00>>50350000
            END;                                               <<DS.00>>50355000
         END;                                                  <<DS.00>>50360000
         END;                                                  <<DS.00>>50365000
                                                               <<DS.00>>50370000
      <<UNDEFINED DEVICE>>                                              50375000
                                                                        50380000
L:    IF FOPCONTROL AND NOT FOPASCII THEN  <<INCONSISTENT?>>   <<01115>>50385000
         BEGIN                                                          50390000
         TOS := ACCVIOL;                                                50395000
         GO ERR                                                         50400000
         END;                                                           50405000
      SAVAOPS := AOPTIONS;   << ALLOC may alter AOPTIONS >>    <<01882>>50410000
      TOS := ALLOC(NOT FOPNEW);    << allocate device >>                50415000
      IF AOPREAD AND (1 <= SAVAOPS.(12:4) <= 3) THEN           <<01882>>50420000
         GO ACCVIOLBL;                                         <<01882>>50425000
                                                               <<01882>>50430000
      IF DTYPE=FDISC THEN                                      <<01882>>50435000
         BEGIN    << fudge foreign disc stuff >>               <<01882>>50440000
         FOPFORMAT := FOPFIXEDFMT;                             <<01882>>50445000
         FOPASCII := 0;                                        <<01882>>50450000
         FOPCONTROL := 0;                                      <<01882>>50455000
         IF AOPAPPEND OR AOPEXECUTE OR (SAVAOPS.(12:4)=3) THEN <<01882>>50460000
            BEGIN                                              <<01882>>50465000
ACCVIOLBL:  TOS := ACCVIOL;                                    <<01882>>50470000
            GO ERR;                                            <<01882>>50475000
            END;                                               <<01882>>50480000
         END;                                                  <<01882>>50485000
      IF FOPLABELLED AND DACCCL = SERIALIO AND NOT SPOOLF THEN <<06054>>50490000
         BEGIN      << Labelled serial device >>               <<03578>>50495000
         TOS := POSITION(DADDR,FILENUM,BLOCKFACTOR,            <<02549>>50500000
            RECSIZE,FOPTIONS,AOPACTYPE);                       <<02549>>50505000
         IF S0 <> 0 THEN GO ERR;                               <<02549>>50510000
         DEL;                                                  <<02549>>50515000
         IF BLOCKFACTOR <> 0 THEN STATE.DEFAULTBF := 0;        <<02549>>50520000
         END          << Labelled mag tape >>                  <<02568>>50525000
      ELSE IF DTYPE = MTAPE AND NOT SPOOLF THEN                <<06054>>50530000
         BEGIN        << Unlabelled tape >>                    <<02568>>50535000
                                                               <<02568>>50540000
         << If tape is on variable density drive and user >>   <<02568>>50545000
         << has some sort of write access, post density.  >>   <<02568>>50550000
                                                               <<02568>>50555000
         IF (VARIABLE'DENSITY) AND (NOT AOPREAD) THEN          <<02568>>50560000
            STORE'DENSITY(DADDR,DP'DEN,0);                     <<02568>>50565000
                                                               <<04308>>50570000
         <<*************************************************>> <<06055>>50575000
         << If write access requested check for write ring  >> <<06055>>50580000
         << Do not request write ring for READ and for      >> <<06055>>50585000
         << READ/WRITE since FORTRAN always opens tape for  >> <<06055>>50590000
         << READ/WRITE even if the user wanted READ only.   >> <<06055>>50595000
         <<*************************************************>> <<06055>>50600000
                                                               <<04308>>50605000
         IF AOPWRITE  OR AOPWRITESAVE OR AOPAPPEND OR          <<06055>>50610000
            AOPUPDATE OR AOPEXECUTE                            <<06055>>50615000
            THEN ATTACHIO (DADDR,0,0,0,1,0,0,4,%11);           <<06055>>50620000
                                                               <<04308>>50625000
         END;                                                  <<02568>>50630000
                                                               <<02568>>50635000
      RBSIZE;     << Get record and block sizes >>                      50640000
      TOS := STATE.READCODE;  <<EOF CHECKING MODE>>                     50645000
      ASSEMBLE(XCH);                                                    50650000
      PXGLOBAL;                                                <<06513>>50655000
      IF DADDR = PXG'INPUTLDEV THEN  ! $STDIN ldev?            <<06513>>50660000
         BEGIN                                                          50665000
         DEL;                                                           50670000
         TOS := PXG'JOBTYPE;                                   <<06513>>50675000
         IF <> THEN TOS := -(TOS-3);                                    50680000
         TOS.(12:2) := TOS;  <<JOB/SESSION>>                            50685000
         IF JOBF THEN  <<CI READ CODE>>                                 50690000
               TOS.(14:2) := STDINCIRD;  <<CI>>                         50695000
         END                                                            50700000
      ELSE                                                              50705000
         BEGIN                                                          50710000
         IF TOS = -2 THEN    <<:DATA ALLOC RETURN>>                     50715000
            BEGIN DEL; TOS := COLONRD; END                              50720000
         ELSE                                                           50725000
            IF DACCCL = SERIALIO THEN <<other data>>           <<03578>>50730000
               BEGIN DEL; TOS := MAGTRD; END                            50735000
         END;                                                           50740000
      IF NOT AOPREAD AND                                       <<00.04>>50745000
         (DTYPE <> TERMINAL OR AOPACTYPE <> 4) THEN            <<00.04>>50750000
         ASSEMBLE(DEL,ZERO);                                   <<00.04>>50755000
      STATE.READCODE := TOS;  <<EOF CHECKING MODE>>                     50760000
                                                               << 8491>>50765000
      <<---------------------------------------------------->> << 8491>>50770000
      << Modify AOPTIONS and FOPTIONS for $STDIN/$STDLIST   >> << 8491>>50775000
      << devices.  Otherwise, check for illegal DS access.  >> << 8491>>50780000
      << User is not allowed to open DS psuedo devices that >> << 8491>>50785000
      << are not his $STDIN or $STDLIST.                    >> << 8491>>50790000
      <<---------------------------------------------------->> << 8491>>50795000
                                                               << 8491>>50800000
      IF (DADDR=PXG'INPUTLDEV) OR (DADDR=PXG'OUTPUTLDEV) THEN  <<06513>>50805000
         BEGIN    <<$STDXX ACCESS>>                                     50810000
         AOPMULTAC := 1;  <<SET MULTI-ACCESS>>                          50815000
         <<AOPNOWAIT := 0;  <<SHOULD DISALLOW NO-WAIT I/O>>    <<00.05>>50820000
         AOPINHIBITBUF := (DTYPE=TERMINAL);  <<BUFFERING?>>             50825000
         FOPFORMAT := 2  <<FORCE UNDEFINED>>                            50830000
         END                                                   << 8491>>50835000
      ELSE                                                     << 8491>>50840000
         BEGIN       << Check for illegal DS access.        >> << 8491>>50845000
         X := GET'DSDEVICE(DADDR);                             << 8491>>50850000
         IF 1 <= X <= 3 THEN                                   << 8491>>50855000
            GO E8;   << Can't open a DS pseudo terminal.    >> << 8491>>50860000
         END;                                                  << 8491>>50865000
                                                               << 8491>>50870000
      IF SPOOLF THEN GO SPOOLL;  <<VIRTUAL DEVICE ALLOC>>               50875000
      IF FOPVARIABLE THEN  <<VARIABLE RECORDS?>>                        50880000
         BEGIN                                                          50885000
         TOS := BLOCKFACTOR;  << FOR SIZE WORDS >>             <<00157>>50890000
         IF NOT FOPNORMVAR THEN TOS := TOS*5; <<SPOOL INFO>>   <<00157>>50895000
         BSIZE := TOS+BSIZE+1; <<ONE MORE FOR TERMINATOR>>     <<00157>>50900000
         RECSIZE := BSIZE&LSL(1);                              <<00157>>50905000
         BLOCKFACTOR := 1;                                     <<00157>>50910000
         END;                                                           50915000
     IF DACCCL = SERIALIO AND AOPAPPEND                        <<03578>>50920000
     AND NOT FOPLABELLED THEN                                  <<00157>>50925000
         BEGIN  <<TAPE APPEND>>                                <<00.SD>>50930000
                                                                        50935000
                                                                        50940000
         <<* * * POSITION TAPE FOR APPENDING * * *>>                    50945000
                                                                        50950000
         TOS := ATTACHIO(DADDR,0,0,0,7,0,0,0,BFLAGS);  <<FSF>> <<+0.05>>50955000
         IF S1STAT = 1 OR S1STAT = EOFSTAT THEN  << TM found >><<03579>>50960000
            BEGIN                                              <<00.06>>50965000
            DDEL;                                              <<00.06>>50970000
            IF DTYPE = MTAPE THEN                              <<02568>>50975000
               SET'LPDT'BOT(DADDR,0);  << No longer at BOT >>  <<02568>>50980000
            TOS := ATTACHIO(DADDR,0,0,0,12,0,0,0,BFLAGS);      <<00.06>>50985000
            IF S1.(8:8) <> %12 THEN GO E0;  <<ATTACHIO error?>><<02568>>50990000
            END                                                <<00.06>>50995000
         ELSE IF S1.(8:8) = %103 THEN  <<RUNAWAY => NEW TAPE?>><<00.06>>51000000
            BEGIN                                              <<00.06>>51005000
            DDEL;                                              <<00.06>>51010000
            ATTACHIO(DADDR,0,0,0,5,0,0,0,USFLAGS+%13);<<Rewnd>><<02568>>51015000
            IF DTYPE = MTAPE THEN                              <<02568>>51020000
               SET'LPDT'BOT(DADDR,1);  << Tape back at BOT >>  <<02568>>51025000
            END                                                <<00.06>>51030000
         ELSE GO E0;  <<ATTACHIO ERROR?>>                      <<00.06>>51035000
         DDEL                                                  <<00.06>>51040000
         END                                                            51045000
      END;                                                              51050000
$PAGE                                                          <<04624>>51055000
   <<*******************************************************>> <<04624>>51060000
   <<              CREATE   AN    ACB                       >> <<04624>>51065000
   << Create an ACB via SETACB.  SETACB will initialize     >> <<04624>>51070000
   << most of the ACB variables and then returns with DB    >> <<04624>>51075000
   << set to the data segment containing the ACB.           >> <<04624>>51080000
   <<*******************************************************>> <<04624>>51085000
                                                                        51090000
   IF USER'SPOOLF                                              << 8485>>51095000
      THEN FNAMEMQ := @SPFN - @Q0                              <<04624>>51100000
      ELSE FNAMEMQ := @FN   - @Q0;                             <<04624>>51105000
   IF DTYPE=SDISC AND AOPTIONS.(4:1)=1 THEN                    <<00188>>51110000
      GOTO E9;                                                 <<00188>>51115000
   SETACB(DUM,0D,0D,0,AFTX,AOPTIONS,FOPTIONS,DTYPE,RECSIZE,    <<06514>>51120000
      BSIZE,NUMBUFFERS,BLOCKFACTOR,DADDR,SPINFO,               <<06514>>51125000
      INTEGER(DNTYPE&LSL(8))+DISP,DISKADR,0D,0D,IPCINFO);      <<HM.00>>51130000
   DEL;  << Delete FLAGS parm, not used here.               >> <<06514>>51135000
   LACBV := TOS; PACBV := TOS; @ACB := TOS;                    <<06514>>51140000
   IF < THEN GO E5;  <<ERROR?>>                                         51145000
   IF > THEN GO NOFMAVT;    << Out of FMAVT entries.        >> <<04519>>51150000
   RESOURCES.ACBLOCK := TRUE;  <<SET ACB CREATED FLAG>>                 51155000
                                                               <<04624>>51160000
   <<*******************************************************>> <<04624>>51165000
   << Copy the file name from either FN or SPFN.  Below is  >> <<06514>>51170000
   << a tricky way to set up the parameters for an MFDS to  >> <<06514>>51175000
   << copy the name from the stack to the ACB.  FNAMEMQ is  >> <<04624>>51180000
   << the Q-relative location of the name to copy.          >> <<04624>>51185000
   <<*******************************************************>> <<04624>>51190000
                                                               <<04624>>51195000
   PCBPT := CURPRC;                                            <<06514>>51200000
   PXGLOBAL;                  << Set PCBGLOBLOC.            >> <<06514>>51205000
   TOS := @ACBNAME;           << DB offset to ACB name.     >> <<06514>>51210000
   TOS := SPCBSTKDST;         << From our stack to ACB.     >> <<06514>>51215000
   TOS := FNAMEMQ-PCBGLOBLOC; << Stack rel offset of name.  >> <<06514>>51220000
   TOS := 4;                  << Move 8 characters, 4 words.>> <<06514>>51225000
   ASSEMBLE(MFDS 4);          << From stack DST to ACB DST. >> <<06514>>51230000
                                                               <<04624>>51235000
                                                               <<06514>>51240000
    ACBACCESS := %76; <<ALL EXCEPT STORE ACC>>                 <<00685>>51245000
   ACBLSTATE := LOGICAL(ACBLSTATE) LOR STATE;  <<INSERT STATE BITS>>    51250000
   ACBPRIV := (FILECODE < 0) LOR AOPGLOBALAFT;                 <<06514>>51255000
                                                               <<04624>>51260000
   <<*******************************************************>> <<04624>>51265000
   <<                                                       >> <<04624>>51270000
   <<               NON    DISK    FILE                     >> <<04624>>51275000
   <<                                                       >> <<04624>>51280000
   << Non disk files do not need an FCB.  Therefore, enter  >> <<04624>>51285000
   << here to update the LACB (if one exists), do some      >> <<04624>>51290000
   << checking and GO TO FINISH to initialize the AFT.      >> <<04624>>51295000
   <<*******************************************************>> <<04624>>51300000
                                                               <<04624>>51305000
   IF ((LOGICAL(DTYPE) LAND %70) <> DIRACC)   <<NON-DISC?>>    <<01115>>51310000
      OR (DTYPE=FDISC) THEN                   <<OR FOREIGN DISC>><<FDF>>51315000
      BEGIN                                                             51320000
      IF (DTYPE=MTAPE OR DTYPE=SDISC)                          <<02356>>51325000
         AND NOT FOPLABELLED                                   <<02356>>51330000
         AND AOPWRITE THEN ACBNEWEOF:=1;                       <<02356>>51335000
                                                               <<04514>>51340000
      <<****************************************************>> <<04514>>51345000
      << Copy the PACB to the LACB and unlock the ACB via   >> <<04514>>51350000
      << UPDATE'LACB and UNLOCK'CB.                         >> <<06514>>51355000
      <<****************************************************>> <<04514>>51360000
                                                               <<04514>>51365000
      UPDATE'LACB(LACBV,PACBV);                                <<06514>>51370000
      UNLOCK'CB(0,PACBV);                                      <<06514>>51375000
                                                               <<06514>>51380000
      << Perform ATTACHIO setup for device allocation for >>   <<04136>>51385000
      << all devices except redirection or reopenning     >>   <<04136>>51390000
      << (by son) $STDLIST for output devices like e.g LP.>>   <<04136>>51395000
      << The extra call for setup will cause on LP extra  >>   <<04136>>51400000
      << page ejection.                                   >>   <<04136>>51405000
      IF ( JOBF << $STDIN/$STDINX >> OR                        <<04136>>51410000
           (AFTX > 2) << non $STDIN/$STDINX/$STDLIST >> OR     <<04136>>51415000
           (LDEVTOTYPE(DADDR) >= TERMINAL LAND  <<terminal>>   <<04136>>51420000
            LDEVTOTYPE(DADDR) < MTAPE)) AND                    <<04136>>51425000
         (DTYPE <> FDISC << it is not a foreign disc >>) THEN  <<04136>>51430000
         IF NOT PRIMEDEVICE(DADDR,XDDEP,PMAP.(8:1))            <<01027>>51435000
         THEN                                                  <<01027>>51440000
         BEGIN                                                 <<01027>>51445000
         TOS := IOERRHDR;     << header I/O err >>             <<01863>>51450000
         GO TO ERR;                                            <<01863>>51455000
         END;                                                  <<01027>>51460000
      GO FINISH                                                         51465000
      END;                                                              51470000
$PAGE                                                          <<04624>>51475000
   <<*******************************************************>> <<04624>>51480000
   <<                                                       >> <<04624>>51485000
   <<           DISK   FILE   COMPLETION                    >> <<04624>>51490000
   <<                                                       >> <<04624>>51495000
   << Set DB back from PACB extra data segment to stack.    >> <<04624>>51500000
   <<*******************************************************>> <<04624>>51505000
                                                               <<04624>>51510000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                51515000
                                                                        51520000
   <<*******************************************************>> <<04624>>51525000
   <<              CREATE    AN    FCB                      >> <<04624>>51530000
   << Create an FCB via FCREATECB.  If the file was opened  >> <<04624>>51535000
   << exclusively, then attempt to put the FCB in the stack.>> <<04624>>51540000
   << For files opened shared, the FCB ALWAYS goes in an ex->> <<04624>>51545000
   << tra data segment (shared FCB data segment).  Shared   >> <<04624>>51550000
   << FCB's are NEVER put in a processes stack.             >> <<04624>>51555000
   <<*******************************************************>> <<04624>>51560000
                                                                        51565000
   MOVE FCBGN := GN,(4);  <<GROUP NAME>>                                51570000
   MOVE FCBAN := AN,(4);  <<ACCOUNT NAME>>                              51575000
                                                               <<04624>>51580000
   <<*******************************************************>> <<04624>>51585000
   << Now create the FCB and copy the local FCB array to the>> <<04624>>51590000
   << control block via UPDATE'FCB.  Most of the FCB was    >> <<04624>>51595000
   << initialized in FCREATE.  The rest of it was initial-  >> <<04624>>51600000
   << ized throughout FOPEN.                                >> <<04624>>51605000
   <<*******************************************************>> <<04624>>51610000
                                                               <<04624>>51615000
   IF AOPMULTAC <> 0 OR AOPGLOBALAFT                           <<06514>>51620000
      THEN STRATEGY := -2   << Shared DST only.             >> <<06514>>51625000
      ELSE STRATEGY := -4;  << Try PXFILE, then shared DST. >> <<06514>>51630000
   FCREATECB(DUM,0D,STRATEGY,FCBSI,CBFCB); << Create it!    >> <<06514>>51635000
   IF < THEN GO E6;  <<ERROR?>>                                         51640000
   FCBV := TOS;   << FCREATECB returns the new FCBV on TOS. >> <<04624>>51645000
   DEL;           << Don't need the @FCB. No split stack.   >> <<04624>>51650000
   EXCHANGEDB(0);          << Back to the stack.            >> <<04624>>51655000
   IF RECOVER5 THEN                                            <<*8508>>51660000
      BEGIN                ! Patch sectors per block to 1 &    <<*8508>>51665000
      FCBSECTPBLK := 1;    ! and the blocking factor to 1 for  <<*8508>>51670000
      FCBBLKFACT  := 1;    ! RECOVER5 to improve performance.  <<*8508>>51675000
      END;                                                     <<*8508>>51680000
   UPDATE'FCB(FCBV);       << Copy local FCB to control blk.>> <<04624>>51685000
   << Now unlock the FCB.  Was locked by FCREATECB.         >> <<04624>>51690000
   UNLOCK'CB(0,FCBV);                                          <<06514>>51695000
   RESOURCES.FCBLOCK := TRUE;  <<SET FCB CREATED FLAG>>                 51700000
                                                               <<04624>>51705000
                                                               <<04624>>51710000
   <<*******************************************************>> <<04624>>51715000
   << Complete update of ACB.  Call FGETCB to reset the DB  >> <<04624>>51720000
   << at the PACB data segment.  UPDATE'LACB will reset the >> <<06514>>51725000
   << DB to the stack.                                      >> <<04624>>51730000
   <<*******************************************************>> <<04624>>51735000
                                                                        51740000
   @ACB := FGET'CB(PACBV,0);                                   <<06514>>51745000
   ACBFCB := FCBV;  <<INSERT FCB VECTOR>>                               51750000
   IF RECOVER5 THEN                                            <<*8508>>51755000
      BEGIN                ! Patch the block size to 1 sector  <<*8508>>51760000
      ACBBSIZE := 128;     ! and the blocking factor to 1 for  <<*8508>>51765000
      ACBBLKFACT := 1;     ! RECOVER5 to improve performance.  <<*8508>>51770000
      END;                                                     <<*8508>>51775000
                                                               <<04514>>51780000
   <<*******************************************************>> <<04514>>51785000
   << Copy the PACB to the LACB and unlock the ACB via the  >> <<04514>>51790000
   << procedure UPDATE'LACB and UNLOCK'CB.                  >> <<06514>>51795000
   <<*******************************************************>> <<04514>>51800000
                                                               <<04514>>51805000
   UPDATE'LACB(LACBV,PACBV);                                   <<06514>>51810000
   UNLOCK'CB(0,PACBV);                                         <<06514>>51815000
                                                                        51820000
   <<*******************************************************>> <<04624>>51825000
   <<               CREATE     FILE     LABEL               >> <<04624>>51830000
   << Allocate the FLAB buffer on stack and initialize the  >> <<04624>>51835000
   << FLAB buffer and write it to disk.                     >> <<04624>>51840000
   <<*******************************************************>> <<04624>>51845000
                                                                        51850000
   ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>                           51855000
   TOS := @FLAB; PS0 := 0;  <<CLEAR BUFFER>>                            51860000
   ASSEMBLE(DUP,INCB); TOS := 127; ASSEMBLE(MOVE 3);                    51865000
   MOVE FLLOCNAME := FN,(4);  <<LOCAL FILE NAME>>                       51870000
   MOVE FLGRPNAME := GN,(4);  <<GROUP NAME>>                            51875000
   MOVE FLACCTNAME := AN,(4);  <<ACCOUNT NAME>>                         51880000
   MOVE FLUSERID := USERID,(4);  <<USER NAME>>                          51885000
   MOVE FLLOCKWORD := LW,(4);  <<LOCK WORD>>                            51890000
   FLSECMX:=[6/32,6/32,6/32,6/32,6/32]D;<<Def: R,A,W,L,X:ANY>> <<01175>>51895000
   FLSECURE:=1;                         << Secure file >>      <<01175>>51900000
   FLFILECODE := FILECODE;                                              51905000
   FLFCBVECT := FCBV;                                                   51910000
   FLFLIM := FCBFLIM;                                                   51915000
   FLPVINFO := PVINFO;                                         <<00188>>51920000
   FLUSERLBL := USERLABELS;                                             51925000
   IF SPOOLF THEN FLCLID := ABSOLUTE(CLOADID);                          51930000
   FOPNOEQUATE := 0;  << Clear file equation bit.           >> <<06860>>51935000
   FLFOPTIONS := FOPTIONS;                                              51940000
   IF FOPMSGFILE THEN FLFORMAT:=1;  <<MSG FILE USES VAR LEN REC  HM.00>>51945000
   FLRECSIZE := -RECSIZE;                                               51950000
   FLBLKSIZE := BSIZE;                                                  51955000
   FLSECTOFF := FCBSECTOFF;                                             51960000
   FLNUMEXTS := FCBNUMEXTS;                                             51965000
   FLEXTSIZE := FCBEXTSIZE;                                             51970000
   FLLASTEXTSIZE := FCBLASTEXTSIZE;                                     51975000
   TOS := CALENDAR;  <<DAY AND YEAR>>                                   51980000
   ASSEMBLE(DUP,DUP);                                                   51985000
   FLCREATE := TOS;                                                     51990000
   FLLASTACC := TOS;                                                    51995000
   FLLASTMOD := TOS;                                                    52000000
   LDEVTOVTAB (FLEXTMAP,FCBEXTMAP,FCBNUMEXTS+1,PVINFO<>0);     <<RV.PV>>52005000
   FLALLOCDATE := CALENDAR;  <<SET RESTORE DATE>>              <<00630>>52010000
   FLMODTIME := FLALLOCTIME := CLOCK;                          <<07227>>52015000
   TOS := @FLDEVNAME&LSL(1);                                            52020000
   MOVE * := DEVL,(8);  <<DEVICE CLASS NAME>>                           52025000
   TOS := 0;  <<FOR LDEV>>                                              52030000
   TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                            52035000
   TOS := TOS&TASL(8)&DLSR(8);  <<SEPARATE LDEV>>                       52040000
   DISKADR := TOS;  <<FILE LABEL SECTOR NR.>>                           52045000
   DADDR := TOS;  <<FILE LABEL LDEV>>                                   52050000
   A := GETSIR(FISIR);  <<GET FILE SIR - FLABIO CHECK!>>       <<+0.06>>52055000
   LABELIO(-1,1);  <<WRITE FILE LABEL>>                        <<06870>>52060000
   IF FSOPEN'SPOOLF THEN                                       << 8485>>52065000
      BEGIN                                                             52070000
      TOS := 0D;                                                        52075000
      TOS := P1;                                                        52080000
      TOS.(0:8) := DADDR;                                               52085000
      TOS := P2;                                                        52090000
      XDDSPOOLINFO(*,%3,XDDEP)   <<PUT LABEL ADDR IN XDD>>     <<+1.03>>52095000
      END;                                                              52100000
   IF SPOOLF THEN  <<SPOOLFILE ACCESSED AS A DEVICE>>          <<+1.03>>52105000
      BEGIN                                                             52110000
      TOS := 0D;                                                        52115000
      TOS := 1;                                                         52120000
      TOS := FCBEXTSIZE;                                                52125000
      XDDSPOOLINFO(*,%41,XDDEP)  <<PUT FILE SIZE IN XDD>>      <<+1.03>>52130000
      END;                                                              52135000
                                                                        52140000
   <<* * * OPEN FILE * * *>>                                            52145000
                                                                        52150000
   TOS := ATTACHIO(DADDR,0,0,0,2,0,0,0,BSFLAGS);  <<OPEN FILE>><<+0.05>>52155000
   IF S1.(8:8) <> 1 THEN GO E0;  <<ATTACHIO ERROR?>>                    52160000
                                                               <<+0.04>>52165000
   <<* * * MEASUREMENT DATA ON NEW DISC FILE OPEN * * *>>      <<+0.04>>52170000
                                                               <<+0.04>>52175000
$  IF X3 = ON                                                  <<+0.04>>52180000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>52185000
   TOS := EFOPEN;  <<EVENT NR.>>                               <<+0.04>>52190000
   TOS := FILENUM;  <<FILE NR.>>                               <<+0.04>>52195000
   TOS := SPOOLF;  <<SPOOLING FLAG>>                           <<+0.04>>52200000
   IF < THEN  <<SPOOLER ACCESS?>>                              <<+0.04>>52205000
      BEGIN                                                    <<+0.04>>52210000
      DEL;                                                     <<+0.04>>52215000
      TOS := 2                                                 <<+0.04>>52220000
      END;                                                     <<+0.04>>52225000
   TOS.(0:2) := TOS;  <<INSERT ACCESSOR CODE>>                 <<+0.04>>52230000
   MMSTAT'(*,*,AOPTIONS,FOPTIONS,RECSIZE,BSIZE,NUMBUFFERS);    <<06863>>52235000
   TOS := EFOPEN';  <<EVENT CODE>>                             <<+0.04>>52240000
   TOS := FCBFLIM;  <<FILE LIMIT>>                             <<+0.04>>52245000
   TOS := FCBNUMEXTS+1;  <<NR. EXTENTS>>                       <<+0.04>>52250000
   TOS.(0:8) := INITALLOC;  <<NR. EXTENTS ALLOCATED>>          <<+0.04>>52255000
   MMSTAT'(*,*,*,*,0,0,0);                                     <<06863>>52260000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>52265000
$  IF                                                          <<+0.04>>52270000
                                                                        52275000
   <<* * * INITIALIZE AFT ENTRY * * *>>                                 52280000
                                                                        52285000
FINISH:                                                                 52290000
   INIT'AFT;                                                   <<06514>>52295000
   FOPEN := AFTX;  <<FILE NR.>>                                         52300000
   CONDCODE := CCE;  <<OK CONDITION CODE>>                              52305000
   TOS := 0;  <<NO ERROR>>                                              52310000
   GO EXIT;                                                             52315000
                                                                        52320000
   <<* * * ERROR RECOVERY * * *>>                                       52325000
                                                                        52330000
E0:  << ATTACHIO ERROR >>                                               52335000
   ASSEMBLE(XCH,ZROB);                                                  52340000
   TOS := IOSTAT(*);                                                    52345000
   GO ERR;                                                              52350000
     HELP  <<FOR DUMMY CALL>>;                                 <<00117>>52355000
                                                                        52360000
E1:  << INVALID FORMAL DESIGNATOR >>                                    52365000
   TOS := INVFREF;                                                      52370000
   GO ERR;                                                              52375000
                                                                        52380000
E3:  << FCREATE ERROR >>                                                52385000
   X := X-1;                                                            52390000
   IF SPOOLF                                                            52395000
      THEN TOS := SPCREATEERR(X)                                        52400000
      ELSE TOS := FCREATEERR(X);                                        52405000
   GO ERR;                                                              52410000
                                                                        52415000
E4:  << TOO MANY FILES >>                                               52420000
   TOS := TMFP;                                                         52425000
   GO ERR;                                                              52430000
                                                                        52435000
E4': << No room left for PXFILE expansion   >>                 <<02357>>52440000
   TOS := NOROOMLEFT;                                          <<02357>>52445000
   GO ERR;                                                     <<02357>>52450000
                                                               <<02357>>52455000
E5:  << NO MEMORY FOR ACB >>                                            52460000
                                                                        52465000
E6:  << NO MEMORY FOR FCB >>                                            52470000
   TOS := MEMPROB;                                                      52475000
   GO ERR;                                                              52480000
                                                                        52485000
E9:  << ILL PARM >>                                                     52490000
    TOS := ILLPARM; GO ERR;                                    <<01.01>>52495000
                                                               <<+1.01>>52500000
E8:  << NOT FS DEVICE >>                                       <<00117>>52505000
    TOS := DEVVIOL; GO ERR;                                    <<00117>>52510000
                                                               <<00117>>52515000
SECVIOL:                                                                52520000
   TOS := SEXVIOL;                                                      52525000
   GO ERR;                                                              52530000
                                                                        52535000
NOFMAVT:                                                       <<04519>>52540000
   TOS := OUTFMAVT;                                            <<04519>>52545000
   GO ERR;                                                     <<04519>>52550000
                                                               <<04519>>52555000
FCODERR:   << FILE CODE ERROR >>                                        52560000
   TOS := PRIVVIOL;                                                     52565000
                                                                        52570000
$PAGE                                                          <<06514>>52575000
!------------------------------------------------------------- <<06514>>52580000
! Release rescources on an error.  If the PACBLOCKED flag is   <<06514>>52585000
! set, then this was an old, multi-access file already opened  <<06514>>52590000
! in which an error occured after SCANFMAVT found the PACB     <<06514>>52595000
! but before the call to FOPENDA.  If ACBLOCK flag is set,     <<06514>>52600000
! then this must be a new disc file or a device file and       << 8543>>52605000
! DELACB will delete the ACB's.                                << 8543>>52610000
!------------------------------------------------------------- <<06514>>52615000
                                                               <<06514>>52620000
ERR:                                                                    52625000
   EXCHANGEDB(0);  <<RESET DB TO STACK>>                                52630000
   IF PACBLOCKED                                               <<06514>>52635000
      THEN UNLOCK'CB(0,PACBV);                                 <<06514>>52640000
   TOS := RESOURCES;  <<RESOURCE FLAGS>>                                52645000
   IF LS0.GLOBAFT THEN CLEAR'GLOBAL'AFT;                       <<06514>>52650000
   IF LS0.ACBLOCK THEN DELACB(PACBV,LACBV);  <<ACB CREATED?>>           52655000
   IF LS0.FCBLOCK THEN FDELETECB(FCBV);  <<FCB CREATED?>>               52660000
   IF A <> -1 THEN RELSIR (FISIR, A);                          <<01708>>52665000
   IF B <> -1 THEN RELSIR (FMAVTSIR, B);                       <<01708>>52670000
   A := -1;   B := -1;                                         <<01708>>52675000
   IF LS0.DEVICELOCK THEN  ! Has a device been allocated?      <<06515>>52680000
      IF SPOOLF THEN                                           <<06515>>52685000
         BEGIN                                                 <<06515>>52690000
         IF SPVDEV <> 0 THEN                                   <<06515>>52695000
            BEGIN          ! Deallocate spoofle virtual LDEV.  <<06515>>52700000
            TOS := %20400; ! Unprimed, don't release space.    <<06515>>52705000
            TOS := SPVDEV; ! Spoolfile virtual LDEV.           <<06515>>52710000
            DEALLOCATE(*); ! Release XDD, free virtual LDEV.   <<06515>>52715000
            END;                                               <<06515>>52720000
         END                                                   <<06515>>52725000
      ELSE                                                     <<06515>>52730000
         DEALLOCATE(DBL(DADDR));                               <<06515>>52735000
   IF LS0.DISKLOCK THEN   <<DISC SPACE ALLOCATION>>            <<DS.00>>52740000
      BEGIN                                                             52745000
      TOS := FCBNUMEXTS+1;                                              52750000
      IF SPOOLF THEN TOS.(8:1) := 1;                                    52755000
      X := DISKDEALLOC(FCBEXTSIZE,FCBLASTEXTSIZE,S0,FCBEXTMAP);         52760000
      DEL;                                                              52765000
$     IF X1 = ON                                                        52770000
      IF <> THEN FTROUBLE(470);  <<ERROR?>>                    <<KJ.03>>52775000
$     IF                                                                52780000
      END;                                                              52785000
   IF LS0.DSLOCK THEN                                          <<RV.PV>>52790000
   BEGIN << RELEASE DS LINE >>                                 <<DS.00>>52795000
      TOS := RFALINENUM;                                       <<DS.00>>52800000
      TOS := DSCLOSEPLABEL;                                    <<DS.00>>52805000
      IF = THEN SUDDENDEATH(52);                               <<DS.00>>52810000
      ASMB(PCAL 0);                                            <<DS.00>>52815000
   END;                                                        <<DS.00>>52820000
   IF TOS.DMOUNT THEN                                          <<RV.PV>>52825000
   BEGIN <<NEED TO DISMOUNT A JUST MOUNTED VOLUME SET>>        <<RV.PV>>52830000
       REQTYPE := IF PVOPEN' THEN CONDDISMOUNT                 <<RV.PV>>52835000
                             ELSE UNCONDDISMOUNT;              <<RV.PV>>52840000
       DISMOUNT (HVSIND, GNPTR, ANPTR,                         <<26.PV>>52845000
                 REQTYPE, PVINFO);                             <<23.PV>>52850000
       IF <> THEN                                              <<RV.PV>>52855000
       BEGIN <<SOME FAILURE>>                                  <<RV.PV>>52860000
           S0 := DISMOUNTPROB; <<HIGHER PRIORITY PROBLEM?>>    <<RV.PV>>52865000
       END ELSE RESOURCES.DMOUNT := FALSE;                     <<RV.PV>>52870000
   END;                                                        <<RV.PV>>52875000
                                                                        52880000
   CONDCODE := CCL;  <<ERROR CONDITION CODE>>                           52885000
   SETPXFILE;  <<INIT. PXFILE POINTER>>                                 52890000
                                                                        52895000
XIT:                                                                    52900000
                                                               <<06514>>52905000
   PXFFOPEN := S0;  <<ERROR NR.>>                                       52910000
                                                                        52915000
EXIT:                                                                   52920000
   IF A <> -1 THEN RELSIR(FISIR,A);  <<RELEASE FILE INTEGRITY SIR?>>    52925000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);                                  52930000
   DP'INDEX := 0;                                              <<02555>>52935000
   DEVPARMFLAG := 0;                                           <<02555>>52940000
   IF  USER'SPOOLF AND RESULT <> 0                             << 8485>>52945000
      THEN  SPOOLFOPEN                                         <<02555>>52950000
   ELSE                                                        <<02555>>52955000
      IF CONDCODE = CCE  AND  REMOTE  THEN                     <<02555>>52960000
         BEGIN                                                 <<02555>>52965000
            << Before we check if we're spooled, must not be >><<04311>>52970000
            << KSAM. (FFILEINFO not supported on KSAM files. >><<04311>>52975000
                                                               <<04311>>52980000
            FGETINFO(AFTX,,REM'FOPT,,,,,,REM'FCODE);           <<04311>>52985000
            IF REM'KSAM'FOPT  OR  REM'KSAM'FCODE               <<04311>>52990000
               THEN REM'SPOOL'ID := 0                          <<04311>>52995000
            ELSE                                               <<04311>>53000000
            BEGIN                                              <<04311>>53005000
            <<Check if spooled>>                               <<02555>>53010000
            FFILEINFO(AFTX,38,REM'SPOOL'ID);                   <<02555>>53015000
            IF <> THEN  REMOTE'ACCESS'ERROR;                   <<04311>>53020000
            END;                                               <<04158>>53025000
                                                               <<04311>>53030000
                                                               <<04311>>53035000
            << Remote spoolfile, download ENV on local side.>> << 8485>>53040000
            IF REM'SPOOL'ID <> 0 THEN   <<It's spooled>>       <<02555>>53045000
               GET'DEV'PARM(ENV'TOKEN,DEVPARMS,DP'INDEX);      <<02555>>53050000
                                                               <<02555>>53055000
         END            << Remote file >>                      <<04383>>53060000
   ELSE IF CONDCODE = CCE THEN   << ENV on 2608x hot prntr? >> <<04383>>53065000
           GET'DEV'PARM (ENV'TOKEN, DEVPARMS, DP'INDEX);       <<04383>>53070000
                                                               <<02555>>53075000
   IF DP'INDEX <> 0 THEN                                       <<02555>>53080000
      BEGIN             <<Call PLOADENV for downloadable >>    <<02555>>53085000
                        <<environment file               >>    <<02555>>53090000
      PLOADENV(RESULT,BDEVPARMS((DP'INDEX+1)&LSL(1)),          <<02555>>53095000
               DEVPARMFLAG,ALLOC'RESULT);                      <<02555>>53100000
      PXGLOBAL;         <<Reset PCB pointer after env open>>   <<06513>>53105000
                                                               <<02555>>53110000
      DP'FLAG := DP'ENV'ERRORS(DEVPARMFLAG);                   << 8485>>53115000
                                                               <<02555>>53120000
      IF DP'FLAG <> 0 THEN                                     <<02555>>53125000
        BEGIN                                                  <<02555>>53130000
        SPOOLFILE'PURGE(AFTX,@XDDEP,0,0);<<Purge the spoofle>> <<04679>>53135000
        CONDCODE := CCL;                                       <<02555>>53140000
        SETPXFILE;                                             <<02555>>53145000
        PXFFOPEN := DP'FLAG;                                   <<02555>>53150000
        TOS := DP'FLAG;                                        <<02555>>53155000
        RESULT := 0;         <<Reset spool open to fail>>      <<02555>>53160000
        GO BUM;                                                <<02555>>53165000
        END                                                    <<02555>>53170000
      ELSE IF USER'SPOOLF OR REM'SPOOL'ID <> 0 THEN            << 8485>>53175000
         <<------------------------------------------------->> << 8485>>53180000
         << Do not do the user label stuff for non spooled  >> << 8485>>53185000
         << env downloads.  Environment files are supported >> << 8485>>53190000
         << on hot Ciper printers.  However, make sure that >> << 8485>>53195000
         << we do it for remote spoolfiles.                 >> << 8485>>53200000
         <<------------------------------------------------->> << 8485>>53205000
                                                               <<04481>>53210000
         BEGIN           << No errors from PLOADENV >>         <<02555>>53215000
         ALLOCFLAB;     << allot stack buffer of 128 words >>  <<02555>>53220000
         FREADLABEL(AFTX,FLAB);   << read u-label 0 >>         <<02555>>53225000
         IF <  THEN ERR'SPULAB;                                <<02555>>53230000
                                                               <<02555>>53235000
         SPULAB'LAST'ENV := " ";                               <<02555>>53240000
         MOVE FLAB(12) := FLAB(11), (17);                      <<02555>>53245000
         MOVE SPULAB'LAST'ENV := DEVPARMS(DP'INDEX+1),         <<02555>>53250000
                            ((DEVPARMS(DP'INDEX)+1)&ASR(1));   <<02555>>53255000
         << Make sure ENV file name is terminated by a CR >>   <<02555>>53260000
         @BFLAB := @FLAB & LSL(1);                             <<02571>>53265000
         BFLAB( 22 + (DEVPARMS(DP'INDEX)-1) ) := %15;          <<02555>>53270000
         FWRITELABEL(AFTX,FLAB);                               <<02555>>53275000
         IF <> THEN ERR'SPULAB;                                <<02555>>53280000
         ASSEMBLE (SUBS 128);     << deallocate stack buffer >><<02555>>53285000
         END;                                                  <<02555>>53290000
                                                               <<02555>>53295000
      END;         << Take care of ENV file >>                 <<02555>>53300000
                                                               <<02555>>53305000
   <<THE FOLLOWING IS A KLUDGE TO AVOID A COMPILER ERROR>>     <<00199>>53310000
   IF CONDCODE=CCE AND                                         <<00199>>53315000
     NOT (REMOTE LOR KSF LOR JOBF LOR SPOOLF) THEN             <<00199>>53320000
   BEGIN <<POSSIBLE KSAM FILE>>                                <<KS.00>>53325000
     FOPTIONS:=0;                                           <<KS.01.06>>53330000
      FGETINFO(RESULT,,FOPTIONS);                              <<KS.00>>53335000
      IF FOPKSAM THEN                                          <<HM.00>>53340000
      BEGIN <<KSAM FILE TO BE OPENED>>                         <<KS.00>>53345000
         IF FOPTIONS.FOPDOMAINF=0 THEN                         <<KS.00>>53350000
         BEGIN <<NEW FILE>>                                    <<KS.00>>53355000
            KFCLOSE(RESULT,0,0);                               <<KS.00>>53360000
            IF PMAP.(3:1)=0 <<FORMALDES ABSENT>>               <<KS.00>>53365000
            OR PMAP.(8:1)=0 <<KSAMPARAM=FORMSMSG ABSENT>> THEN <<KS.00>>53370000
               BEGIN  <<CAN NOT OPEN>>                         <<KS.00>>53375000
               CONDCODE:=CCL; <<ERROR CONDITION CODE>>         <<KS.00>>53380000
               SETPXFILE;                                   <<KS.01.06>>53385000
               PXFFOPEN:=ILLPARM;<<"ILLEGAL PARAMETER">>       <<KS.00>>53390000
               RESULT:=0; <<FOPEN:=0>>                         <<KS.00>>53395000
               GO BUM;                                         <<KS.00>>53400000
               END;  <<CAN NOT OPEN>>                          <<KS.00>>53405000
            IF AOPGLOBALAFT THEN                               <<06514>>53410000
               BEGIN                                           <<06514>>53415000
ILLKSAM:       SETPXFILE;                                      <<06514>>53420000
               PXFFOPEN := KSAMGLOB;                           <<06514>>53425000
               RESULT := 0;           << FOPEN := 0         >> <<06514>>53430000
               GO BUM;                                         <<06514>>53435000
               END;                                            <<06514>>53440000
            TOS:=KOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,       <<KS.00>>53445000
           -RECSIZE,DEVL <<NB>>,FORMMSG,USERLABELS,            <<KS.00>>53450000
            BLOCKFACTOR,PRICOPBUFS,FILESIZE,NUMEXTENTS,        <<KS.00>>53455000
            INITALLOC,FILECODE);                               <<KS.00>>53460000
            PUSH(STATUS);                                      <<KS.00>>53465000
            TOS:=TOS.(6:2);                                    <<KS.00>>53470000
            CONDCODE:=TOS;                                     <<KS.00>>53475000
            RESULT:=TOS;                                       <<KS.00>>53480000
         END <<NEW FILE>>                                      <<KS.00>>53485000
      ELSE                                                     <<KS.00>>53490000
         BEGIN <<OLD FILE>>                                    <<KS.00>>53495000
            IF AOPCOPY THEN                                    <<HM.00>>53500000
            <<DO NOTHING. NOT KSAM ACCESS>>                    <<KS.00>>53505000
         ELSE                                                  <<KS.00>>53510000
            BEGIN<<STANDARD OLD KSAM>>                         <<KS.00>>53515000
               KFCLOSE(RESULT,0,0);                            <<KS.00>>53520000
               IF AOPGLOBALAFT                                 <<06514>>53525000
                  THEN GOTO ILLKSAM;                           <<06514>>53530000
              IF NOT DIRACCF THEN                              <<01264>>53535000
              BEGIN       << disallow Run KSAM files >>        <<01264>>53540000
               FOPNOEQUATE:=SAVFOPNEQ; <<RESTORE NOEQUATE BIT    KJ.03>>53545000
               TOS:=KOPEN(FORMDESIGNATOR,FOPTIONS,AOPTIONS,    <<KS.00>>53550000
              -RECSIZE,DEVL <<NB>>,FORMMSG,USERLABELS,         <<KS.00>>53555000
               BLOCKFACTOR,PRICOPBUFS,FILESIZE,NUMEXTENTS,     <<KS.00>>53560000
               INITALLOC,FILECODE);                            <<KS.00>>53565000
               PUSH(STATUS);                                   <<KS.00>>53570000
               TOS:=TOS.(6:2);                                 <<KS.00>>53575000
               CONDCODE:=TOS;                                  <<KS.00>>53580000
               RESULT:=TOS;                                    <<KS.00>>53585000
              END;                                             <<01264>>53590000
            END;<<STANDARD OLD KSAM>>                          <<KS.00>>53595000
         END; <<OLD FILE>>                                     <<KS.00>>53600000
      END;<<KSAM FILE>>                                        <<KS.00>>53605000
   END;<<POSSIBLE KSAM FILE>>                                  <<KS.00>>53610000
BUM:                                                           <<KS.00>>53615000
   IF CONDCODE<>CCE THEN FOPEN := 0;                           <<00107>>53620000
   RESETCRITICAL(CRIT);                                                 53625000
   ERROREXIT(15,S0,0)                                                   53630000
   END;     << procedure FOPEN >>                                       53635000
$ PAGE " FRENAME  "                                            <<06272>>53640000
$ CONTROL SEGMENT = FILESYS4                                            53645000
PROCEDURE FRENAME(FILENUM,NEWFREF);                            <<KS.00>>53650000
   <<MUST BE CALLED WITH DB SET TO THE STACK>>                          53655000
   VALUE FILENUM;                                                       53660000
   INTEGER FILENUM;                                                     53665000
   BYTE ARRAY NEWFREF;                                                  53670000
   OPTION PRIVILEGED;                                                   53675000
   BEGIN                                                                53680000
                                                               <<04514>>53685000
   <<*******************************************************>> <<04514>>53690000
   <<  Error condition        ACBERROR      Condition Code  >> <<04514>>53695000
   <<                                                       >> <<04514>>53700000
   << PCBXFSECT not initialized             ***H A N G ***  >> <<04514>>53705000
   << 1 > FILENUM > FXMAXNUM                ***H A N G ***  >> <<04514>>53710000
   << Privileged file code and caller not   ***H A N G ***  >> <<04514>>53715000
   << FILNUM is $NULL                            CCE        >> <<04514>>53720000
   << DTYPE <> "DISC"         DEVVIOL            CCL        >> <<04514>>53725000
   << FILENUM <> EXCLUSIVE    MULITACCERR        CCL        >> <<04514>>53730000
   << R/W Label Error         LBLIOERR           CCL        >> <<04514>>53735000
   << NEWFREF Invalid         INVFREF            CCL        >> <<04514>>53740000
   << FILENUM Rename to $NULL INVFNAME           CCL        >> <<04514>>53745000
   << RENAME accross HVS's    HVSIOL             CCL        >> <<04514>>53750000
   << ****N O R M A L****                        CCE        >> <<04514>>53755000
   <<                                                       >> <<04514>>53760000
   <<*******************************************************>> <<04514>>53765000
                                                               <<04514>>53770000
   ARRAY ERRORMAP (1:8)=PB := DUPNSD,UNDEFFILESD,SEXVIOL,               53775000
      DIROVFLO,DIROVFLO,DIROVFLO,DIRIOERR,NORIN;                        53780000
   INTEGER CRIT;  <<FOR SETCRITICAL>>                                   53785000
   INTEGER PCBGLOBLOC;    <<PCBX POINTER>>                     <<06513>>53790000
   INTEGER A;  <<USED BY GETSIR>>                                       53795000
   INTEGER B := -1;  <<USED BY GETSIR>>                                 53800000
   INTEGER DBFLAG := 0;  <<DB SET TO STACK FLAG>>                       53805000
   INTEGER NTYPE;                                                       53810000
   INTEGER OLDNTYPE;                                                    53815000
   INTEGER DOMAIN;                                                      53820000
   INTEGER DADDR;                                                       53825000
   INTEGER NEWNTYPE;                                                    53830000
   LOGICAL NEWFOPTIONS := 0;                                            53835000
   BYTE ARRAY TNEWFREF(0:35);  << TEMP. FILE NAME >>           <<04132>>53840000
   ARRAY FN (0:3);  <<LOCAL FILE NAME>>                                 53845000
   ARRAY GN (0:3);  <<GROUP NAME>>                                      53850000
   ARRAY AN (0:3);  <<ACCT. NAME>>                                      53855000
   ARRAY LW (0:3);  <<LOCK WORD>>                                       53860000
   BYTE ARRAY BFN(*) = FN, BGN(*) = GN, BAN(*) = AN;           <<01849>>53865000
   INTEGER POINTER FNPTR,GNPTR,ANPTR;                                   53870000
   BYTE POINTER BFNPTR, BGNPTR, BANPTR;                        <<01849>>53875000
   DOUBLE DRCODE;                                                       53880000
   INTEGER RCB = DRCODE;                                                53885000
   INTEGER RCA = DRCODE+1;                                              53890000
   DOUBLE FADDR;                                                        53895000
                                                                        53900000
   INTEGER FCBMQ;   << Q-relative offset to FCB.            >> <<06514>>53905000
   INTEGER DSTX;    << Original Stack number >>                <<04514>>53910000
   INTEGER POINTER FCB;  <<FCB POINTER>>                                53915000
   DOUBLE POINTER FCBDBL = FCB;                                         53920000
   DOUBLE                    << DST and offset of ...       >> <<06514>>53925000
      FCB'CB'ADDR,           << FCB control block address.  >> <<06514>>53930000
      FCB'STK'ADDR;          << FCB stack address.          >> <<06514>>53935000
                                                                        53940000
   <<FILE LABEL PARAMETERS>>                                            53945000
                                                                        53950000
   DOUBLE LABADR;  <<FILE LABEL SECTOR NR.>>                            53955000
   INTEGER P1 = LABADR;                                                 53960000
   INTEGER P2 = LABADR+1;                                               53965000
   ARRAY LABADRA (*) = LABADR;                                          53970000
   INTEGER ARRAY FLAB (0:127);  <<FILE LABEL BUFFER>>                   53975000
   DOUBLE ARRAY FLABDBL(*)=FLAB;                               <<07227>>53980000
   ARRAY FTAB(0:120);  << :FILE COMMAND PARM. BUFFER >>        <<04132>>53985000
                                                                        53990000
   <<JIT INFO>>                                                         53995000
                                                                        54000000
   INTEGER ARRAY JITINFO(0:26) = Q;                                     54005000
   ARRAY HANAME (*) = JITINFO(3);  <<HOME ACCT. NAME>>                  54010000
   ARRAY LGNAME (*) = JITINFO(11);  <<LOGON GROUP NAME>>                54015000
   ARRAY USERID (*) = JITINFO(15);  <<USER NAME>>                       54020000
   DOUBLE UCAP = JITINFO+25;  <<USER CAPABILITIES>>                     54025000
   LOGICAL SFCAP = UCAP;  <<SAVE FILE CAPABILITY?>>                     54030000
                                                                        54035000
                                                               <<DS.00>>54040000
   << REMOTE FILE ACCESS (RFA) VARIABLES >>                    <<DS.00>>54045000
                                                               <<DS.00>>54050000
   INTEGER POINTER RFAPTR; << APPENDAGE POINTER >>             <<DS.00>>54055000
   INTEGER RFALEN; << APPENDAGE LENGTH >>                      <<DS.00>>54060000
   INTEGER USERDB; <<U/B KSAM>>                                <<KS.00>>54065000
   INTEGER POINTER AFT; <<U/B KSAM>>                           <<KS.00>>54070000
                                                               <<DS.00>>54075000
                                                                        54080000
   ARRAY                                                       <<RV.PV>>54085000
       GENTRY (*),                                             <<RV.PV>>54090000
       SHVSNAME (*);                                           <<RV.PV>>54095000
                                                               <<RV.PV>>54100000
                                                               <<RV.PV>>54105000
   LOGICAL ACB'FLAGS;         << Flags sent to LOC'ACB      >> <<04514>>54110000
                                                               <<04514>>54115000
   <<*******************************************************>> <<04514>>54120000
   << ACB'POINTERS - Below are the declarations and equates >> <<04514>>54125000
   << for the PACB and AFT arrays.  LOC'ACB places the AFT  >> <<04514>>54130000
   << at ACB(-4) to ACB(-1) and the PACB follows.           >> <<04514>>54135000
                                                               <<04514>>54140000
   INTEGER ACBMQ;          << Q-relative ACB loc for LOC'ACB>> <<04514>>54145000
   INTEGER AFTE;    <<AFT entry word 0, type and $NULL bit. >> <<04514>>54150000
   DOUBLE  PACBV;   << Physical ACB Vector                  >> <<06514>>54155000
   DOUBLE  LACBV;   << Logical  ACB Vector                  >> <<06514>>54160000
   INTEGER IOQX;    << No-wait I/O pending Queue index.     >> <<04514>>54165000
   RFASTUFF;        << Set up remote file variables.        >> <<06514>>54170000
                                                               <<04514>>54175000
   << The order of the above declarationa cannot be changed >> <<04514>>54180000
   << in any way.  Also, the ACB declaration must immed-    >> <<04514>>54185000
   << iately follow.                                        >> <<04514>>54190000
                                                               <<04514>>54195000
   INTEGER ARRAY ACB(0:SIZEXACB-1) = Q;                        <<04514>>54200000
   DOUBLE ARRAY ACBDBL(*)=ACB;                                 <<04514>>54205000
                                                               <<04514>>54210000
   <<*******************************************************>> <<04514>>54215000
$ PAGE " FRENAME - LABELIO "                                   <<06272>>54220000
   SUBROUTINE LABELIO (RW);                                             54225000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           54230000
                                                                        54235000
        INPUT VARIABLES:                                                54240000
            RW - I/O MODE                                               54245000
               0 - READ                                                 54250000
               1 - WRITE                                                54255000
                                                                        54260000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE      54265000
        IS CALLED>>                                                     54270000
      VALUE RW;                                                         54275000
      INTEGER RW;                                                       54280000
      BEGIN                                                             54285000
      X := FLABIO(DADDR,LABADR,RW,FLAB);  <<R/W LABEL>>                 54290000
      IF <> THEN  <<ERROR?>>                                            54295000
         BEGIN                                                          54300000
         FLABIOERR(X,FILENUM);  <<HANDLE ERROR>>                        54305000
         TOS := LBLIOERR;                                               54310000
         TOS := CCL;                                                    54315000
         GO RELEASE'FCB;                                       <<06514>>54320000
         END                                                            54325000
      END;                                                              54330000
                                                               <<06514>>54335000
                                                               <<06514>>54340000
                                                               <<06514>>54345000
<<                  CHKHVSBOUNDS                            >> <<06514>>54350000
                                                               <<06514>>54355000
   SUBROUTINE CHKHVSBOUNDS;                                    <<RV.PV>>54360000
       BEGIN                                                   <<RV.PV>>54365000
           TOS := @AN & LSL (1);                               <<RV.PV>>54370000
           TOS := @ANPTR & LSL (1);                            <<RV.PV>>54375000
           TOS := @GN & LSL (1);                               <<RV.PV>>54380000
           TOS := @GNPTR & LSL (1);                            <<RV.PV>>54385000
           IF BPS3 <> BPS2, (8) OR BPS1 <> BPS0, (8) THEN      <<RV.PV>>54390000
           BEGIN  <<POSSIBLE DIFFERENT HVS'S>>                 <<RV.PV>>54395000
               <<ALLOCATE SPACE FOR NEEDED ARRAYS>>            <<RV.PV>>54400000
               DDEL; DDEL;  <<POINTERS>>                       <<RV.PV>>54405000
               TOS := GSIZE+(NAMESIZE*3);                      <<RV.PV>>54410000
               PUSH (S);                                       <<RV.PV>>54415000
               @SHVSNAME := (@GENTRY := TOS) + GSIZE;          <<RV.PV>>54420000
               ASSEMBLE (ADDS 0);                              <<RV.PV>>54425000
               IF FCBPVINFO = 0 THEN                           <<06514>>54430000
               BEGIN <<SOURCE HVS IS SYSTEM VOLUME SET>>       <<RV.PV>>54435000
                   SHVSNAME := "  ";                           <<RV.PV>>54440000
                   MOVE SHVSNAME (1) :=                        <<RV.PV>>54445000
                        SHVSNAME, ((NAMESIZE*3)-1);            <<RV.PV>>54450000
               END ELSE                                        <<RV.PV>>54455000
               BEGIN  <<NEED SOURCE HVS NAME>>                 <<RV.PV>>54460000
                   DRCODE := DIRECFIND (%10,0D,AN,GN,          <<RV.PV>>54465000
                                        FN,GENTRY);            <<RV.PV>>54470000
                   IF <> THEN                                  <<RV.PV>>54475000
                   BEGIN                                       <<RV.PV>>54480000
                       IF < THEN TOS := DIRIOERR ELSE                   54485000
                         BEGIN  << convert directory err nr. >>         54490000
                         TOS := ERRORMAP(RCA);                          54495000
                         IF RCA=2 THEN TOS := TOS-RCB                   54500000
                         ELSE IF RCA=8 THEN TOS := TOS+RCB;             54505000
                         END;                                           54510000
                       TOS := CCL;                             <<RV.PV>>54515000
                       GO TO RELEASE'FCB;                      <<06514>>54520000
                   END;                                        <<RV.PV>>54525000
                   MOVE SHVSNAME :=                            <<RV.PV>>54530000
                        GENTRY (GHVSNAME), (NAMESIZE*3);       <<RV.PV>>54535000
               END;                                            <<RV.PV>>54540000
               <<GET TARGET HVS NAME>>                         <<RV.PV>>54545000
               DRCODE := DIRECFIND (%10,0D,ANPTR,GNPTR,        <<RV.PV>>54550000
                                    FNPTR,GENTRY);             <<RV.PV>>54555000
               IF <> THEN                                      <<RV.PV>>54560000
               BEGIN                                           <<RV.PV>>54565000
                       IF < THEN TOS := DIRIOERR ELSE                   54570000
                         BEGIN  << convert directory err nr. >>         54575000
                         TOS := ERRORMAP(RCA);                          54580000
                         IF RCA=2 THEN TOS := TOS-RCB                   54585000
                         ELSE IF RCA=8 THEN TOS := TOS+RCB;             54590000
                         END;                                           54595000
                   TOS := CCL;                                 <<RV.PV>>54600000
                   GO TO RELEASE'FCB;                          <<06514>>54605000
               END;                                            <<RV.PV>>54610000
               TOS := @SHVSNAME & LSL (1);                     <<RV.PV>>54615000
               TOS := @GENTRY (GHVSNAME) & LSL (1);            <<RV.PV>>54620000
               IF * <> *, (24) THEN                            <<RV.PV>>54625000
               BEGIN <<SOURCE AND TARGET HVS'S DIFFERENT>>     <<RV.PV>>54630000
                   TOS := HVSVIOL;                             <<RV.PV>>54635000
                   TOS := CCL;                                 <<RV.PV>>54640000
                   GO TO RELEASE'FCB;                          <<06514>>54645000
               END;                                            <<RV.PV>>54650000
               TOS := GSIZE+(NAMESIZE*3);                      <<RV.PV>>54655000
               ASSEMBLE (SUBS 0);                              <<RV.PV>>54660000
           END ELSE ASSEMBLE (DDEL, DDEL);                     <<RV.PV>>54665000
       END;<<OF CHKHVSBOUNDS>>                                 <<RV.PV>>54670000
$PAGE  " FRENAME - MAIN BLOCK "                                <<06514>>54675000
   SUBROUTINE UPDATEFCB;                                       <<06514>>54680000
                                                               <<06514>>54685000
      <<****************************************************>> <<06514>>54690000
      << Updates the actual FCB in the control block (where >> <<06514>>54695000
      << ever it may be) by overlaying  it with the updated >> <<06514>>54700000
      << FCB that exists on the stack.                      >> <<06514>>54705000
      <<****************************************************>> <<06514>>54710000
                                                               <<06514>>54715000
      BEGIN                                                    <<06514>>54720000
      TOS := FCB'CB'ADDR;  << CB DST and offset of FCB.     >> <<06514>>54725000
      TOS := FCB'STK'ADDR; << Stack DST and offset of FCB.  >> <<06514>>54730000
      TOS := SIZEBFCB;     << Now copy minimum FCB back.    >> <<06514>>54735000
      MOVE'DS'5;                                               <<06514>>54740000
      END;                                                     <<06514>>54745000
                                                               <<06514>>54750000
                                                               <<06514>>54755000
<<                     MAIN BLOCK                           >> <<06514>>54760000
                                                               <<06514>>54765000
$  IF X0 = ON                                                           54770000
   IF MONCALLABLE THEN  <<MONITORING?>>                                 54775000
      BEGIN                                                             54780000
      TOS := "FR"; TOS := "EN"; TOS := "AM"; TOS := "E ";               54785000
      ASSEMBLE(DZRO,DZRO);                                              54790000
      FTITLE(*,*,*,*);                                                  54795000
      DEBUG                                                             54800000
      END;                                                              54805000
$  IF                                                                   54810000
                                                                        54815000
   ERRORON;                                                             54820000
   CRIT := SETCRITICAL;                                                 54825000
   CHECKDB;  <<WHERE'S DB?>>                                            54830000
   IF <> THEN DBFLAG := DBFLAG+1;  <<NOT SET TO STACK?>>                54835000
   ACB'FLAGS := STATUS;                                        <<06296>>54840000
   ACB'FLAGS.(1:15):=0;  <<  Privmode check only            >> <<04514>>54845000
   GET'ACB'Q'LOC;                                              <<04514>>54850000
   LOC'ACB(DSTX, ACBMQ, FILENUM, ACB'FLAGS);                   <<04514>>54855000
   DSTX := TOS;  <<LOC'ACB returns DST on TOS               >> <<04514>>54860000
   IF < THEN  <<INVALID FILE NR.?>>                                     54865000
      BEGIN                                                             54870000
      TOS := INVFN;                                                     54875000
      TOS := CCL;                                                       54880000
      GO EXIT                                                           54885000
      END;                                                              54890000
   IF > THEN  <<$NULL?>>                                                54895000
      BEGIN                                                             54900000
      TOS := 0;  <<NO ERROR>>                                           54905000
      TOS := CCE;                                                       54910000
      GO EXIT                                                           54915000
      END;                                                              54920000
   IF LOGICAL(DBFLAG) THEN  <<DB WAS NOT AT STACK?>>                    54925000
      BEGIN                                                             54930000
      TOS := ILLDB;                                                     54935000
      TOS := CCL;                                                       54940000
      GO RELEASE'ACB;                                          <<06514>>54945000
      END;                                                              54950000
   CASE FTYPE OF                                               <<DS.00>>54955000
   BEGIN                                                       <<DS.00>>54960000
                                                               <<DS.00>>54965000
   BEGIN << CONVENTIONAL FILE >>                               <<DS.00>>54970000
CONVENTIONAL:                                                  <<HM.00>>54975000
   IF ACBACCCL<>DIRACC OR ACBSPOOLED OR ACBDTYPE=FDISC THEN    <<01115>>54980000
      BEGIN                                                             54985000
      TOS := DEVVIOL;                                                   54990000
      TOS := CCL;                                                       54995000
      GO RELEASE'ACB;                                          <<06514>>55000000
      END;                                                              55005000
   OLDNTYPE := ACBDNTYPE;                                               55010000
   B := GETSIR(FISIR);  <<GET FILE SIR NOW!>>                           55015000
                                                                        55020000
   <<* * * LOCATE FCB * * *>>                                           55025000
                                                                        55030000
   ALLOC'C'FCB;   << Alloc. min FCB w/o full extent map.    >> <<06514>>55035000
   GET'FCB'Q'LOC;                                              <<06514>>55040000
   LOCK'CB(0,0,FCBMQ,ACBFCB);                                  <<06514>>55045000
   FCB'CB'ADDR := DS1;        << Save the FCB addresses for >> <<06514>>55050000
   FCB'STK'ADDR := DS3;       << update back to the FCB CB. >> <<06514>>55055000
   TOS := SIZECFCB;           << Min. FCB plus 1st. extent. >> <<06514>>55060000
   MOVE'DS'5;                 << Copy FCB to our stack.     >> <<06514>>55065000
   DEL;                       << Delete FLAGS parameter.    >> <<06514>>55070000
   IF FCBEXCLSTAT <> -1 THEN  <<NOT OPENED EXCLUSIVELY?>>               55075000
      BEGIN                                                             55080000
      TOS := MLTIACCERR;                                                55085000
      TOS := CCL;                                                       55090000
      GO RELEASE'FCB;                                          <<06514>>55095000
      END;                                                              55100000
   TOS := 0;  <<FOR LDEV>>                                              55105000
   TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                            55110000
   TOS := TOS&TASL(8)&DLSR(8);  <<SEPARATE LDEV>>                       55115000
   LABADR := TOS;  <<FILE LABEL SECTOR NR.>>                            55120000
   DADDR := TOS;  <<FILE LABEL LDEV>>                                   55125000
                                                                        55130000
   <<*******************************************************>> <<06166>>55135000
   << Read file label and insert new name into the FLAB on  >> <<06166>>55140000
   << the stack via FNFORMAT.  New files that are renamed,  >> <<06166>>55145000
   << (including $NEWPASS) skip the two big IF's below and  >> <<06166>>55150000
   << simply write the new FLAB back out with the new name. >> <<06166>>55155000
   <<*******************************************************>> <<06166>>55160000
                                                                        55165000
                                                               <<06514>>55170000
   LABELIO(0);  <<READ FILE LABEL>>                                     55175000
   @FNPTR := @FLLOCNAME;                                                55180000
   @GNPTR := @FLGRPNAME;                                                55185000
   @ANPTR := @FLACCTNAME;                                               55190000
   MOVE FN := FNPTR,(4);                                                55195000
   MOVE GN := GNPTR,(4);                                                55200000
   MOVE AN := ANPTR,(4);                                                55205000
   LW := "  "; MOVE LW(1) := LW,(3);                                    55210000
   MOVE TNEWFREF := NEWFREF,(36);  <<COPY FILE REF.>>          <<04132>>55215000
   NTYPE := FNFORMAT(TNEWFREF,FNPTR,GNPTR,ANPTR,LW);           <<04132>>55220000
   IF NTYPE > 2 THEN  << FILE EQ. OR ERROR >>                  <<04132>>55225000
      IF NTYPE = 3 THEN  << CHECK FILE EQ >>                   <<04132>>55230000
         BEGIN                                                 <<04132>>55235000
         NTYPE := FQFORMAT(TNEWFREF,FNPTR,GNPTR,ANPTR,LW);     <<04132>>55240000
         IF NTYPE = 4 THEN GOTO E1;                            <<04132>>55245000
         END                                                   <<04132>>55250000
      ELSE                                                     <<04132>>55255000
      BEGIN                                                             55260000
E1:   TOS := INVFREF;                                                   55265000
      TOS := CCL;                                                       55270000
      GO RELEASE'FCB;                                          <<06514>>55275000
      END;                                                              55280000
   DOMAIN := FLDOMAIN;  <<FILE DOMAIN>>                                 55285000
   NEWNTYPE := NTYPE;                                          <<04132>>55290000
                                                                        55295000
   <<* * * GET INFORMATION IN JIT * * *>>                               55300000
                                                                        55305000
   PXGLOBAL; <<INIT. PCBX POINTER>>                            <<06513>>55310000
   TOS := @JITINFO;  <<STACK ADR.>>                                     55315000
   TOS := PXG'JITDST; TOS := JITASEC;                          <<06513>>55320000
   TOS := 27;                                                           55325000
   ASSEMBLE(MFDS 4);                                                    55330000
   IF NTYPE = 2 THEN  << GROUP & ACCT ABSENT? >>               <<+1.01>>55335000
      BEGIN                                                             55340000
      MOVE FLGRPNAME := LGNAME,(4);                                     55345000
      MOVE FLACCTNAME := HANAME,(4)                                     55350000
      END                                                               55355000
   ELSE IF NTYPE = 1 THEN  << ACCT NAME ABSENT? >>             <<+1.01>>55360000
      MOVE FLACCTNAME := HANAME,(4);                                    55365000
                                                                        55370000
   <<* * * Rename a permanent file * * *>>                     <<01849>>55375000
                                                                        55380000
   CHKHVSBOUNDS;                                               <<01882>>55385000
   IF DOMAIN = 1 AND FLACTUAL THEN                             <<06166>>55390000
      BEGIN     << insert name in system directory >>                   55395000
      IF NOT SFCAP THEN                                        <<01849>>55400000
         BEGIN   << No Save File capability.                >> <<01849>>55405000
         TOS := SFERR;                                         <<01849>>55410000
         TOS := CCL;                                           <<01849>>55415000
         GO RELEASE'FCB;                                       <<06514>>55420000
         END;                                                  <<01849>>55425000
      TOS := @USERID&LSL(1);                                   <<00088>>55430000
      TOS := @FLUSERID&LSL(1);                                          55435000
      TOS := @HANAME&LSL(1);                                   <<00706>>55440000
      TOS := @AN&LSL(1); <<ACCT OF FILE BEING RENAMED>>        <<00706>>55445000
      IF BPS3 <> BPS2,(8)  OR  BPS1 <> BPS0,(8) THEN           <<00706>>55450000
         BEGIN <<CREATOR VIOLATION>>                           <<00706>>55455000
         TOS := USERIDVIOL;                                             55460000
         TOS := CCL;                                                    55465000
         GO RELEASE'FCB;                                       <<06514>>55470000
         END;                                                           55475000
      A := GETSIR(DSSIR);  <<GET DIRECTORY SIR(?)>>                     55480000
      DRCODE := DIRECPURGEFILE (-FSECTORS(FLAB),0,AN,          <<38.PV>>55485000
                                GN,FN,FCBMVTABX);              <<06514>>55490000
      IF <> THEN  <<ERROR?>>                                            55495000
         BEGIN                                                          55500000
         RELSIR(DSSIR,A);                                               55505000
         TOS := DIRIOERR;                                               55510000
         TOS := CCL;                                                    55515000
         GO RELEASE'FCB;                                       <<06514>>55520000
         END;                                                           55525000
      P1.(0:8) := VTABINX (DADDR,FCBMVTABX<>0);                <<06514>>55530000
      DRCODE := DIRECINSERTFILE (FSECTORS(FLAB),0,ANPTR,GNPTR, <<38.PV>>55535000
                                 FNPTR,LABADR,FCBMVTABX);      <<06514>>55540000
      IF <> THEN  <<ERROR?>>                                            55545000
         BEGIN                                                          55550000
         IF < THEN TOS := DIRIOERR                                      55555000
         ELSE IF RCA = 1 THEN TOS := DUPNSD                             55560000
         ELSE IF RCA = 2 THEN TOS := UNDEFFILESD-RCB                    55565000
         ELSE IF RCA = 3 THEN TOS := SEXVIOL                            55570000
         ELSE IF (4 <= RCA <= 6) THEN TOS := DIROVFLO          <<00088>>55575000
         ELSE IF RCA = 8 THEN TOS := NORIN+RCB                          55580000
         ELSE TOS := DIRIOERR;                                          55585000
         DRCODE := DIRECRESETFILE  (FSECTORS(FLAB),0,AN,       <<00088>>55590000
                                    GN,FN,LABADR,FCBMVTABX);   <<06514>>55595000
         IF <> THEN TOS := DIRIOERR;                                    55600000
         RELSIR(DSSIR,A);                                               55605000
         TOS := CCL;                                                    55610000
         GO RELEASE'FCB;                                       <<06514>>55615000
         END;                                                           55620000
      RELSIR(DSSIR,A);                                                  55625000
      P1.(0:8) := 0  <<CLEAR VOLUME TABLE INDEX>>                       55630000
      END;                                                              55635000
                                                               <<01849>>55640000
   <<* * * Rename a temp file (including $OLDPASS). *  * * *>> <<06166>>55645000
                                                               <<01849>>55650000
   IF DOMAIN = 2 OR FLOLDPASS THEN  <<INSERT NAME IN JTFD?>>            55655000
      BEGIN                                                             55660000
      P1.(0:8) := VTABINX (DADDR,FCBMVTABX<>0);                <<06514>>55665000
      TOS := ADDJTENTRY(FLLOCNAME,GNPTR,ANPTR,2,2,LABADRA);             55670000
      ASSEMBLE(TEST);                                                   55675000
      RCA := TOS;                                                       55680000
      IF <>                                                    <<01849>>55685000
        THEN                                                   <<01849>>55690000
         BEGIN   << Dup temp file name or JTFD overflow.    >> <<01849>>55695000
         @BFNPTR := @FNPTR & LSL(1);                           <<01849>>55700000
         @BGNPTR := @GNPTR & LSL(1);                           <<01849>>55705000
         @BANPTR := @ANPTR & LSL(1);                           <<01849>>55710000
         IF RCA = 2   << Duplicate name...                  >> <<01849>>55715000
           AND BFN = BFNPTR, (8)   << ...O.K. if we're...   >> << 8507>>55720000
           AND BGN = BGNPTR, (8)   << ...renaming the file..>> << 8507>>55725000
           AND BAN = BANPTR, (8)   << ...to itself.         >> << 8507>>55730000
           THEN   << Do nothing, skip REMJTENTRY below.     >> <<01849>>55735000
           ELSE                                                <<01849>>55740000
              BEGIN   << Real error, choose one and scram.  >> <<01849>>55745000
              TOS := IF RCA = 2 THEN DUPNJD ELSE JTFDIROFL;    <<01849>>55750000
              TOS := CCL;                                      <<01849>>55755000
              GO RELEASE'FCB;                                  <<06514>>55760000
              END;                                             <<01849>>55765000
         END                                                   <<01849>>55770000
        ELSE                                                   <<01849>>55775000
         BEGIN   << Delete the old temp file name here.     >> <<01849>>55780000
         NTYPE := OLDNTYPE;                                    <<01849>>55785000
         @FNPTR := @FN;                                        <<01849>>55790000
         @GNPTR := @GN;                                        <<01849>>55795000
         @ANPTR := @AN;                                        <<01849>>55800000
         IF NOT FLACTUAL THEN  << $OLDPASS? >>                 <<06166>>55805000
            BEGIN                                              <<01849>>55810000
            P1.(0:8):=VTABINX (DADDR,FCBMVTABX<>0);            <<06514>>55815000
            EXCHANGEDB(PXG'JITDST);                            <<06513>>55820000
            IF DADB0(JITPFP) = LABADR                          <<06868>>55825000
               THEN DADB0(JITPFP) := 0D;                       <<06868>>55830000
            EXCHANGEDB(0);  <<RESET DB TO STACK>>              <<01849>>55835000
            IF FLOLDPASS THEN FLDOMAIN := 2;   << Oldtemp.  >> <<01849>>55840000
            FLDESIGNATOR := 0;  <<MAKE DESIGNATOR ACTUAL>>     <<01849>>55845000
            P1.(0:8) := 0;  <<CLEAR LOGICAL DEVICE NR.>>       <<01849>>55850000
            NEWFOPTIONS := FLFOPTIONS  <<SAVE FOPTIONS>>       <<01849>>55855000
            END;                                               <<01849>>55860000
         IF DOMAIN = 2 THEN  <<TEMPORARY FILE?>>               <<01849>>55865000
            BEGIN   << Delete JTFD entry.                   >> <<01849>>55870000
           X := REMJTENTRY(FNPTR,GNPTR,ANPTR,2,0).(8:8);       <<04574>>55875000
<< THE UPPER 8 BITS (0:8) ARE USED FOR THE OLD FILE REFERENCE>><<04574>>55880000
<< COUNT SO IT CAN BE PRESERVED WHEN REPLACING FILE EQU'S    >><<04574>>55885000
               IF <> THEN FTROUBLE(488);                       <<01849>>55890000
            END;                                               <<01849>>55895000
         END;                                                  <<01849>>55900000
      END;                                                     <<01849>>55905000
$PAGE                                                          <<06514>>55910000
   <<*********** Write Updated File Label ******************>> <<06514>>55915000
                                                                        55920000
   FLLASTMOD := CALENDAR;  <<UPDATE MODIFICATION DATE>>                 55925000
   FLMODTIME := CLOCK;     ! Update modification time.         <<07227>>55930000
   MOVE FLLOCKWORD := LW,(4);  <<UPDATE LOCKWORD>>                      55935000
   LABELIO(1);  <<WRITE FILE LABEL>>                                    55940000
                                                                        55945000
   <<*******************************************************>> <<06514>>55950000
   << If the FOPTIONS have changed (eg. $NEWPASS renamed to >> <<06514>>55955000
   << $OLDPASS) then update the FOPTIONS in the FCB and ACB >> <<06514>>55960000
   << and update the FCB with the new options.              >> <<06514>>55965000
   <<*******************************************************>> <<06514>>55970000
                                                                        55975000
   IF NEWFOPTIONS <> 0 THEN                                    <<06514>>55980000
      BEGIN                                                    <<06514>>55985000
      FCBFOPTIONS := NEWFOPTIONS;  << Update FCB options.   >> <<06514>>55990000
      ACBFOPTIONS := NEWFOPTIONS;  << Update ACB options.   >> <<06514>>55995000
      UPDATEFCB;                                               <<06514>>56000000
      END;                                                     <<06514>>56005000
                                                               <<06514>>56010000
   ACBDNTYPE := NEWNTYPE;                                      <<06514>>56015000
                                                               <<+0.04>>56020000
   <<* * * MEASUREMENT DATA ON FRENAME * * *>>                 <<+0.05>>56025000
                                                               <<+0.05>>56030000
$  IF X3 = ON                                                  <<+0.05>>56035000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>56040000
   MMSTAT'(EFRENAME,FILENUM,0,0,0,0,0);  <<MEASURE EVENT>>     <<06863>>56045000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>56050000
$  IF                                                          <<+0.05>>56055000
                                                               <<+0.05>>56060000
   TOS := 0;  <<NO ERROR>>                                              56065000
   TOS := CCE;                                                          56070000
   GO RELEASE'FCB;                                             <<06514>>56075000
   HELP  <<FOR DUMMY CALL>>;                                   <<00117>>56080000
                                                                        56085000
RELEASE'FCB:                                                   <<06514>>56090000
   UNLOCK'CB(0,ACBFCB);                                        <<06514>>56095000
                                                                        56100000
RELEASE'ACB:                                                   <<06514>>56105000
   IF FSTYPE THEN                                              <<DS.00>>56110000
   ACBERROR := S1;  <<ERROR NR.>>                                       56115000
                                                               <<04514>>56120000
   UNLOC'ACB(ACBMQ,0);  << Release ACB               >>        <<04514>>56125000
   IF B <> -1 THEN RELSIR(FISIR,B);  <<RELEASE FILE SIR>>               56130000
   END; << CONVENTIONAL FILE;                                  <<DS.00>>56135000
                                                               <<DS.00>>56140000
   BEGIN << REMOTE FILE >>                                     <<DS.00>>56145000
      ALLOCRFABUF;                                             <<DS.00>>56150000
      RFALEN := 22;                                            <<07049>>56155000
      TOS := "RFA ";                                           <<DS.00>>56160000
      TOS := 17;                                               <<DS.00>>56165000
      TOS := RFAFILE;                                          <<DS.00>>56170000
      ALLOCBUF; << FOR NAME ARRAY >>                           <<DS.00>>56175000
      ASSEMBLE(ADDS 18);                                       <<07049>>56180000
      TOS := X;                                                <<DS.00>>56185000
      MOVE * := NEWFREF,(36);                                  <<07049>>56190000
      MWCNOBUF;                                                <<DS.00>>56195000
      CHECKXFER;                                               <<DS.00>>56200000
      DELAPPENDAGE;                                            <<DS.00>>56205000
      PREPRETURN;                                              <<DS.00>>56210000
      IF LS0.CC <> CCE THEN                                    <<D1.01>>56215000
         BEGIN                                                 <<D1.01>>56220000
         FCHECK(FILENUM,S1);                                   <<D1.01>>56225000
         IF <> THEN S1 := NAVAILDEV;                           <<D1.01>>56230000
         END;                                                  <<D1.01>>56235000
   END; << REMOTE FILE >>                                      <<DS.00>>56240000
                                                               <<DS.00>>56245000
      <<DUMMY 2>>;                                             <<KS.00>>56250000
      <<DUMMY 3>>;                                             <<KS.00>>56255000
      <<DUMMY 4>>;                                             <<KS.00>>56260000
      <<DUMMY 5>>;                                             <<KS.00>>56265000
      BEGIN <<KSAM FILE>>                                      <<KS.00>>56270000
         USERDB:=EXCHANGEDB(0);                                <<KS.00>>56275000
         SETAFT;                                               <<KS.00>>56280000
         AFTFLAG:=3;<<KSAM ERROR>>                             <<KS.00>>56285000
         AFTERRNUM:=UNIMPL;<<"UNIMPLEMENTED">>                 <<KS.00>>56290000
         TOS:=UNIMPL;<<"UNIMPLEMENTED">>                       <<KS.00>>56295000
         TOS:=CCL;                                             <<KS.00>>56300000
         EXCHANGEDB(USERDB);                                   <<KS.00>>56305000
      END;<<KSAM FILE>>                                        <<KS.00>>56310000
      <<DUMMY 7>>;                                             <<HM.00>>56315000
      GO CONVENTIONAL;  <<MSG FILE>>                           <<HM.00>>56320000
   END; << FTYPE CASE >>                                       <<DS.00>>56325000
EXIT:                                                                   56330000
   CONDCODE := TOS;  <<SET CONDITION CODE>>                             56335000
   RESETCRITICAL(CRIT);                                                 56340000
   ERROREXIT(2,S0,0)                                                    56345000
   END;                                                                 56350000
$ PAGE " FCLOSE "                                                       56355000
$ CONTROL SEGMENT = FILESYS7                                            56360000
PROCEDURE FCLOSE(FILENUM,DISP,SECCODE);                        <<KS.00>>56365000
                                                               <<04517>>56370000
   <<*******************************************************>> <<04517>>56375000
   << Closes the specified file (Really!!!)                 >> <<04517>>56380000
   <<                                                       >> <<04517>>56385000
   << Entry Points:                                         >> <<04517>>56390000
   <<    FCLOSE - User callabel entry point                 >> <<04517>>56395000
   <<    FSCLOSE- System spoolfile entry point              >> <<04517>>56400000
   <<    FJCLOSE- System CI $STDXX entry point              >> <<04517>>56405000
   <<    KFCLOSE- KSAM file entry point                     >> <<04517>>56410000
   <<    FTCLOSE- Used by LYNX2 to close the terminal       >> <<6029>> 56415000
   <<             configuration file.                       >> <<6029>> 56420000
   <<                                                       >> <<04517>>56425000
   << Input variables:                                      >> <<04517>>56430000
   <<    FILENUM - File number of the file                  >> <<04517>>56435000
   <<    DISP    - File disposition                         >> <<04517>>56440000
   <<       (12:1) - Return disc space beyond file limit    >> <<04517>>56445000
   <<       (13:3) - Domain disposition                     >> <<04517>>56450000
   <<          0 - No change                                >> <<04517>>56455000
   <<          1 - Save permanent                           >> <<04517>>56460000
   <<          2 - Save temporary and rewind                >> <<04517>>56465000
   <<          3 - Save temporary and no rewind             >> <<04517>>56470000
   <<          4 - Release (purge file)                     >> <<04517>>56475000
   <<     SECCODE- File security                            >> <<04517>>56480000
   <<          0 - Unrestricted access                      >> <<04517>>56485000
   <<          1 - Creator - restricted access              >> <<04517>>56490000
   <<                                                       >> <<04517>>56495000
   << Condition Code:                                       >> <<04517>>56500000
   <<    CCE - OK                                           >> <<04517>>56505000
   <<    CCL - ERROR                                        >> <<04517>>56510000
   <<                                                       >> <<04517>>56515000
   << Note that DB may be set to any data segement when     >> <<04517>>56520000
   << this procedure is called.                             >> <<04517>>56525000
   <<*******************************************************>> <<04517>>56530000
                                                               <<04517>>56535000
   VALUE FILENUM,DISP,SECCODE;                                          56540000
   INTEGER FILENUM,DISP,SECCODE;                                        56545000
   OPTION PRIVILEGED;                                                   56550000
   BEGIN                                                                56555000
   << >>                                                                56560000
   ENTRY FSCLOSE;       <<SPOOLFILE SEC ENTRY POINT>>                   56565000
   ENTRY FJCLOSE;       <<CI $STDXX SEC ENTRY POINT>>                   56570000
   ENTRY KFCLOSE; <<SECONDARY ENTRY POINT FOR KSAM>>           <<KS.00>>56575000
   ENTRY PVCLOSE;       <<CONDITIONAL DISMOUNT ENTRY POINT>>   <<RV.PV>>56580000
   ENTRY FCLOSEDA;      <<SHOULD BE PAIRED WITH FOPENDA>>      <<RV.PV>>56585000
   ENTRY FTCLOSE; << Used by LYNX2 to close term. config.file>><<6029>> 56590000
   ENTRY LOGCLOSE; << Special entry to close files without   >><<*8660>>56595000
                   << checking account security              >><<*8660>>56600000
   << >>                                                                56605000
   ARRAY ERRORMAP (1:8)=PB := DUPNSD,UNDEFFILESD,SEXVIOL,               56610000
      DIROVFLO,DIROVFLO,DIROVFLO,DIRIOERR,NORIN;                        56615000
   LOGICAL MUSTCLOSE := FALSE;  <<IGNORE ERRORS WHILE CLOSING?>>        56620000
   DOUBLE DRCODE;  <<NR. SECTORS DEALLOCATED>>                          56625000
   INTEGER RCB = DRCODE;  <<FIRST HALF OF DRCODE>>                      56630000
   INTEGER RCA = DRCODE+1;  <<SECOND HALF OF DRCODE>>                   56635000
   LOGICAL ORIG'DST;  <<Original DST upon entry             >> <<04517>>56640000
                                                               <<04517>>56645000
   INTEGER I;  <<UTILITY INTEGER>>                                      56650000
   INTEGER J;  <<UTILITY INTEGER>>                                      56655000
   INTEGER ARRAY LOG'BUF(0:14)=Q; << Sys. logging, must be Q>> <<04713>>56660000
   DOUBLE FADDR;                                                        56665000
   INTEGER FADDRW1 = FADDR, FADDRW2 = FADDRW1+1;               <<RV.PV>>56670000
   DOUBLE POINTER EXTENTRY;                                             56675000
                                                                        56680000
   <<MISC. FILE PARAMETERS>>                                            56685000
                                                                        56690000
   DEFINE                                                      <<04513>>56695000
      DISP'CRUNCH  = DISP.(12:1)#,   << Crunch bit          >> <<04513>>56700000
      DISP'DOMAIN  = DISP.(13:3)#;   << Domain bits         >> <<04513>>56705000
   INTEGER DOMAIN;  <<FOP'S FILE DOMAIN>>                               56710000
   INTEGER ATYPE;  <<ACCESS TYPE>>                                      56715000
   INTEGER PDISP;  <<PENDING DISPOSITION>>                              56720000
   LOGICAL PURGE := FALSE;  <<DEALLOCATE DISC SPACE FLAG>>              56725000
   LOGICAL CRUNCH := FALSE;  <<DEALLOCATE DISC SPACE PAST EOF?>>        56730000
   LOGICAL SUBTYPE;          <<DEVICE SUBTYPE >>               <<*7839>>56735000
   LOGICAL ARRAY DUMMY(0:2) = Q;<< needed for some attio calls <<*7839>>56740000
                                                                        56745000
   <<MISC. DEVICE PARAMETERS>>                                          56750000
                                                                        56755000
   LOGICAL DADDR;  <<LOGICAL DEVICE NR.>>                               56760000
   DOUBLE IO'STATUS;  << Return parm from ATTACHIO.         >> <<04814>>56765000
   INTEGER WAITIO'STATUS = IO'STATUS + 0;  << Statu of ATIO.>> <<04814>>56770000
   DEFINE ERR'STAT = WAITIO'STATUS.(8:8)#; << Error bits.   >> <<04814>>56775000
                                                                        56780000
   <<PCBX PARAMETERS>>                                                  56785000
                                                                        56790000
   INTEGER PCBGLOBLOC;     ! PCBX Q-relative location.         <<06513>>56795000
   INTEGER POINTER PXFILE;  <<PCBX FILE SECTION>>                       56800000
   INTEGER PCBPT;           ! Pointer to PCB for defines       <<06514>>56805000
                                                                        56810000
   <<AFT PARAMETERS>>                                                   56815000
                                                                        56820000
   INTEGER POINTER AFT;  <<AFT ENTRY POINTER>>                          56825000
   DOUBLE POINTER AFTDBL = AFT;                                         56830000
                                                                        56835000
   <<ACB PARAMETERS>>                                                   56840000
                                                                        56845000
   LOGICAL FLAGS;    <<Flags for call to LOC'ACB.          >>  <<04517>>56850000
                                                                        56855000
   <<FCB PARAMETERS>>                                                   56860000
                                                                        56865000
   INTEGER FCBMQ;  << Used for LOCK'CB for Q value.         >> <<04624>>56870000
   DOUBLE  FCBV;  <<FCB VECTOR>>                               <<06514>>56875000
   INTEGER POINTER FCB;  <<FCB POINTER>>                                56880000
   DOUBLE POINTER FCBDBL = FCB;                                         56885000
   DOUBLE                    << DST and address of ...      >> <<06514>>56890000
      FCB'CB'ADDR,           << Control block FCB address.  >> <<06514>>56895000
      FCB'STK'ADDR;          << Stack FCB address.          >> <<06514>>56900000
   DOUBLE FCB'VARS;                << Word 0 and 1 of FCB.  >> <<04624>>56905000
   INTEGER FCB'0    = FCB'VARS;    << Word 0 of FCB.        >> <<04624>>56910000
   INTEGER FCBSI;                  << Extract bits for size >> <<04624>>56915000
   LOGICAL RELFCB := FALSE;  <<DELETE FCB?>>                            56920000
                                                                        56925000
   <<FILE LABEL PARAMETERS>>                                            56930000
                                                                        56935000
   DOUBLE DISKADR;  <<FILE LABEL SECTOR NR.>>                           56940000
   INTEGER POINTER FLAB;  <<FILE LABEL POINTER>>                        56945000
   DOUBLE POINTER FLABDBL = FLAB;                                       56950000
   LOGICAL LABELERROR := FALSE;  <<BAD FILE LABEL?>>                    56955000
                                                                        56960000
   << JIT Parameters >>                                        <<02349>>56965000
   DOUBLE UCAP;                                                <<02349>>56970000
   LOGICAL SFCAP=UCAP;                                         <<02349>>56975000
   <<RESOURCE PARAMETERS>>                                              56980000
                                                                        56985000
   LOGICAL A;  <<FOR GETSIR>>                                           56990000
   LOGICAL B:=-1; << FOR FMAVTSIR >>                           <<06514>>56995000
   LOGICAL CRIT;  <<FOR SETCRITICAL>>                                   57000000
   LOGICAL RESOURCES := FALSE;  <<FOR ERROR RECOVERY>>                  57005000
   DEFINE SIRLOCK = (15:1)#,  <<FILE SIR LOCKED?>>                      57010000
          FCBLOCK = (14:1)#,  <<FCB LOCKED?>>                  <<RV.PV>>57015000
          DMOUNT  = (13:1)#;  <<NEED TO DISMOUNT VOL SET?>>    <<RV.PV>>57020000
                                                                        57025000
   <<JOB/CI $STDXX ACCESS >>                                            57030000
                                                                        57035000
   LOGICAL JOBF;                                                        57040000
   LOGICAL PRIMED;                                                      57045000
   LOGICAL CI;                                                          57050000
   LOGICAL CLOSEIT;                                                     57055000
   LOGICAL LYNX2;                                              <<6029>> 57060000
   LOGICAL LOGC;   << True if LOGCLOSE was called >>           <<*8660>>57065000
                                                                        57070000
   <<SPOOLFILE ACCESS>>                                                 57075000
                                                                        57080000
   LOGICAL SPOOLF;                                                      57085000
   INTEGER POINTER XDDEP;                                               57090000
   LOGICAL SPVDEV;                                                      57095000
   INTEGER Z;  <<UTILITY VARIABLE>>                            <<00.06>>57100000
   DOUBLE POINTER XMAP;  <<EXT MAP TEMP PTR>>                  <<00.06>>57105000
                                                               <<DS.00>>57110000
   << REMOTE FILE ACCESS (RFA) VARIABLES >>                    <<DS.00>>57115000
                                                               <<DS.00>>57120000
   INTEGER POINTER RFAPTR; << APPENDAGE POINTER >>             <<DS.00>>57125000
   INTEGER RFALEN; << APPENDAGE LENGTH >>                      <<DS.00>>57130000
   LOGICAL KSC; <<ONLY TRUE IF ENTRY KFCLOSE USED>>            <<KS.00>>57135000
                                                               <<DS.00>>57140000
   << PRIVATE VOLUME DECLARATIONS >>                           <<RV.PV>>57145000
   EQUATE                                                      <<RV.PV>>57150000
       UNCONDDISMOUNT = 2,                                     <<RV.PV>>57155000
       CONDDISMOUNT = -3;                                      <<RV.PV>>57160000
   INTEGER                                                     <<RV.PV>>57165000
       HVSIND := [8/"*", 8/" "],                               <<RV.PV>>57170000
       XDSDST,                                                 <<RV.PV>>57175000
       REQTYPE := UNCONDDISMOUNT;                              <<06514>>57180000
   LOGICAL                                                     <<RV.PV>>57185000
        FCLOSEDA',                                             <<RV.PV>>57190000
       PVCLOSE';                                               <<RV.PV>>57195000
                                                               <<HM.00>>57200000
   << COMMUNICATION FILE DECLARATIONS >>                       <<HM.00>>57205000
   LOGICAL MSGFILE:=FALSE;                                     <<HM.00>>57210000
                                                               <<03509>>57215000
   << These variables are part of a kludge to fix crunch- >>   <<03509>>57220000
   << ing of files so that the disc space is returned     >>   <<03509>>57225000
   << AFTER the file label is updated.                    >>   <<03509>>57230000
                                                               <<03509>>57235000
   DOUBLE POINTER extent'list;  << For a list of extents >>    <<03509>>57240000
   INTEGER extent'list'size;    << Num of entries in list>>    <<03509>>57245000
   INTEGER extent'list'last'size;  << Size of last entry >>    <<03509>>57250000
   INTEGER extsize;                                            <<04307>>57255000
                                                               <<03509>>57260000
   INTEGER partial'ext'ldev;  << ldev of partial extent >>     <<03509>>57265000
   DOUBLE partial'ext'len;    << length of extent.      >>     <<03509>>57270000
   DOUBLE partial'ext'addr;   << address of extent.     >>     <<03509>>57275000
   INTEGER count;                                              <<03509>>57280000
   POINTER TARGET;                                             <<04517>>57285000
                                                               <<03509>>57290000
                                                               <<RV.PV>>57295000
                                                               <<04517>>57300000
<<**********************************************************>> <<04517>>57305000
<<                                                          >> <<04517>>57310000
<<  ############### ACB POINTERS #################          >> <<04517>>57315000
<<                                                          >> <<04517>>57320000
<<  Below are the declarations and equates for the PACB and >> <<04517>>57325000
<<  AFT arrays.  They cannot be changed in any way and they >> <<04517>>57330000
<<  MUST BE THE LAST DECLARATIONS !!!!!!  LOC'ACB places    >> <<04517>>57335000
<<  the AFT at ACB(-4) to ACB(-1) and the PACB follows.     >> <<04517>>57340000
                                                               <<04517>>57345000
INTEGER ACBMQ;                                                 <<04517>>57350000
INTEGER AFTE;      << AFT entry word 0, type and $NULL bit  >> <<04517>>57355000
DOUBLE  PACBV;     << Physical ACB Vector                   >> <<06514>>57360000
INTEGER PACBV'DSTN = PACBV + 0;                                <<S7505>>57365000
DOUBLE  LACBV;     << Logical  ACB Vector                   >> <<06514>>57370000
INTEGER IOQX;      << No-Wait I/O pending Queue Index       >> <<04517>>57375000
RFASTUFF;          << Set up remote file variables.         >> <<06514>>57380000
                                                               <<04517>>57385000
<< SIZEXACB = %70, 0-%67 used by LOC'ACB and the last word  >> <<04517>>57390000
<< used for the DSTX define, since a declaration past the   >> <<04517>>57395000
<< ACB declaration will cause a Primary Q overflow.         >> <<04517>>57400000
                                                               <<04517>>57405000
INTEGER ARRAY ACB(0:SIZEXACB) = Q;                             <<04517>>57410000
DOUBLE ARRAY ACBDBL(*)=ACB;                                    <<04517>>57415000
DEFINE DSTX = ACB(SIZEXACB)#; << Returned by LOC'ACB        >> <<04517>>57420000
                                                               <<04517>>57425000
<<  Do not place any declarations after this point!!!  Just >> <<04517>>57430000
<<  as important, do no stack any data before the call to   >> <<04517>>57435000
<<  IOMOVE or FQUIESCIO.  Both procedures expect the ACB    >> <<04517>>57440000
<<  and DSTX to be directly below the procedure calls.      >> <<04517>>57445000
<<  FQUIESC'IO finds the ACB at Q-62 and IOMOVE at Q-63.    >> <<04517>>57450000
<<  (IOMOVE has 3 parms, FQUIESCE'IO one parm and one word  >> <<04517>>57455000
<<  for Integer function return value.                      >> <<04517>>57460000
<<**********************************************************>> <<04517>>57465000
                                                               <<04517>>57470000
$PAGE " FCLOSE - LABELIO "                                     <<06272>>57475000
   SUBROUTINE LABELIO (RW);                                             57480000
      <<READS OR WRITES THE FILE LABEL INTO THE STACK BUFFER.           57485000
                                                                        57490000
        INPUT VARIABLES:                                                57495000
            RW - I/O MODE                                               57500000
               0 - READ                                                 57505000
               1 - WRITE                                                57510000
                                                                        57515000
        NOTE THAT DB MUST BE SET TO THE STACK WHEN THIS SUBROUTINE IS   57520000
        CALLED>>                                                        57525000
      VALUE RW;                                                         57530000
      INTEGER RW;                                                       57535000
      BEGIN                                                             57540000
      X := FLABIO(DADDR,DISKADR,RW,FLAB);  <<R/W LABEL>>                57545000
      IF <> THEN  <<ERROR?>>                                            57550000
         BEGIN                                                          57555000
         FLABIOERR(X,FILENUM);  <<HANDLE ERROR>>                        57560000
         TOS := LBLIOERR;                                               57565000
         GO ERR                                                         57570000
         END                                                            57575000
      END;                                                              57580000
                                                               <<06514>>57585000
                                                               <<06514>>57590000
<<                   RELEASE DISK                           >> <<06514>>57595000
                                                               <<06514>>57600000
                                                                        57605000
   SUBROUTINE RELEASEDISK (FIRST,LAST);                                 57610000
      <<DEALLOCATES THE DISC SPACE FOR THE SPECIFIED EXTENTS OF THE     57615000
        FILE BEING CLOSED.                                              57620000
                                                                        57625000
        INPUT PARAMETERS:                                               57630000
            FIRST - THE FIRST EXTENT INDEX TO BE DEALLOCATED            57635000
            LAST - THE LAST EXTENT INDEX TO BE DEALLOCATED              57640000
                                                                        57645000
        THE TOTAL NUMBER OF SECTORS RELEASED IS ADDED TO DRCODE.  ALSO, 57650000
        THE DEALLOCATED EXTENT DESCRIPTORS ARE CLEARED IN THE FCB       57655000
        AND FILE LABEL EXTENT MAPS>>                                    57660000
      VALUE FIRST,LAST;                                                 57665000
      INTEGER FIRST,LAST;                                               57670000
      BEGIN                                                             57675000
      extent'list'size := 0;                                   <<03509>>57680000
      count := last - first + 1;  << Number of extents >>      <<03509>>57685000
      IF FIRST <= LAST THEN  <<EXTENTS TO BE DEALLOCATED?>>             57690000
         BEGIN                                                          57695000
         << Remember size of last extent in list >>            <<03509>>57700000
                                                               <<03509>>57705000
         extent'list'last'size := IF last=fcbnumexts THEN      <<03509>>57710000
                          fcblastextsize ELSE fcbextsize;      <<03509>>57715000
                                                               <<03509>>57720000
         TOS := @FCBEXTMAP+FIRST&LSL(1);  <<FCB EXTENT MAP POINTER>>    57725000
         TOS := @FLEXTMAP+S3&LSL(1);  <<FILE LABEL EXTENT MAP POINTER>> 57730000
                                                                        57735000
         << Add extents to list of extents to purge >>         <<03509>>57740000
                                                               <<03509>>57745000
         WHILE count > 0 DO                                    <<03509>>57750000
            BEGIN  << Add extents to list >>                   <<03509>>57755000
                                                               <<03509>>57760000
               extent'list (extent'list'size) :=               <<03509>>57765000
                     DPS1 (extent'list'size);                  <<03509>>57770000
               extent'list'size := extent'list'size + 1;       <<03509>>57775000
               count := count - 1;                             <<03509>>57780000
                                                               <<03509>>57785000
            END;   << Add extents to list >>                   <<03509>>57790000
                                                               <<03509>>57795000
                                                                        57800000
         <<* * * COMPUTE SECTORS DEALLOCATED * * *>>                    57805000
                                                                        57810000
         DO BEGIN                                                       57815000
            TOS := DPS1;  <<FCB EXTENT DESCRIPTOR>>                     57820000
            IF <> THEN  <<EXTENT ALLOCATED?>>                           57825000
               BEGIN                                                    57830000
               TOS := 0; << LEFT HALF OF DOUBLE EXT SIZE >>    <<00300>>57835000
               IF S7 = FCBNUMEXTS THEN  <<LAST EXTENT?>>                57840000
                  TOS := FCBLASTEXTSIZE                                 57845000
               ELSE  <<NOT LAST EXTENT>>                                57850000
                  TOS := FCBEXTSIZE;                                    57855000
               DRCODE := DRCODE+TOS  <<ADD TO TOTAL>>                   57860000
               END;                                                     57865000
            ASSEMBLE(DDEL,DZRO; DZRO);                                  57870000
            DPS5 := TOS;  <<CLEAR FCB EXTENT DESCRIPTOR>>               57875000
            DPS2 := TOS;  <<CLEAR FILE LABEL EXTENT DESCRIPTOR>>        57880000
            ASSEMBLE(INCB,INCB);  <<NEXT FCB EXTENT>>                   57885000
            ASSEMBLE(INCA,INCA);  <<NEXT FILE LABEL EXTENT>>            57890000
            S4 := S4+1  <<BUMP FIRST EXTENT INDEX>>                     57895000
            END UNTIL S4 > S3;                                          57900000
         DDEL                                                           57905000
         END                                                            57910000
      END;                                                              57915000
$PAGE " FCLOSE - BACK'SPACE'RECORDS "                          <<06272>>57920000
SUBROUTINE ATTIO(FUNC,FLAGS);                                  <<06040>>57925000
VALUE FUNC,FLAGS;                                              <<06040>>57930000
INTEGER FUNC,FLAGS;                                            <<06040>>57935000
                                                               <<06040>>57940000
<<**********************************************************>> <<06040>>57945000
<< A short cut to ATTACHIO for tapes.  It performs the func->> <<06040>>57950000
<< tion specified with the specified FLAGS and checks for   >> <<06040>>57955000
<< errors, ignoring the error sometimes.                    >> <<06040>>57960000
<<**********************************************************>> <<06040>>57965000
                                                               <<06040>>57970000
BEGIN                                                          <<06040>>57975000
IO'STATUS := ATTACHIO(DADDR,0,0,0,FUNC,0,0,4,FLAGS);           <<06040>>57980000
IF ERR'STAT <> 1 AND NOT MUSTCLOSE THEN                        <<06040>>57985000
   BEGIN                                                       <<06040>>57990000
   ACBERROR := IOSTAT(ERR'STAT);                               <<06040>>57995000
   IF ACBERROR = EOF OR ACBERROR = EOT OR ACBERROR = TAPERREC  <<06040>>58000000
      THEN ACBERROR := 0    << Ignore these errors for tape.>> <<06040>>58005000
   ELSE                                                        <<06040>>58010000
      BEGIN                                                    <<06040>>58015000
      TOS := ACBERROR;      << Report error.  Place error on>> <<06040>>58020000
      GO TO ERR;            << TOS and get out!             >> <<06040>>58025000
      END;                                                     <<06040>>58030000
   END;                                                        <<06040>>58035000
END;                                                           <<06040>>58040000
                                                               <<06040>>58045000
SUBROUTINE BACK'SPACE'RECORDS;                                 <<04814>>58050000
                                                               <<04814>>58055000
<<**********************************************************>> <<04814>>58060000
<< This subroutine performs a BSR function for each pre-read>> <<04814>>58065000
<< performed to properly position the tape, mispositioned   >> <<04814>>58070000
<< due to pre-reads.  ACBTAPEDISP contains the number of    >> <<04814>>58075000
<< pre-reads, obtained from FQUIESCE'IO.                    >> <<04814>>58080000
<<**********************************************************>> <<04814>>58085000
                                                               <<04814>>58090000
BEGIN                                                          <<04814>>58095000
IF LOG(ACBNEWEOF) THEN  << No pre-reads were performed, any >> <<04814>>58100000
   ACBTAPEDISP := 0     << outstanding I/O's were writes.   >> <<04814>>58105000
ELSE                                                           <<04814>>58110000
   WHILE ACBTAPEDISP > 0 DO                                    <<04814>>58115000
     BEGIN                                                     <<04814>>58120000
     ATTIO(BSR,BFLAGS);                                        <<06040>>58125000
     ACBTAPEDISP := ACBTAPEDISP - 1;                           <<04814>>58130000
     END;                                                      <<04814>>58135000
END; << Subroutine BACK'SPACE'RECORDS.                      >> <<04814>>58140000
                                                               <<06514>>58145000
                                                               <<06514>>58150000
<<------------------ WRITE'EOFS ---------------------------->> <<*7507>>58155000
                                                               <<06514>>58160000
SUBROUTINE WRITE'EOFS;                                         <<06040>>58165000
                                                               <<06040>>58170000
<<**********************************************************>> <<06040>>58175000
<< If the last operation to serial device was a write and   >> <<06040>>58180000
<< we are not at BOT, then perform three WRITE'EOF's and    >> <<06040>>58185000
<< two BSF's to insure that there are always at least 3 EOF >> <<06040>>58190000
<< marks at the end of a tape.                              >> <<06040>>58195000
<<**********************************************************>> <<06040>>58200000
                                                               <<06040>>58205000
BEGIN                                                          <<06040>>58210000
IF ACBNEWEOF = 1 AND                                           <<*7507>>58215000
   ( (ACBDTYPE = MTAPE LAND NOT CHECK'BOT(DADDR) ) OR          <<*7507>>58220000
      ACBDTYPE = SDISC                           ) THEN        <<*7507>>58225000
   BEGIN                                                       <<06040>>58230000
   ATTIO(WRITE'EOF,BFLAGS);                                    <<06040>>58235000
   ACBNEWEOF := 0;           << Clear bit signifying write. >> <<06040>>58240000
                                                               <<06040>>58245000
   << Now perform the extra 2 EOF's and BSF's for Mag Tape. >> <<06040>>58250000
                                                               <<06040>>58255000
   IF ACBDTYPE = MTAPE THEN                                    <<06040>>58260000
      BEGIN                                                    <<06040>>58265000
      ATTIO(WRITE'EOF,BFLAGS);                                 <<06040>>58270000
      ATTIO(WRITE'EOF,BFLAGS);                                 <<06040>>58275000
      ATTIO(BSF,BFLAGS);                                       <<06040>>58280000
      ATTIO(BSF,BFLAGS);                                       <<06040>>58285000
      END;                                                     <<06040>>58290000
   END;                                                        <<06040>>58295000
END;                                                           <<06040>>58300000
                                                               <<06040>>58305000
$PAGE " FCLOSE - UPDATEFCB "                                   <<06272>>58310000
                                                                        58315000
   SUBROUTINE UPDATEFCB;                                                58320000
                                                               <<04624>>58325000
      <<****************************************************>> <<04624>>58330000
      << Updates the actual FCB in the control block (where >> <<04624>>58335000
      << ever it may be) by overlaying  it with the updated >> <<04624>>58340000
      << FCB that exists on the stack.                      >> <<04624>>58345000
      <<****************************************************>> <<04624>>58350000
                                                               <<04624>>58355000
      BEGIN                                                             58360000
                                                               <<04624>>58365000
      TOS := FCB'CB'ADDR;  << DST and offset to control blk.>> <<06514>>58370000
      TOS := FCB'STK'ADDR; << Stack location of FCB.        >> <<06514>>58375000
      TOS := FCBSI;        << Let em go.                    >> <<06514>>58380000
      MOVE'DS'5;                                               <<04624>>58385000
      END;                                                              58390000
                                                               <<06514>>58395000
                                                               <<06514>>58400000
<<                   DISMOUNT                               >> <<06514>>58405000
                                                               <<06514>>58410000
                                                               <<06514>>58415000
   INTEGER SUBROUTINE DISMOUNT';                               <<RV.PV>>58420000
       BEGIN                                                   <<RV.PV>>58425000
           IF FCLOSEDA' THEN RETURN;                           <<RV.PV>>58430000
           REQTYPE := IF PVCLOSE' THEN CONDDISMOUNT            <<RV.PV>>58435000
                                  ELSE UNCONDDISMOUNT;         <<RV.PV>>58440000
           PCBPT := CURPRC;                                    <<06514>>58445000
           IF (XDSDST := SPCBXDSDST) <> 0 THEN                 <<06514>>58450000
            EXCHANGEDB (0); <<TO STACK>>                       <<RV.PV>>58455000
           DISMOUNT (HVSIND, FCBGN, FCBAN,                     <<RV.PV>>58460000
                     REQTYPE, FCBPVINFO);                      <<06514>>58465000
           IF <> THEN                                          <<RV.PV>>58470000
           BEGIN <<SOME FAILURE>>                              <<RV.PV>>58475000
               <<REQTYPE CONTAINS DISMOUNT ERROR NUMBER>>      <<23.PV>>58480000
               <<CALLER OF DISMOUNT' NEEDS TO MAP IT>>         <<23.PV>>58485000
               <<INTO A FILESYS ERROR NUMBER>>                 <<23.PV>>58490000
               DISMOUNT' := DISMOUNTPROB;                      <<RV.PV>>58495000
           END;                                                <<RV.PV>>58500000
           RESOURCES.DMOUNT := FALSE; <<ONLY TRY ONCE>>        <<RV.PV>>58505000
           IF XDSDST <> 0 THEN EXCHANGEDB (XDSDST);            <<RV.PV>>58510000
       END;<<OF DISMOUNT'>>                                    <<RV.PV>>58515000
                                                               <<06514>>58520000
                                                               <<06514>>58525000
<<                   CLEAR'AFT                              >> <<06514>>58530000
                                                               <<06514>>58535000
                                                               <<06514>>58540000
SUBROUTINE CLEAR'AFT;                                          <<06514>>58545000
                                                               <<06514>>58550000
<< Simply clears the AFT entry, global or local.            >> <<06514>>58555000
                                                               <<06514>>58560000
BEGIN                                                          <<06514>>58565000
IF GLOBAL'FILENUM THEN                                         <<06514>>58570000
   BEGIN                         << Go to global AFT area.  >> <<06514>>58575000
   EXCHANGEDB(GLOBAL'AFT'DSTN);                                <<06514>>58580000
   @AFT := \FILENUM\ * AFTENTRY;                               <<06514>>58585000
   END                                                         <<06514>>58590000
ELSE                                                           <<06514>>58595000
   BEGIN                                                       <<06514>>58600000
   SETAFT;                       << Set AFT in PXFILE area. >> <<06514>>58605000
   END;                                                        <<06514>>58610000
                                                               <<06514>>58615000
AFTDBL(0) := AFTDBL(1) := AFTDBL(2) := 0D;                     <<06514>>58620000
                                                               <<06514>>58625000
IF GLOBAL'FILENUM                                              <<06514>>58630000
   THEN EXCHANGEDB(0);           << Back to the stack.      >> <<06514>>58635000
END;                                                           <<06514>>58640000
$PAGE " FCLOSE - MAIN BLOCK "                                  <<06272>>58645000
   <<* * * INITIALIZE PARAMETERS * * *>>                                58650000
                                                               <<*8660>>58655000
   IF (LOGC := FALSE) THEN                                     <<*8660>>58660000
      BEGIN                                                    <<*8660>>58665000
LOGCLOSE:                                                      <<*8660>>58670000
      IF PRIVMODE THEN                                         <<*8660>>58675000
         LOGC := TRUE                                          <<*8660>>58680000
      ELSE                                                     <<*8660>>58685000
         BEGIN                                                 <<*8660>>58690000
         TOS := ILLCAP;                                        <<*8660>>58695000
         TOS := CCL;                                           <<*8660>>58700000
         GO EXIT;                                              <<*8660>>58705000
         END;                                                  <<*8660>>58710000
      END;                                                     <<*8660>>58715000
                                                               <<*8660>>58720000
                                                                        58725000
   IF (LYNX2 := FALSE) THEN                                    <<6029>> 58730000
      BEGIN                                                    <<6029>> 58735000
FTCLOSE:                                                       <<6029>> 58740000
      IF PRIVMODE                                              <<6029>> 58745000
         THEN LYNX2 := TRUE                                    <<6029>> 58750000
      ELSE                                                     <<6029>> 58755000
         BEGIN                                                 <<6029>> 58760000
         TOS := ILLCAP;                                        <<6029>> 58765000
         TOS := CCL;                                           <<6029>> 58770000
         GO EXIT;                                              <<6029>> 58775000
         END;                                                  <<6029>> 58780000
      END;                                                     <<6029>> 58785000
                                                               <<6029>> 58790000
   IF (SPOOLF := FALSE) THEN                                            58795000
      BEGIN                                                             58800000
FSCLOSE:                                                                58805000
      SPOOLF := TRUE;                                                   58810000
      END;                                                              58815000
   IF (JOBF := FALSE) THEN                                              58820000
      BEGIN                                                             58825000
FJCLOSE:                                                                58830000
      JOBF := TRUE;                                                     58835000
      SPOOLF := FALSE;                                                  58840000
      END;                                                              58845000
   IF (KSC:=FALSE) THEN                                        <<KS.00>>58850000
   BEGIN <<KSAM SECONDARY ENTRY POINT BEGINS>>                 <<KS.00>>58855000
KFCLOSE:                                                       <<KS.00>>58860000
      KSC:=TRUE;                                               <<KS.00>>58865000
      SPOOLF:=JOBF:=FALSE;                                     <<KS.00>>58870000
   END; <<KSAM SECONDARY ENTRY POINT BEGINS>>                  <<KS.00>>58875000
   IF (PVCLOSE' := FALSE) THEN                                 <<RV.PV>>58880000
   BEGIN <<CONDITIONAL DISMOUNT ENTRY POINT>>                  <<RV.PV>>58885000
PVCLOSE:                                                       <<RV.PV>>58890000
       PVCLOSE' := TRUE;                                       <<RV.PV>>58895000
       KSC := SPOOLF := JOBF := FALSE;                         <<RV.PV>>58900000
   END;                                                        <<RV.PV>>58905000
   IF (FCLOSEDA' := FALSE) THEN                                <<RV.PV>>58910000
   BEGIN                                                       <<RV.PV>>58915000
FCLOSEDA:                                                      <<RV.PV>>58920000
       FCLOSEDA' := TRUE;                                      <<RV.PV>>58925000
       PVCLOSE' := KSC := SPOOLF := JOBF := FALSE;             <<RV.PV>>58930000
   END;                                                        <<RV.PV>>58935000
                                                                        58940000
$  IF X0 = ON                                                           58945000
   IF MONCALLABLE THEN  <<MONITORING?>>                                 58950000
      BEGIN                                                             58955000
      TOS := "FC"; TOS := "LO"; TOS := "SE";                            58960000
      ASSEMBLE(ZERO,DZRO; DZRO);                                        58965000
      FTITLE(*,*,*,*);                                                  58970000
      DEBUG                                                             58975000
      END;                                                              58980000
$  IF                                                                   58985000
                                                                        58990000
   ERRORON;                                                             58995000
                                                               <<03509>>59000000
   << Insure that there will be enough stack space while  >>   <<03509>>59005000
   << FCLOSE is critical.                                 >>   <<03509>>59010000
                                                               <<03509>>59015000
   TOS := %1400;                                               <<03509>>59020000
   ASSEMBLE (ADDS 0);                                          <<03509>>59025000
   TOS := %1400;                                               <<03509>>59030000
   ASSEMBLE (SUBS 0);                                          <<03509>>59035000
                                                               <<03509>>59040000
   CRIT := SETCRITICAL;                                                 59045000
   ORIG'DST := EXCHANGEDB(0);  << Save original DST number     <<04517>>59050000
   MUSTCLOSE := ((DISP = -1) LAND PRIVMODE) LOR JOBF;          <<*8088>>59055000
   IF SPOOLF OR JOBF THEN  <<SPECIAL CLOSE?>>                           59060000
      BEGIN                                                             59065000
      IF NOT PRIVMODE THEN  <<NOT PRIVILEGED?>>                         59070000
         BEGIN                                                          59075000
         TOS := ILLCAP;                                                 59080000
         TOS := CCL;                                                    59085000
         GO EXIT                                                        59090000
        ; HELP  <<FOR DUMMY CALL>>;                            <<00117>>59095000
         END                                                            59100000
      END;                                                              59105000
   PCBPT := CURPRC;                ! Set to current process.   <<06514>>59110000
   CI := (SPCBPTYPE' = USER'MAIN); ! 2 bits in PCB signify CI  <<06514>>59115000
                                                               <<6029>> 59120000
   << The CLOSEIT flag will not allow a CI to close file    >> <<6029>> 59125000
   << number 1 or 2 (usually $STDIN/$STDLIST) unless called >> <<6029>> 59130000
   << by FJCLOSE. This creates a problem for LYNX2. When a  >> <<6029>> 59135000
   << session (CI) is terminating, MORGUE will FJCLOSE file >> <<6029>> 59140000
   << number 2 and then file number 1. However, when filenum>> <<6029>> 59145000
   << 1 gets closed, the terminal for $STDIN needs to be    >> <<6029>> 59150000
   << deallocated. Part of this deallocation will cause the >> <<6029>> 59155000
   << LYNX2 code to open the terminal configuration file    >> <<6029>> 59160000
   << (which will be fnum 2) download the info to some      >> <<6029>> 59165000
   << magic LYNX2 table(s) and then proceed to close it.    >> <<6029>> 59170000
   << All this time it is running on the CI's stack and     >> <<6029>> 59175000
   << the file number is 2. Therefore the file system will  >> <<6029>> 59180000
   << not allow the file to be closed (but cleaverly returns>> <<6029>> 59185000
   << CCE and no error). If this is LYNX2 calling, must     >> <<6029>> 59190000
   << force CLOSEIT to be TRUE - or else this file will     >> <<6029>> 59195000
   << never be closed, the ACB/FCB will never be released...>> <<6029>> 59200000
                                                               <<6029>> 59205000
   IF NOT JOBF AND CI AND (1 <= FILENUM <= 2) AND DISP <> 4             59210000
      AND NOT LYNX2   THEN CLOSEIT := FALSE                    <<6029>> 59215000
      ELSE CLOSEIT := TRUE;                                             59220000
   IF NOT CI AND FILENUM <= 2                                  <<01863>>59225000
      THEN PRIMED := FALSE                                     <<01863>>59230000
      ELSE PRIMED := TRUE;                                     <<01863>>59235000
   IF JOBF AND DISP = 4 AND FILENUM = 2 THEN                            59240000
     BEGIN  << Deletion of Output spoolfile on close.   >>              59245000
     SPECIAL'SPOOL'CLOSE(FILENUM,DISP,SECCODE);                         59250000
     TOS := IF = THEN CCE ELSE CCL;                                     59255000
     GOTO EXIT;                                                         59260000
     END;                                                               59265000
   PXGLOBAL;               ! Initialize PCBGLOBLOC.            <<06513>>59270000
   TOS:=@UCAP;           << Address of user cap variable >>    <<02349>>59275000
   TOS:=PXG'JITDST;        ! Obtain JIT DST.                   <<06513>>59280000
   TOS:=JITUCAP;         << Location in JIT of user cap >>     <<02349>>59285000
   TOS:=2;               << Number of words to move >>         <<02349>>59290000
   ASSEMBLE(MFDS 4);     << Get user cap from JIT >>           <<02349>>59295000
   SETPXFILE;  <<INIT. PXFILE POINTER>>                                 59300000
                                                                        59305000
   <<* * *       Obtain the FMAVT SIR NOW!!!        * * *>>    <<04517>>59310000
                                                                        59315000
   B := GETSIR(FMAVTSIR);                                      <<01863>>59320000
                                                               <<04517>>59325000
   <<*******************************************************>> <<04517>>59330000
   <<  Next, copy our AFT entry and ACB's onto the stack    >> <<04517>>59335000
   << into out Q relative array ACB.                        >> <<04517>>59340000
   <<*******************************************************>> <<04517>>59345000
                                                               <<04517>>59350000
   FLAGS := STATUS;      << STATUS register priv bit.       >> <<06296>>59355000
   FLAGS.(1:15) := 0;    << Privmode check only.            >> <<04517>>59360000
   GET'ACB'Q'LOC;                                              <<04517>>59365000
   LOC'ACB(DSTX,ACBMQ,FILENUM,FLAGS,FMAVTSIR,B);               <<04517>>59370000
   DSTX := TOS;      <<LOC'ACB returns current DST number   >> <<04517>>59375000
                                                               <<04517>>59380000
   IF < THEN GO E1;  <<INVALID FILE NR.?>>                              59385000
   IF > THEN GO RELAFTENT;  <<$NULL?>>                                  59390000
                                                               <<*7839>>59395000
   DADDR := ACBDADDR;   << Logical Device Number >>            <<*7839>>59400000
                                                               <<04517>>59405000
   <<*******************************************************>> <<04517>>59410000
   << If we try to close the file with I/O pending, return  >> <<04517>>59415000
   << I/O pending error unless we are in a "MUST CLOSE"     >> <<04517>>59420000
   << situation.                                            >> <<04517>>59425000
   <<*******************************************************>> <<04517>>59430000
                                                               <<04517>>59435000
   IF IOQX <> 0 THEN                                           <<04517>>59440000
      BEGIN   << No-Wait I/O pending                        >> <<04517>>59445000
      IF NOT MUSTCLOSE THEN  <<RETURN ERROR?>>                          59450000
         BEGIN                                                          59455000
         TOS := IOPENDING;                                              59460000
         GO ERR                                                         59465000
         END;                                                           59470000
                                                               <<04517>>59475000
      <<****************************************************>> <<04517>>59480000
      << If the IOQX is non-zero, signifying that there is  >> <<04517>>59485000
      << a No-Wait I/O pending than delete this request via >> <<04517>>59490000
      << ABORTIOX or WAITFORIO (for disc files).  If the    >> << 8485>>59495000
      << IOQX is negative, then this is a file system stub, >> << 8485>>59500000
      << don't do anything with it. Message file IOQX's are >> << 8485>>59505000
      << also stubs that should be ignored.                 >> << 8485>>59510000
      <<****************************************************>> <<04517>>59515000
                                                               <<04517>>59520000
      IF FTYPE <> MSG'TYPE AND IOQX > 0 THEN                   << 8485>>59525000
         IF ACBACCCL = DIRACC                                  << 8485>>59530000
            THEN WAITFORIO(IOQX)    ! Wait for disc I/O.       << 8485>>59535000
            ELSE ABORTIOX(IOQX);    ! Non disc, abort the I/O. << 8485>>59540000
      IOQX := 0;  << Clear out IOQX word in AFT             >> <<04517>>59545000
      END;                                                              59550000
   ACBERROR := 0;  <<clear out error, allow check in quiesce>><<<*7839>>59555000
   SUBTYPE := LDEVTOSUBTYPE(ACBDADDR);  << get device subtyp>> <<*7839>>59560000
   IF FTYPE<>0 AND FTYPE<>MSG'TYPE OR ACBACCCL<>0 THEN         <<01882>>59565000
     IF B <> -1 THEN RELSIR(FMAVTSIR,B);                       <<01882>>59570000
   CASE FTYPE OF                                               <<DS.00>>59575000
   BEGIN                                                       <<DS.00>>59580000
                                                               <<DS.00>>59585000
   BEGIN << CONVENTIONAL FILE >>                               <<DS.00>>59590000
CONV: <<USED FOR KSAM>>                                        <<KS.00>>59595000
   IF ACBDTYPE=FDISC THEN DISP := SECCODE := 0;                <<01882>>59600000
   IF ACBMSGFILE AND (NOT ACBCOPY OR ACBWRITE) THEN            <<01882>>59605000
      MSGFILE := TRUE;                                         <<01882>>59610000
   IF ACBACCCL = DIRACC AND LOGICAL(ACBPRIV) AND NOT PRIVMODE THEN      59615000
      GO E1;  <<COULDN'T HAVE OPENED IT?>>                              59620000
                                                                        59625000
   <<* * * HANDLE SPECIAL SITUATIONS FOR SPOOLING * * *>>               59630000
                                                                        59635000
   IF ACBSPOOLED THEN                                          << 8562>>59640000
      BEGIN                                                             59645000
      SPOOLF := 1;                                                      59650000
      IF LOGICAL(ACBSPOOLIO) AND PRIMED THEN <<write fclose>>  <<*8802>>59655000
         BEGIN                                                          59660000
         ACBCTL := 0;                                                   59665000
         ACBNEWEOF := 1;                                                59670000
         @TARGET := 0;       << Initialize dummy pointer.   >> <<04865>>59675000
         IOMOVE(4,TARGET,0); << Write file close record     >> <<04517>>59680000
         END;                                                           59685000
      END;                                                              59690000
   IF ACBINHIBITBUF AND STREAMING'DEVICE THEN                  <<*7839>>59695000
      BEGIN                                                    <<*7839>>59700000
      IO'STATUS := ATTACHIO(DADDR,0,0,@DUMMY,CHECK'STATUS,     <<*7839>>59705000
                            3,0,4,BFLAGS);                     <<*7839>>59710000
      IF ERR'STAT <> 1 AND NOT MUSTCLOSE THEN                  <<*7839>>59715000
         BEGIN                                                 <<*7839>>59720000
         ACBERROR := IOSTAT(ERR'STAT);                         <<*7839>>59725000
         IF ACBERROR = EOF OR ACBERROR = EOT OR                <<*7839>>59730000
                ACBERROR = TAPERREC THEN                       <<*7839>>59735000
           ACBERROR := 0                                       <<*7839>>59740000
         ELSE                                                  <<*7839>>59745000
            BEGIN                                              <<*7839>>59750000
            TOS := ACBERROR;                                   <<*7839>>59755000
            GO TO ERR;                                         <<*7839>>59760000
            END;                                               <<*7839>>59765000
         END;                                                  <<*7839>>59770000
      END;                                                     <<*7839>>59775000
   IF NOT MSGFILE AND NOT ACBINHIBITBUF                        <<HM.00>>59780000
     AND ((CLOSEIT LAND ACBSHCNT <= 1) LOR                     <<HM.00>>59785000
      (NOT CLOSEIT LAND NOT LOGICAL(ACBSPOOL))) THEN                    59790000
      BEGIN                                                             59795000
                                                               <<04517>>59800000
      <<****************************************************>> <<04517>>59805000
      << FQUIESCIO also needs the ACB and DSTX directly     >> <<04517>>59810000
      << above the procedure call. Obtain the number of pre->> <<04814>>59815000
      << reads from FQUIESCE'IO.  For serial devices, we    >> <<04814>>59820000
      << will do a BSR for each pre-read.                   >> <<04814>>59825000
      <<****************************************************>> <<04517>>59830000
                                                               <<04517>>59835000
      TOS := FQUIESCE'IO(FALSE);  << Must use TOS to insure >> <<04814>>59840000
      ACBTAPEDISP := TOS;         << the ACB at Q-62!!!!!!  >> <<04814>>59845000
      IF (ACBERROR <> 0) AND NOT MUSTCLOSE THEN                <<*7839>>59850000
         BEGIN  << error occurred in FQUIESCE'IO >>            <<*7839>>59855000
         IF ACBERROR = EOF OR ACBERROR = EOT OR                <<*7973>>59860000
            ACBERROR = TAPERREC THEN                           <<*7973>>59865000
            << we don't need to report end of file, end >>     <<*7973>>59870000
            << of tape, or tape retries                 >>     <<*7973>>59875000
            ACBERROR := 0                                      <<*7973>>59880000
         ELSE                                                  <<*7973>>59885000
            BEGIN                                              <<*7973>>59890000
            TOS := ACBERROR;                                   <<*7973>>59895000
            GO ERR;                                            <<*7973>>59900000
            END;                                               <<*7973>>59905000
         END;                                                  <<*7839>>59910000
      END                                                      <<S7505>>59915000
   ELSE                                                        <<S7505>>59920000
      BEGIN                                                    <<S7505>>59925000
      IF ACBACCCL=DIRACC AND NOT(ACBINHIBITBUF LOR MSGFILE)    <<S7505>>59930000
         THEN COMPLETE'IO(PACBV'DSTN);                         <<S7505>>59935000
      END;                                                     <<S7505>>59940000
   IF NOT CLOSEIT THEN                                                  59945000
      BEGIN                                                             59950000
      TOS := 0;                                                         59955000
      TOS := CCE;                                                       59960000
      GO XIT;                                                           59965000
      END;                                                              59970000
   IF ACBREADTYPE <> 0 THEN  <<$STDIN(X) - UPDATE EOF?>>                59975000
      BEGIN                                                             59980000
      IF ACBREADMODE <> STDINCIRD THEN  <<NON-CI?>>                     59985000
         BEGIN                                                          59990000
         IF (LOGICAL(ACBREADMODE+1) LAND LOGICAL(ACBEOFS)) <> 0 THEN    59995000
            ACBEOF := 1;                                                60000000
         ACBEOFS := 0                                          <<07047>>60005000
         END                                                            60010000
      END;                                                              60015000
   IF NOT SPOOLF AND NOT MSGFILE THEN                          <<HM.00>>60020000
      IF (SPOOLF := ACBSPXDDX <> 0) THEN DISP := 0;                     60025000
                                                               <<04517>>60030000
   <<*******************************************************>> <<04517>>60035000
   <<  Copy the FCB onto the stack.  Because of space prob- >> <<04517>>60040000
   << lems in out Q-relative locations.  We expand SREG by  >> <<04517>>60045000
   << FCBSIZE and move the Control Block onto stack.        >> <<04517>>60050000
   <<*******************************************************>> <<04517>>60055000
                                                               <<04517>>60060000
   IF ACBACCCL = DIRACC AND ACBDTYPE <> FDISC THEN  <<DISC FILE?><<FDF>>60065000
      BEGIN                                                             60070000
      A := GETSIR(FISIR);  <<GET FILE SIR NOW!>>                        60075000
      RESOURCES.SIRLOCK := TRUE;  <<SET SIR FLAG>>                      60080000
      FCBV := ACBFCB;                                          <<04624>>60085000
      FCB'VARS := GETFCB'INFO(FCBV,0);  << Get FCB size.    >> <<04624>>60090000
      FCBSI := FCB'0.SIZEF;     << Extract bits of FCB size.>> <<04624>>60095000
      PUSH(S);               << Allocate local FCB array    >> <<04624>>60100000
      @FCB := TOS + 1;       << on Top Of Stack.            >> <<04624>>60105000
      TOS := FCBSI;          << Expand S by FCB size.       >> <<04624>>60110000
      ASSEMBLE(ADDS 0);                                        <<04624>>60115000
      GET'FCB'Q'LOC;                                           <<04624>>60120000
      LOCK'CB(0,0,FCBMQ,FCBV);                                 <<06514>>60125000
      FCB'CB'ADDR  := DS1;   << Save the FCB addresses for  >> <<06514>>60130000
      FCB'STK'ADDR := DS3;   << update back to the FCB CB.  >> <<06514>>60135000
      TOS := FCBSI;                                            <<04624>>60140000
      MOVE'DS'5;             << Copy the FCB onto stack.    >> <<04624>>60145000
      DEL;                   << Delete FLAG parameter.      >> <<04624>>60150000
      RESOURCES.FCBLOCK := TRUE; << FCB is locked.          >> <<04624>>60155000
                                                               <<04624>>60160000
      IF FCBDISP = HARDFLABERR                                 <<04624>>60165000
         THEN LABELERROR := TRUE;                              <<04624>>60170000
      IF MUSTCLOSE THEN                                        <<04624>>60175000
         BEGIN                                                 <<04624>>60180000
         FCBDISP := 0;                                         <<04624>>60185000
         FCBCRUNCH := 0;                                       <<04624>>60190000
         END;                                                  <<04624>>60195000
      END; << Disc file.                                    >> <<04624>>60200000
                                                               <<04624>>60205000
   IF MUSTCLOSE OR LABELERROR THEN ACBDISP := DISP := 0;                60210000
   ATYPE := ACBACTYPE;  <<ACCESS TYPE>>                                 60215000
                                                               <<06514>>60220000
   IF (TOS:=ACBDISP) <> 0 THEN DISP.(13:3):=TOS ELSE DEL;      <<02351>>60225000
                                                                        60230000
   <<* * * PROCESS ACCORDING TO DEVICE TYPE * * *>>                     60235000
                                                                        60240000
   IF ACBDTYPE<>FDISC THEN TOS:=ACBACCCL                       <<01115>>60245000
                      ELSE TOS:=3;                             <<01115>>60250000
   IF = THEN  <<DIRECT ACCESS DEVICE?>>                                 60255000
      BEGIN                                                             60260000
                                                                        60265000
      <<DIRECT ACCESS DEVICE>>                                          60270000
                                                                        60275000
                                                               <<06514>>60280000
      TOS := FCBLABEL;  <<LDEV AND SECTOR NR.>>                         60285000
      BS1 := 0;  <<CLEAR LDEV>>                                         60290000
      DISKADR := TOS;  <<FILE LABEL SECTOR NR.>>                        60295000
      << SET PENDING DISPOSITION >>                                     60300000
      IF SPOOLF THEN  <<SPOOLFILE?>>                                    60305000
         BEGIN                                                          60310000
         @XDDEP := ACBSPXDDX;   <<XDD TABLE INDEX>>            <<+1.03>>60315000
         IF INTEGER(SPOOLF) > 0 THEN   <<ACCESSED AS DEVICE?>> <<+1.03>>60320000
            BEGIN                                                       60325000
            SPVDEV := ACBSPVDEV;   <<VIRTUAL DEVICE NR.>>      <<+1.03>>60330000
            DISP := IF LOGICAL(ACBSPOOLIO)                     <<+1.03>>60335000
              THEN 0   <<OUTPUT: SAVE FILE>>                   <<+1.03>>60340000
              ELSE 4   <<INPUT: DELETE>>                       <<+1.03>>60345000
            END                                                         60350000
         ELSE   << SPOOLFILE ACCESSED AS A FILE >>             <<+1.03>>60355000
            IF DISP = 1 THEN                                   <<+1.03>>60360000
               BEGIN  <<REDUCE NR. OF COPIES, TERMINATE IF 0>> <<+1.03>>60365000
               TOS := XDDSPOOLINFO(0D,%4,XDDEP);                        60370000
               DISP := IF TOS = 0                              <<+1.03>>60375000
                  THEN 4   <<LAST COPY PRINTED: DELETE>>       <<+1.03>>60380000
                  ELSE 0   <<MORE COPIES TO PRINT: KEEP>>      <<+1.03>>60385000
               END;                                                     60390000
         IF DISP <> 0 THEN DISP := 4;  <<DEFAULT: DELETE>>     <<+1.03>>60395000
         TOS := 0;  <<FOR DOMAIN>>                                      60400000
         IF DISP = 0 THEN   << SAVE? >>                        <<+1.03>>60405000
            BEGIN   <<SAVE FILE IN IDD OR ODD>>                <<+1.03>>60410000
            TOS := TOS+1;  <<DOMAIN := 1: SAVE FILE>>          <<+1.03>>60415000
            IF FCBOCNTOUT = 1   << LAST COPY? >>               <<+1.03>>60420000
               THEN DISP := %10   << CRUNCH FILE >>            <<+1.03>>60425000
            END;                                                        60430000
         IF ACBSPSQZ=1   << ALREADY CRUNCHED? >>               <<+1.03>>60435000
            THEN DISP := DISP'DOMAIN;   <<Don't crunch again>> <<04513>>60440000
         DOMAIN := TOS                                                  60445000
         END                                                            60450000
      ELSE  <<NORMAL FILE>>                                             60455000
         BEGIN                                                          60460000
         DOMAIN := FCBDOMAIN;  <<SET DOMAIN>>                           60465000
         IF DISP'DOMAIN = 3 THEN DISP'DOMAIN := 2;<<job temp>> <<04513>>60470000
         IF DISP'DOMAIN = 2 THEN                               <<04513>>60475000
            IF DOMAIN=1 THEN GO E3  << sys file >>                      60480000
            ELSE IF DOMAIN=2 THEN DISP'DOMAIN := 0; << temp >> <<04513>>60485000
         END;                                                           60490000
      IF LABELERROR THEN  <<BAD LABEL?>>                                60495000
         BEGIN                                                          60500000
         IF NOT MUSTCLOSE THEN  <<RETURN ERROR?>>                       60505000
            BEGIN                                                       60510000
            TOS := LBLIOERR;                                            60515000
            GO ERR                                                      60520000
            END;                                                        60525000
         IF DOMAIN = 2 THEN REMJTENTRY(ACBNAME,FCBGN,FCBAN,2,0);        60530000
         DOMAIN := PURGE := 1;                                          60535000
         GO FCBACBMGT                                                   60540000
         END;                                                           60545000
      ALLOCFLAB;  <<ALLOCATE FILE LABEL BUFFER>>                        60550000
      LABELIO(0);  <<READ LABEL>>                                       60555000
      RESOURCES.DMOUNT := FCBMVTABX <> 0;                      <<06514>>60560000
      LDEVTOVTAB(FLEXTMAP,FCBEXTMAP,FCBNUMEXTS+1,FCBMVTABX<>0);<<RV.PV>>60565000
                                                               <<04513>>60570000
     <<*****************************************************>> <<04513>>60575000
     << Determine if we should crunch the file, now, or     >> <<04513>>60580000
     << possible in the future.                             >> <<04513>>60585000
     <<*****************************************************>> <<04513>>60590000
                                                               <<04513>>60595000
     IF FCBOCNT > 1 THEN                                       <<04513>>60600000
        BEGIN               << Not the last accessor.       >> <<04513>>60605000
        IF DISP'CRUNCH = 1 THEN                                <<04513>>60610000
           BEGIN                                               <<04513>>60615000
           IF FCBDISP = 0                                      <<04513>>60620000
              THEN FCBCRUNCH := 1;  << Will crunch.    >>      <<04513>>60625000
           DISP'CRUNCH := 0;   << Won't crunch this pass!   >> <<04513>>60630000
           END                                                 <<04513>>60635000
        ELSE                                                   <<04513>>60640000
           IF DISP'DOMAIN <> 0                                 <<04513>>60645000
              THEN FCBCRUNCH := 0;  << Won't crunch.   >>      <<04513>>60650000
        END                                                    <<04513>>60655000
     ELSE                                                      <<04513>>60660000
        BEGIN               << Last accessor, do we crunch? >> <<04513>>60665000
        IF DISP'CRUNCH = 1 THEN                                <<04513>>60670000
           BEGIN                                               <<04513>>60675000
           IF 1 <= FCBDISP <= 4 AND FCBCRUNCH = 0              <<04513>>60680000
              THEN DISP'CRUNCH := 0;     << Can't crunch.   >> <<04513>>60685000
           END                                                 <<04513>>60690000
        ELSE                                                   <<04513>>60695000
           IF DISP'DOMAIN = 0 AND FCBCRUNCH = 1                <<04513>>60700000
              THEN DISP'CRUNCH := 1;     << Let's crunch.   >> <<04513>>60705000
        END;                                                   <<04513>>60710000
                                                                        60715000
      <<* * * CRUNCH FILE * * *>>                                       60720000
                                                                        60725000
      IF (%10 <= DISP <= %13) AND NOT ACBCIRFILE               <<04549>>60730000
                              AND NOT MSGFILE THEN             <<04549>>60735000
         BEGIN                                                          60740000
         IF ATYPE=0 THEN     <<READ ONLY ACCESS>>              <<01052>>60745000
            BEGIN                                              <<01882>>60750000
            TOS := ACCVIOL;     << can't crunch file >>        <<01882>>60755000
            DISP := DISP'DOMAIN;  << Remove Crunch bit      >> <<04513>>60760000
            GO ERR                                             <<01882>>60765000
            END;                                               <<01882>>60770000
         CRUNCH := TRUE;  <<SET FLAG>>                                  60775000
                                                               <<04549>>60780000
         <<*************************************************>> <<04549>>60785000
         << Obtain block number of EOF.  For fixed length   >> <<04549>>60790000
         << and undefined, divide EOF record number by      >> <<04549>>60795000
         << blocking factor.  For normal variable, FCBEND   >> <<04549>>60800000
         << contains the block number of the last data blk,  > <<04549>>60805000
         << which is the number of blocks -1.               >> << 7602>>60810000
         IF ACBVARIABLE THEN    << Variable length file.    >> << 7602>>60815000
            BEGIN                                              <<04549>>60820000
            IF FCBEOF = 0D                                     <<04549>>60825000
               THEN TOS := 0D           << Empty file       >> <<04549>>60830000
               ELSE << Kludge to protect pre-MPEIV files.   >> <<04768>>60835000
                  IF FCBEND = 0D  AND NOT ACBSPECVAR           << 7602>>60840000
                     THEN GO TO NO'CRUNCH                      <<04768>>60845000
                     ELSE TOS := FCBEND + 1D;                  <<04768>>60850000
            END                                                <<04549>>60855000
         ELSE                                                  <<04549>>60860000
            BEGIN             << Fixed  or undefined length >> <<04549>>60865000
            TOS := FCBEOF/DOUBLE(FCBBLKFACT);                  <<04549>>60870000
            IF FCBEOF MOD DOUBLE(FCBBLKFACT) <> 0D             <<04549>>60875000
               THEN TOS := TOS + 1D; << Partial Block       >> <<04549>>60880000
            END;                                               <<04549>>60885000
                                                               <<04549>>60890000
         <<*************************************************>> <<04549>>60895000
         << TOS contains EOF block number.  Calculate EOF   >> <<04549>>60900000
         << EXTENT and sector displacement into that extent.>> <<04549>>60905000
         <<*************************************************>> <<04549>>60910000
                                                               <<04549>>60915000
         X := FCBSECTPBLK;                                              60920000
         MPYD;                                                          60925000
         TOS := TOS+DOUBLE(LOGICAL(FCBSECTOFF));                        60930000
         X := FCBEXTSIZE;                                               60935000
         DIVD;                                                          60940000
         I := TOS;  <<REM: EOF EXTENT SECTOR DISP.>>           <<+1.03>>60945000
         J := TOS;  <<QUOT: EOF EXTENT INDEX>>                 <<+1.03>>60950000
         DEL;                                                           60955000
         DRCODE := 0D;  <<INIT. NR. SECTORS DEALLOCATED>>               60960000
                                                                        60965000
         <<* * * RELEASE UNUSED PART OF EOF EXTENT * * *>>              60970000
                                                                        60975000
         << The following code has been altered to     >>      <<03509>>60980000
         << prevent problems when the system crashs    >>      <<03509>>60985000
         << after space has been returned but before   >>      <<03509>>60990000
         << the file label has been updated.  This fix >>      <<03509>>60995000
         << is a kludge, but the code is shit and      >>      <<03509>>61000000
         << needs to be re-written.                    >>      <<03509>>61005000
                                                               <<03509>>61010000
         partial'ext'len := 0D;                                <<03509>>61015000
         extsize := fcbextsize;                                <<04307>>61020000
         IF I <> 0 THEN  <<RELEASE PARTIAL EXTENT?>>                    61025000
            BEGIN                                                       61030000
            @EXTENTRY := @FCBEXTMAP+J&LSL(1);  <<EOF EXTENT DESCRIPTOR>>61035000
            IF J = FCBNUMEXTS THEN  <<LAST EXTENT?>>                    61040000
               TOS := FCBLASTEXTSIZE  <<EXTENT SIZE>>                   61045000
            ELSE  <<NOT LAST EXTENT>>                                   61050000
               TOS := FCBEXTSIZE;  <<EXTENT SIZE>>                      61055000
                                                               <<03509>>61060000
            partial'ext'len := DOUBLE(LOGICAL(TOS-I));         <<03509>>61065000
            drcode := partial'ext'len;                         <<03509>>61070000
            TOS := EXTENTRY;  <<SAVE EOF EXTENT DESCRIPTOR>>            61075000
            PARTIAL'EXT'LDEV := BS1; << Save ldev.          >> <<06861>>61080000
            BS1 := 0;                << Clear LDEV.         >> <<06861>>61085000
            partial'ext'addr := TOS+DOUBLE(LOGICAL(i));        <<03509>>61090000
            J := J+1;                                                   61095000
            IF SPOOLF THEN                                              61100000
               BEGIN                                                    61105000
               DISABLE;  <<UPD CUR SPFILE SECT CNT>>                    61110000
               TOS := ABS(NUMSSECT);                                    61115000
               TOS := ABS(X := X+1);                                    61120000
               TOS:= TOS - DRCODE;                             <<06861>>61125000
               ABS(X) := TOS;                                           61130000
               ABS(X := X-1) := TOS;                                    61135000
               ENABLE;                                                  61140000
               END;                                                     61145000
            END;                                                        61150000
                                                                        61155000
         <<* * * DEALLOCATE REMAINING EXTENTS * * *>>                   61160000
         << Allocate a buffer for a list of extents    >>      <<03509>>61165000
         << to purge, Releasedisk will then fill it.   >>      <<03509>>61170000
                                                               <<03509>>61175000
         PUSH (S);                                             <<03509>>61180000
         @extent'list := TOS + 1;                              <<03509>>61185000
         TOS := (fcbnumexts*2) + 1;                            <<03509>>61190000
         ASSEMBLE (ADDS 0);   << Allocate the buffer >>        <<03509>>61195000
                                                               <<03509>>61200000
         RELEASEDISK(J,FCBNUMEXTS);  <<RELEASE OTHER EXTENTS>>          61205000
         IF NOT SPOOLF AND DOMAIN = 1 AND (%10 <= DISP <= %11) <<00157>>61210000
            THEN << RE-SAVE OLD PERM FILE >>                   <<00117>>61215000
            DIRECADJUST (-DRCODE,0,FLACCTNAME,                 <<39.PV>>61220000
                         FLGRPNAME,FCBMVTABX);                 <<06514>>61225000
                                                                        61230000
         <<*************************************************>> <<04549>>61235000
         << UPDATE FCB AND FILE LABEL - File limit for var- >> <<04549>>61240000
         << iable length is in blocks.                      >> <<04549>>61245000
         <<*************************************************>> <<04549>>61250000
                                                                        61255000
         IF ACBNORMVAR THEN                                    <<04549>>61260000
            BEGIN                                              <<04549>>61265000
            IF FCBEOF = 0D                                     <<04549>>61270000
               THEN FCBFLIM := FLFLIM := 0D                    <<04549>>61275000
               ELSE FCBFLIM := FLFLIM := FCBEND + 1D;          <<04549>>61280000
            END                                                <<04549>>61285000
         ELSE                                                  <<04549>>61290000
             FCBFLIM := FLFLIM := FCBEOF;                      <<04549>>61295000
         FCBNUMEXTS := J-1;  <<UPDATE NR. EXTENTS>>                     61300000
         FLNUMEXTS := J-1;  <<UPDATE NR. EXTENTS>>                      61305000
         TOS := I;  <<EOF SECTOR DISP.>>                                61310000
         IF = THEN TOS := TOS+FCBEXTSIZE;  <<BEGINNING OF EXTENT?>>     61315000
         I := TOS;  <<LAST EXTENT SIZE>>                                61320000
         IF J = 1 THEN  <<SINGLE EXTENT FILE?>>                         61325000
            BEGIN                                                       61330000
            FCBEXTSIZE := I;  <<UPDATE EXTENT SIZE>>                    61335000
            FLEXTSIZE := I  <<UPDATE EXTENT SIZE>>                      61340000
            END;                                                        61345000
         FCBLASTEXTSIZE := I;  <<UPDATE LAST EXTENT SIZE>>              61350000
         FLLASTEXTSIZE := I;  <<UPDATE LAST EXTENT SIZE>>               61355000
         UPDATEFCB;  <<UPDATE FCB>>                                     61360000
         Labelio (1);  << Write file label >>                  <<03509>>61365000
                                                               <<03509>>61370000
         << Now we can safely deallocate the extents. The   >> <<06861>>61375000
         << partial extent LDEV check is for safety reasons.>> <<06861>>61380000
         << First release partial extent.                   >> <<06861>>61385000
                                                               <<03509>>61390000
         IF PARTIAL'EXT'LEN > 0D AND PARTIAL'EXT'LDEV <> 0     <<06861>>61395000
            THEN Return'Disc'Space (partial'ext'ldev,          <<06861>>61400000
              partial'ext'addr, partial'ext'len);              <<03509>>61405000
                                                               <<03509>>61410000
         IF spoolf THEN                                        <<03509>>61415000
            extent'list'size.(8:1) := 1;                       <<03509>>61420000
         x := Diskdealloc (extsize, extent'list'last'size,     <<04307>>61425000
                           extent'list'size, extent'list);     <<03509>>61430000
                                                               <<03509>>61435000
$IF X1=ON                                                      <<03509>>61440000
         IF <> THEN Ftrouble (471);                            <<03509>>61445000
$IF                                                            <<03509>>61450000
                                                               <<03509>>61455000
                                                               <<03509>>61460000
         END;                                                           61465000
                                                               <<04768>>61470000
NO'CRUNCH:                                                     <<04768>>61475000
                                                               <<04768>>61480000
      DISP := DISP'DOMAIN;      << Remove crunch bit        >> <<04513>>61485000
                                                                        61490000
      <<* * * SAVE $NEWPASS FILE * * *>>                                61495000
                                                                        61500000
      IF FLNEWPASS AND (DISP <> 4) THEN  <<$NEWPASS FILE?>>    <<07391>>61505000
         BEGIN                                                          61510000
         TOS := FLLABEL;  <<$NEWPASS VTABX AND SECTOR NR.>>    <<RV.PV>>61515000
         EXCHANGEDB(PXG'JITDST);                               <<06513>>61520000
         FADDR := DADB0(JITPFP);  <<$OLDPASS LDEV AND SECTOR NR.>>      61525000
         DADB0(JITPFP) := TOS;  <<MAKE $NEWPASS $OLDPASS>>              61530000
         EXCHANGEDB(0);  <<RESET DB TO STACK>>                          61535000
         IF FADDR <> 0D THEN  <<DELETE OLD $OLDPASS?>>                  61540000
            BEGIN                                                       61545000
            LABELIO(1);  <<WRITE LABEL>>                                61550000
            ASSEMBLE(SUBS 128);  <<DEALLOCATE FILE LABEL BUFFER>>       61555000
            TOS := 0D;  <<FOR RESULT OF FDELETE>>                       61560000
            TOS := LUN (FADDRW1.(0:8),FCBMVTABX);              <<06514>>61565000
            TOS := FADDRW1.(8:8); <<SECTOR # (HIGH ORDER)>>    <<RV.PV>>61570000
            TOS := FADDRW2;       <<SECTOR # (LOW ORDER)>>     <<RV.PV>>61575000
            IF FRELSPACE(*,*,FCBMVTABX)=0D THEN FTROUBLE(489); <<06514>>61580000
            ASSEMBLE(ADDS 128);  <<RE-ALLOCATE FILE LABEL BUFFER>>      61585000
            LABELIO(0)  <<RE-READ LABEL>>                               61590000
            END;                                                        61595000
         FLDESIGNATOR := 3;  <<MAKE $OLDPASS>>                          61600000
         DISP := 0                                                      61605000
         END;                                                           61610000
                                                                        61615000
      <<* * * RECONCILE PENDING DISPOSITION * * *>>                     61620000
                                                                        61625000
FCBACBMGT:                                                              61630000
      PDISP := FCBDISP;                                                 61635000
      IF PDISP = 1 AND DISP = 4 AND DOMAIN = 1 THEN                     61640000
         DISP := PDISP := 0;                                            61645000
      IF DISP <> 0 THEN                                                 61650000
         IF (PDISP = 0) OR (DISP < PDISP) THEN PDISP := DISP;           61655000
      IF INTEGER(SPOOLF) < 0 THEN                              <<+1.01>>61660000
        IF (DISP := PDISP) <> 0 THEN DOMAIN := 0;              <<+1.01>>61665000
                                                                        61670000
      <<* * * UNLOCK FILE RIN * * *>>                                   61675000
                                                                        61680000
      IF FCBRIN <> 0 THEN  <<FILE HAS RIN?>>                            61685000
         BEGIN                                                          61690000
         RUNLOCK(FCBRIN);                                               61695000
         IF = THEN MRCAPOK(FALSE)  << WAS POSSIBLE >>                   61700000
         END;                                                           61705000
                                                                        61710000
      <<* * * CHECK FOR SINGLE/LAST ACCESSOR * * *>>                    61715000
                                                                        61720000
      FCBOCNT := FCBOCNT-1;  <<DECREMENT OPEN COUNT>>                   61725000
      IF FCBOCNT = 0 THEN  <<ZERO OPEN COUNT?>>                         61730000
         BEGIN                                                          61735000
         ASSEMBLE(DZRO,ZERO);                                           61740000
         FCBOCNTIN := TOS;  <<CLEAR INPUT COUNT>>                       61745000
         FCBOCNTOUT := TOS;  <<CLEAR OUTPUT COUNT>>                     61750000
         FCBDISP := TOS;                                                61755000
         RELFCB := TRUE;  <<SET DELETE FCB FLAG>>                       61760000
                                                                        61765000
         <<* * * PROCESS ACCORDING TO DISPOSITION * * *>>               61770000
                                                                        61775000
         TOS := PDISP;                                                  61780000
         X := S0;  <<PLACE COPY IN X>>                                  61785000
         IF TOS > 4 THEN  <<INVLAID?>>                                  61790000
            BEGIN                                                       61795000
            TOS := UNIMPL;                                              61800000
            GO ERR                                                      61805000
            END;                                                        61810000
         CASE * X OF                                                    61815000
            BEGIN                                                       61820000
                                                                        61825000
            <<0: LEAVE DISPOSITION>>                           <<+1.03>>61830000
                                                                        61835000
            IF NOT FLOLDPASS AND DOMAIN = 0 THEN GO REL;                61840000
                                                                        61845000
            <<1: SAVE PERMANENT DISPOSITION>>                  <<+1.03>>61850000
                                                                        61855000
            BEGIN                                                       61860000
            IF ACBDNTYPE = 3 THEN GO E2;  <<NULL NAME?>>                61865000
            IF DOMAIN <> 1 THEN  <<NOT PERMANENT FILE?>>                61870000
               BEGIN                                           <<02349>>61875000
               IF NOT SFCAP THEN  << No save file cap >>       <<02349>>61880000
                  BEGIN                                        <<02349>>61885000
                  TOS:=SFERR;                                  <<02349>>61890000
                  GO ERR;                                      <<02349>>61895000
                  END;                                         <<02349>>61900000
               IF LOGC THEN << Special log close, ignore >>    <<*8660>>61905000
                            << security on directory     >>    <<*8660>>61910000
                  DRCODE := DIRECRESETFILE (FSECTORS(FLAB),0,  <<*8660>>61915000
                             FLACCTNAME, FLGRPNAME, FLLOCNAME, <<*8660>>61920000
                             FLLABEL, FCBMVTABX)               <<*8660>>61925000
               ELSE                                            <<*8660>>61930000
                  DRCODE := DIRECINSERTFILE (FSECTORS(FLAB),0, <<*8660>>61935000
                       FLACCTNAME,FLGRPNAME,FLLOCNAME,         <<*8660>>61940000
                       FLLABEL, FCBMVTABX);                    <<*8660>>61945000
               IF < THEN GO E4;  <<I/O ERROR?>>                         61950000
               IF > THEN  <<OTHER ERROR?>>                              61955000
                  BEGIN                                                 61960000
                  TOS := ERRORMAP(RCA);  <<RAW ERROR NR.>>              61965000
                  IF RCA = 2 THEN TOS := TOS-RCB;                       61970000
                  IF RCA = 8 AND RCB <> 0 THEN                          61975000
                     BEGIN                                              61980000
                     ASSEMBLE(ADDS 5);  <<DIRECFINDFILE WORKSPACE>>     61985000
                     DIRECFINDFILE (0,0D,FLACCTNAME,           <<38.PV>>61990000
                           FLGRPNAME,FLLOCNAME,AS5,FCBMVTABX); <<06514>>61995000
                     TOS := IF = THEN DUPNSD ELSE NORIN+RCB             62000000
                     END;                                               62005000
                  GO ERR                                                62010000
                  END;                                                  62015000
               IF SECCODE=1 <<set matrix to R,A,W,L,X:CR and >><<01175>>62020000
               THEN BEGIN    << secure the file. >>            <<01175>>62025000
                   FLSECMX:=[6/1,6/1,6/1,6/1,6/1]D; <<CR ONLY>><<01175>>62030000
                   FLSECURE:=1;                     <<SECURE IT<<01175>>62035000
                   END;                                        <<01175>>62040000
               END;                                                     62045000
            IF DOMAIN = 2 THEN  <<JOB TEMPORARY FILE?>>                 62050000
               BEGIN                                                    62055000
                X:=REMJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME,  <<04574>>62060000
                              2,0).(8:8);                      <<04574>>62065000
<< THE UPPER 8 BITS (0:8) ARE USED FOR THE OLD FILE REFERENCE>><<04574>>62070000
<< COUNT SO IT CAN BE PRESERVED WHEN REPLACING FILE EQU'S    >><<04574>>62075000
               IF <> THEN GO E4  <<ERROR?>>                             62080000
               END;                                                     62085000
            DOMAIN := 1  <<MAKE DOMAIN PERMANENT>>                      62090000
            END;                                                        62095000
                                                                        62100000
            <<2: SAVE TEMPORARY DISPOSITION>>                  <<+1.03>>62105000
                                                                        62110000
            BEGIN                                                       62115000
SAVET:      IF DISP = 0 THEN GO CLEANUP;                                62120000
            IF ACBDNTYPE = 3 THEN GO E2;  <<NULL NAME?>>                62125000
            IF DOMAIN <> 2 THEN  <<NOT JOB TEMPORARY?>>                 62130000
               BEGIN                                                    62135000
               TOS := ADDJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME,2,2,    62140000
                  FLLABEL);  <<ADD TO JOB DIRECTORY>>          <<RV.PV>>62145000
               ASSEMBLE(TEST);                                          62150000
               RCA := TOS;                                              62155000
               IF <> THEN  <<ERROR?>>                                   62160000
                  BEGIN                                                 62165000
                  TOS := IF RCA = 2 THEN DUPNJD ELSE JTFDIROFL;         62170000
                  GO ERR                                                62175000
                  END                                                   62180000
               END;                                                     62185000
            DOMAIN := 2  <<MAKE DOMAIN TEMPORARY>>                      62190000
            END;                                                        62195000
                                                                        62200000
            <<3: SAVE TEMPORARY DISPOSITION>>                  <<+1.03>>62205000
                                                                        62210000
            GO SAVET;                                                   62215000
                                                                        62220000
            <<4: RELEASE DISPOSITION>>                         <<+1.03>>62225000
                                                                        62230000
            BEGIN                                                       62235000
REL:        IF FLLOCK&LSR(13) <> 0 OR FCBLKST <> 0 THEN                 62240000
               BEGIN                                                    62245000
               TOS := MLTIACCERR;                                       62250000
               GO ERR                                                   62255000
               END;                                                     62260000
                                                                        62265000
            <<* * * DELETE DIRECTORY ENTRY * * *>>                      62270000
                                                                        62275000
            IF DOMAIN = 1 AND FLACTUAL THEN                    <<06288>>62280000
               BEGIN  << Permanent file and not $OLDPASS?   >> <<06288>>62285000
               IF NOT LOGICAL(ACBACCESS.(12:1)) THEN                    62290000
                  BEGIN                                                 62295000
                  TOS := LOGICAL(ACBACCESS&LSL(8)) LOR SEXVIOL;         62300000
                  GO ERR                                                62305000
                  END;                                                  62310000
               DRCODE := DIRECPURGEFILE (-FSECTORS(FLAB),0,    <<38.PV>>62315000
                  FLACCTNAME,FLGRPNAME,FLLOCNAME,FCBMVTABX);   <<06514>>62320000
               IF < THEN GO E4;  <<I/O ERROR?>>                         62325000
              IF > THEN FTROUBLE(490);<< OTHER ERROR?>>        <<KJ.03>>62330000
               END                                                      62335000
            ELSE IF DOMAIN = 2 THEN  <<JOB TEMPORARY FILE?>>            62340000
               BEGIN                                                    62345000
                X:=REMJTENTRY(FLLOCNAME,FLGRPNAME,FLACCTNAME,  <<04574>>62350000
                              2,0).(8:8);                      <<04574>>62355000
<< THE UPPER 8 BITS (0:8) ARE USED FOR THE OLD FILE REFERENCE>><<04574>>62360000
<< COUNT SO IT CAN BE PRESERVED WHEN REPLACING FILE EQU'S    >><<04574>>62365000
               IF <> THEN GO E4  <<ERROR?>>                             62370000
               END;                                                     62375000
            PURGE := TRUE  <<SET DEALLOCATE DISC SPACE FLAG>>           62380000
            END                                                         62385000
                                                                        62390000
            END;                                               <<HM.00>>62395000
         IF MSGFILE THEN FCCLOSE(FILENUM,FCB,FLAB);            <<HM.00>>62400000
         END                                                            62405000
      ELSE  <<NON-ZERO OPEN COUNT>>                                     62410000
         BEGIN                                                          62415000
                                                                        62420000
         <<* * * DE-LINK SHARED FILE ACCESSOR * * *>>                   62425000
                                                                        62430000
         IF ATYPE <> 0 THEN FCBOCNTOUT := FCBOCNTOUT-1;                 62435000
         IF ATYPE = 0 OR ATYPE > 3 THEN FCBOCNTIN := FCBOCNTIN-1;       62440000
         IF ACBSEMI THEN FCBEXCLSTAT := FCBEXCLSTAT-1;  <<SEMI-EXCL?>>  62445000
         FCBDISP := IF LABELERROR THEN HARDFLABERR ELSE PDISP;          62450000
         PDISP := 0;                                                    62455000
         IF MSGFILE THEN FCCLOSE(FILENUM,FCB,FLAB);            <<HM.00>>62460000
         UPDATEFCB  <<UPDATE FCB>>                                      62465000
         END;                                                           62470000
                                                                        62475000
      <<* * * UPDATE PASSED FILE POINTER IN JIT * * *>>                 62480000
                                                                        62485000
CLEANUP:                                                                62490000
      IF FLOLDPASS AND (PDISP <> 0) THEN  <<NEW $OLDPASS?>>             62495000
         BEGIN                                                          62500000
         FADDR := FLLABEL;  <<LDEV AND SECTOR NR.>>            <<RV.PV>>62505000
         EXCHANGEDB(PXG'JITDST);                               <<06513>>62510000
         IF DADB0(JITPFP) = FADDR THEN DADB0(JITPFP) := 0D;             62515000
         EXCHANGEDB(0)  <<RESET DB TO STACK>>                           62520000
         END;                                                           62525000
                                                                        62530000
      <<* * * UPDATE FILE LABEL * * *>>                                 62535000
                                                                        62540000
      IF NOT PURGE THEN  <<WRITE UPDATED FILE LABEL?>>                  62545000
         BEGIN                                                          62550000
         FLDOMAIN := DOMAIN;                                            62555000
         IF DOMAIN <> 0 THEN                                   <<06298>>62560000
            FLDESIGNATOR := 0;  << Make actual designator.  >> <<06298>>62565000
         IF FCBOCNTIN = 0 THEN FLSTATUS := LOGICAL(FLSTATUS) LAND 2;    62570000
         IF FCBOCNTOUT = 0 THEN FLSTATUS := LOGICAL(FLSTATUS) LAND 1;   62575000
         IF FCBOCNT = 0 THEN  <<LAST ACCESSOR?>>                        62580000
            BEGIN                                                       62585000
            FLFCBVECT := 0D;                                   <<06514>>62590000
            FLPVINFO := 0;                                     <<00188>>62595000
            FLSTATUS := FCBLKST;                                        62600000
            FLEXCL := 0                                                 62605000
            END;                                                        62610000
         FLUSERLBL := FCBUSERLBL;  <<UPDATE USER LABEL EOF>>            62615000
         FLEOF := FCBEOF;  <<UPDATE FILE EOF>>                          62620000
         FLSTART:=FCBSTART;                                    <<HM.00>>62625000
         FLEND:=FCBEND;                                        <<HM.00>>62630000
         FLDTYPE := FCBDTYPE;                                           62635000
         FLSUBTYPE := FCBSUBTYPE;                                       62640000
         TOS := CALENDAR;  <<DAY AND YEAR>>                             62645000
         FLLASTACC := S0;  <<UPDATE LAST ACCESS DATE>>                  62650000
         IF (1 <= ATYPE <= 6) THEN                             <<07227>>62655000
            BEGIN                                              <<07227>>62660000
            FLLASTMOD := TOS;     ! File modify date.          <<07227>>62665000
            FLMODTIME := CLOCK;   ! File modify time.          <<07227>>62670000
            END                                                <<07227>>62675000
         ELSE                                                  <<07227>>62680000
            DEL;                  ! Delete CALENDER on TOS.    <<07227>>62685000
         LABELIO(1)  <<WRITE LABEL>>                                    62690000
         END;                                                           62695000
      END                                                               62700000
   ELSE  <<NON-DIRECT ACCESS DEVICE>>                                   62705000
      BEGIN                                                             62710000
                                                               <<02723>>62715000
      DISP := DISP'DOMAIN;  << Remove the crunch bit.       >> <<06728>>62720000
      PDISP := DISP;                                           <<02723>>62725000
                                                                        62730000
      <<SERIAL INPUT/OUTPUT DEVICE>>                                    62735000
                                                                        62740000
      IF TOS = 3 THEN  <<SERIAL I/O?>>                                  62745000
        IF LABELDEVICE THEN                                    <<03578>>62750000
           BEGIN                                               <<02688>>62755000
           << Update ACB so CHECKUL gets up to date data.   >> <<*7581>>62760000
           UNLOC'ACB(ACBMQ,%10);                               <<*7581>>62765000
           TOS := CHECKUL(FILENUM,4,IF MUSTCLOSE THEN -1       <<02688>>62770000
                                                 ELSE DISP);   <<02688>>62775000
           IF < THEN GO ERR;                                   <<02688>>62780000
                                                               <<02723>>62785000
   << CHECKUL returns NAVAILDEV and CCE when the tape      >>  <<02723>>62790000
   << drive has already been released because of a         >>  <<02723>>62795000
   << =REPLY 0.  DISP is changed to ensure that FREEDEVICE >>  <<02723>>62800000
   << will not DCLOSE the drive since a new tape may have  >>  <<02723>>62805000
   << already been mounted on the drive. >>                    <<02723>>62810000
                                                               <<02723>>62815000
           IF TOS = NAVAILDEV THEN DISP := 2;                  <<02723>>62820000
           END   << of labeled tape >>                         <<02723>>62825000
        ELSE                                                   <<02549>>62830000
         BEGIN                                                          62835000
                                                               <<04814>>62840000
         <<*************************************************>> <<04814>>62845000
         << Back Space Record for each pre-read performed   >> <<04814>>62850000
         << for serial devices to properly position the tape>> <<04814>>62855000
         << mispositioned due to pre-reads.  We do this for >> <<04814>>62860000
         << buffered files with no-rewind disposition.      >> <<04814>>62865000
         <<*************************************************>> <<04814>>62870000
                                                               <<04814>>62875000
         IF DISP = 3 AND NOT ACBINHIBITBUF                     <<04814>>62880000
            THEN BACK'SPACE'RECORDS;                           <<04814>>62885000
                                                               <<04589>>62890000
         <<*************************************************>> <<04589>>62895000
         << For all other dispositions excepy No Rewind, we >> <<04589>>62900000
         << do the following.  Write EOF if a new EOF has   >> <<04589>>62905000
         << been established.  Then, depending of the disp- >> <<04589>>62910000
         << osition, rewind and maybe unload the device.    >> <<04589>>62915000
         <<*************************************************>> <<04589>>62920000
                                                               <<04589>>62925000
         IF ACBACTUAL AND DISP <> 3 THEN                                62930000
            BEGIN                                                       62935000
            WRITE'EOFS;                                        <<06040>>62940000
            IF ACBDTYPE <> FDISC THEN                          <<*7667>>62945000
               IF DISP = 1                                     <<*7667>>62950000
                  THEN ATTIO(REW'UNLOAD,UBPFLAGS)              <<*7667>>62955000
                  ELSE ATTIO(REWIND,UBPFLAGS);                 <<*7667>>62960000
            IF ACBDTYPE = MTAPE OR ACBDTYPE = SDISC THEN       <<06040>>62965000
               BEGIN   << Set BOT bit and clean up LDEV.    >> <<06040>>62970000
               CLEANLDEV (DADDR);                              <<06040>>62975000
               IF ACBDTYPE = MTAPE THEN                        <<*7669>>62980000
                  SET'LPDT'BOT(DADDR,1);                       <<*7669>>62985000
               END;                                            <<06040>>62990000
            END                                                         62995000
         END;                                                           63000000
      END;                                                              63005000
                                                                        63010000
   <<* * * UPDATE EOF BIT IN JIT * * *>>                                63015000
                                                                        63020000
   IF ACBREADTYPE <> 0 THEN  <<$STDIN(X)?>>                             63025000
      BEGIN                                                             63030000
      TOS := ACBEOF = 0;                                                63035000
      TOS := ACBREADMODE;                                               63040000
      ASSEMBLE(TBC 14);                                                 63045000
      IF = THEN    << Not Command Interpreter. >>                       63050000
         IF NOT (CI LOR (1 <= FILENUM <= 2)) THEN  <<NOT CI?>>          63055000
           BEGIN                                                        63060000
           ASSEMBLE(DDUP);                                              63065000
           EXCHANGEDB(PXG'JITDST);                             <<06513>>63070000
           IF TOS                                                       63075000
              THEN ADB0(JITEOF).(9:1) := TOS                   <<06868>>63080000
              ELSE ADB0(JITEOF).(8:1) := TOS;                  <<06868>>63085000
           EXCHANGEDB(0)  <<RESET DB TO STACK>>                         63090000
           END;                                                         63095000
      DDEL                                                              63100000
      END;                                                              63105000
                                                                        63110000
   <<* * * DEALLOCATE DEVICE * * *>>                                    63115000
                                                                        63120000
   IF ACBACCCL=DIRACC AND ACBDTYPE<>FDISC THEN  <<DISC FILE?>> <<01115>>63125000
      BEGIN                                                             63130000
      IF RESOURCES.SIRLOCK THEN RELSIR (FISIR,A);              <<RV.PV>>63135000
                 ATTIO(CLOSE'FILE,USFLAGS+%13);                <<06040>>63140000
      IF NOT RELFCB THEN         << Last accessor?          >> <<06514>>63145000
         UNLOCK'CB(0,FCBV)       << Simply unlock the FCB.  >> <<06514>>63150000
      ELSE                                                     <<06514>>63155000
         BEGIN                                                          63160000
         IF FCBRIN <> 0 THEN DEALLORIN (FCBRIN.(1:15));        <<RV.PV>>63165000
         FDELETECB (FCBV); <<DELETE FCB>>                      <<RV.PV>>63170000
         IF INTEGER(SPOOLF) > 0 AND PURGE                      <<06515>>63175000
            THEN DEALLOCATE(DBL(SPVDEV));                      <<06515>>63180000
         IF INTEGER(SPOOLF) < 0 AND PURGE THEN SREMOVEXDD(XDDEP);       63185000
         TOS := 0;  <<FOR RESULT OF DISKDEALLOC>>                       63190000
         TOS := FCBEXTSIZE;  <<EXTENT SIZE>>                            63195000
         TOS := FCBLASTEXTSIZE;  <<LAST EXTENT SIZE>>                   63200000
         TOS := FCBNUMEXTS+1;  <<NR. EXTENTS>>                          63205000
         IF SPOOLF AND PURGE THEN TOS.(8:1) := 1;                       63210000
         IF NOT PURGE THEN TOS := -TOS;  <<DECREMENT USE COUNTS ONLY?>> 63215000
         X := DISKDEALLOC(*,*,*,FCBEXTMAP);  <<DEALLOCATE EXTENTS>>     63220000
$        IF X1 = ON                                                     63225000
         IF <> THEN FTROUBLE(471); <<ERROR?>>                  <<KJ.03>>63230000
$        IF                                                             63235000
         IF SPOOLF AND NOT PURGE THEN                                   63240000
            BEGIN                                                       63245000
            TOS := 0D;                                                  63250000
            TOS := FCBNUMEXTS+1;                                        63255000
            IF INTEGER(SPOOLF)<0 AND ACBSPSQZ=1 THEN           <<00.06>>63260000
               BEGIN                                           <<00.06>>63265000
               Z := 0;                                         <<00.06>>63270000
               @XMAP := @FCBEXTMAP;                            <<00.06>>63275000
               WHILE (Z:=Z+1) <= FCBNUMEXTS DO                 <<00.06>>63280000
                  IF XMAP(Z)=0D THEN TOS := TOS-1;             <<00.06>>63285000
               END;                                            <<00.06>>63290000
            TOS := FCBLASTEXTSIZE;                                      63295000
            XDDSPOOLINFO(*,%41,XDDEP);   <<POST FILE SIZE>>    <<+1.03>>63300000
            XDDSPOOLINFO(FCBEOF,%21,XDDEP)   <<POST NR. RECORDS  +1.03>>63305000
            END                                                         63310000
         END;                                                  <<06514>>63315000
      IF INTEGER(SPOOLF) > 0 AND NOT PURGE                     <<06515>>63320000
         THEN DEALLOCATE(DBL(SPVDEV))                          <<06515>>63325000
      END                                                               63330000
   ELSE                                                        <<07226>>63335000
      BEGIN      ! Non disc file deallocation.                 <<07226>>63340000
      TOS := 0;             ! Reserve space for flags word.    <<07226>>63345000
      TOS.(4:1) := 1;       ! Last accessor abort.             <<07226>>63350000
      TOS.(6:1) := 1;       ! Don't wait for the file close.   <<07226>>63355000
      IF NOT PRIMED THEN                                       <<07226>>63360000
         TOS.(7:1) := 1;    ! Primed or not?                   <<07226>>63365000
      IF ACBLABELLED=1 AND DISP > 1 THEN                       <<07226>>63370000
         TOS.(3:1) := 1;    ! Don't rewind labelled tape.      <<07226>>63375000
      TOS := DADDR;                                            <<06515>>63380000
      DEALLOCATE(*)  <<DE-ALLOCATE DEVICE>>                             63385000
                                                               <<TL.02>>63390000
      END;                                                              63395000
                                                                        63400000
   <<* * * LOG FILE CLOSE * * *>>                                       63405000
                                                                        63410000
   IF LABELERROR THEN PDISP := -1;  <<SPECIAL DISPOSITION>>             63415000
   I := PDISP&LSL(8)+ACBDOMAIN;  << DISP/DOMAIN >>                      63420000
   J := IF INTEGER(SPOOLF) > 0                                          63425000
           THEN ACBSPTYPE&LSL(8)                                        63430000
           ELSE ACBDTYPE&LSL(8);                               <<06867>>63435000
                                                               << 8539>>63440000
   IF ACBACCCL = 0 AND ACBDTYPE<>FDISC THEN  <<DISC FILE?>>    <<01115>>63445000
      BEGIN                                                             63450000
      MOVE LOG'BUF := FLLOCNAME,(4);     ! File name.          << 8539>>63455000
      TOS := @LOG'BUF(4)*2+1;                                  << 8539>>63460000
      TOS := @FLGRPNAME*2;                                     << 8539>>63465000
      MOVE * := *,(8);                   ! Group name.         << 8539>>63470000
      MOVE LOG'BUF(9) := FLACCTNAME,(4); ! Account name.       << 8539>>63475000
      TOS := FSECTORS(FLAB)                                             63480000
      END                                                               63485000
   ELSE  <<NON-DISC FILE>>                                              63490000
      BEGIN                                                             63495000
      MOVE LOG'BUF := ACBNAME,(4);       ! File name.          << 8539>>63500000
      TOS := @LOG'BUF(4); PS0 := "  ";  <<CLEAR REMAINDER>>    <<04713>>63505000
      ASSEMBLE(DUP,INCB); TOS := 8; ASSEMBLE(MOVE 3);                   63510000
      TOS := 0D                                                         63515000
      END;                                                              63520000
   FADDR := TOS;                                                        63525000
   LOG'BUF(4).(0:8) := ".";                                    <<04713>>63530000
   LOG'BUF(8).(8:8) := ".";                                    <<04713>>63535000
                                                               <<+0.04>>63540000
   <<* * * MEASUREMENT DATA ON FCLOSE * * *>>                  <<+0.04>>63545000
                                                               <<+0.04>>63550000
$  IF X3 = ON                                                  <<+0.04>>63555000
   IF MEAS'TAPE'ON THEN BEGIN                                  <<+1.C3>>63560000
   IF ACBACCCL = DIRACC THEN  <<MEASURE?>>                     <<+0.04>>63565000
      MMSTAT'(EFCLOSE,FILENUM,DISP,SECCODE,0,0,0);             <<06863>>63570000
   END; << OF MEAS'TAPE'ON>>                                   <<+1.C3>>63575000
$  IF                                                          <<+0.04>>63580000
                                                                        63585000
   <<*******************************************************>> <<04589>>63590000
   << If we are not the last accessors to the ACB, then     >> <<04589>>63595000
   << copy the possible changed ACB back to the control blk.>> <<04589>>63600000
   << via UNLOC'ACB.  However, send a special flag that sig->> <<06509>>63605000
   << nifies NOT to unlock the ACB.  We do not copy the PACB>> <<06509>>63610000
   << back for message files because FCCLOSE copied his own >> <<06509>>63615000
   << version on its stack, changed it, and copied it back. >> <<06509>>63620000
   << We have an old version on the stack for message files.>> <<06509>>63625000
   << Then, call DELACB to decrement the share counts.  If  >> <<06509>>63630000
   << the count goes to 0, then the ACB will be deleted. If >> <<06509>>63635000
   << not, then DELACB will be the one to unlock the ACB.   >> <<06509>>63640000
   << It MUST remain locked through the call to DELACB to   >> <<06509>>63645000
   << insure that the ACB share counts are correct!         >> <<06509>>63650000
   <<*******************************************************>> <<04589>>63655000
                                                               <<04589>>63660000
   IF ACBSHCNT > 1 AND NOT MSGFILE                             <<06509>>63665000
      THEN UNLOC'ACB(ACBMQ,%10); << Copy back, don't unlock.>> <<06509>>63670000
                                                               <<06509>>63675000
   <<*******************************************************>> <<06509>>63680000
   << Now call DELACB to decrement the share counts, and    >> <<06509>>63685000
   << delete the ACB if the last accessor.  If not the last >> <<06509>>63690000
   << accessor, DELACB will THEN unlock the ACB!            >> <<06509>>63695000
   <<*******************************************************>> <<06509>>63700000
                                                               <<06509>>63705000
   DELACB(PACBV,LACBV,ACBACTYPE);  <<DELETE LOG/PHYS ACB>>     <<04796>>63710000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);                         <<00218>>63715000
   LOG5(LOG'BUF,I,FADDR,J,ACBRTFRCT,ACBBTFRCT,DADDR,5);        <<06867>>63720000
                                                                        63725000
   <<* * * FREE AFT ENTRY * * *>>                                       63730000
                                                                        63735000
RELAFTENT:                                                              63740000
                                                               <<06514>>63745000
                                                               <<06514>>63750000
   CLEAR'AFT;                        << Zero AFT entry.     >> <<06514>>63755000
   TOS := 0;  <<NO ERROR NR.>>                                          63760000
   TOS := CCE;  <<OK CONDITION CODE>>                                   63765000
   IF INTEGER(SPOOLF) < 0 AND RELFCB THEN                               63770000
      IF DISP = 0 THEN                                                  63775000
         BEGIN                                                          63780000
         XDDSPOOLINFO(0D,%10,XDDEP);  <<READY BIT SET>>        <<+1.03>>63785000
         END                                                            63790000
      ELSE                                                              63795000
         BEGIN                                                          63800000
         DEL;                                                           63805000
         TOS := CCG;                                                    63810000
         END;                                                           63815000
   GO EXIT;                                                             63820000
                                                                        63825000
   <<* * * ERROR RECOVERY - RELEASE RESOURCES * * *>>                   63830000
                                                                        63835000
E0:                                                                     63840000
   ASSEMBLE(XCH,ZROB);                                                  63845000
   TOS := IOSTAT(*);  <<CONVERT ERROR NR.>>                             63850000
   GO ERR;                                                              63855000
                                                                        63860000
E1:  << INVALID FILE NUMBER >>                                          63865000
   TOS := INVFN;                                                        63870000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                63875000
   GO EXIT;                                                             63880000
                                                                        63885000
E2:  << INVALID FILE REFERENCE >>                                       63890000
   TOS := INVFREF;                                                      63895000
   GO ERR;                                                              63900000
                                                                        63905000
E3:  << TRYING TO SAVE A SYSTEM FILE IN JTFD >>                         63910000
   TOS := INVSAVE;                                                      63915000
   GO ERR;                                                              63920000
                                                                        63925000
E4:  << DIRECTORY I/O ERROR >>                                          63930000
   TOS := DIRIOERR;                                                     63935000
                                                                        63940000
ERR:                                                                    63945000
   TOS := RESOURCES;                                                    63950000
   IF LS0.FCBLOCK THEN  <<RELEASE FCB?>>                                63955000
      UNLOCK'CB(0,FCBV);                                       <<06514>>63960000
   IF TOS.SIRLOCK THEN RELSIR(FISIR,A);  <<RELEASE SIR?>>               63965000
    IF NOT MUSTCLOSE THEN RESOURCES.DMOUNT := FALSE;           <<00208>>63970000
   ACBERROR := S0;  <<INSERT ERROR CODE IN ACB>>                        63975000
   TOS := CCL;  <<ERROR CONDITION CODE>>                                63980000
                                                                        63985000
XIT:                                                                    63990000
                                                               <<04517>>63995000
   UNLOC'ACB(ACBMQ,0);          <<  Release that ACB!!!!!   >> <<04517>>64000000
   IF B <> -1 THEN RELSIR(FMAVTSIR,B);                         <<00201>>64005000
   END; << CONVENTIONAL FILE >>                                <<DS.00>>64010000
                                                               <<DS.00>>64015000
   BEGIN << REMOTE FILE >>                                     <<DS.00>>64020000
      PDISP := RFAPDISP; << Pending disposition.           >>  <<06514>>64025000
      IF <> AND (DISP.(13:3) = 0 OR DISP.(13:3) > PDISP)       <<DS.03>>64030000
      THEN DISP := PDISP; << USE PENDING DISP >>               <<DS.03>>64035000
      ALLOCRFABUF;                                             <<04517>>64040000
      RFALEN := 6;                                             <<DS.00>>64045000
      TOS := "RFA ";                                           <<DS.00>>64050000
      TOS := 2;                                                <<DS.00>>64055000
      TOS := RFAFILE;                                          <<DS.00>>64060000
      LS0.(0:1) := KSC.(15:1); << KSAM KFCLOSE >>              <<DS.06>>64065000
      TOS := DISP;                                             <<DS.00>>64070000
      TOS := SECCODE;                                          <<DS.00>>64075000
      MWCNOBUF;                                                <<DS.00>>64080000
      CHECKXFER;                                               <<DS.00>>64085000
      DELAPPENDAGE;                                            <<DS.00>>64090000
      TOS := TOS.CC;                                           <<DS.00>>64095000
      IF S0 = CCE THEN                                         <<DS.00>>64100000
      BEGIN << FILE CLOSED, CLOSE LINE >>                      <<DS.00>>64105000
         TOS := RFALINE;                                       <<DS.00>>64110000
         TOS := DSCLOSEPLABEL;                                 <<DS.00>>64115000
         ASMB(PCAL 0);                                         <<DS.00>>64120000
         CLEAR'AFT;                                            <<06514>>64125000
         ASSEMBLE(ZERO,XCH); ! No error, switch with CC.       <<06514>>64130000
       END                                                     <<DS.04>>64135000
       ELSE                                                    <<DS.04>>64140000
          BEGIN     << FCLOSE FAILURE >>                       <<DS.04>>64145000
          FCHECK(RFAFILE,I);                                   <<DS.04>>64150000
          IF < THEN                                            <<DS.04>>64155000
             TOS:=NAVAILDEV                                    <<DS.04>>64160000
          ELSE                                                 <<DS.04>>64165000
             TOS:=I;                                           <<DS.04>>64170000
          ASSEMBLE(XCH);                                       <<DS.04>>64175000
          END;                                                 <<DS.04>>64180000
   END; << REMOTE FILE >>                                      <<DS.00>>64185000
         <<DUMMY FOR 2>>;                                      <<KS.00>>64190000
         <<DUMMY FOR 3>>;                                      <<KS.00>>64195000
         <<DUMMY FOR 4>>;                                      <<KS.00>>64200000
         <<DUMMY FOR 5>>;                                      <<KS.00>>64205000
         BEGIN <<KSAM FILE>>                                   <<KS.00>>64210000
            IF KSC THEN                                        <<KS.00>>64215000
            GO CONV <<SECONDARY ENTRY USED>>                   <<KS.00>>64220000
         ELSE                                                  <<KS.00>>64225000
            BEGIN <<FILE PAIR TO BE CLOSED>>                   <<KS.00>>64230000
               KCLOSE(FILENUM,DISP,SECCODE);                   <<KS.00>>64235000
               PUSH(STATUS);                                   <<KS.00>>64240000
               TOS:=TOS.CC;                                    <<KS.00>>64245000
               ASSEMBLE(ZERO,XCH);                             <<KS.00>>64250000
            END; <<FILE PAIR TO BE CLOSED>>                    <<KS.00>>64255000
         END; <<KSAM FILE>>                                    <<KS.00>>64260000
   <<DUMMY 7>>;                                                <<HM.00>>64265000
   BEGIN     << Message file >>                                <<01882>>64270000
   FTYPE := 0;                                                 <<01882>>64275000
   GO CONV;                                                    <<01882>>64280000
   END;                                                        <<01882>>64285000
                                                               <<DS.00>>64290000
   END; << FTYPE CASE >>                                       <<DS.00>>64295000
                                                                        64300000
EXIT:                                                                   64305000
    IF B <> -1 THEN RELSIR(FMAVTSIR,B);                        <<06514>>64310000
   IF RESOURCES.DMOUNT THEN                                    <<00208>>64315000
   BEGIN                                                       <<00208>>64320000
       IF (X := DISMOUNT') <> 0 THEN                           <<00208>>64325000
       BEGIN <<OVERRIDE ORIGINAL ERROR. LESS CRITICAL>>        <<00208>>64330000
           S0 := CCL; <<ERROR CONDITION CODE>>                 <<00208>>64335000
       END;                                                    <<00208>>64340000
   END;                                                        <<00208>>64345000
   CONDCODE := TOS;  <<STORE CONDITION CODE>>                           64350000
   EXCHANGEDB(ORIG'DST);  <<RESET DB TO ORIG.>>                <<04517>>64355000
   RESETCRITICAL(CRIT);                                                 64360000
   ERROREXIT(3,S0,0)                                                    64365000
   END;                                                                 64370000
$ PAGE "SPECIAL'SPOOL'CLOSE"                                            64375000
PROCEDURE SPECIAL'SPOOL'CLOSE(FILENUM,DISP,SECCODE);                    64380000
VALUE FILENUM,DISP,SECCODE;                                             64385000
INTEGER FILENUM,DISP,SECCODE;                                           64390000
OPTION PRIVILEGED,UNCALLABLE;                                           64395000
COMMENT                                                                 64400000
                                                                        64405000
   This is a procedure that will cause the deletion of                  64410000
a output spool file on FCLOSE of that file.  This is a                  64415000
KLUDGE for the CI until we figure out what we really                    64420000
want to do.                                                             64425000
                                                                        64430000
Algorithm                                                      <<S8492>>64435000
                                                                        64440000
  Find offset in ODD                                                    64445000
  Set OUTPRI to 0                                                       64450000
  FJCLOSE file (sets file to READY state)                      <<S8492>>64455000
  Lock ODD                                                     <<S8492>>64460000
  If file has been grabbed by SPOOK, deleted by DELETESPOOL-   <<S8492>>64465000
    FILE, or is not READY for any other reason, return CCL.    <<S8492>>64470000
    Note that it will not be opened by a spooler because we    <<S8492>>64475000
    cleverly set OUTPRI to 0.                                  <<S8492>>64480000
  If file is READY, set it LOCKED and release ODD.  Ideally    <<S8492>>64485000
    we would lock the ODD before the FJCLOSE to prevent anyone <<S8492>>64490000
    from accessing the file once FJCLOSE sets it READY.  This  <<S8492>>64495000
    would require holding the ODD SIR through FJCLOSE and its  <<S8492>>64500000
    several disc I/O's, as well as having to beware of possi-  <<S8492>>64505000
    ble deadlocks caused by FJCLOSE acquiring additional SIRs. <<S8492>>64510000
    The design team felt the present approach was a better     <<S8492>>64515000
    short-term (emphasized) solution.                          <<S8492>>64520000
  FSOPEN file                                                           64525000
  FSCLOSE file, deleting it                                    <<S8492>>64530000
                                                                        64535000
;                                                                       64540000
BEGIN                                                                   64545000
INTEGER ARRAY BASE(*)=DB+0;                                             64550000
LOGICAL STATUS=Q-1;                                                     64555000
INTEGER DEV'FILE'ID;                                                    64560000
INTEGER ODD'OFFSET;                                                     64565000
INTEGER SAVE'ODD'SIR;                                          <<S8492>>64570000
POINTER XDD'SUBENTRY;                                          <<06862>>64575000
                                                                        64580000
  << get the device file id using ffileinfo #38 >>                      64585000
STATUS.CC := CCE;                                                       64590000
FFILEINFO (FILENUM,38,DEV'FILE'ID);                                     64595000
IF < THEN                                                               64600000
  STATUS.CC := CCL                                                      64605000
ELSE BEGIN  <<Got the dev file id ok >>                                 64610000
  IF NOT SFINDODD(DEV'FILE'ID,ODD'OFFSET) THEN                 <<06862>>64615000
     CONDCODE := CCL                                           <<06862>>64620000
  ELSE                                                         <<06862>>64625000
    BEGIN                                                      <<06862>>64630000
    @XDD'SUBENTRY := ODD'OFFSET.(1:15); ! Ignore ODD bit.      <<06862>>64635000
    EXCHANGEDB(ODDDST);                                        <<06862>>64640000
    XDDS'OUTPUT'PRIORITY := 0;                                 <<06862>>64645000
    EXCHANGEDB (0);                                                     64650000
    FJCLOSE(FILENUM,0,0);                                               64655000
    IF < THEN                                                           64660000
      STATUS.CC := CCL                                                  64665000
    ELSE BEGIN                                                          64670000
      EXCHANGEDB (ODDDST);  << Why stop now, it's such fun >>  <<S8492>>64675000
      SAVE'ODD'SIR := GETSIR (ODDSIR);                         <<S8492>>64680000
      IF XDD'SUBENTRY <> XDDS'UNUSED'SUBENTRY  <<Still there>> <<S8492>>64685000
         AND XDDS'SPOOL'STATE = XDDS'READY THEN                <<S8492>>64690000
         BEGIN   << Safe to delete file.                    >> <<S8492>>64695000
         XDDS'SPOOL'STATE := XDDS'LOCKED;                      <<S8492>>64700000
         RELSIR (ODDSIR, SAVE'ODD'SIR);                        <<S8492>>64705000
         EXCHANGEDB (0);                                       <<S8492>>64710000
         FILENUM := FSOPEN(,%305,%400,ODD'OFFSET);             <<S8492>>64715000
         IF <> THEN                                            <<S8492>>64720000
           STATUS.CC := CCG                                    <<S8492>>64725000
         ELSE BEGIN                                            <<S8492>>64730000
           FSCLOSE (FILENUM,DISP,SECCODE);                     <<S8492>>64735000
           IF < THEN                                           <<S8492>>64740000
             STATUS.CC := CCL;                                 <<S8492>>64745000
           END;                                                <<S8492>>64750000
         END     << Safe to delete file.                    >> <<S8492>>64755000
      ELSE                                                     <<S8492>>64760000
         BEGIN   << File no longer available.               >> <<S8492>>64765000
         RELSIR (ODDSIR, SAVE'ODD'SIR);                        <<S8492>>64770000
         EXCHANGEDB (0);                                       <<S8492>>64775000
         CONDCODE := CCL;                                      <<S8492>>64780000
         END;    << File no longer available.               >> <<S8492>>64785000
      END                                                               64790000
    END                                                                 64795000
  END;                                                                  64800000
END;                                                                    64805000
$PAGE  "FERRMSG"                                               <<06272>>64810000
$CONTROL SEGMENT = FILESYS7    << FERRMSG >>                            64815000
PROCEDURE FERRMSG(ERRORCODE,MSGBUFF',MSGLENGTH);               <<09.EB>>64820000
   INTEGER ERRORCODE,MSGLENGTH;                                <<09.EB>>64825000
   ARRAY MSGBUFF';                                             <<09.EB>>64830000
COMMENT                                                        <<09.EB>>64835000
                                                               <<09.EB>>64840000
RETURNS STRING FOR FILE SYSTEM MESSAGE NUMBER. PARAMETERS:     <<09.EB>>64845000
                                                               <<09.EB>>64850000
ERRORCODE - FILE SYSTEM ERROR NUMBER (GOTTEN FROM FCHECK).     <<09.EB>>64855000
MSGBUFF   - BUFFER IN WHICH THE ERROR MESSAGE WILL BE PLACED.  <<09.EB>>64860000
            MUST BE AT LEAST 72 BYTES LONG.                    <<09.EB>>64865000
MSGLENGTH - THE LENGTH OF THE STRING PLACED IN MSGBUFF.        <<09.EB>>64870000
                                                               <<09.EB>>64875000
CONDITION CODES:                                               <<09.EB>>64880000
                                                               <<09.EB>>64885000
CCE - EVERYTHING OK.                                           <<09.EB>>64890000
CCL - NO ERROR MESSAGE EXISTS FOR THIS ERRORCODE.              <<09.EB>>64895000
      (OR MAY BE MESSAGE SYSTEM ERROR.  SEE GENMESSAGE         <<09.EB>>64900000
       INTRINSIC)                                              <<09.EB>>64905000
CCG - SOMETHING WRONG WITH CALL:                               <<09.EB>>64910000
         - MSGBUFF ADDRESS MAY BE OUT OF BOUNDS.               <<09.EB>>64915000
         - MSGBUFF MAY NOT BE LARGE ENOUGH.                    <<09.EB>>64920000
         - MSGLENGTH ADDRESS IS OUT OF BOUNDS.                 <<09.EB>>64925000
;                                                              <<09.EB>>64930000
BEGIN                                                          <<09.EB>>64935000
                                                               <<09.EB>>64940000
                                                               <<09.EB>>64945000
EQUATE                                                         <<09.EB>>64950000
   FILESYSSET      = 8,                                        <<09.EB>>64955000
   MSGBUFFSIZE     = 72,                                       <<09.EB>>64960000
   MSGBUFFSIZEWM1  = 35,                                       <<03060>>64965000
   UBND            = -7;                                       <<03060>>64970000
                                                               <<09.EB>>64975000
LOGICAL                                                        <<09.EB>>64980000
   INTRINDESCRIP := [10/307, 6/3],                             <<09.EB>>64985000
   P1 = INTRINDESCRIP,                                         <<09.EB>>64990000
   P2 = P1,                                                    <<09.EB>>64995000
   P3 = P1,                                                    <<09.EB>>65000000
   P4 = P1,                                                    <<09.EB>>65005000
   P5 = P1;                                                    <<09.EB>>65010000
                                                               <<09.EB>>65015000
BYTE ARRAY MSGBUFF(*) = MSGBUFF';                              <<09.EB>>65020000
BYTE ARRAY INBUFF(0:MSGBUFFSIZE);                              <<09.EB>>65025000
                                                               <<09.EB>>65030000
                                                               <<09.EB>>65035000
ERRORON;                                                       <<09.EB>>65040000
IF FBNDCHK(@MSGLENGTH,1,UBND) AND FBNDCHK(@MSGBUFF',           <<03060>>65045000
   MSGBUFFSIZE/2,UBND) AND FBNDCHK(@ERRORCODE,                 <<03060>>65050000
   1,UBND) THEN                                                <<03060>>65055000
BEGIN                                                          <<09.EB>>65060000
   MSGLENGTH := 0;                                             <<09.EB>>65065000
   FORMSG(INBUFF,FILESYSSET,ERRORCODE,%100000,P1,P2,P3,P4,P5,  <<09.EB>>65070000
      MSGBUFF,MSGBUFFSIZE,MSGLENGTH,-1,0);                     <<09.EB>>65075000
   IF = THEN CONDCODE := CCE                                   <<13.EB>>65080000
   ELSE                                                        <<13.EB>>65085000
   BEGIN                                                       <<13.EB>>65090000
      MOVE MSGBUFF' := "UNDEFINED FILE SYSTEM ERROR ";         <<13.EB>>65095000
      MSGLENGTH := 27;                                         <<13.EB>>65100000
      CONDCODE := CCL;                                         <<13.EB>>65105000
   END;                                                        <<13.EB>>65110000
END                                                            <<13.EB>>65115000
ELSE CONDCODE := CCG;                                          <<13.EB>>65120000
                                                               <<13.EB>>65125000
ERROREXIT(INTRINDESCRIP,0,0);                                  <<13.EB>>65130000
                                                               <<13.EB>>65135000
END; << PROCEDURE FERRMSG >>                                   <<13.EB>>65140000
$PAGE "MPE-IV FILE SYSTEM - OUTER BLOCK "                      <<KS.00>>65145000
$CONTROL SEGMENT=FILEACCESS, MAP                                        65150000
END. <<END OF FILE SYSTEM>>                                    <<KS.00>>65155000
