$CONTROL USLINIT,CODE,MAP                                               00010000
<<PVINIT - MODULE 32>>                                                  00012000
<< HP32002C MPE SOURCE C.00.08 >>                              <<03778>>00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL MAIN = PVINIT                                         <<03537>>00028000
$THIRTY                                                                 00030000
$CONTROL PRIVILEGED                                                     00032000
$TITLE "PVINIT - GLOBAL DECLARATIONS"                                   00034000
$CONTROL SEGMENT=VINITCI                                       <<RK1PV>>00036000
BEGIN                                                                   00038000
                                                                        00040000
$SET X8=ON                                                     <<l7750>>00042000
$INCLUDE INCLLPDT                                              <<06276>>00044000
$INCLUDE INCLLDT5                                              <<06276>>00046000
$INCLUDE INCLFLAB                                              <<06468>>00048000
$PAGE "INCLPXG - PXGLOBAL INCLUDE FILE"                        <<l7750>>00050000
$INCLUDE INCLPXG                                               <<06529>>00052000
$PAGE "INCLJMAT - JOB MASTER TABLE INCLUDE FILE"               <<l7750>>00054000
$INCLUDE INCLJMAT                                              <<06529>>00056000
$PAGE "INCLJIT - JOB INFORMATION TABLE INCLUDE FILE"           <<l7750>>00058000
$INCLUDE INCLJIT                                               <<06529>>00060000
$PAGE "INCLJDT - JOB DIRECTORY TABLE INCLUDE FILE"             <<l7750>>00062000
$INCLUDE INCLJDT                                               <<06529>>00064000
$PAGE "VINIT - GLOBAL DECLARATIONS"                            <<l7750>>00066000
<<************************* VINIT *************************>>           00068000
<< fix for KPR #15570 -bmp                                   >><<03541>>00070000
<< KPR #15570 - stack and prompt were being trashed during   >><<03541>>00072000
<<              entry of command lines longer than 19 bytes. >><<03541>>00074000
<< Enhancement to support Linus (HP 9110)                    >><<03537>>00076000
<< and CS'80 discs. Linus enhancement complete               >><<03537>>00078000
<< as described in Vinit - Linus ERS.                        >><<03537>>00080000
<< CS'80 enhancement partially implemented.                  >><<03537>>00082000
<< bmp - Nov 1981                                            >><<03537>>00084000
<< Allow Pdtrack to list out the Defective sector Table      >><<03536>>00086000
<< on a CS'80 disc. -bmp Nov. 81                             >><<03536>>00088000
<< Implement DIAG entry point enhancements to Pdtrack        >><<03583>>00090000
<< command - HP INTERNAL USE ONLY - bmp Nov 1981             >><<03583>>00092000
<< A slight enhancement.. Allow Pdtrack on Serial devices.   >><<03621>>00094000
<< This was not allowed previously because the Serial Disc   >><<03621>>00096000
<< Interface pretty well ignores the contents of the         >><<03621>>00098000
<< DTT or DSCT anyways. This was mostly done to allow        >><<03621>>00100000
<< printing of the Spared Track Tables when using the        >><<03621>>00102000
<< special entry point.                                      >><<03621>>00104000
<< Fixed COPY to not reassign deleted tracks in spare region.>><<*9055>>00106000
                                                                        00108000
$SET X3=OFF    << FOR DFSM DEBUG >>                            <<03510>>00110000
                                                               <<03510>>00112000
ENTRY                                                          <<03537>>00114000
  TESTENTRY,                                                   <<03537>>00116000
  DIAG;                                                        <<03537>>00118000
                                                               <<03510>>00120000
LOGICAL STAT=Q-1;                                                       00122000
LOGICAL DELP=Q-2;                                              <<RK.08>>00124000
INTEGER X=X;                                                            00126000
INTEGER S0=S-0,S1=S-1,S2=S-2,S3=S-3,S4=S-4,S5=S-5;                      00128000
INTEGER QM0=Q-0,QM5=Q-5;                                                00130000
LOGICAL LS0=S-0;                                                        00132000
DOUBLE DS3=S-3,DS6=S-6;                                                 00134000
BYTE POINTER BPS0 = S-0;                                                00136000
DEFINE INT=INTEGER#;                                           <<03510>>00138000
DEFINE LOG=LOGICAL#;                                           <<03510>>00140000
DEFINE DBL=DOUBLE#;                                            <<03510>>00142000
                                                               <<03510>>00144000
EQUATE VUFPOS = 6;                                             <<04299>>00146000
$INCLUDE INCLVUF                                               <<04299>>00148000
DEFINE id =                                                    <<03510>>00150000
   "VINIT         (C) HEWLETT-PACKARD CO., 1978"#;             <<04299>>00152000
                                                               <<03510>>00154000
                                                                        00156000
DEFINE         condcode=status.(6:2)#;                         <<03510>>00158000
                                                                        00160000
INTEGER OUTF;  <<OUTPUT FILE NUMBER>>                                   00162000
INTEGER LDEV;                                                  <<03620>>00164000
INTEGER FUNCT;  <<COMMAND TYPE>>                                        00166000
                                                                        00168000
LOGICAL                                                                 00170000
     req'brk,                                                  <<03510>>00172000
     VSIDSPEC,                                                          00174000
     VNAMESPEC,                                                         00176000
     validvsid;                                                <<03510>>00178000
                                                                        00180000
LOGICAL MORE:=TRUE;  <<FUNCTION LOOP CONTROL VARIABLE>>                 00182000
<< this is a flag to see if VINIT got run from a special >>    <<03510>>00184000
<< entry point. For right now, the only thing it does is >>    <<03510>>00186000
<< it wont check for only'one'on for a cond;recover      >>    <<03510>>00188000
<< for those damn automated test!                        >>    <<03510>>00190000
                                                               <<03510>>00192000
LOGICAL special'entry;                                         <<03510>>00194000
LOGICAL DIAG'ENTRY := FALSE;                                   <<03537>>00196000
INTEGER SECTRK;   << # OF SECTORS PER TRACK >>                 <<03620>>00198000
INTEGER TRKCYL;                                                <<04670>>00200000
INTEGER MAXLPS;                                                <<04670>>00202000
INTEGER SECSIZE;                                               <<04670>>00204000
INTEGER STATUS := 0;  <<DTRACK IO ERROR STATUS>>               <<03620>>00206000
                                                                        00208000
EQUATE dtt'size = 128;                                         <<03510>>00210000
INTEGER ARRAY dtt(0:dtt'size-1);                               <<03510>>00212000
DOUBLE ARRAY                                                   <<03537>>00214000
  DTTD(*) = DTT;  << For DSCT use >>                           <<03537>>00216000
EQUATE MAX'DTT'CHANGES = 255,  <<SECTOR/TRACK ENTRY ONLY>>     <<03620>>00218000
       DTT'DISP'OFFSET = MAX'DTT'CHANGES+1,                    <<03620>>00220000
       DTT'CHANGES'SIZE = MAX'DTT'CHANGES+128;                 <<03620>>00222000
INTEGER ARRAY DTT'CHANGES(0:DTT'CHANGES'SIZE);                 <<03620>>00224000
ARRAY DTT'DISP(*) = DTT'CHANGES(DTT'DISP'OFFSET);              <<03620>>00226000
                                                                        00228000
EQUATE                                                                  00230000
     BUFFSIZE  = 11777,  <<MAX. BUFFER SIZE FOR 7933>>         <<04670>>00232000
     BUFFSIZE' =   64;  <<MAX SECTORS PER TRACK>>              <<RK1PV>>00234000
                                                                        00236000
ARRAY BUFF(-3:BUFFSIZE-1);                                     <<RK1PV>>00238000
                                                                        00240000
DOUBLE ARRAY BUFFD(*) = BUFF;                                           00242000
                                                                        00244000
BYTE ARRAY BUFFB(*) = BUFF;                                             00246000
                                                                        00248000
ARRAY VDIRB(*) = BUFF;                                                  00250000
                                                                        00252000
INTEGER ARRAY DEVPARM(0:3);                                             00254000
                                                                        00256000
LOGICAL ARRAY DEVSTATUS(0:3);                                           00258000
                                                                        00260000
ARRAY Msgw (0:35);  <<Message Buffer>>                         <<03537>>00262000
BYTE ARRAY Msg (*) = Msgw;                                     <<03537>>00264000
                                                                        00266000
ARRAY Rbufw(0:36);                                             <<03541>>00268000
BYTE ARRAY Rbuf(*) = Rbufw;                                    <<03541>>00270000
                                                                        00272000
BYTE ARRAY PBUF(0:71);                                                  00274000
ARRAY PBUFW(*) = PBUF;                                         <<RK.08>>00276000
                                                                        00278000
EQUATE                                                                  00280000
       MAXVOLNUM   =  8;  <<MAX. VOLUMES PER VOLUME SET>>               00282000
EQUATE max'discs = 16; << max amount of discs configurable >>  <<03510>>00284000
                       << in system                        >>  <<03510>>00286000
                                                                        00288000
EQUATE  << DATA SEGMENTS/SIRS >>                                        00290000
     DIRDST    = 20,                                                    00292000
     DIRSIR    =  8,                                                    00294000
     FILESIR   =  37,                                          <<06276>>00296000
     VTABDST   = 29,                                                    00298000
     VTABSIR   = 22,                                                    00300000
     MVTABDST  = 53,                                                    00302000
     MVTABSIR  = 27;                                                    00304000
                                                                        00306000
<<****************** COMMAND PARSER DECLARATIONS *****************>>    00308000
                                                                        00310000
EQUATE  <<DELIMITERS>>                                                  00312000
     COMMA       =  0,                                                  00314000
     PERIOD      =  1,                                                  00316000
     SEMICOLON   =  2,                                                  00318000
     EQUALSIGN   =  3,                                                  00320000
     CARRETURN   =  4;                                                  00322000
                                                                        00324000
EQUATE  max'keyword'len   = 8;                                 <<03510>>00326000
EQUATE  max'keywords  = 4;                                     <<03510>>00328000
INTEGER ARRAY keywdlen(0:max'keywords-1);                      <<03510>>00330000
                                                                        00332000
INTEGER ARRAY keyparmval(0:max'keywords-1);                    <<03510>>00334000
                                                                        00336000
BYTE POINTER KEYWDLOC;                                                  00338000
                                                                        00340000
ARRAY VSIDW(0:12) := "*       ";                               <<00112>>00342000
BYTE ARRAY                                                     <<RK.08>>00344000
     VNAME(0:7),                                               <<RK.08>>00346000
     VSID(*) = VSIDW,                                          <<RK.08>>00348000
     VSNAME(*) = VSID,                                         <<RK.08>>00350000
     VGNAME(*) = VSID(8),                                      <<RK.08>>00352000
     VANAME(*) = VSID(16),                                     <<RK.08>>00354000
     keyword(0:max'keyword'len*max'keywords-1);                <<03510>>00356000
BYTE pointer bptr'keyword;  << for keyword,in getfunction >>   <<03510>>00358000
INTEGER number'keywords;                                       <<03510>>00360000
LOGICAL ARRAY keywdspec(0:max'keywords-1);                     <<03510>>00362000
LOGICAL array keyparmspec(0:max'keywords-1);                   <<03510>>00364000
                                                                        00366000
EQUATE FUNCTNUM = 20;  <<NUMBER OF VINIT FUNCTIONS>>           <<03638>>00368000
                                                                        00370000
BYTE ARRAY FUNCTLIST(0:(FUNCTNUM+1)*8):=                                00372000
     "ERR     ",  << FUNCTION ERROR >>                                  00374000
     "INIT    ",  << USER COMMAND >>                                    00376000
     "FORMAT  ",  << USER COMMAND >>                                    00378000
     "SCRATCH ",  << USER COMMAND >>                                    00380000
     "COPY    ",  << USER COMMAND >>                                    00382000
     "COND    ",                                                        00384000
     "DTRACK  ",  << USER COMMAND >>                                    00386000
     "DELVOL  ",  << USER COMMAND >>                                    00388000
     "DSTAT   ",  << USER COMMAND >>                                    00390000
     "PDEFN   ",  << USER COMMAND >>                                    00392000
     "PLABEL  ",  << USER COMMAND >>                                    00394000
     "PDTRACK ",  << USER COMMAND >>                                    00396000
     "PFSPACE ",  << USER COMMAND >>                                    00398000
     "SERIAL  ",  << USER COMMAND >>                                    00400000
     "EXIT    ",  << TERMINATE    >>                                    00402000
     "DEBUG   ",  << DEBUG CALL   >>                           <<00145>>00404000
     "HELP    ",  << HELP  CALL   >>                           <<00145>>00406000
     "XPLAIN  ",  << HELP  CALL   >>                           <<00145>>00408000
     "EXPLAIN ",  << HELP  CALL   >>                           <<<<FDF>>00410000
     "VERIFY  ",  << USER COMMAND >>                           <<03638>>00412000
     "FOREIGN ";  << USER COMMAND >>                           <<01115>>00414000
                                                                        00416000
<< PARMINFO DESCRIPTION -                                               00418000
                                                                        00420000
   THE PARMINFO ARRAY IS USED TO CONTROL THE PARSING OF VINIT           00422000
   COMMANDS. THERE IS ONE ENTRY FOR EACH COMMAND WHICH A USER           00424000
   CAN ENTER.                                                           00426000
                                                                        00428000
   THE FORMAT OF EACH ENTRY IS -                                        00430000
                                                                        00432000
   PARMINFO(N).(12:4) - NUMBER OF PARAMETERS ALLOWED FOR THIS           00434000
                        COMMAND (MAXIMUM IS FOUR).                      00436000
              .( 8:4) - OPTIONAL PARAMETER MASK INDICATION WHICH        00438000
                        OF THE PARAMETERS FOR THE COMMAND ARE           00440000
                        OPTIONAL. EACH BIT IN THE MASK REPRESENTS       00442000
                        A PARAMETER POSITION; IF THE BIT IS SET,        00444000
                        THE PARAMETER IS OPTIONAL. THE RIGHTMOST BIT    00446000
                        CORRESPONDS TO THE FIRST PARAMETER IN THE       00448000
                        SYNTAX.                                         00450000
              .( 6:2) - TYPE OF THE FIRST PARAMETER:                    00452000
                        0 = INTEGER                                     00454000
                        1 = VOLUME NAME (8 CHARACTERS)                  00456000
                        2 = VOLUME SET SPECIFIER(THREE 8 CHARACTER      00458000
                            STRINGS WITH DELIMITERS)                    00460000
                        3 = KEYWORD STRING (COMMAND DEPENDENT).         00462000
              .( 4:2) - TYPE OF SECOND PARAMETER.                       00464000
              .( 2:2) - TYPE OF THIRD PARAMETER.                        00466000
              .( 0:2) - TYPE OF FOURTH PARAMETER.                       00468000
>>                                                                      00470000
ARRAY PARMINFO(0:FUNCTNUM):=                                            00472000
     %000000,  << ERR - PLACE HOLDER >>                                 00474000
     %160704,  << INIT - TYP:VNAME,INT,VSID,KEYWD;OPT:N,N,Y,Y;          00476000
                         NUM=4                              >>          00478000
     %006042,  << FORMAT - TYP:INT,KEYWD;OPT:N,Y;NUM=2      >> <<03537>>00480000
     %006042,  << SCRATCH - TYP:INT,KEYWD;OPT:N,Y;NUM=2     >>          00482000
     %170304,  << COPY-TYP:INT,INT,KEY,KEY;OPT:N,N,Y,Y;NUM=4>> <<04670>>00484000
     %006042,  << COND- TYP:INT,KEYWD;OPT:N,Y;NUM=2         >>          00486000
     %000001,  << DTRACK - TYP:INT;OPT:N;NUM=1              >>          00488000
     %004442,  << DELVOL - TYP:VNAME,VSID;OPT:N,Y;NUM=2     >>          00490000
     %001421,  << DSTAT - TYP:KEYWD;OPT:Y;NUM=1             >>          00492000
     %001021,  << PDEFN - TYP:VSID;OPT:Y;NUM=1              >>          00494000
     %000001,  << PLABEL - TYP:INT;OPT:N;NUM=1              >>          00496000
     %000001,  << PDTRACK - TYP:INT;OPT:N;NUM=1             >>          00498000
     %007442,  << pfspace - typ:keywd,keywd;opt:n,y;num=2   >> <<03510>>00500000
     %000001,  << SERIAL  - TYP:INT;OPT:N;NUM=1             >>          00502000
     %000000,  << EXIT - TYP:;OPT:;NUM=0                    >>          00504000
     %000000,  << DEBUG - TYP:;OPT:;NUM=0                   >> <<00145>>00506000
     %000000,  << HELP  - TYP:;OPT:;NUM=0                   >> <<00145>>00508000
     %000000,  << XPLAIN- TYP:;OPT:;NUM=0                   >> <<00145>>00510000
     %000000,  << EXPLAIN-TYP:;OPT:;NUM=0                   >> <<<<FDF>>00512000
     %006042,  << VERIFY - TYP:INT,KEYWD;OPT:N,Y;NUM=2      >> <<03638>>00514000
     %000001;  << FOREIGN - TYP:INT;OPT:N;NUM=1             >> <<01115>>00516000
                                                                        00518000
INTEGER ARRAY DELIMS(0:FUNCTNUM*4+3):=                         <<01115>>00520000
     0,0,0,0,                          << ERROR    >>                   00522000
     COMMA,COMMA,SEMICOLON,CARRETURN,  << INIT     >>                   00524000
     SEMICOLON,CARRETURN,0,0,          << FORMAT   >>          <<03537>>00526000
     SEMICOLON,CARRETURN,0,0,          << SCRATCH  >>                   00528000
     COMMA,SEMICOLON,SEMICOLON,CARRETURN,<< COPY   >>          <<04670>>00530000
     SEMICOLON,CARRETURN,0,0,          << COND     >>                   00532000
     CARRETURN,0,0,0,                  << DTRACK   >>                   00534000
     COMMA,CARRETURN,0,0,              << DELVOL   >>                   00536000
     CARRETURN,0,0,0,                  << DSTAT    >>                   00538000
     CARRETURN,0,0,0,                  << PDEFN    >>                   00540000
     CARRETURN,0,0,0,                  << PLABEL   >>                   00542000
     CARRETURN,0,0,0,                  << PDTRACK  >>                   00544000
     semicolon,carreturn,0,0,          << pfspace  >>          <<03510>>00546000
     CARRETURN,0,0,0,                  << SERIAL   >>          <<00145>>00548000
     CARRETURN,0,0,0,                  << EXIT     >>          <<01115>>00550000
     CARRETURN,0,0,0,                  << DEBUG    >>          <<01115>>00552000
     CARRETURN,0,0,0,                  << HELP     >><<FDF.0>> <<01115>>00554000
     CARRETURN,0,0,0,                  << XPLAIN   >>          <<00145>>00556000
     CARRETURN,0,0,0,                  << EXPLAIN  >>          <<<<FDF>>00558000
     SEMICOLON,CARRETURN,0,0,          << VERIFY   >>          <<03638>>00560000
     CARRETURN,0,0,0;                  << FOREIGN  >><<FDF.0>> <<01115>>00562000
                                                                        00564000
COMMENT                                                        <<01445>>00566000
         BITS IN MASK SPECIFY WHICH BITS ARE ALLOWED ON IN     <<01445>>00568000
         THE DISC STATUS RETURNED BY CHECKDISC.  THE BIT       <<01445>>00570000
         MEANINGS ARE:                                         <<01445>>00572000
                                                               <<01445>>00574000
             3 -> FOREIGN AND UP                               <<01445>>00576000
             4 -> MOUNTED                                      <<01445>>00578000
             5 -> DOWNPND                                      <<01445>>00580000
             6 -> DOWN                                         <<01445>>00582000
             7 -> RESERVED                                     <<01445>>00584000
             8 -> SERIAL AND UP                                <<01445>>00586000
             9 -> OFFLINE                                      <<01445>>00588000
            10 -> SYSDOMAIN                                    <<01445>>00590000
            11 -> NOT PVTYPE                                   <<01445>>00592000
            12 -> NOT REMOVABLE                                <<01445>>00594000
            13 -> NOT A DISC                                   <<01445>>00596000
            14 -> DEV NOT CONFIGURED                           <<01445>>00598000
            15 -> LDEV OUT OF RANGE                            <<01445>>00600000
;                                                              <<01445>>00602000
                                                               <<01445>>00604000
ARRAY MASK(0:FUNCTNUM):=                                       <<00145>>00606000
     %000000,  << ERR - PLACE HOLDER >>                                 00608000
     %011220,  << INIT -             >>                        <<06059>>00610000
     %011220,  << FORMAT -           >>                        <<06059>>00612000
     %011220,  << SCRATCH -          >>                        <<06059>>00614000
     %015670,  << COPY -            >>                         <<04670>>00616000
     %007470,  << COND -             >>                                 00618000
     %006020,  << DTRACK -           >>                        <<06059>>00620000
     %001000,  << DELVOL -           >>                                 00622000
     %000000,  << DSTAT -           >>                                  00624000
     %000000,  << PDEFN -            >>                                 00626000
     %007670,  << PLABEL -           >>                        <<RK.03>>00628000
     %007670,  << PDTRACK -          >>                        <<03621>>00630000
     %007470,  << PFSPACE -          >>                                 00632000
     %011200,  <<SERIAL -            >>                        <<01445>>00634000
     %000000,  << EXIT   -           >>                        <<00145>>00636000
     %000000,  << DEBUG  -           >>                        <<00145>>00638000
     %000000,  << HELP   -           >>                        <<00145>>00640000
     %000000,  << XPLAIN -           >>                        <<00145>>00642000
     %000000,  << EXPLAIN-           >>                        <<<<FDF>>00644000
     %017670,  << VERIFY -          >>                         <<04670>>00646000
     %011220;  << FOREIGN -          >>                        <<06059>>00648000
EQUATE MAXSECTTRK = 64;  <<MAX. POSSIBLE SEC/TRK ANY SUBTYPE>> <<00866>>00650000
                                                                        00652000
<< MVTAB entry >>                                              <<03510>>00654000
DEFINE mvtabxf =(8:8)#;                                        <<03510>>00656000
EQUATE mvtabldev = 5;                                          <<03510>>00658000
DEFINE ldevf = (0:8)#;                                         <<03510>>00660000
                                                               <<03510>>00662000
<< volume table >>                                             <<03510>>00664000
EQUATE vol'table'dst = %35;                                    <<03510>>00666000
EQUATE num'sys'vol = 2;                                        <<03510>>00668000
EQUATE vol'table'ldev = %14;                                   <<03510>>00670000
DEFINE vol'table'ent'size = (8:8)#;                            <<03510>>00672000
DEFINE vol'ent'ldev =(0:8)#;                                   <<03510>>00674000
                                                               <<03510>>00676000
<< vol set dirc ent >>                                         <<03510>>00678000
DEFINE numvol = (0:4)#;                                        <<03510>>00680000
                                                               <<03510>>00682000
   <<   Directory  >>                                          <<03510>>00684000
                                                               <<03510>>00686000
   EQUATE             a = 0;      << write out entry block >>  <<03510>>00688000
   EQUATE             dadirty=%221;                            <<03510>>00690000
   EQUATE             filelevel= 0;                            <<03510>>00692000
   EQUATE            grouplevel = 1 ;                          <<03777>>00694000
   ARRAY              dds(*) = DB+0;                           <<03510>>00696000
   DEFINE             dirtyf =(15:1)#;                         <<03510>>00698000
   EQUATE             dirc'bad'file = 1;                       <<03510>>00700000
   DEFINE          bad'addr = %77777777D#;                     <<03510>>00702000
                                                               <<03510>>00704000
                                                               <<03510>>00706000
                                                               <<03510>>00708000
EQUATE  << DRIVER FUNCTION CODES >>                                     00710000
     R            =    0,  <<READ I/O REQUEST>>                         00712000
     W            =    1,  <<WRITE I/O REQUEST>>                        00714000
     RS           =    7,  <<REQUEST STATUS I/O REQUEST>>               00716000
     F            =    8,  <<FORMAT TRACK I/O REQUEST>>                 00718000
     IN           =    9,  <<INITIALIZE TRACK I/O REQUEST>>             00720000
     IT           =    9,  <<INITIALIZE TRACK (FLOPPY)>>       <<00239>>00722000
     RFS          =   10,  <<READ FULL SECTOR I/O REQUEST>>             00724000
     WL           =   11,  <<WRITE LABEL (SECTOR 0) REQUEST>>           00726000
     RSPD         =   12,  <<READ WITH SPARING DISABLED>>      <<00112>>00728000
     VM           =   12,  <<VERIFY MEDIA (FLOPPY)>>           <<00239>>00730000
     FPA          =   13,  << FIND PHYSICAL ADDRESS >>         <<03537>>00732000
     REQ'VOL'LIMIT=13,<<CS'80: returns highest logical sector>><<03537>>00734000
     VERIFY'CS'80 =   14,  << CS'80 disc verify >>             <<03537>>00736000
     SET'ADDR'SEC =   82,  << CS'80 SET ADDRESS >>             <<03620>>00738000
     SPARE'BLOCK  =   88,  << CS'80 Spare cmd                >><<03583>>00740000
     Initiate'Utility = 91, << CS'80 General Purpose Command.>><<03620>>00742000
     INIT'UTIL    =   91;  << CS'80 INITIATE UTILITY >>        <<03620>>00744000
                                                               <<03537>>00746000
DEFINE                                                         <<03537>>00748000
     RW'ERT       =   %400310D#, <<R/W ERROR TEST>>            <<03620>>00750000
     RO'ERT       =   %400311D#, <<READ ONLY ERROR TEST>>      <<03620>>00752000
     RETAIN'DATA  = 0D#,                                       <<03620>>00754000
     NO'RETAIN'DATA= 1D#;                                      <<03537>>00756000
                                                               <<03537>>00758000
EQUATE                                                         <<03537>>00760000
     RETAIN'ALL'SPARES = 0,  << CS'80 keep spares parm >>      <<03537>>00762000
     RETAIN'FACTORY'SPARES = 1,  << CS'80 fact. sp. only >>    <<03537>>00764000
     Physical'Format = 2,  << Allowed on Disc only.          >><<03537>>00766000
     DEFAULT'INTERLEAVE = 0;  << No interleave >>              <<03537>>00768000
                                                                        00770000
EQUATE                                                                  00772000
     CCG          =    0,  <<GREATER-THAN CONDITION CODE>>              00774000
     CCL          =    1,  <<LESS-THAN CONDITION CODE>>                 00776000
     CCE          =    2,  <<EQUAL CONDITION CODE>>                     00778000
     SPT          =  %20,  <<I/O ERROR - SPARED TRACK>>                 00780000
     DFT          =  %21,  <<I/O ERROR - DEFECTIVE TRACK>>              00782000
     CDERR        =  %17,  <<I/O ERROR - COREECTABLE DATA ERROR>>       00784000
     SYSDB        =  512,                                               00786000
     FSCNT        =  141,  <<WORD COUNT FOR RFS DISC I/O>>              00788000
     FSERR        =    0,  <<FILE SYSTEM ERROR>>                        00790000
     DTTALT       =  126,  <<NEXT AVAILABLE ALTERNATE - DTT>>           00792000
     DTTLPS       =  127,  <<LOGICAL PACK SIZE (CYLINDERS) - DTT>>      00794000
     TRKERR       =  %14,  <<DISC I/O ERROR - TRACK ERROR>>             00796000
     TIMEOUT      =  %24,  <<TIME OUT>>                        <<03620>>00798000
     INVADDR      =  %64,  <<INVALID ADDRESS>>                 <<04851>>00800000
     VERERR       = %154,  <<VERIFY ERROR - FLOPPY ONLY>>      <<03712>>00802000
     NO'SPARE     = %164,  <<I/O ERROR NO MORE SPARE TRACK>>   <<03620>>00804000
     SYSLDEV      =    1,  <<SYSTEM DISC>>                              00806000
     PVPMOUNT     =   12,  <<LOG RECORD TYPE>>                          00808000
     SUCCESSFUL   =    1,  <<ATTACHIO GSTATUS VALUE>>                   00810000
     DIRADR2      =   13,  <<WORD IN COLD LOAD INFO SECTOR>>   <<00239>>00812000
     DIRSECT      =   20,  <<WORD IN COLD LOAD INFO SECTOR>>   <<00239>>00814000
     COLDLOADSECT =   28;  <<ADDRESS OF COLD LOAD SECTOR>>     <<00239>>00816000
EQUATE  <<VS DEFINITION ENTRY >>                                        00818000
     VDMISC       =  4,                                                 00820000
     VDINFO       =  5;                                                 00822000
                                                                        00824000
EQUATE  << DIT LOCATIONS >>                                             00826000
     DSTAT1     = 18,  <<REQUEST STATUS WORD 1 (OF 2)>>                 00828000
     DSTAT2     = 19;                                                   00830000
                                                                        00832000
EQUATE VOLDIRENTSIZE = 6;                                               00834000
                                                                        00836000
EQUATE  << VOLUME LABEL INFORMATION >>                                  00838000
     LDEVINFO     =  6,                                                 00840000
     LGENINDEX    =  7,                                                 00842000
     LSYSID       = 16,  << BYTE ADDRESS >>                    <<00112>>00844000
     LSYSID1      =  8,                                                 00846000
     LSYSID2      =  9,                                                 00848000
     LINITDATE    = 14,                                                 00850000
     LDIRBASE     = 15,                                                 00852000
     LDIRSIZE     = 16,                                                 00854000
     LSYSIDLOC    = 16,  <<BYTES>>                                      00856000
     LVNAMELOC    = 20,  <<BYTES>>                                      00858000
     LVNAMELOC'   = 10,  <<WORDS>>                                      00860000
     LVDIRINFO    = 30,                                                 00862000
     LVSACCNTLOC  = 34,  <<BYTES>>                                      00864000
     LVSACCNTLOC' = 17,  <<WORDS>>                                      00866000
     LVSGROUPLOC  = 42,  <<BYTES>>                                      00868000
     LVSGROUPLOC' = 21,  <<WORDS>>                                      00870000
     LVOLDIR      = 25,                                                 00872000
     LVOLDIRLOC   = 50;  <<BYTES>>                                      00874000
                                                                        00876000
EQUATE  << TABLE/ENTRY SIZES >>                                         00878000
     VDCENTSIZE   = 56,  <<CLASS DEFINITION ENTRY>>            <<RK2PV>>00880000
     VDSENTSIZE   = 56,  <<(MAXVOLNUM+1)*VDVENTSIZE>>          <<RK2PV>>00882000
     VDVENTSIZE   =  6,                                                 00884000
     VDVENTSIZEB  = 12,                                                 00886000
     MVTABENTSIZE = 13;                                                 00888000
                                                                        00890000
DEFINE  << SYSTEM DB AREA >>                                            00892000
     PVPROCPINX   = ABSOLUTE(SYSDB+%363)#,                              00894000
     PVRECG'CNT   = ABSOLUTE(SYSDB+%364)#,                              00896000
     VMOUNTINFO   = ABSOLUTE(SYSDB+%365)#;                              00898000
DEFINE     sys'cold'loadid = ABSOLUTE(sysdb +%75)#;            <<03510>>00900000
                                                                        00902000
                                                                        00904000
DEFINE  << PARTIAL FIELDS >>                                            00906000
     MVF        = ( 1:1)#,  <<MASTER VOLUME (VOLUME LABEL)>>            00908000
     TRKF       = (0:14)#,  <<TRACK FIELD OF DTT ENTRY>>                00910000
     DTCF       = (14:2)#,  <<DISPOSITION FIELD OF DTT ENTRY>>          00912000
     HEADF      = ( 3:5)#,  <<HEAD FIELD OF SECTOR PREAMBLE>>           00914000
     DOUBLESIDED= (4:1)=1#,  << FLOPPY STATUS2 >>              <<00239>>00916000
     DOWNF      = ( 6:1)#,                                              00918000
     VTABXF     = ( 0:8)#,  <<VTAB INDEX IN EXTENT MAP ENTRY>>          00920000
     QSTATUS    = ( 8:5)#,                                              00922000
     GSTATUS    = (13:3)#,                                              00924000
     TSTATUS    = ( 8:8)#,                                              00926000
     NREADYF    = (14:1)#,  <<NOT-READY BIT OF STATUS (DISMOUNTED)>>    00928000
     SCRATCHF   = ( 0:1)#,                                              00930000
     SINGLESIDED= (4:1)=0#,  << FLOPPY STATUS2 >>              <<00239>>00932000
     VTENTNUMF  = ( 0:8)#,                                              00934000
     VTENTSIZEF = ( 8:8)#;                                              00936000
                                                                        00938000
<< Definitions for init/dttanalysis   >>                       <<03527>>00940000
                                                               <<03527>>00942000
<< The following are for ldev 1, master system disc, only >>   <<03527>>00944000
                                                               <<03527>>00946000
DEFINE  ldev1'start'resv'area = 0D#;                           <<03527>>00948000
DEFINE  ldev1'end'resv'area   = 399D#;                         <<03527>>00950000
DEFINE  ldev1'resv'area'sz    = 400#;                          <<03527>>00952000
DEFINE  ldev1'beg'good'adr    = 400D#;                         <<03527>>00954000
                                                               <<03527>>00956000
<< The following are for all other discs >>                    <<03527>>00958000
                                                               <<03527>>00960000
DEFINE  start'resv'area = 0D#;                                 <<03527>>00962000
DEFINE  end'resv'area   = 9D#;                                 <<03527>>00964000
DEFINE  resv'area'sz    = 10#;                                 <<03527>>00966000
DEFINE  beg'good'adr    = 10D#;                                <<03527>>00968000
                                                               <<03527>>00970000
DEFINE CC=STAT.(6:2)#;                                                  00972000
DEFINE RETURN'CCL = BEGIN CC := CCL; RETURN; END; #;           <<00239>>00974000
DEFINE DUPLICATE = ASSEMBLE(DUP)#;                                      00976000
DEFINE DELETE = ASSEMBLE(DEL)#;                                         00978000
DEFINE ENABLE = ASSEMBLE(SED 0)#;                                       00980000
                                                                        00982000
DEFINE DOWNED = STATUS.(8:1)#;                                          00984000
                                                               <<01115>>00986000
                                                               <<01115>>00988000
DEFINE                                                         <<06276>>00990000
     LDT'INDEX  = 0 #,                                         <<06276>>00992000
     LDTX'INDEX = 0 #,                                         <<06276>>00994000
     LPDT'INDEX = LDEV * INTEGER (LPDT'ENTRY'SIZE) #,          <<06276>>00996000
     FOREIGN    = LPDT'NON'SYS'DOMAIN AND                      <<06276>>00998000
                  LPDT'RDY'SER'FRN'DISC AND                    <<06276>>01000000
                  LPDT'SERIAL'OR'FOREIGN = LPDT'FOREIGN #;     <<06276>>01002000
                                                               <<01115>>01004000
LOGICAL DISC'TYPE;                                             <<04670>>01006000
DEFINE                                                         <<04670>>01008000
   SYS     = DISC'TYPE.(15:1)#,                                <<04670>>01010000
   PVOL   = DISC'TYPE.(14:1)#,                                 <<04670>>01012000
   SERIALD = DISC'TYPE.(13:1)#,                                <<04670>>01014000
   SCRVOL  = DISC'TYPE.(12:1)#,                                <<04670>>01016000
   FORVOL  = DISC'TYPE.(11:1)#,                                <<04670>>01018000
   DISC    = DISC'TYPE.(10:1)#,                                <<04670>>01020000
   MH'DISC = DISC'TYPE.( 9:1)#,                                <<04670>>01022000
   FLOPPY  = DISC'TYPE.( 8:1)#,                                <<04670>>01024000
   CS'80   = DISC'TYPE.( 7:1)#,                                <<04670>>01026000
   CARTRIDGE=DISC'TYPE.( 6:1)#,                                <<*8114>>01028000
   DOWNDEV = DISC'TYPE.( 0:1)#;                                <<04670>>01030000
                                                               <<04670>>01032000
DEFINE INAPPROPRIATE=                                          <<01115>>01034000
   BEGIN                                                       <<01115>>01036000
      GENMSG(PVMSGSET,DEVERR13);                               <<01115>>01038000
      RETURN;                                                  <<01115>>01040000
   END#;                                                       <<01115>>01042000
                                                                        01044000
DEFINE EXIT' = MORE:=FALSE#;  <<EXIT PROGRAM>>                          01046000
                                                                        01048000
DEFINE                                                                  01050000
     MPYD = ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD)#,                01052000
     DIVD = ASSEMBLE(ZERO,CAB;LDXA,LDIV;CAB,LDXA;LDIV)#;                01054000
                                                                        01056000
DEFINE TRAPS = PUSH(STATUS);                                            01058000
               TOS.(2:1):=0;  <<RESET USER TRAPS>>                      01060000
               SET(STATUS)#;                                            01062000
                                                               <<06276>>01064000
DEFINE                                                         <<06276>>01066000
   DEF'MOVE'FROM'DST =                                         <<06276>>01068000
      MOVE'FROM'DST (DBTARGET, DSTN, DSTOFFSET, WORD'COUNT);   <<06276>>01070000
         VALUE   DBTARGET, DSTN, DSTOFFSET, WORD'COUNT;        <<06276>>01072000
         LOGICAL DBTARGET, DSTN, DSTOFFSET, WORD'COUNT;        <<06276>>01074000
      BEGIN                                                    <<06276>>01076000
      X := TOS;  << Save return address >>                     <<06276>>01078000
      ASSEMBLE (MFDS 0);                                       <<06276>>01080000
      TOS := X;                                                <<06276>>01082000
      END #;                                                   <<06276>>01084000
                                                               <<03537>>01086000
DEFINE                                                         <<06468>>01088000
   DEF'CHECKSUM = CHECKSUMX;                                   <<06468>>01090000
   BEGIN                                                       <<06468>>01092000
   CHECKSUM;                                                   <<06468>>01094000
   S2 := TOS;                                                  <<06468>>01096000
   END  << Checksum >>#;                                       <<06468>>01098000
                                                               <<06468>>01100000
DEFINE                                                         <<06468>>01102000
   DEF'PUT'FILE'NAME = PUT'FILE'NAME;                          <<06468>>01104000
   BEGIN                                                       <<06468>>01106000
   BUFFER (4) := BUFFER (14) := "  ";                          <<06468>>01108000
   MOVE BUFFER := FLLOCNAME, (4);                              <<06468>>01110000
   SCAN BBUFFER UNTIL "  ",1;                                  <<06468>>01112000
   MOVE * := ".",1;                                            <<06468>>01114000
   MOVE BUFFER (10) := FLGRPNAME, (4);                         <<06468>>01116000
   MOVE * := BUF'PTR (20) WHILE AN,1;                          <<06468>>01118000
   MOVE * := ".",1;                                            <<06468>>01120000
   MOVE BUFFER (10) := FLACCTNAME, (4);                        <<06468>>01122000
   MOVE * := BUF'PTR (20) WHILE AN,1;                          <<06468>>01124000
   MOVE * := 0;                                                <<06468>>01126000
   END #; << Put'File'Name >>                                  <<06468>>01128000
EQUATE Cartridge'Sector = 512;<<sector size for Linus/Buffalo>><<*8114>>01130000
EQUATE Blocked'IO = 1;    << for Attachio Flags              >><<03537>>01132000
EQUATE Diagnostic'And'Block = %21; <<      For Attachio      >><<03583>>01134000
<< A note about setting the Diagnostic Bit in the Flags      >><<03583>>01136000
<< word of an Attachio call. The CS'80 driver people         >><<03583>>01138000
<< have changed the meaning of what this bit means.          >><<03583>>01140000
<< For CS'80 devices, setting this bit means the driver      >><<03583>>01142000
<< no longer handles device release requests, putting        >><<03583>>01144000
<< entries into the DSCT or I/O error logging.               >><<03583>>01146000
<< Also if you use it, be prepared to do your own request    >><<03583>>01148000
<< status after each unsuccessful operation.                 >><<03583>>01150000
DEFINE SKIP'SPARING = TRUE#;                                   <<03537>>01152000
DEFINE JUMP'SPARING = FALSE#;                                  <<03537>>01154000
DEFINE NO'SPARING = FALSE#;                                    <<03537>>01156000
EQUATE Default'Errinfo = 5;                                    <<03537>>01158000
EQUATE Return'Message = 2; << Used to Initiate CS'80 Utility.>><<03583>>01160000
EQUATE Read'Drive'Tables = %304;                               <<03583>>01162000
EQUATE First'Byte = 20;                                        <<03583>>01164000
                                                               <<03583>>01166000
<< When using the Initiate'Utility function of               >><<03583>>01168000
<< the driver, the returned data is offset in                >><<03583>>01170000
<< the buffer.                                               >><<03583>>01172000
                                                               <<06276>>01174000
                                                                        01176000
EQUATE PVMSGSET = 15;                                                   01178000
EQUATE DEVERRMSG = 60;                                                  01180000
                                                                        01182000
EQUATE  << PRIVATE VOLUME ERRORS (INDICES INTO PVERRMSGSET) >>          01184000
     OKEXIT       =   0,                                                01186000
     VMOUNTOFF    =  20,                                                01188000
     OPREJECT     =  21,                                                01190000
     NOTAVAIL     =  22,                                                01192000
     SYSTEMUSE    =  23,                                                01194000
     NODGROUP     =  24,                                                01196000
     NODACCNT     =  25,                                                01198000
     NOTMOUNTED   =  26,                                                01200000
     NODVSET      =  27,                                                01202000
     NOHVSET      =  28,                                                01204000
     NOHGROUP     =  29,                                                01206000
     NOHACCNT     =  30,                                                01208000
     NOVGROUP     =  31,                                                01210000
     NOVACCNT     =  32,                                                01212000
     DUPMOUNT     =  33,                                                01214000
     NOTVALDUSER  =  34,                                                01216000
     DOWNSET      =  35,                                                01218000
     DOWNVOL      =  36,                                                01220000
     DIFFCLASS    =  37,                                                01222000
     USERERR1     =  38,                                                01224000
     USERERR2     =  39,                                                01226000
                                                                        01228000
     MVTABERR     =  50,    << PVERR 50 >>                              01230000
     PVUSERERR    =  51,                                                01232000
     DIRECERR     =  52,                                                01234000
                                                                        01236000
     DEVERR1      =  60,  <<DEVICE OUT OF RANGE>>                       01238000
     DEVERR2      =  61,  <<DEVICE NOT CONFIGURED>>                     01240000
     DEVERR3      =  62,  <<DEVICE IS NOT A DISC>>                      01242000
     DEVERR4      =  63,  <<DEVICE IS NOT REMOVABLE>>                   01244000
     DEVERR5      =  64,  <<DEVICE IS NOT PV TYPE (INVLD SUBTYPE)>>     01246000
     DEVERR6      =  65,  <<DEVICE NOT IN USER DOMAIN>>                 01248000
     DEVERR7      =  66,  <<DEVICE IS NOT ON-LINE>>                     01250000
     DEVERR8      =  67,  <<DEVICE IS A SERIAL DISC>>                   01252000
     DEVERR9      =  68,  <<DEVICE IS RESERVED BY SYSTEM>>              01254000
     DEVERR10     =  69,  <<DEVICE IS DOWNED>>                 <<00.DL>>01256000
     DEVERR11     =  70,  <<DEVICE HAS DOWN PENDING>>          <<00.DL>>01258000
     DEVERR12     =  71,  <<DEVICE IS IN USE BY PV-SYSTEM>>    <<00.DL>>01260000
     DEVERR13     =  72,  <<INAPPROPRIATE FOR FOREIGN DISC>>   <<01115>>01262000
                                                                        01264000
     VIERR0       = 100,  <<function aborted>>                          01266000
     VIERR1       = 101,  <<unrecognized function>>                     01268000
     VIERR2       = 102,  <<inv. track disposition>>                    01270000
     VIERR3       = 103,  <<inv. keyword string>>                       01272000
     VIERR4       = 104,  <<no vol. set currently specified>>           01274000
     VIERR5       = 105,  <<LDEV not downed>>                           01276000
     VIERR6       = 106,  <<LDEV not downed or scratch>>                01278000
     VIERR7       = 107,  <<vol. not member of vol. set>>               01280000
     VIERR8       = 108,  <<subTYPe inconsistency>>                     01282000
     VIERR9       = 109,  <<pack size inconsistency>>                   01284000
     VIERR10      = 110,  <<attempted to copy to bad track>>            01286000
     VIERR11      = 111,  <<no suspect tracks found>>                   01288000
     VIERR12      = 112,  <<no alternate tracks available>>             01290000
     VIERR13      = 113,  <<track not reassigned>>                      01292000
     VIERR14      = 114,  <<def. track in reserved area - reformat>>    01294000
     VIERR15      = 115,  <<inv. keyword parameter>>                    01296000
     VIERR16      = 116,  <<vol. name > 8 char.>>                       01298000
     VIERR17      = 117,  <<vol. set name > 8 char.>>                   01300000
     VIERR18      = 118,  <<keyword > 8 char.>>                         01302000
     VIERR19      = 119,  <<vol. name has non-alpha first char.>>       01304000
     VIERR20      = 120,  <<vol. set has non-alpha first char.>>        01306000
     VIERR21      = 121,  <<keyword has non-alpha first char.>>         01308000
     VIERR22      = 122,  <<vol. name has special char.>>               01310000
     VIERR23      = 123,  <<vol. set has special char.>>                01312000
     VIERR24      = 124,  <<keyword has special char.>>                 01314000
     VIERR25      = 125,  <<no parameters allowed for this function>>   01316000
     VIERR26      = 126,  <<missing non-optional parameter>>            01318000
     VIERR27      = 127,  <<non-numeric in LDEV parameter>>             01320000
     VIERR28      = 128,  <<invalid LDEV value>>                        01322000
     VIERR29      = 129,  <<too many names in vol. set>>                01324000
     VIERR30      = 130,  <<missing keyword paramater>>                 01326000
     VIERR31      = 131,  <<unexpected delimiter>>                      01328000
     VIERR32      = 132,  <<unexpected parameter>>                      01330000
     VIERR33      = 133,  <<format or protect switch problem>> <<RK1PV>>01332000
     VIERR34      = 134,  <<problem with DTT or FST table>>    <<RK1PV>>01334000
     VIERR35      = 135,  <<illegal cylinder address>>         <<RK3PV>>01336000
     VIERR36      = 136,  <<illegal head address>>             <<RK3PV>>01338000
     VIERR37      = 137,  <<DTT table full -- entry not added>><<RK3PV>>01340000
     VIERR38      = 138,  <<LDEV NOT IN VTAB -- ON/OFFLINE >>  <<RK.05>>01342000
     VIERR39      = 139,  <<VOLUME NOT OR PART OF VOLUME SET>> <<00145>>01344000
     VIWARN0      = 140,  <<vol. already scratch/reset>>                01346000
     VIWARN1      = 141,  <<suspect track in alternate area>>           01348000
     VIWARN2      = 142,  <<suspect track in reserved area>>            01350000
     VIWARN3      = 143,  <<suspected tracks detected(format)>><<RK3PV>>01352000
     VIWARN4      = 144,  <<duplicate entry in dtt>>          <<RK3PV>>01354000
     VIWARN5      = 145,  <<COND won't work unless VS mounted>><<00145>>01356000
     VIWARN6      = 146,  <<RECOVER CHANGED TO ALL -- >1 USER>><<00145>>01358000
     VIWARN7      = 147,  <<RECOVER CHANGED TO ALL -- SYSVOL >><<00145>>01360000
     VIWARN8      = 148,  <<FILE ! PURGED>>                    <<00239>>01362000
     VIWARN9      = 149,  <<DTRACK WON'T WITH >1 USER >>       <<00239>>01364000
     VIWARN10     = 150,  <<UNREADABLE LABEL ON LDEV ! >>      <<00239>>01366000
     VIWARN11     = 151,  <<TRACK ! : HEAD ! MADE INVISIBLE>>  <<00239>>01368000
    vierr55      = 155,  << no w.s. for RECOVER >>             <<03510>>01370000
    vierr56      = 156,  << fatal err while try to rec >>      <<03510>>01372000
    viwarn57     = 157,  << beg recover >>                     <<03510>>01374000
    viwarn58     = 158,  << finish recover,beg cond >>         <<03510>>01376000
    vierr59      = 159,  << space already alloc to a file >>   <<03510>>01378000
    viwarn60     = 160,  << file not rec,m bad in dirc >>      <<03510>>01380000
    vierr61      = 161,  << i/o err on DFSM >>                 <<03510>>01382000
    vierr62      = 162,  << i/o err on DTT >>                  <<03510>>01384000
    vierr63      = 163,  << i/o err on r disc lab-cond >>      <<03510>>01386000
    vierr64      = 164,  << open file on REC >>                <<03510>>01388000
     VIERR65      = 165,  <<MORE THAN 4 BAD TRKS ON FLOPPY>>   <<00239>>01390000
     VIERR66      = 166,  <<ILLEGAL OR UNDEFINED SUBTYPE>>     <<00239>>01392000
     VIERR67      = 167,  <<NO SUSPECT TRACKS IN VOLUME SET>>  <<00239>>01394000
    vierr68      = 168,  << deleted trks in DFSM/dirc >>       <<03510>>01396000
    vierr69      = 169,  << i/o err while try to rec >>        <<03510>>01398000
     VIHELP       = 170,  <<LISTING FOR HELP AND XPLAIN>>      <<00239>>01400000
     VIERR71      = 171,  <<DIRPURGE FAILED ON !>>             <<00239>>01402000
     VIERR72      = 172,  <<MUSTOPEN FAILED ON !>>             <<00239>>01404000
     VIERR73      = 173,  <<FCLOSE-DELETE FAILED ON !>>        <<00239>>01406000
    viwarn74    = 174   << couldnt read flab >>                <<03510>>01408000
    ,viwarn75    = 175   << checksum error >>                  <<03510>>01410000
    ,viwarn76    = 176   << special ept >>                     <<03537>>01412000
    ,vierr77     = 177   << problem w DFSM >>                  <<03510>>01414000
    ,viwarn78    = 178  << extent of file already released >>  <<03510>>01416000
    ,viwarn79    = 179   << logging disabled >>                <<03510>>01418000
    ,viwarn80    = 180   << logging enabled  >>                <<03510>>01420000
    ,viwarn81    = 181   << try rec or RLDS >>                 <<03510>>01422000
    ,vierr82     = 182   << i/o err on DFSM >>                 <<03510>>01424000
    ,viwarn83    = 183   << i/o err on wr flab >>              <<03510>>01426000
    ,vierr84     = 184   << could not begin COND >>            <<03510>>01428000
    ,vierr85     = 185   << function ab, but dirc+disc NOT >>  <<03510>>01430000
    ,viwarn86    = 186   << logging disabled, DTRACK >>        <<03510>>01432000
    ,viwarn87    = 187   << logging enabled, DTRACK  >>        <<03510>>01434000
    ,vierr90     = 190  << no vm or dst >>                     <<03510>>01436000
    ,VIWARN88     = 188  << BEGIN VERIFY >>                    <<03537>>01438000
    ,VIWARN89     = 189  << SPARING SECTOR ! >>                <<03537>>01440000
    ,vierr91     = 191 << Linus ran out of spares.           >><<03537>>01442000
    ,vierr92     = 192 << Media is uninitialized.            >><<03537>>01444000
    ,vierr93     = 193 << Media has not been formatted.      >><<03537>>01446000
    ,viwarn94    = 194 << Attempt to reset a scratch.        >><<03537>>01448000
    ,viwarn95    = 195  <<Linus has no DSCT.                 >><<03536>>01450000
    ,viwarn96    = 196  <<Label unreadable but DSCT may be OK>><<03536>>01452000
    ,vierr97     = 197  <<Can't read the DSCT.               >><<03536>>01454000
    ,viwarn98    = 198  <<DSCT is empty.                     >><<03536>>01456000
    ,viwarn99    = 199  << ! Defective Sectors Found.        >><<03536>>01458000
    ,viwarn100   = 200  << Sector ! (decimal) defective.     >><<03536>>01460000
    ,viwarn101   = 201 << Couldn't read Spare Block Table.   >><<03583>>01462000
    ,viwarn102   = 202 << Spare Block Table empty.           >><<03583>>01464000
    ,viwarn103   = 203 << Header Spare Block Printout.       >><<03583>>01466000
    ,viwarn104   = 204 << Detail Line Spare Block Printout.  >><<03583>>01468000
    ,viwarn105  = 205 << Out of spare tracks >>                <<03620>>01470000
    ,vierr106  = 206 << IO error during sparing >>             <<03620>>01472000
    ,viwarn108  = 208 << Do you want purge file xx ? >>        <<03620>>01474000
    ,viwarn107  = 207 << Do you want purge all bad files ? >>  <<03620>>01476000
    ,vierr109    = 209 << Couldn't read the Spare Table.     >><<03583>>01478000
    ,viwarn110   = 210 << Header line for Spare Table.       >><<03583>>01480000
    ,viwarn111   = 211 << Detail line per head.              >><<03583>>01482000
    ,viwarn112   = 212 << Detail line per spare              >><<03583>>01484000
                       << above for factory discovered.      >><<03583>>01486000
    ,viwarn113   = 213 << Detail line for field spare.       >><<03583>>01488000
    ,viwarn114   = 214 <<suspect sector in directory area>>    <<03620>>01490000
    ,viwarn115   = 215 <<suspect sector in bit map area>>      <<03620>>01492000
    ,viwarn116   = 216 <<suspect sector in desc. area>>        <<03620>>01494000
     ,vierr117  = 217 <<non-CS80 device>>                      <<03638>>01496000
     ,vierr118  = 218 <<it is not serial disc>>                <<03638>>01498000
     ,vierr119  = 219 <<unable to read gap table>>             <<03638>>01500000
     ,viwarn120  = 220 <<no data>>                             <<03638>>01502000
     ,viwarn121  = 221 <<unable to read sector>>               <<03638>>01504000
     ,viwarn122  = 222 <<end of data>>                         <<03638>>01506000
     ,vierr123  = 223 <<Inappropriate media-2 sided floppy>>   <<03712>>01508000
     ,viwarn124  = 224 <<Defective ! track>>                   <<03712>>01510000
     ,vierr125 = 225 <<unable to reassign tracks>>             <<04670>>01512000
     ,viwarn127 = 227 <<System logging disable>>               <<04670>>01514000
     ,viwarn128 = 228 <<System logging unable>>                <<04670>>01516000
     ,viwarn129 = 229 <<Volume not mounted>>                   <<04670>>01518000
     ,viwarn130 = 230 <<Unable to report bad files>>           <<04670>>01520000
     ,viwarn131 = 231 <<Unreadable or lost data>>              <<04670>>01522000
     ,viwarn132 = 232 <<Suspect or deleted sector/track >>     <<04670>>01524000
     ,viwarn133 = 233 <<xx% completed>>                        <<04670>>01526000
     ,viwarn134 = 234 <<Beginning Copy>>                       <<04670>>01528000
     ,vierr135 = 235 <<More than one user or temp. files>>     <<04670>>01530000
     ,vierr136 = 236 <<Media error - unable to initilize>>     <<04670>>01532000
     ,viwarn137 = 237 <<sector xx recovered>>                           01534000
     ,viwarn138 = 238 <<Warning: ldev x not downed>>                    01536000
     ,viwarn139 = 239 <<Beginning Verify (x% of disc space)>>           01538000
     ;                                                         <<03536>>01540000
                                                                        01542000
$PAGE " DISC/DEFECTIVE TRACKS TABLE DEFINITIONS"               <<03510>>01544000
$INCLUDE INCDISC1                                              <<03510>>01546000
$PAGE " DFSM DST DEFINITIONS"                                  <<03510>>01548000
$INCLUDE INCLDFS1                                              <<03510>>01550000
$INCLUDE INCLDFS2                                              <<03510>>01552000
$PAGE " PVINIT - GLOBAL DECLARATIONS"                          <<03510>>01554000
LOGICAL PROCEDURE GETSIR(N);                                            01556000
VALUE N; LOGICAL N;                                                     01558000
OPTION EXTERNAL;                                                        01560000
                                                                        01562000
PROCEDURE RELSIR(N,B);                                                  01564000
VALUE N,B; LOGICAL N,B;                                                 01566000
OPTION EXTERNAL;                                                        01568000
LOGICAL PROCEDURE SETSYSDB;                                             01570000
OPTION EXTERNAL;                                                        01572000
                                                                        01574000
PROCEDURE RESETDB(D);                                                   01576000
VALUE D; LOGICAL D;                                                     01578000
OPTION EXTERNAL;                                                        01580000
                                                                        01582000
INTEGER PROCEDURE EXCHANGEDB(D);                                        01584000
VALUE D; INTEGER D;                                                     01586000
OPTION EXTERNAL;                                                        01588000
                                                                        01590000
PROCEDURE LOG12(MISCINFO,DEVINFO,VNAME,VNAMELEN,RECTYPE);               01592000
VALUE MISCINFO,DEVINFO,VNAMELEN,RECTYPE;                                01594000
LOGICAL MISCINFO,DEVINFO;                                               01596000
INTEGER VNAMELEN,RECTYPE;                                               01598000
ARRAY VNAME;                                                            01600000
OPTION EXTERNAL;                                                        01602000
                                                                        01604000
DOUBLE  PROCEDURE Attachio(Ldev,Qmisc,Dstx,Adr,Fnct,           <<03537>>01606000
                           Cnt,P1,P2,Flags);                   <<03537>>01608000
VALUE   Ldev,Qmisc,Dstx,Adr,Fnct,Cnt,P1,P2,Flags;              <<03537>>01610000
INTEGER Ldev,Qmisc,Dstx,Adr,Fnct,Cnt,P1,P2,Flags;              <<03537>>01612000
OPTION EXTERNAL;                                                        01614000
                                                                        01616000
INTEGER PROCEDURE Ldevtotype(Ldev);                            <<03537>>01618000
VALUE   Ldev;                                                  <<03537>>01620000
INTEGER Ldev;                                                  <<03537>>01622000
OPTION EXTERNAL;                                               <<03537>>01624000
                                                               <<03537>>01626000
INTEGER PROCEDURE Ldevtosubtype(Ldev);                         <<03537>>01628000
VALUE   Ldev;                                                  <<03537>>01630000
INTEGER Ldev;                                                  <<03537>>01632000
OPTION EXTERNAL;                                               <<03537>>01634000
                                                               <<03537>>01636000
DOUBLE PROCEDURE REQSTATUS(LDN);                                        01638000
VALUE LDN; INTEGER LDN;                                                 01640000
OPTION EXTERNAL;                                                        01642000
                                                                        01644000
PROCEDURE GETVSDEFN(VSID,VSDEFN,VSDEF,PVERR);                           01646000
LOGICAL VSDEF;                                                          01648000
INTEGER PVERR;                                                          01650000
ARRAY VSID,VSDEFN;                                                      01652000
OPTION VARIABLE,EXTERNAL;                                               01654000
                                                                        01656000
PROCEDURE GETMVTABENTRY(MVTABX,MVTABENT);                               01658000
VALUE MVTABX; INTEGER MVTABX;                                           01660000
ARRAY MVTABENT;                                                         01662000
OPTION EXTERNAL;                                                        01664000
                                                                        01666000
PROCEDURE GETABENTRY(TABDST,INDEX,TABENT);                              01668000
VALUE TABDST,INDEX;                                                     01670000
INTEGER TABDST,INDEX;                                                   01672000
ARRAY TABENT;                                                           01674000
OPTION EXTERNAL;                                                        01676000
                                                                        01678000
PROCEDURE PUTABENTRY(TABDST,INDEX,TABENT);                              01680000
VALUE TABDST,INDEX;                                                     01682000
INTEGER TABDST,INDEX;                                                   01684000
ARRAY TABENT;                                                           01686000
OPTION EXTERNAL;                                                        01688000
                                                                        01690000
PROCEDURE CHECKDISC(LDN,STAT);                                          01692000
VALUE LDN; INTEGER LDN;                                                 01694000
LOGICAL STAT;                                                           01696000
OPTION EXTERNAL;                                                        01698000
                                                               <<01115>>01700000
INTEGER PROCEDURE DISCTYPE(LDEV, LABL);                        <<01115>>01702000
VALUE LDEV;                                                    <<01115>>01704000
INTEGER LDEV;                                                  <<01115>>01706000
ARRAY LABL;                                                    <<01115>>01708000
OPTION EXTERNAL;                                               <<01115>>01710000
                                                                        01712000
LOGICAL PROCEDURE setcritical;                                 <<03510>>01714000
   OPTION EXTERNAL;                                            <<03510>>01716000
                                                               <<03510>>01718000
PROCEDURE resetcritical(i);                                    <<03510>>01720000
   VALUE i;                                                    <<03510>>01722000
   LOGICAL i;                                                  <<03510>>01724000
   OPTION EXTERNAL;                                            <<03510>>01726000
                                                               <<03510>>01728000
LOGICAL PROCEDURE Lock'Dfs'Data'Seg(ldev);                     <<03510>>01730000
   VALUE ldev;                                                 <<03510>>01732000
   INTEGER ldev;                                               <<03510>>01734000
   OPTION EXTERNAL;                                            <<03510>>01736000
                                                               <<03510>>01738000
PROCEDURE Unlock'Dfs'Data'Seg;                                 <<03510>>01740000
   OPTION EXTERNAL;                                            <<03510>>01742000
                                                               <<03510>>01744000
LOGICAL PROCEDURE Scan'Page;                                   <<03510>>01746000
   OPTION EXTERNAL;                                            <<03510>>01748000
                                                               <<03510>>01750000
PROCEDURE Set'Reset'Bit'Map(set'bits);                         <<03510>>01752000
   VALUE set'bits;                                             <<03510>>01754000
   LOGICAL set'bits;                                           <<03510>>01756000
   OPTION EXTERNAL;                                            <<03510>>01758000
                                                               <<03510>>01760000
PROCEDURE Must'Set'Reset'Bit'Map(set'bits);                    <<03510>>01762000
   VALUE set'bits;                                             <<03510>>01764000
   LOGICAL set'bits;                                           <<03510>>01766000
   OPTION EXTERNAL;                                            <<03510>>01768000
                                                               <<03510>>01770000
PROCEDURE Convert'Address'To'Map;                              <<03510>>01772000
   OPTION EXTERNAL;                                            <<03510>>01774000
                                                               <<03510>>01776000
LOGICAL PROCEDURE Get'Page(page);                              <<03510>>01778000
   VALUE page;                                                 <<03510>>01780000
   INTEGER page;                                               <<03510>>01782000
   OPTION EXTERNAL;                                            <<03510>>01784000
                                                               <<03510>>01786000
LOGICAL PROCEDURE Get'Disc'Info(ldev,disc'label,               <<03510>>01788000
                  read'label,dtt,type,subtype,                 <<03510>>01790000
                  disc'size,bit'map'address,                   <<03510>>01792000
                  bit'map'size'pages,dt'address,               <<03510>>01794000
                  dt'size'words,dt'dirty'flag,                 <<03510>>01796000
                  number'of'buffers,dt'check'sum,              <<03510>>01798000
                  sectors'per'track,                           <<03510>>01800000
                  default'logical'pack'size,                   <<03510>>01802000
                  max'logical'pack'size,                       <<03510>>01804000
                  tracks'per'cylinder,                         <<03510>>01806000
                  starting'head'number,trkmult);               <<03510>>01808000
   VALUE ldev,read'label;                                      <<03510>>01810000
   INTEGER ldev;                                               <<03510>>01812000
   ARRAY disc'label;                                           <<03510>>01814000
   LOGICAL read'label;                                         <<03510>>01816000
   INTEGER ARRAY dtt;                                          <<03510>>01818000
   INTEGER type;                                               <<03510>>01820000
   INTEGER subtype;                                            <<03510>>01822000
   DOUBLE disc'size;                                           <<03510>>01824000
   DOUBLE bit'map'address;                                     <<03510>>01826000
   INTEGER bit'map'size'pages;                                 <<03510>>01828000
   DOUBLE dt'address;                                          <<03510>>01830000
   INTEGER dt'size'words;                                      <<03510>>01832000
   LOGICAL dt'dirty'flag;                                      <<03510>>01834000
   INTEGER number'of'buffers;                                  <<03510>>01836000
   LOGICAL dt'check'sum;                                       <<03510>>01838000
   INTEGER sectors'per'track;                                  <<03510>>01840000
   INTEGER default'logical'pack'size;                          <<03510>>01842000
   INTEGER max'logical'pack'size;                              <<03510>>01844000
   INTEGER tracks'per'cylinder;                                <<03510>>01846000
   INTEGER starting'head'number;                               <<03510>>01848000
   INTEGER trkmult;                                            <<03510>>01850000
   OPTION VARIABLE,EXTERNAL;                                   <<03510>>01852000
                                                               <<03510>>01854000
LOGICAL PROCEDURE Read'Disc(ldev,add,dst,target,count);        <<03510>>01856000
   VALUE ldev,add,dst,count;                                   <<03510>>01858000
   INTEGER ldev,dst,count;                                     <<03510>>01860000
   DOUBLE add;                                                 <<03510>>01862000
   ARRAY target;                                               <<03510>>01864000
   OPTION EXTERNAL;                                            <<03510>>01866000
                                                               <<03510>>01868000
LOGICAL PROCEDURE Write'Disc(ldev,add,dst,source,count);       <<03510>>01870000
   VALUE ldev,add,dst,count;                                   <<03510>>01872000
   INTEGER ldev,dst,count;                                     <<03510>>01874000
   DOUBLE add;                                                 <<03510>>01876000
   ARRAY source;                                               <<03510>>01878000
   OPTION EXTERNAL;                                            <<03510>>01880000
                                                               <<03510>>01882000
PROCEDURE Move'From'Data'Seg(dst,offset,count,target);         <<03510>>01884000
   VALUE dst,offset,count;                                     <<03510>>01886000
   INTEGER dst,offset,count;                                   <<03510>>01888000
   ARRAY target;                                               <<03510>>01890000
   OPTION EXTERNAL;                                            <<03510>>01892000
                                                               <<03510>>01894000
INTEGER PROCEDURE Get'Disc'Space(ldev,number'of'sectors,       <<03510>>01896000
                                 disc'address);                <<03510>>01898000
   VALUE ldev,number'of'sectors;                               <<03510>>01900000
   INTEGER ldev;                                               <<03510>>01902000
   DOUBLE number'of'sectors,disc'address;                      <<03510>>01904000
   OPTION EXTERNAL;                                            <<03510>>01906000
                                                               <<03510>>01908000
PROCEDURE Return'Disc'Space(ldev,disc'address,                 <<03510>>01910000
                             number'of'sectors);               <<03510>>01912000
   VALUE ldev,disc'address,number'of'sectors;                  <<03510>>01914000
   INTEGER ldev;                                               <<03510>>01916000
   DOUBLE disc'address,number'of'sectors;                      <<03510>>01918000
   OPTION EXTERNAL;                                            <<03510>>01920000
                                                               <<03510>>01922000
INTEGER PROCEDURE Get'Specific'Disc'Space(ldev,disc'address,   <<03510>>01924000
                      number'of'sectors);                      <<03510>>01926000
   VALUE ldev,disc'address,number'of'sectors;                  <<03510>>01928000
   INTEGER ldev;                                               <<03510>>01930000
   DOUBLE disc'address,number'of'sectors;                      <<03510>>01932000
   OPTION EXTERNAL;                                            <<03510>>01934000
                                                               <<03510>>01936000
PROCEDURE dirwrite(which);                                     <<03510>>01938000
   VALUE which;                                                <<03510>>01940000
   LOGICAL which;                                              <<03510>>01942000
   OPTION EXTERNAL;                                            <<03510>>01944000
                                                               <<03510>>01946000
LOGICAL PROCEDURE Make'Check'Sum(buffer,count);                <<03510>>01948000
   VALUE count;                                                <<03510>>01950000
   ARRAY buffer;                                               <<03510>>01952000
   INTEGER count;                                              <<03510>>01954000
   OPTION EXTERNAL;                                            <<03510>>01956000
                                                               <<03510>>01958000
LOGICAL PROCEDURE Write'Disc'Label(ldev,dst,source);           <<03510>>01960000
   VALUE ldev,dst;                                             <<03510>>01962000
   INTEGER ldev,dst;                                           <<03510>>01964000
   ARRAY source;                                               <<03510>>01966000
   OPTION EXTERNAL;                                            <<03510>>01968000
                                                               <<03510>>01970000
LOGICAL PROCEDURE Create'Dfs'Data'Seg(ldev,disc'label,         <<03510>>01972000
                       assume'dt'is'dirty,flag'dt'as'dirty);   <<03510>>01974000
   VALUE ldev,assume'dt'is'dirty,flag'dt'as'dirty;             <<03510>>01976000
   INTEGER ldev;                                               <<03510>>01978000
   LOGICAL assume'dt'is'dirty;                                 <<03510>>01980000
   LOGICAL flag'dt'as'dirty;                                   <<03510>>01982000
   array disc'label;                                           <<03510>>01984000
   OPTION VARIABLE,EXTERNAL;                                   <<03510>>01986000
                                                               <<03510>>01988000
LOGICAL PROCEDURE Deallocate'Dfs'Data'Seg(ldev);               <<03510>>01990000
   VALUE ldev;                                                 <<03510>>01992000
   INTEGER ldev;                                               <<03510>>01994000
   OPTION EXTERNAL;                                            <<03510>>01996000
                                                               <<03510>>01998000
PROCEDURE Delete'Dfs'Data'Seg(ldev);                           <<03510>>02000000
   VALUE ldev;                                                 <<03510>>02002000
   INTEGER ldev;                                               <<03510>>02004000
   OPTION EXTERNAL;                                            <<03510>>02006000
                                                               <<03510>>02008000
PROCEDURE Process'Dfs'Error(ldev,error'status,                 <<03510>>02010000
                            type'of'error);                    <<03510>>02012000
   VALUE ldev,error'status,type'of'error;                      <<03510>>02014000
   INTEGER ldev;                                               <<03510>>02016000
   LOGICAL error'status;                                       <<03510>>02018000
   INTEGER type'of'error;                                      <<03510>>02020000
   OPTION EXTERNAL;                                            <<03510>>02022000
                                                               <<03510>>02024000
INTEGER PROCEDURE DSTATCOM(REQTYPE,LDEV);                               02026000
VALUE REQTYPE,LDEV;                                                     02028000
INTEGER REQTYPE,LDEV;                                                   02030000
OPTION EXTERNAL;                                                        02032000
                                                                        02034000
DOUBLE PROCEDURE DIRECFIND (TYPE,LINKAGE'INDEXP,ANAME,GUNAME,  <<RV.PV>>02036000
                            FNAME,PRETURN);                    <<RV.PV>>02038000
VALUE TYPE,LINKAGE'INDEXP;                                     <<RV.PV>>02040000
LOGICAL TYPE;                                                  <<RV.PV>>02042000
DOUBLE LINKAGE'INDEXP;                                         <<RV.PV>>02044000
ARRAY ANAME,GUNAME,FNAME,PRETURN;                                       02046000
OPTION EXTERNAL;                                                        02048000
                                                                        02050000
DOUBLE PROCEDURE DIRECSCAN (TYPE,LINKAGE'INDEXP,ANAME,GUNAME,           02052000
                            FNAME,RECIP,PARMS,MVTABX);                  02054000
VALUE TYPE,LINKAGE'INDEXP,MVTABX;                                       02056000
INTEGER TYPE,MVTABX;                                                    02058000
DOUBLE  LINKAGE'INDEXP;                                                 02060000
ARRAY ANAME,GUNAME,FNAME,PARMS;                                         02062000
INTEGER PROCEDURE RECIP;                                                02064000
OPTION EXTERNAL,VARIABLE;                                               02066000
DOUBLE PROCEDURE direcpurgefile(numsects,dummy,an,gn,          <<03510>>02068000
                                fn,mvtabx);                    <<03510>>02070000
   VALUE numsects,dummy,mvtabx;                                <<03510>>02072000
   DOUBLE numsects;                                            <<03510>>02074000
   INTEGER dummy,mvtabx;                                       <<03510>>02076000
   ARRAY an,gn,fn;                                             <<03510>>02078000
   OPTION EXTERNAL,VARIABLE;                                   <<03510>>02080000
                                                               <<03510>>02082000
                                                                        02084000
DOUBLE PROCEDURE VTABINDEX(VID,VSID,LDN,GEN);                           02086000
VALUE LDN;                                                              02088000
BYTE ARRAY VID,VSID;                                                    02090000
INTEGER LDN,GEN;                                                        02092000
OPTION VARIABLE,EXTERNAL;                                               02094000
                                                                        02096000
PROCEDURE DEBUG;                                                        02098000
OPTION EXTERNAL;                                                        02100000
                                                                        02102000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,PARM1,PARM2,                  02104000
   PARM3,PARM4,PARM5,DEST,REPLY,OFFSET,DST,IOTYPE);                     02106000
VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,                   02108000
   DEST,REPLY,OFFSET,DST,IOTYPE;                                        02110000
INTEGER SETNO,MSGNO,DEST,DST;                                           02112000
LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,                02114000
   IOTYPE;                                                              02116000
OPTION VARIABLE,EXTERNAL;                                               02118000
                                                                        02120000
INTEGER PROCEDURE MUSTOPEN (FD,FO,AO,R,D,FM,U,B,N,FS,          <<00239>>02122000
                          NE,I,FC);                            <<00239>>02124000
    VALUE   FO,AO,R,U,B,N,FS,NE,I,FC;                          <<00239>>02126000
    BYTE ARRAY FD,D,FM;                                        <<00239>>02128000
    LOGICAL FO,AO;                                             <<00239>>02130000
    INTEGER R,U,B,N,NE,I,FC;                                   <<00239>>02132000
    DOUBLE  FS;                                                <<00239>>02134000
    OPTION  EXTERNAL,VARIABLE;                                 <<00239>>02136000
                                                               <<00239>>02138000
DOUBLE PROCEDURE DIRECPURGE(TYPE,LINKAGE'INDEXP,ANAME,GUNAME,  <<00239>>02140000
                            FNAME,MVTABX);                     <<00239>>02142000
VALUE TYPE,LINKAGE'INDEXP,MVTABX;                              <<00239>>02144000
LOGICAL TYPE,MVTABX;                                           <<00239>>02146000
DOUBLE LINKAGE'INDEXP;                                         <<00239>>02148000
ARRAY ANAME,GUNAME,FNAME;                                      <<00239>>02150000
OPTION EXTERNAL,VARIABLE;                                      <<00239>>02152000
DOUBLE PROCEDURE WAITFORIO(IOQX);                              <<04670>>02154000
   VALUE IOQX;                                                 <<04670>>02156000
   INTEGER IOQX;                                               <<04670>>02158000
   OPTION EXTERNAL;                                            <<04670>>02160000
                                                               <<04670>>02162000
INTEGER PROCEDURE GETDATASEG(MEMSIZE,VDSIZE);                  <<04670>>02164000
   VALUE MEMSIZE,VDSIZE;                                       <<04670>>02166000
   INTEGER MEMSIZE,VDSIZE;                                     <<04670>>02168000
   OPTION EXTERNAL;                                            <<04670>>02170000
                                                               <<04670>>02172000
PROCEDURE RELDATASEG(IX);                                      <<04670>>02174000
   VALUE IX;                                                   <<04670>>02176000
   INTEGER IX;                                                 <<04670>>02178000
   OPTION EXTERNAL;                                            <<04670>>02180000
                                                               <<04670>>02182000
DOUBLE PROCEDURE CONVERT'MAP'TO'ADDRESS;                       <<04670>>02184000
   OPTION EXTERNAL;                                            <<04670>>02186000
                                                               <<04670>>02188000
INTRINSIC WHO,READ,PRINT,ASCII,BINARY,DASCII,CALENDAR,MYCOMMAND,        02190000
     RESETCONTROL,DBINARY,                                     <<DE>>   02192000
     CTRANSLATE,                                               <<03712>>02194000
     TERMINATE,PRINTFILEINFO,FCLOSE,XCONTRAP;                  <<01599>>02196000
                                                               <<RK.08>>02198000
PROCEDURE EOF;                                                 <<RK.08>>02200000
OPTION FORWARD;                                                <<RK.08>>02202000
                                                               <<03510>>02204000
LOGICAL PROCEDURE initdfsm(ldev,mv,dirsz,diradr,vlab);         <<03510>>02206000
   VALUE ldev,mv,dirsz;                                        <<03510>>02208000
   LOGICAL mv;                                                 <<03510>>02210000
   INTEGER ldev,dirsz;                                         <<03510>>02212000
   DOUBLE diradr;                                              <<03510>>02214000
   ARRAY vlab;                                                 <<03510>>02216000
   OPTION FORWARD;                                             <<03510>>02218000
                                                               <<03510>>02220000
PROCEDURE condense'disc(ldev,recover);                         <<03510>>02222000
   VALUE ldev,recover;                                         <<03510>>02224000
   INTEGER ldev;                                               <<03510>>02226000
   LOGICAL recover;                                            <<03510>>02228000
   OPTION FORWARD;                                             <<03510>>02230000
                                                               <<03510>>02232000
PROCEDURE pfentries(listfn,ldev);                              <<03510>>02234000
   VALUE listfn,ldev;                                          <<03510>>02236000
   INTEGER listfn,ldev;                                        <<03510>>02238000
   OPTION forward;                                             <<03510>>02240000
                                                               <<03510>>02242000
PROCEDURE pfre(fn,all,which'ldev);                             <<03510>>02244000
   VALUE fn,all,which'ldev;                                    <<03510>>02246000
   INTEGER fn,which'ldev;                                      <<03510>>02248000
   LOGICAL all;                                                <<03510>>02250000
   OPTION FORWARD;                                             <<03510>>02252000
                                                               <<03510>>02254000
LOGICAL PROCEDURE Is'It'Cartridge(Ldev);                       <<*8114>>02256000
VALUE   Ldev;                                                  <<03537>>02258000
INTEGER Ldev;                                                  <<03537>>02260000
OPTION FORWARD;                                                <<03537>>02262000
                                                               <<03537>>02264000
INTEGER PROCEDURE Cartridge'Io(Ldev,Qmisc,Buf,Funct,Wc,Addr,   <<*8114>>02266000
                               Flags,Spare'Mode,Errinfo,       <<*8114>>02268000
                               Err'Return);                    <<*8114>>02270000
VALUE Ldev,Funct,Wc,Addr,Flags,Spare'Mode,Errinfo;             <<03537>>02272000
INTEGER Ldev,Qmisc,Funct,Wc,Flags;                             <<03537>>02274000
LOGICAL Spare'Mode,Errinfo,Err'return;                         <<03537>>02276000
DOUBLE Addr;                                                   <<03537>>02278000
ARRAY Buf;                                                     <<03537>>02280000
OPTION FORWARD;                                                <<03537>>02282000
                                                               <<03537>>02284000
PROCEDURE Lock(Ldev);                                          <<03537>>02286000
VALUE Ldev;                                                    <<03537>>02288000
INTEGER Ldev;                                                  <<03537>>02290000
OPTION FORWARD;                                                <<03537>>02292000
                                                               <<03537>>02294000
PROCEDURE Unlock(Ldev);                                        <<03537>>02296000
VALUE Ldev;                                                    <<03537>>02298000
INTEGER Ldev;                                                  <<03537>>02300000
OPTION FORWARD;                                                <<03537>>02302000
                                                               <<03537>>02304000
PROCEDURE Disable'Break;                                       <<03537>>02306000
OPTION FORWARD;                                                <<03537>>02308000
                                                               <<03537>>02310000
PROCEDURE Enable'Break;                                        <<03537>>02312000
OPTION FORWARD;                                                <<03537>>02314000
                                                               <<03537>>02316000
LOGICAL PROCEDURE Cartridge'Numbers(Ldev,Buffer);              <<*8114>>02318000
VALUE Ldev;                                                    <<03537>>02320000
INTEGER Ldev;                                                  <<03537>>02322000
ARRAY Buffer;                                                  <<03537>>02324000
OPTION FORWARD;                                                <<03537>>02326000
                                                               <<03537>>02328000
PROCEDURE Format'A'Cartridge(Ldev,Spares,Interleave);          <<*8114>>02330000
Value Ldev,Spares,Interleave;                                  <<03537>>02332000
Integer Ldev,Spares,Interleave;                                <<03537>>02334000
OPTION FORWARD;                                                <<03537>>02336000
                                                               <<03537>>02338000
PROCEDURE Format'Msg(Spares);                                  <<03537>>02340000
VALUE Spares;                                                  <<03537>>02342000
INTEGER Spares;                                                <<03537>>02344000
OPTION FORWARD;                                                <<03537>>02346000
                                                               <<03537>>02348000
PROCEDURE Print'Cartridge'Spares(Ldev);                        <<*8114>>02350000
VALUE Ldev;                                                    <<03583>>02352000
INTEGER Ldev;                                                  <<03583>>02354000
OPTION FORWARD;                                                <<03583>>02356000
                                                               <<03583>>02358000
PROCEDURE Print'CS'80'Spares(Ldev);                            <<03583>>02360000
VALUE Ldev;                                                    <<03583>>02362000
INTEGER Ldev;                                                  <<03583>>02364000
OPTION FORWARD;                                                <<03583>>02366000
                                                               <<03583>>02368000
                                                                        02370000
INTRINSIC FOPEN,FCHECK,FWRITE,QUIT,FCONTROL;                   <<RK3PV>>02372000
INTRINSIC print'file'info;                                     <<03510>>02374000
                                                                        02376000
$PAGE "PVINIT - UTILITY PROCEDURES"                                     02378000
PROCEDURE controly;                                            <<03510>>02380000
BEGIN                                                                   02382000
                                                                        02384000
<<===================================================                   02386000
                                                                        02388000
     Procedure to handle control - y.                                   02390000
                                                                        02392000
   Parameters:                                                          02394000
      None.                                                             02396000
                                                                        02398000
   Assumptions:                                                         02400000
          this is only called for pfentries                             02402000
          DB may be at the stack or at DFSM DFST                        02404000
                                                                        02406000
   Globals:                                                             02408000
         sets req'brk to true                                           02410000
                                                                        02412000
   Externals:                                                           02414000
         Exchangedb                                                     02416000
                                                                        02418000
   Intrinsics:                                                          02420000
         None.                                                          02422000
                                                                        02424000
   Callers:                                                             02426000
         pfentries                                                      02428000
                                                                        02430000
   Fixid:                                                               02432000
         This fix was add as part of the new disc free space map,       02434000
       the fix i.d. on procedure header applies to the whole            02436000
       procedure.                                                       02438000
                                                                        02440000
   Changes:                                                             02442000
                                                                        02444000
====================================================>>                  02446000
                                                                        02448000
   INTEGER     sdec = Q+1;                                              02450000
   INTEGER     dst = sdec+1;                                            02452000
                                                                        02454000
   << set db back to stack, it may already be at the stack >>           02456000
                                                                        02458000
   dst:=exchangedb(0);                                                  02460000
                                                                        02462000
   req'brk:=true;                                                       02464000
   resetcontrol;                                                        02466000
                                                                        02468000
   exchangedb(dst);                                                     02470000
                                                                        02472000
   << DB set back to wherever it was before >>                          02474000
                                                                        02476000
   TOS:=%31400 + sdec;                                                  02478000
                                                                        02480000
   ASSEMBLE(xeq 0);                                                     02482000
                                                                        02484000
END;   << controly >>                                                   02486000
                                                               <<01599>>02488000
                                                                        02490000
PROCEDURE SPACE(SKIP);                                                  02492000
VALUE SKIP; INTEGER SKIP;                                               02494000
OPTION PRIVILEGED,UNCALLABLE;                                           02496000
BEGIN                                                                   02498000
     INTEGER I;                                                         02500000
     ARRAY BLANK(0:1);                                         <<RK.08>>02502000
                                                                        02504000
     BLANK:="  ";                                              <<RK.08>>02506000
     FOR I:=1 UNTIL SKIP DO FWRITE(OUTF,BLANK,-1,0);                    02508000
END  << SPACE >>;                                                       02510000
                                                               <<00239>>02512000
PROCEDURE PRINTLDEV(LDEV);                                     <<00239>>02514000
VALUE LDEV;                                                    <<00239>>02516000
INTEGER LDEV;                                                  <<00239>>02518000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>02520000
                                                               <<00239>>02522000
BEGIN                                                          <<00239>>02524000
   ARRAY TEMP(0:5);                                            <<00239>>02526000
   BYTE ARRAY BTEMP(*) = TEMP;                                 <<00239>>02528000
   INTEGER L;                                                  <<00239>>02530000
   MOVE BTEMP := "LDEV: ";                                     <<00239>>02532000
   L := ASCII(LDEV,10,BTEMP(6));                               <<00239>>02534000
   FWRITE(OUTF,TEMP,0,0);                                      <<00239>>02536000
   FWRITE(OUTF,TEMP,-(L+6),0);                                 <<00239>>02538000
END;                                                           <<00239>>02540000
                                                                        02542000
PROCEDURE DEVERROR(DEV,STATUS);                                         02544000
VALUE DEV,STATUS;                                                       02546000
INTEGER DEV;                                                            02548000
LOGICAL STATUS;                                                         02550000
OPTION PRIVILEGED,UNCALLABLE;                                           02552000
BEGIN                                                                   02554000
     INTEGER ERRNUM:=0;                                                 02556000
                                                                        02558000
     WHILE NOT STATUS DO  <<LOOK FOR FIRST ERROR BIT>>                  02560000
     BEGIN                                                              02562000
          ERRNUM:=ERRNUM+1;                                             02564000
          STATUS:=STATUS & LSR(1);                                      02566000
     END;                                                               02568000
     IF ERRNUM=12 THEN INAPPROPRIATE                           <<01115>>02570000
       ELSE GENMSG(PVMSGSET,(ERRNUM+DEVERRMSG),%10000,DEV);    <<01115>>02572000
END  << DEVERROR >>;                                                    02574000
                                                                        02576000
PROCEDURE DATECONV(DATE,BUF);                                           02578000
VALUE DATE;                                                             02580000
INTEGER DATE;                                                           02582000
BYTE ARRAY BUF;                                                         02584000
OPTION PRIVILEGED,UNCALLABLE;                                           02586000
BEGIN                                                                   02588000
     INTEGER M,D,Y;                                                     02590000
     INTEGER ARRAY DTAB(0:11)=PB:=                                      02592000
            0,  31,  59,  90, 120, 151, 181,                            02594000
          212, 243, 273, 304, 334;                                      02596000
                                                                        02598000
     MOVE BUF:="  /  /  ";                                              02600000
     Y:=DATE.(0:7);  <<YEAR>>                                           02602000
     D:=DATE.(7:9);  <<DAY >>                                           02604000
     IF Y.(14:2) = 0 AND D >= 60 THEN D:=D-1;  <<LEAP YEAR>>            02606000
     M:=12;  <<ASSUME DECEMBER>>                                        02608000
     DO M:=M-1 UNTIL DTAB(M) < D;  <<FIND CORRECT MONTH>>               02610000
     D:=D-DTAB(M);  <<DAY OF THE MONTH>>                                02612000
     M:=M+1;  <<FIX MONTH FOR OUTPUT PURPOSES>>                         02614000
     ASCII(M,-10,BUF(1));  <<MONTH>>                                    02616000
     ASCII(D,-10,BUF(4));  <<DAY  >>                                    02618000
     ASCII(Y,-10,BUF(7));  <<YEAR >>                                    02620000
END << DATECONV >>;                                                     02622000
                                                                        02624000
$PAGE "PROCEDURE DISCERROR"                                    <<03537>>02626000
PROCEDURE DISCERROR(LDN,FNCT,IOSTAT,ADDR,SEG,OFFSET);          <<RK.08>>02628000
VALUE LDN,FNCT,IOSTAT,ADDR,SEG,OFFSET;                         <<RK.08>>02630000
INTEGER LDN,FNCT,SEG,OFFSET;                                   <<RK.08>>02632000
LOGICAL IOSTAT;                                                         02634000
DOUBLE ADDR;                                                            02636000
OPTION PRIVILEGED,UNCALLABLE;                                           02638000
BEGIN                                                                   02640000
     INTEGER LEN,LOC;                                                   02642000
                                                               <<RK.08>>02644000
     BYTE ARRAY TEMP(0:13);                                             02646000
                                                                        02648000
     Msgw := "  ";                                             <<03537>>02650000
     MOVE Msgw(1) := Msgw,(35);                                <<03537>>02652000
     Len := Loc := 0;                                          <<03537>>02654000
     IF Is'It'Cartridge(Ldn) THEN                              <<*8114>>02656000
        MOVE Msg := "CARTRIDGE ",2                             <<03537>>02658000
     ELSE                                                      <<03537>>02660000
     MOVE MSG:="DISC ",2;                                               02662000
     CASE FNCT OF                                              <<03537>>02664000
     BEGIN                                                              02666000
          MOVE * :="READ",2;                                            02668000
          MOVE * :="WRITE",2;                                           02670000
          ; <<2>>                                              <<RK1PV>>02672000
          ; <<3>>                                              <<RK1PV>>02674000
          ; <<4>>                                              <<RK1PV>>02676000
          ; <<5>>                                              <<RK1PV>>02678000
          ; <<6>>                                              <<RK1PV>>02680000
          MOVE * :="REQUEST STATUS",2;                         <<03537>>02682000
          MOVE * :="FORMAT",2;                                 <<RK1PV>>02684000
          MOVE * :="INITIALIZE",2;                             <<RK1PV>>02686000
          MOVE * :="READ FULL SECTOR",2;                       <<RK1PV>>02688000
          MOVE * :="WRITE LABEL",2;                            <<RK1PV>>02690000
          MOVE * :="READ SPARE DISABLE",2;                     <<RK1PV>>02692000
          MOVE * :="FIND PHYS. ADDR./REQ. VOL. LIMIT",2;       <<03537>>02694000
          MOVE * :="VERIFY",2;                                 <<03537>>02696000
          ; <<15>>                                             <<03537>>02698000
          MOVE * := "LOCK",2;                                  <<03537>>02700000
          MOVE * := "UNLOCK",2;                                <<03537>>02702000
     END;                                                               02704000
     IF FNCT = SPARE'BLOCK THEN                                <<03537>>02706000
       MOVE * := "SECTOR SPARING",2;                           <<03537>>02708000
     IF FNCT = Initiate'Utility THEN                           <<03583>>02710000
       MOVE * := "INITIATE UTILITY",2;                         <<03537>>02712000
     MOVE * :=" ERROR ON LDEV# ",2;                                     02714000
     LOC:=TOS-@MSG;                                                     02716000
     LOC:=LOC+ASCII(LDN,10,MSG(LOC));                                   02718000
     PRINT(Msgw,-Loc,0);                                       <<03537>>02720000
     Msgw := "  ";                                             <<03537>>02722000
     MOVE Msgw(1) := Msgw,(35);                                <<03537>>02724000
     MOVE Msg := "STATUS=%",2;                                 <<03537>>02726000
     LEN:=ASCII(IOSTAT.TSTATUS,8,TEMP);                                 02728000
     MOVE * :=TEMP(6-LEN),(LEN),2;                                      02730000
     MOVE * :=", ADDRESS=%",2;                                          02732000
     LEN:=DASCII(ADDR,8,TEMP);                                          02734000
     MOVE * :=TEMP(11-LEN),(LEN),2;                                     02736000
     MOVE * := " SEGMENT:%",2;                                 <<00092>>02738000
     LEN:=ASCII(SEG,8,TEMP);                                   <<RK.08>>02740000
     MOVE * := TEMP(6-LEN),(LEN),2;                            <<00092>>02742000
     MOVE * := " OFFSET:%",2;                                  <<00092>>02744000
     LEN:=ASCII(OFFSET,8,TEMP);                                <<00092>>02746000
     MOVE * := TEMP(6-LEN),(LEN),2;                            <<00092>>02748000
     LEN:=TOS-@MSG;                                                     02750000
     PRINT(MSGW,-LEN,0);                                       <<RK.08>>02752000
END << DISCERROR >>;                                                    02754000
$PAGE "PROCEDURE DISCIO"                                       <<04670>>02756000
INTEGER PROCEDURE DISCIO(LDEV,FUNCT,BUF,ADDR,WC,ERRINFO,DSTX); <<04670>>02758000
VALUE LDEV,FUNCT,ADDR,WC,DSTX;                                 <<04670>>02760000
INTEGER LDEV,FUNCT,WC,DSTX;                                    <<04670>>02762000
LOGICAL ERRINFO;                                                        02764000
DOUBLE ADDR;                                                            02766000
ARRAY BUF;                                                              02768000
OPTION VARIABLE;                                                        02770000
OPTION PRIVILEGED,UNCALLABLE;                                           02772000
BEGIN                                                                   02774000
     <<ERRINFO:                                                         02776000
          INPUT - FLAGS FOR ERROR HANDLING                              02778000
                  (15:1) = 0 - OMIT DISC ERROR MESSAGE                  02780000
                           1 - PRINT DISC ERROR MESSAGE.                02782000
                  (14:1) = 0 - DON'T RETURN ERROR STATUS                02784000
                         = 1 - RETURN ERROR TO CALLER.                  02786000
                  (13:1) = 0 - OMIT FUNCTION ABORT MESSAGE              02788000
                           1 - PRINT FUNCTION ABORT MESSAGE             02790000
     >>                                                                 02792000
     LOGICAL PMAP = Q-4;                                                02794000
     LOGICAL IOSTAT,ERRFLAGS;                                           02796000
     INTEGER                                                            02798000
          ADDR1 = ADDR,                                                 02800000
          ADDR2 = ADDR+1;                                               02802000
     INTEGER POINTER BUFP = BUF;                                        02804000
     INTEGER DST,FL;                                           <<04670>>02806000
                                                                        02808000
     CC:=CCE;                                                           02810000
     ERRFLAGS := IF PMAP.(14:1) THEN ERRINFO ELSE 5;           <<04670>>02812000
     DST := IF PMAP THEN DSTX ELSE 0;                          <<04670>>02814000
     IF LPDT'DEV'OWN'STATE = LPDT'OWNED AND                    <<06276>>02816000
        LPDT'SERIAL'OR'FOREIGN = LPDT'SERIAL THEN              <<06276>>02818000
        FL := 41                                               <<06276>>02820000
     ELSE                                                      <<06276>>02822000
        FL := 1;                                               <<06276>>02824000
     IF PMAP.(14:1) AND ERRINFO.(7:1) THEN FL.(15:1) := 0;     <<04670>>02826000
     IF FUNCT = INIT'UTIL AND (ADDR=RW'ERT OR ADDR=RO'ERT) THEN<<03620>>02828000
     << THIS FUNCTION IS ONLY VALID FOR CS'80 DISCS    >>      <<03620>>02830000
     << TO PERFORM INITIATE UTILITY FUNCTION DISC DRIVE>>      <<03620>>02832000
     << MUST HAVE SET SECTOR ADDRESS (BUF-PARAMETER)   >>      <<03620>>02834000
     << CS'80 SPARE SECTORS PROCEDURE USES TWO         >>      <<03620>>02836000
     << FOLLOWING FUNCTIONS :                          >>      <<03620>>02838000
     << READ/WRITE ERROR TEST ON SECTOR (WC=0) OR      >>      <<03620>>02840000
     << TRACK (WC=1) - RW'ERT (P1=2,P2=%310),          >>      <<03620>>02842000
     << READ ONLY ERROR TEST - RO'ERT (P1=2,P2=%311)   >>      <<03620>>02844000
     BEGIN                                                     <<03620>>02846000
     TOS:=ATTACHIO(LDEV,0,0,@BUFP,SET'ADDR'SEC,0,0,0,FL);      <<03620>>02848000
     DELETE;                                                   <<03620>>02850000
     IOSTAT:=TOS;                                              <<03620>>02852000
     IF IOSTAT.GSTATUS <> SUCCESSFUL THEN GOTO ERR;            <<03620>>02854000
     << SET PARAMETERS FOR INITIATE UTILITY FUNCTION   >>      <<03620>>02856000
     IF ADDR=RO'ERT THEN PBUFW := 4 ELSE PBUFW := 5;<<#OF ARG>><<03620>>02858000
     PBUF(2) := 5;   << # OF LOOPS >>                          <<03620>>02860000
     PBUF(3) := 0;   << OFFSET >>                              <<03620>>02862000
     PBUF(4) := 0;   << REPORT - 10 BYTES INFO >>              <<03620>>02864000
     PBUF(5) := WC;  << 0 - SECTOR, 1 - TRACK >>               <<03620>>02866000
     PBUF(6) := 0;   << DATA SOURCE - INTERNAL PATTERN >>      <<03620>>02868000
     WC := -20;      << BUFFER SIZE >>                         <<03620>>02870000
     @BUFP := @PBUFW;                                          <<03620>>02872000
     END;                                                      <<03620>>02874000
                                                               <<03620>>02876000
     TOS:=ATTACHIO(LDEV,0,DST,@BUFP,FUNCT,WC,ADDR1,ADDR2,FL);  <<04670>>02878000
     DISCIO := TOS;                                            <<04670>>02880000
     IOSTAT:=TOS;                                                       02882000
     IF <> THEN                                                <<04670>>02884000
     BEGIN                                                     <<04670>>02886000
     IF IOSTAT.GSTATUS <> SUCCESSFUL THEN  <<UNSUCESSFUL I/O>>          02888000
ERR:                                                           <<03620>>02890000
     BEGIN                                                              02892000
          CC:=CCL;                                                      02894000
          IF ERRFLAGS THEN DISCERROR(LDEV,FUNCT,IOSTAT,ADDR,   <<01115>>02896000
                                     STAT.(8:8),DELP);         <<RK.08>>02898000
          IF ERRFLAGS.(13:1) THEN GENMSG(PVMSGSET,VIERR0);              02900000
     END;                                                               02902000
     END;                                                      <<04670>>02904000
     IF ERRFLAGS.(14:1) THEN ERRINFO:=IOSTAT;                           02906000
END << DISCIO >>;                                                       02908000
                                                                        02910000
LOGICAL PROCEDURE DLIO (LDEV,FUNCT,BUF,ADDR,WC,IOSTAT);        <<04670>>02912000
VALUE LDEV,FUNCT,ADDR,WC;                                      <<04670>>02914000
INTEGER LDEV,FUNCT,WC;                                         <<04670>>02916000
LOGICAL IOSTAT;                                                <<04670>>02918000
DOUBLE ADDR;                                                   <<04670>>02920000
ARRAY BUF;                                                     <<04670>>02922000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>02924000
                                                               <<04670>>02926000
BEGIN                                                          <<04670>>02928000
INTEGER QMISC := 0;                                            <<04670>>02930000
IF CARTRIDGE THEN                                              <<*8114>>02932000
   CARTRIDGE'IO (LDEV,QMISC,BUF,FUNCT,WC,ADDR,BLOCKED'IO,      <<*8114>>02934000
                 NO'SPARING,IOSTAT,IOSTAT)                     <<*8114>>02936000
ELSE                                                           <<04670>>02938000
   DISCIO (LDEV,FUNCT,BUF,ADDR,WC,IOSTAT);                     <<04670>>02940000
DLIO := IF = THEN TRUE ELSE FALSE;                             <<04670>>02942000
END;                                                           <<04670>>02944000
$PAGE "PROCEDURE UNREADABLE'LABEL"                             <<03537>>02946000
LOGICAL PROCEDURE UNREADABLE'LABEL(LDN,OK);                    <<00239>>02948000
VALUE LDN,OK;                                                  <<00239>>02950000
INTEGER LDN;                                                   <<00239>>02952000
LOGICAL OK;                                                    <<00239>>02954000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>02956000
BEGIN                                                          <<00239>>02958000
   ARRAY Temp(0 : Cartridge'Sector - 1);                       <<*8114>>02960000
   INTEGER IOSTATUS;                                           <<03537>>02962000
   LOGICAL L'Iostatus = Iostatus;                              <<03537>>02964000
   INTEGER Qmisc := 0;                                         <<03537>>02966000
                                                               <<00239>>02968000
   IOSTATUS := 2; << RETURN ERROR >>                           <<00239>>02970000
   Unreadable'Label := FALSE;                                  <<03537>>02972000
                                                               <<03537>>02974000
   IF Is'It'Cartridge(Ldn) THEN                                <<*8114>>02976000
   BEGIN                                                       <<03537>>02978000
      Cartridge'Io(Ldn,Qmisc,Temp,R,Cartridge'Sector,          <<*8114>>02980000
                   Disc'Label'Address,Blocked'IO,NO'SPARING,   <<*8114>>02982000
                   L'Iostatus,L'Iostatus);                     <<*8114>>02984000
   END                                                         <<03537>>02986000
   ELSE                                                        <<03537>>02988000
      DISCIO(LDN,R,TEMP,0D,128,IOSTATUS);                      <<03537>>02990000
   IF IOSTATUS.TSTATUS = SUCCESSFUL THEN RETURN;               <<00239>>02992000
   UNREADABLE'LABEL := TRUE;                                   <<00239>>02994000
   GENMSG(PVMSGSET,VIWARN10,%10000,LDN);                       <<00239>>02996000
   IF NOT OK THEN GENMSG(PVMSGSET,VIERR0);                     <<00239>>02998000
END;                                                           <<00239>>03000000
                                                               <<00239>>03002000
$PAGE "PROCEDURE SCRATCHVOL"                                   <<03537>>03004000
LOGICAL PROCEDURE SCRATCHVOL(LDN);                                      03006000
VALUE LDN; INTEGER LDN;                                                 03008000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>03010000
BEGIN                                                                   03012000
     ARRAY VLAB(*) = BUFF;                                              03014000
     BYTE ARRAY VLABB(*) = BUFF;                               <<00145>>03016000
     INTEGER Qmisc := 0;                                       <<03537>>03018000
     LOGICAL Dummy;                                            <<03537>>03020000
                                                                        03022000
     CC := CCE;                                                <<00239>>03024000
     IF Is'It'Cartridge(Ldn) THEN                              <<*8114>>03026000
     BEGIN                                                     <<03537>>03028000
        Cartridge'Io(Ldn,Qmisc,Vlab,R,Cartridge'Sector,        <<*8114>>03030000
                     Disc'Label'Address,Blocked'IO,NO'SPARING, <<*8114>>03032000
                     Default'Errinfo,Dummy);                   <<*8114>>03034000
     END                                                       <<03537>>03036000
     ELSE                                                      <<03537>>03038000
        DISCIO(LDN,R,VLAB,0D,128);                             <<03537>>03040000
     IF < THEN  <<DISC I/O ERROR>>                                      03042000
     BEGIN                                                              03044000
          CC:=CCL;                                                      03046000
          RETURN;                                                       03048000
     END;                                                               03050000
     SCRATCHVOL := DISCTYPE(LDN,VLAB)=3;                       <<01115>>03052000
END << SCRATCHVOL>>;                                                    03054000
                                                               <<RK.08>>03056000
LOGICAL PROCEDURE OVERWRITE(LDEV,MESSAGE);                     <<RK.08>>03058000
VALUE LDEV,MESSAGE;                                            <<RK.08>>03060000
INTEGER LDEV,MESSAGE;                                          <<RK.08>>03062000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>03064000
BEGIN                                                          <<RK.08>>03066000
                                                               <<01115>>03068000
   COMMENT                                                     <<01115>>03070000
                                                               <<01115>>03072000
       THIS PROCEDURE DETERMINES WHETHER IT IS OK TO OVERWRITE <<01115>>03074000
       A DISC VOLUME.  IF THE VOLUME IS NOT SCRATCH, IT ASKS   <<01115>>03076000
       FOR CONFIRMATION FROM THE USER.                         <<01115>>03078000
                                                               <<01115>>03080000
       ;                                                       <<01115>>03082000
                                                               <<01115>>03084000
   ARRAY VLAB(*) = BUFF;                                       <<RK.08>>03086000
   BYTE ARRAY VLABB(*) = BUFF;                                 <<RK.08>>03088000
   INTEGER SIZE := 0;                                          <<RK.08>>03090000
   BYTE ARRAY BA(0:39);                                        <<RK.08>>03092000
   BYTE ARRAY NAME(*) = BA;                                    <<RK.08>>03094000
   BYTE ARRAY VOLUMESET(*) = BA(10);                           <<RK.08>>03096000
   BYTE ARRAY GROUP(*) = BA(20);                               <<RK.08>>03098000
   BYTE ARRAY ACCOUNT(*) = BA(30);                             <<RK.08>>03100000
   EQUATE IBM'FLOPPY = %10;                                    <<04131>>03102000
                                                               <<RK.08>>03104000
   TOS := SCRATCHVOL(LDEV);                                    <<RK.08>>03106000
   IF < THEN RETURN; <<DISC ERROR - WILL BE FALSE>>            <<RK.08>>03108000
   IF TOS THEN                                                 <<RK.08>>03110000
      BEGIN                                                    <<RK.08>>03112000
      OVERWRITE := TRUE;                                       <<RK.08>>03114000
      RETURN;                                                  <<RK.08>>03116000
      END;                                                     <<RK.08>>03118000
   MOVE BA := 20("  ");                                        <<RK.08>>03120000
   MOVE NAME      := VLABB(LVNAMELOC),(8);                     <<RK.08>>03122000
   MOVE VOLUMESET := VLABB(LVOLDIRLOC),(8);                    <<RK.08>>03124000
   MOVE GROUP     := VLABB(LVSGROUPLOC),(8);                   <<RK.08>>03126000
   MOVE ACCOUNT   := VLABB(LVSACCNTLOC),(8);                   <<RK.08>>03128000
   WHILE SIZE = 0 DO                                           <<RK.08>>03130000
      BEGIN                                                    <<RK.08>>03132000
      TOS := @PBUF;                                            <<RK.08>>03134000
      CASE DISCTYPE(LDEV, VLAB) OF                             <<01115>>03136000
         BEGIN                                                 <<01115>>03138000
           BEGIN  <<CASE 0 -- SYSTEM VOLUME>>                  <<01115>>03140000
             MOVE * := "A FORMER SYSTEM VOLUME ",2;            <<01115>>03142000
             MOVE * := NAME WHILE AN,1;                        <<01115>>03144000
             GO TO GENERATION;                                 <<01115>>03146000
           END;                                                <<01115>>03148000
           BEGIN  <<CASE 1 -- PRIVATE VOLUME>>                 <<01115>>03150000
             MOVE * := NAME WHILE AN,1;                        <<01115>>03152000
             MOVE * := " OF ",2;                               <<01115>>03154000
             MOVE * := VOLUMESET WHILE AN,1;                   <<01115>>03156000
             MOVE * := ".",2;                                  <<01115>>03158000
             MOVE * := GROUP WHILE AN,1;                       <<01115>>03160000
             MOVE * := ".",2;                                  <<01115>>03162000
             MOVE * := ACCOUNT WHILE AN,1;                     <<01115>>03164000
             GO GENERATION;                                    <<01115>>03166000
           END;                                                <<01115>>03168000
           BEGIN <<CASE 2 -- SERIAL>>                          <<01115>>03170000
             MOVE * := "A SERIAL DISC ",2;                     <<01115>>03172000
GENERATION:  MOVE * := " WITH GENERATION = ",2;                <<01115>>03174000
             SIZE := TOS-@PBUF;                                <<01115>>03176000
             SIZE := SIZE+ASCII(VLAB(LGENINDEX),10,PBUF(SIZE));<<01115>>03178000
           END;                                                <<01115>>03180000
                 <<CASE 3 -- SCRATCH>>                         <<01115>>03182000
           ;     <<NOT USED>>                                  <<01115>>03184000
           BEGIN <<CASE 4 -- FOREIGN>>                         <<01115>>03186000
             MOVE * := "A FOREIGN DISC ",2;                    <<01115>>03188000
             TOS := REQSTATUS(LDEV);                           <<04131>>03190000
             ASSEMBLE(DELB);                                   <<04131>>03192000
             IF TOS.(3:4)=IBM'FLOPPY THEN                      <<04131>>03194000
                MOVE * := "(IBM DISKETTE) ",2;                 <<04131>>03196000
             SIZE := TOS-@PBUF;                                <<01115>>03198000
           END;                                                <<01115>>03200000
         END;   <<OF CASE ON DISCTYPE>>                        <<01115>>03202000
      PRINT(PBUFW,-SIZE,0);                                    <<RK.08>>03204000
      TOS := @PBUF;                                            <<RK.08>>03206000
      MOVE * := " TO BE ",2;                                   <<RK.08>>03208000
      CASE MESSAGE OF                                          <<RK.08>>03210000
         BEGIN                                                 <<RK.08>>03212000
         MOVE * := "OVERWRITTEN ?",2;                          <<RK.08>>03214000
         MOVE * := "INITIALIZED ?",2;                          <<RK.08>>03216000
         MOVE * := "FORMATTED ?",2;                            <<RK.08>>03218000
         MOVE * := "MADE SCRATCH ?",2;                         <<RK.08>>03220000
         MOVE * := "COPIED TO ?",2;                            <<RK.08>>03222000
         MOVE * := "MADE SERIAL ?",2;                          <<RK.08>>03224000
         MOVE * := "MADE FOREIGN ?",2;                         <<01115>>03226000
         END; << OF CASE >>                                    <<RK.08>>03228000
      MOVE * := " (Y/N) ",2;                                   <<RK.08>>03230000
      SIZE := TOS - @PBUF;                                     <<RK.08>>03232000
      PRINT(PBUFW,-SIZE,%320);                                 <<RK.08>>03234000
      SIZE := READ(RBUFW,-4);                                  <<RK.08>>03236000
      IF <> THEN EOF;                                          <<RK.08>>03238000
      IF SIZE <> 0 THEN                                        <<RK.08>>03240000
         IF RBUF = "Y" OR RBUF = "y" THEN OVERWRITE := TRUE    <<00092>>03242000
         ELSE IF RBUF = "N" OR RBUF = "n" THEN RETURN          <<00092>>03244000
         ELSE SIZE := 0;                                       <<RK.08>>03246000
      END; << OF SIZE <> 0 >>                                  <<RK.08>>03248000
END; << OF OVERWRITE >>                                        <<RK.08>>03250000
                                                               <<RK.08>>03252000
$PAGE " PROCEDURE VOLUME'MOUNTED"                              <<04670>>03254000
LOGICAL PROCEDURE VOLUME'MOUNTED (LDEV,VOL'INDEX,MVTAB'INDEX,  <<04670>>03256000
                                  VOL'SET'LDEV);               <<04670>>03258000
VALUE LDEV;                                                    <<04670>>03260000
LOGICAL LDEV;                                                  <<04670>>03262000
INTEGER VOL'INDEX,MVTAB'INDEX;                                 <<04670>>03264000
INTEGER ARRAY VOL'SET'LDEV;                                    <<04670>>03266000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<04670>>03268000
                                                               <<04670>>03270000
<<This procedure checks if private or system volume is      >> <<04670>>03272000
<<mounted. Additionaly returns volume index, MVTAB index and>> <<04670>>03274000
<<volume logical device set. The volume logical device table>> <<04670>>03276000
<<has 16 entries. Non zero entry indicates valid LDEV.      >> <<04670>>03278000
                                                               <<04670>>03280000
BEGIN                                                          <<04670>>03282000
INTEGER MSGNUM,MVTABX,I,OFFSET,COND'INDEX,VOLUME'COUNT;        <<04670>>03284000
ARRAY VSID(0:11);                                              <<04670>>03286000
ARRAY VLAB(0:SECSIZE);                                         <<04670>>03288000
ARRAY VSDEFN (*) = VLAB;                                       <<04670>>03290000
ARRAY MVTABENT (*) = VLAB;                                     <<04670>>03292000
ARRAY VOL'ENT (*) = VLAB;                                      <<04670>>03294000
ARRAY VOLSETLDEV (0:MAX'DISCS);                                <<04670>>03296000
LOGICAL A;                                                     <<04670>>03298000
LOGICAL PMAP = Q-4;                                            <<04670>>03300000
DEFINE  VOLIND = PMAP.(0:13)#;                                 <<04670>>03302000
DEFINE  MVTABI = PMAP.(0:14)#;                                 <<04670>>03304000
DEFINE  VSLDEV = PMAP.(0:15)#;                                 <<04670>>03306000
                                                               <<04670>>03308000
VOLUME'MOUNTED := FALSE;                                       <<04670>>03310000
                                                               <<04670>>03312000
VOLSETLDEV := 0;                                               <<04670>>03314000
MOVE VOLSETLDEV(1) := VOLSETLDEV,(MAX'DISCS-1);                <<04670>>03316000
                                                               <<04670>>03318000
<< PRIVATE VOLUME >>                                           <<04670>>03320000
                                                               <<04670>>03322000
IF PVOL THEN                                                   <<04670>>03324000
   BEGIN                                                       <<04670>>03326000
   DISCIO (LDEV,R,VLAB,0D,SECSIZE);                            <<04670>>03328000
   IF <> THEN                                                  <<04670>>03330000
      RETURN;                                                  <<04670>>03332000
                                                               <<04670>>03334000
   MOVE VSID := VLAB (DISC'LAB'SET),(4);                       <<04670>>03336000
   MOVE VSID(4) := VLAB (DISC'LAB'GROUP'NAME),(4);             <<04670>>03338000
   MOVE VSID(8) := VLAB (DISC'LAB'ACCNT'NAME),(4);             <<04670>>03340000
   GETVSDEFN (VSID,VSDEFN,,MSGNUM);                            <<04670>>03342000
   IF <> THEN                                                  <<04670>>03344000
      BEGIN                                                    <<04670>>03346000
      GENMSG (PVMSGSET,MSGNUM);                                <<04670>>03348000
      RETURN;                                                  <<04670>>03350000
      END;                                                     <<04670>>03352000
   MVTABX := VSDEFN (VDMISC).MVTABXF;                          <<04670>>03354000
   IF MVTABX = 0 THEN                                          <<04670>>03356000
      RETURN;                                                  <<04670>>03358000
   VOLUME'COUNT := VSDEFN (VDINFO).NUMVOL;                     <<04670>>03360000
   GETMVTABENTRY (MVTABX,MVTABENT);                            <<04670>>03362000
                                                               <<04670>>03364000
   <<Check if all volumes are mounted>>                        <<04670>>03366000
                                                               <<04670>>03368000
   COND'INDEX := -1;                                           <<04670>>03370000
   OFFSET := 5;                                                <<04670>>03372000
   I := 0;                                                     <<04670>>03374000
   WHILE (I:=I+1) <= VOLUME'COUNT DO                           <<04670>>03376000
      IF (VOLSETLDEV (I) :=                                    <<04670>>03378000
          MVTABENT (OFFSET + (I-1)*2).LDEVF) = 0 THEN          <<04670>>03380000
          RETURN                                               <<04670>>03382000
      ELSE                                                     <<04670>>03384000
         IF VOLSETLDEV (I) = LDEV THEN                         <<04670>>03386000
            COND'INDEX := I;                                   <<04670>>03388000
   END                                                         <<04670>>03390000
                                                               <<04670>>03392000
<< SYSTEM VOLUME >>                                            <<04670>>03394000
                                                               <<04670>>03396000
ELSE                                                           <<04670>>03398000
   BEGIN                                                       <<04670>>03400000
   A := GETSIR (MVTABSIR);                                     <<06276>>03402000
   MVTABX := 0;                                                <<04670>>03404000
   GETMVTABENTRY (MVTABX,MVTABENT);                            <<04670>>03406000
   MOVE'FROM'DATA'SEG (VOL'TABLE'DST,0,16,VOL'ENT);            <<04670>>03408000
   VOLUME'COUNT := VOL'ENT (NUM'SYS'VOL);                      <<04670>>03410000
   OFFSET := VOL'ENT.VOL'TABLE'ENT'SIZE;                       <<04670>>03412000
                                                               <<04670>>03414000
   <<Check all system volumes>>                                <<04670>>03416000
                                                               <<04670>>03418000
   COND'INDEX := -1;                                           <<04670>>03420000
   I := 0;                                                     <<04670>>03422000
   WHILE (I:=I+1) <= VOLUME'COUNT DO                           <<04670>>03424000
      BEGIN                                                    <<04670>>03426000
      MOVE'FROM'DATA'SEG (VOL'TABLE'DST,I*OFFSET,OFFSET,       <<04670>>03428000
                          VOL'ENT);                            <<04670>>03430000
      IF VOL'ENT <> 0 AND                                      <<04670>>03432000
         (VOLSETLDEV (I) :=                                    <<04670>>03434000
          VOL'ENT (VOL'TABLE'LDEV).VOL'ENT'LDEV) = LDEV THEN   <<04670>>03436000
         COND'INDEX := I;                                      <<04670>>03438000
      END;                                                     <<04670>>03440000
   RELSIR (MVTABSIR, A);                                       <<06276>>03442000
   END;                                                        <<04670>>03444000
                                                               <<04670>>03446000
IF COND'INDEX < 0 THEN                                         <<04670>>03448000
   RETURN;                                                     <<04670>>03450000
                                                               <<04670>>03452000
IF VOLIND THEN                                                 <<04670>>03454000
   VOL'INDEX := COND'INDEX;                                    <<04670>>03456000
IF MVTABI THEN                                                 <<04670>>03458000
   MVTAB'INDEX := MVTABX;                                      <<04670>>03460000
IF VSLDEV THEN                                                 <<04670>>03462000
   MOVE VOL'SET'LDEV := VOLSETLDEV,(MAX'DISCS);                <<04670>>03464000
VOLUME'MOUNTED := TRUE;                                        <<04670>>03466000
                                                               <<04670>>03468000
END;                                                           <<04670>>03470000
$PAGE "PROCEDURE GET'DEV'INFO"                                 <<04670>>03472000
LOGICAL PROCEDURE GET'DEV'INFO (LDEV,TYPE,SUBTYPE);            <<04670>>03474000
VALUE LDEV;                                                    <<04670>>03476000
INTEGER LDEV,TYPE,SUBTYPE;                                     <<04670>>03478000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>03480000
                                                               <<04670>>03482000
<<This procedure sets the DISC'TYPE flag which describes    >> <<04670>>03484000
<<the logical and physical type of volume. It also returns  >> <<04670>>03486000
<<a message - UNREADABLE LABEL.                             >> <<04670>>03488000
                                                               <<04670>>03490000
BEGIN                                                          <<04670>>03492000
ARRAY VLAB (*) = BUFF;                                         <<04670>>03494000
                                                               <<04670>>03496000
GET'DEV'INFO := TRUE;                                          <<04670>>03498000
IF NOT GET'DISC'INFO (LDEV,VLAB,TRUE,,TYPE,SUBTYPE,,,,,,,,,    <<04670>>03500000
                      SECTRK,,,TRKCYL) THEN                    <<04670>>03502000
   BEGIN                                                       <<04670>>03504000
   GET'DEV'INFO := FALSE;                                      <<04670>>03506000
   GENMSG (PVMSGSET,VIWARN10,%10000,LDEV);                     <<04670>>03508000
   GENMSG (PVMSGSET,VIERR0);                                   <<04670>>03510000
   RETURN;                                                     <<04670>>03512000
   END;                                                        <<04670>>03514000
DISC'TYPE.(6:10) := 0;  <<Initialize flags>>                   <<04670>>03516000
CASE DISCTYPE (LDEV,VLAB) OF                                   <<04670>>03518000
   BEGIN                                                       <<04670>>03520000
   SYS    := 1;                                                <<04670>>03522000
   PVOL   := 1;                                                <<04670>>03524000
   SERIALD := 1;                                               <<04670>>03526000
   SCRVOL  := 1;                                               <<04670>>03528000
   FORVOL  := 1;                                               <<04670>>03530000
   END;                                                        <<04670>>03532000
SECSIZE := SECTOR'SIZE;                                        <<04670>>03534000
IF TYPE = MH'DISC'TYPE THEN                                    <<04670>>03536000
   MH'DISC := 1;                                               <<04670>>03538000
IF TYPE = FLOPPY'DISC'TYPE THEN                                <<04670>>03540000
   FLOPPY := 1;                                                <<04670>>03542000
IF TYPE = CS'80'TYPE THEN                                      <<04670>>03544000
   BEGIN                                                       <<04670>>03546000
   CS'80 := 1;                                                 <<04670>>03548000
   IF (SUBTYPE = ST'9110 LOR SUBTYPE = ST'9144) THEN           <<*8114>>03550000
      BEGIN                                                    <<04670>>03552000
      SECSIZE := 512;                                          <<04670>>03554000
      CARTRIDGE := 1;                                          <<*8114>>03556000
      END;                                                     <<04670>>03558000
   END;                                                        <<04670>>03560000
                                                               <<04670>>03562000
IF MH'DISC OR FLOPPY OR CS'80 THEN                             <<04670>>03564000
   DISC := 1;                                                  <<04670>>03566000
END;                                                           <<04670>>03568000
$PAGE "PROCEDURE SETSCRATCH"                                   <<03537>>03570000
PROCEDURE SETSCRATCH(LDN,FLAGS);                                        03572000
VALUE LDN,FLAGS;                                                        03574000
INTEGER LDN;                                                            03576000
LOGICAL FLAGS;                                                          03578000
OPTION PRIVILEGED,UNCALLABLE;                                           03580000
BEGIN                                                                   03582000
     ARRAY VLAB(*) = BUFF;                                              03584000
     BYTE ARRAY VLABB(*) = BUFF;                                        03586000
     INTEGER     type                                          <<03510>>03588000
                ,subtype                                       <<03510>>03590000
                ;                                              <<03510>>03592000
     INTEGER Qmisc := 0;                                       <<03537>>03594000
     LOGICAL Dummy;                                            <<03537>>03596000
     DEFINE                                                             03598000
          STATE   = FLAGS.(15:1)#,                                      03600000
          SETVLAB = FLAGS.(14:1)#;                                      03602000
                                                                        03604000
     CC := CCE;                                                <<00239>>03606000
     IF SETVLAB THEN  <<CREATE SCRATCH VOLUME LABEL>>                   03608000
     BEGIN                                                              03610000
          Vlab := 0;                                           <<*8114>>03612000
          MOVE Vlab(1) := Vlab,(Cartridge'Sector - 1);         <<*8114>>03614000
          IF Is'It'Cartridge(Ldn) THEN                         <<*8114>>03616000
          BEGIN                                                <<03537>>03618000
               Type := Ldevtotype(Ldn);                        <<03537>>03620000
               Subtype := Ldevtosubtype(Ldn);                  <<03537>>03622000
          END                                                  <<03537>>03624000
          ELSE                                                 <<03537>>03626000
               Get'Disc'Info(ldn,,,,type,subtype);             <<03537>>03628000
          vlab(disc'lab'type'word).disc'lab'type:=             <<03510>>03630000
                                     type;                     <<03510>>03632000
          vlab(disc'lab'type'word).disc'lab'subtype:=          <<03510>>03634000
                                     subtype;                  <<03510>>03636000
          MOVE VLABB(LVNAMELOC):="SCRATCH ";                            03638000
          MOVE VLABB(LVSACCNTLOC):=" ",2;                               03640000
          ASSEMBLE(DUP,DECA);                                           03642000
          MOVE * := * ,(16);                                            03644000
     END ELSE                                                           03646000
     BEGIN                                                              03648000
          IF Is'It'Cartridge(Ldn) THEN                         <<*8114>>03650000
          BEGIN                                                <<03537>>03652000
               Cartridge'Io(Ldn,Qmisc,Vlab,R,Cartridge'Sector,<<<*8114>>03654000
                            Disc'Label'Address,Blocked'IO,     <<*8114>>03656000
                            NO'SPARING,Default'Errinfo,Dummy); <<*8114>>03658000
          END                                                  <<03537>>03660000
          ELSE                                                 <<03537>>03662000
               DISCIO(LDN,R,VLAB,0D,128);<<READ IN OLD LABEL >><<03537>>03664000
          IF < THEN  <<DISC I/O ERROR>>                                 03666000
          BEGIN                                                         03668000
               CC:=CCL;                                                 03670000
               RETURN;                                                  03672000
          END;                                                          03674000
          IF VLAB(LDEVINFO).SCRATCHF = STATE  THEN                      03676000
          BEGIN                                                         03678000
               IF STATE THEN                                            03680000
                  MOVE MSG :="SCRATCH"                                  03682000
               ELSE                                                     03684000
                  MOVE MSG :="RESET  ";                                 03686000
               MSG(7):=0;  <<GENMSG STOPPER>>                           03688000
               GENMSG(PVMSGSET,VIWARN0,0,@MSG);                         03690000
               RETURN;                                                  03692000
          END;                                                          03694000
     END;                                                               03696000
     VLAB(LDEVINFO).SCRATCHF:=STATE;                                    03698000
     VLAB(LSYSID2).(15:1):=STATE;  <<SET ID TO "3001" IF SYSVOL>>       03700000
     IF Is'It'Cartridge(Ldn) THEN                              <<*8114>>03702000
     BEGIN                                                     <<03537>>03704000
          Cartridge'Io(Ldn,Qmisc,Vlab,WL,Cartridge'Sector,     <<*8114>>03706000
                       Disc'Label'Address,Blocked'IO,          <<*8114>>03708000
                       JUMP'SPARING,Default'Errinfo,Dummy);    <<*8114>>03710000
     END                                                       <<03537>>03712000
     ELSE                                                      <<03537>>03714000
          DISCIO(LDN,WL,VLAB,0D,128);                          <<03537>>03716000
     IF < THEN  <<DISC I/O ERROR>>                                      03718000
     BEGIN                                                              03720000
          CC:=CCL;                                                      03722000
          RETURN;                                                       03724000
     END;                                                               03726000
END << SETSCRATCH >>;                                                   03728000
                                                                        03730000
                                                                        03732000
$PAGE "PVINIT - CONDENSE AND DTRACK UTILITIES"                 <<00239>>03734000
                                                                        03736000
DOUBLE PROCEDURE GETMAXADDR(LDN);                                       03738000
VALUE LDN; INTEGER LDN;                                                 03740000
OPTION PRIVILEGED,UNCALLABLE;                                           03742000
BEGIN                                                                   03744000
   LOGICAL       proc'status                                   <<03510>>03746000
                ;                                              <<03510>>03748000
   DOUBLE        max'addr                                      <<03510>>03750000
                ;                                              <<03510>>03752000
                                                                        03754000
     CC:=CCE;  <<ASSUME SUCCESSFUL COMPLETION>>                         03756000
                                                               <<03510>>03758000
   proc'status:=Get'Disc'Info(ldn,,,,,,max'addr);              <<03510>>03760000
   IF NOT(proc'status) THEN                                    <<03510>>03762000
      BEGIN                                                    <<03510>>03764000
         cc:=ccl;                                              <<03510>>03766000
         RETURN;                                               <<03510>>03768000
      END;                                                     <<03510>>03770000
   getmaxaddr:=max'addr;                                       <<03510>>03772000
END << GETMAXADDR >>;                                                   03774000
                                                                        03776000
$CONTROL SEGMENT=CONDENSE                                      <<00239>>03778000
INTEGER PROCEDURE LASTEXTSIZE(FLAB);                                    03780000
INTEGER ARRAY FLAB;                                                     03782000
OPTION PRIVILEGED,UNCALLABLE;                                           03784000
BEGIN                                                                   03786000
     INTEGER RSIZE;                                                     03788000
     DOUBLE ARRAY FLABDBL (*) = FLAB;                          <<06468>>03790000
                                                                        03792000
     TOS:=FLRECSIZE;                                                    03794000
     IF < THEN TOS:=-TOS ELSE TOS:=TOS&LSL(1);                          03796000
     RSIZE:=TOS;  <<POS. BYTES>>                                        03798000
     IF FLLASTEXTSIZE = 0 THEN <<COMPUTE LAST EXT SIZE>>                03800000
     BEGIN                                                              03802000
          TOS:=FLFLIM;                                                  03804000
          X:=FLBLKSIZE/(RSIZE&LSR(1));                                  03806000
          DIVD;                                                         03808000
          IF TOS <> 0 THEN TOS:=TOS+1D;                                 03810000
          X:=(FLBLKSIZE+127) & LSR(7);                                  03812000
          MPYD;                                                         03814000
          TOS:=TOS+DOUBLE(LOGICAL(FLSECTOFF));                          03816000
          TOS:=FLEXTSIZE;                                               03818000
          ASSEMBLE(LDIV,DELB;TEST);                                     03820000
          IF = THEN TOS:=TOS+FLEXTSIZE;                                 03822000
     END ELSE                                                           03824000
     TOS:=FLLASTEXTSIZE;                                                03826000
     LASTEXTSIZE:=TOS;                                                  03828000
END << LASTEXTSIZE >>;                                                  03830000
                                                                        03832000
INTEGER PROCEDURE DTRACK'RECIP(NTRY,LEVEL,PARMS,SIRS);         <<00239>>03834000
VALUE LEVEL,PARMS,SIRS;                                        <<00239>>03836000
INTEGER LEVEL,PARMS;                                           <<00239>>03838000
DOUBLE SIRS;                                                   <<00239>>03840000
ARRAY NTRY;                                                    <<00239>>03842000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>03844000
BEGIN                                                          <<00239>>03846000
     <<DB IS AT THE DIRECTORY DATA SEGMENT UPON ENTRY TO       <<00239>>03848000
     <<THIS PROCEDURE.                                         <<00239>>03850000
     INTEGER DELTAQ = Q+0;                                     <<00239>>03852000
     ARRAY ARRQ0(*) = Q-0;                                     <<00239>>03854000
                                                               <<00239>>03856000
     INTEGER LEN;                                              <<03620>>03858000
     INTEGER I,J,EXT,DEV,VTABX,IOSTATUS,                       <<00239>>03860000
          LASTEXT,EXTLENGTH,ERR;                               <<00239>>03862000
     LOGICAL MASK;                                             <<00239>>03864000
     LOGICAL FIRST'TIME := TRUE;                               <<03620>>03866000
     DOUBLE FLABADDR;                                          <<00239>>03868000
     DOUBLE EXTADDREND,                                        <<03620>>03870000
            PHYSICAL'START,                                    <<03620>>03872000
            PHYSICAL'END,                                      <<03620>>03874000
            LOGICAL'START,                                     <<03620>>03876000
            LOGICAL'END,                                       <<03620>>03878000
            TEMP,                                              <<03620>>03880000
            A1,                                                <<03620>>03882000
            A2;                                                <<03620>>03884000
     INTEGER                                                   <<00239>>03886000
          FLABADDR1 = FLABADDR,                                <<00239>>03888000
          FLABADDR2 = FLABADDR+1;                              <<00239>>03890000
     DOUBLE EXTADDR;                                           <<00239>>03892000
     INTEGER                                                   <<00239>>03894000
          EXTADDR1 = EXTADDR,                                  <<00239>>03896000
          EXTADDR2 = EXTADDR+1;                                <<00239>>03898000
     BYTE ARRAY BBUF(0:24) = Q;                                <<03620>>03900000
     DOUBLE ARRAY Q'COPY'D(0:2) = Q;                           <<00239>>03902000
     INTEGER ARRAY RPARMS(*);                                  <<00239>>03904000
     INTEGER POINTER FLAB;  <<FILE LABEL>>                     <<06468>>03906000
     DOUBLE POINTER FLABDBL = FLAB;                            <<06468>>03908000
     DOUBLE ARRAY TRACK'START(*);                              <<00239>>03910000
     LOGICAL ARRAY TRK'STARTB(*) = TRACK'START;                <<03620>>03912000
     DOUBLE ARRAY TRACK'END(*);                                <<00239>>03914000
     LOGICAL ARRAY TRK'ENDB(*) = TRACK'END;                    <<03620>>03916000
     ARRAY NAMESW(*);                                          <<00239>>03918000
     DOUBLE ARRAY NAMESD(*) = NAMESW;                          <<00239>>03920000
     INTEGER ARRAY FILE'DISP(*);                               <<00239>>03922000
     ARRAY VDTAB(*);  <<VOLUME TO DEV CONVERSION TABLE>>       <<00239>>03924000
     DOUBLE ARRAY NTRYD(*) = NTRY;                             <<00239>>03926000
     EQUATE  <<DIRECTORY INFORMATION>>                         <<00239>>03928000
          DADIRTY     = %221,                                  <<00239>>03930000
          FILELEVEL   =    0,                                  <<00239>>03932000
          GROUPLEVEL  =    1,                                  <<00239>>03934000
          ACCNTLEVEL  =    2;                                  <<00239>>03936000
     DEFINE                                                    <<00239>>03938000
          THISVOL     = RPARMS ( 2)#,                          <<00239>>03940000
          NUMENTRIES  = RPARMS ( 3)#,                          <<00239>>03942000
          HEADER      = RPARMS ( 8)#,                          <<03620>>03944000
          NAMEINDEX   = FILE'DISP(0)#;                         <<00239>>03946000
                                                               <<00239>>03948000
                                                               <<00239>>03950000
     LOGICAL SUBROUTINE DEF'CHECKSUM;                          <<06468>>03952000
                                                               <<00239>>03954000
      LOGICAL SUBROUTINE PRINT'FILENAME;                       <<03620>>03956000
         BEGIN                                                 <<03620>>03958000
         PBUF := " "; MOVE PBUF(1) := PBUF,(72);               <<03620>>03960000
         MOVE PBUFW(15) := NAMESW(NAMEINDEX*12),(4);           <<03620>>03962000
         MOVE PBUF:=PBUF(30) WHILE AN,1; <<ACCOUNT>>           <<03620>>03964000
         MOVE * := ".",2;                                      <<03620>>03966000
         MOVE PBUFW(15) := NAMESW(NAMEINDEX*12+4),(4);         <<03620>>03968000
         MOVE * :=PBUF(30) WHILE AN,1; <<GROUP>>               <<03620>>03970000
         MOVE * := ".",2;                                      <<03620>>03972000
         MOVE PBUFW(15) := NAMESW(NAMEINDEX*12+8),(4);         <<03620>>03974000
         MOVE * := PBUF(30) WHILE AN; <<FILE>>                 <<03620>>03976000
         FWRITE(OUTF,PBUFW,-30,0);                             <<03620>>03978000
         END; <<END OF PRINT'FILENAME>>                        <<03620>>03980000
                                                               <<00239>>03982000
                                                               <<00239>>03984000
     Q'COPY'D(0) := NTRYD(0); << SAVE NAME Q-REL >>            <<00239>>03986000
     Q'COPY'D(1) := NTRYD(1); << SAVE NAME Q-REL >>            <<00239>>03988000
     Q'COPY'D(2) := NTRYD(2); << SAVE FLAB Q-REL >>            <<00239>>03990000
                                                               <<00239>>03992000
     EXCHANGEDB(0);  <<BACK TO VINIT STACK>>                   <<00239>>03994000
                                                               <<00239>>03996000
                                                               <<00239>>03998000
     @RPARMS:=@ARRQ0(PARMS - DELTAQ);                          <<00239>>04000000
     IF RPARMS < 0 THEN                                        <<00239>>04002000
        BEGIN                                                  <<00239>>04004000
        DTRACK'RECIP := 5; <<TERMINATE DIRECTORY SCAN>>        <<00239>>04006000
        EXCHANGEDB(DIRDST);                                    <<00239>>04008000
        RETURN;                                                <<00239>>04010000
        END;                                                   <<00239>>04012000
                                                               <<00239>>04014000
     @VDTAB:=RPARMS(1);                                        <<00239>>04016000
     @TRACK'START:=RPARMS(4);                                  <<00239>>04018000
     @TRACK'END:=RPARMS(5);                                    <<00239>>04020000
     @NAMESW:=RPARMS(6);                                       <<00239>>04022000
     @FILE'DISP:=RPARMS(7);                                    <<00239>>04024000
                                                               <<00239>>04026000
                                                               <<00239>>04028000
     IF  FILELEVEL <= LEVEL <= ACCNTLEVEL THEN                 <<00239>>04030000
        BEGIN                                                  <<00239>>04032000
        NAMESD( (NAMEINDEX+1)*6 + LEVEL*2 ) := Q'COPY'D(0);    <<00239>>04034000
        NAMESD( (NAMEINDEX+1)*6 + LEVEL*2 + 1 ) := Q'COPY'D(1);<<00239>>04036000
        END;                                                   <<00239>>04038000
                                                               <<00239>>04040000
                                                               <<00239>>04042000
     CASE LEVEL OF                                             <<00239>>04044000
     BEGIN                                                     <<00239>>04046000
        BEGIN << FILE LEVEL = 0 >>                             <<00239>>04048000
        FLABADDR:=Q'COPY'D(2);  <<VTAB INDEX/FLAB POINTER>>    <<00239>>04050000
        VTABX:=FLABADDR1.VTABXF;                               <<00239>>04052000
        FLABADDR1.VTABXF:=0;<<MAKE FLABADDR VALID DISC ADDR>>  <<00239>>04054000
        IF FLABADDR=%77777777D THEN                            <<00239>>04056000
           BEGIN<<BAD LABEL-A CRASH OCCURED IN RESTORING>>     <<00239>>04058000
           DTRACK'RECIP := 1;  << CONTINUE SCAN >>             <<00239>>04060000
           EXCHANGEDB(DIRDST);                                 <<00239>>04062000
           RETURN;                                             <<00239>>04064000
           END;                                                <<00239>>04066000
        IF (DEV:=VDTAB(VTABX)) = 0 THEN<<MISSING V-SET MEMBER>><<00239>>04068000
           BEGIN                                               <<00239>>04070000
           DTRACK'RECIP:=1;  <<CONTINUE SCAN>>                 <<00239>>04072000
           EXCHANGEDB(DIRDST);                                 <<00239>>04074000
           RETURN;                                             <<00239>>04076000
           END;                                                <<00239>>04078000
        IOSTATUS := 2;                                         <<00239>>04080000
        @FLAB:=@BUFF;                                          <<00239>>04082000
        DISCIO(DEV,R,FLAB,FLABADDR,128,IOSTATUS);              <<00239>>04084000
        IF IOSTATUS.GSTATUS <> SUCCESSFUL THEN                 <<00239>>04086000
           BEGIN                                               <<00239>>04088000
           NAMEINDEX := NAMEINDEX + 1;                         <<00239>>04090000
           PRINT'FILENAME;                                     <<03620>>04092000
           MOVE PBUF := " ** BAD FILE LABEL";                  <<03620>>04094000
           FWRITE(OUTF,PBUFW,-18,0);                           <<03620>>04096000
           IF NAMEINDEX < MAXSECTTRK THEN                      <<03620>>04098000
           BEGIN                                               <<03620>>04100000
           MOVE NAMESW( (NAMEINDEX+1)*12 ) :=                  <<00239>>04102000
                NAMESW( (NAMEINDEX)*12 ), (12);<<COPY G & A >> <<00239>>04104000
           FILE'DISP(NAMEINDEX) := 1;                          <<00239>>04106000
           END;                                                <<03620>>04108000
           DTRACK'RECIP:=1;  <<CONTINUE>>                      <<00239>>04110000
           EXCHANGEDB(DIRDST);                                 <<00239>>04112000
           RETURN;                                             <<00239>>04114000
           END;                                                <<00239>>04116000
                                                               <<00239>>04118000
        LASTEXT := DFLEXTINDEX + FLNUMEXTS;                    <<06468>>04120000
        IF LOG (FLCHECKSUM) = CHECKSUMX THEN   <<VALID LABEL>> <<06468>>04122000
           FOR EXT:=DFLEXTINDEX UNTIL LASTEXT DO  <<CHECK IT>> <<06468>>04124000
              IF FLABDBL (EXT) <> 0D THEN  <<EXTENT IN USE>>   <<06468>>04126000
                 BEGIN                                         <<00239>>04128000
                 EXTADDR := FLABDBL (EXT);                     <<06468>>04130000
                 EXTLENGTH:=IF EXT=LASTEXT THEN                <<00239>>04132000
                            LASTEXTSIZE(FLAB) ELSE FLAB(41);   <<00239>>04134000
                 IF (EXTADDR1.VTABXF = THISVOL) THEN           <<00239>>04136000
                    BEGIN                                      <<00239>>04138000
                    EXTADDR1.VTABXF:=0;<<ZERO VTAB INDEX>>     <<00239>>04140000
                    EXTADDREND:=EXTADDR+DBL(EXTLENGTH-1);      <<03620>>04142000
                    <<SCAN TRACK TABLES ENTRIES>>              <<03620>>04144000
                    FOR I := 1 UNTIL NUMENTRIES DO             <<03620>>04146000
                     IF (TRACK'END(I) >= EXTADDR) AND          <<03620>>04148000
                     EXTADDREND >= TRACK'START(I)              <<03620>>04150000
                     THEN BEGIN                                <<03620>>04152000
                     IF FIRST'TIME AND NAMEINDEX < MAXSECTTRK  <<03620>>04154000
                      THEN BEGIN                               <<03620>>04156000
                     <<------------------------------------>>  <<03620>>04158000
                     << SAVE FILE NAME FOR PROCESS BAD     >>  <<03620>>04160000
                     << TRACK PROCEDURE                    >>  <<03620>>04162000
                     <<------------------------------------>>  <<03620>>04164000
                      NAMEINDEX := NAMEINDEX +1;               <<03620>>04166000
                      MOVE NAMESW ((NAMEINDEX+1)*12) :=        <<03620>>04168000
                      NAMESW (NAMEINDEX*12),(12); <<G&A>>      <<03620>>04170000
                      FILE'DISP (NAMEINDEX) := 2; <<FILE>>     <<03620>>04172000
                      IF HEADER = 0 THEN                       <<03620>>04174000
                       BEGIN                                   <<03620>>04176000
                       PBUF := "-";                            <<03620>>04178000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04180000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04182000
                       PBUF := " ";                            <<03620>>04184000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04186000
                       MOVE PBUF := "FILE";                    <<03620>>04188000
                       MOVE PBUF(24) := "LOST DATA (SECTORS)"; <<03620>>04190000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04192000
                       PBUF := " ";                            <<03620>>04194000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04196000
                       MOVE PBUF(14) := "PHYSICAL ADDRESS";    <<03620>>04198000
                       MOVE PBUF(38) := "LOGICAL ADDRESS";     <<03620>>04200000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04202000
                       PBUF := "-";                            <<03620>>04204000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04206000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04208000
                       HEADER := 1;                            <<03620>>04210000
                       END;                                    <<03620>>04212000
                      END;                                     <<03620>>04214000
                     <<------------------------------------>>  <<03620>>04216000
                     << PRINT FILENAME                     >>  <<03620>>04218000
                     <<------------------------------------>>  <<03620>>04220000
                     IF FIRST'TIME THEN                        <<03620>>04222000
                      BEGIN                                    <<03620>>04224000
                      PRINT'FILENAME;                          <<03620>>04226000
                      FIRST'TIME := FALSE;                     <<03620>>04228000
                      END;                                     <<03620>>04230000
                     <<------------------------------------>>  <<03620>>04232000
                     << CALCULATE BAD PHYSICAL AND LOGICAL >>  <<03620>>04234000
                     << SECTOR ADDRESS                     >>  <<03620>>04236000
                     <<------------------------------------>>  <<03620>>04238000
                     A1:=TRACK'START(I)-EXTADDR;               <<03620>>04240000
                     A2:=EXTADDREND-TRACK'END(I);              <<03620>>04242000
                     PHYSICAL'START := IF A1 < 0D              <<03620>>04244000
                                    THEN EXTADDR               <<03620>>04246000
                                    ELSE TRACK'START(I);       <<03620>>04248000
                     PHYSICAL'END := IF A2 < 0D                <<03620>>04250000
                                  THEN EXTADDREND              <<03620>>04252000
                                  ELSE TRACK'END(I);           <<03620>>04254000
                     TEMP:=DBL((EXT-DFLEXTINDEX)*FLEXTSIZE);   <<06468>>04256000
                     LOGICAL'START := TEMP + (IF A1 > 0D       <<03620>>04258000
                                             THEN A1 ELSE 0D); <<03620>>04260000
                     LOGICAL'END := TEMP + (IF A2 > 0D         <<03620>>04262000
                                   THEN TRACK'END(I)-EXTADDR   <<03620>>04264000
                                   ELSE DBL(EXTLENGTH) );      <<03620>>04266000
                     <<------------------------------------>>  <<03620>>04268000
                     << ELIMINATE ENTRY FORM TRACK TABLES  >>  <<03620>>04270000
                     << IF ENTRY INSIDE EXTENT             >>  <<03620>>04272000
                     <<------------------------------------>>  <<03620>>04274000
                     IF A1 > 0D AND A2 > 0D THEN               <<03620>>04276000
                      BEGIN                                    <<03620>>04278000
                      IF I <> NUMENTRIES THEN                  <<03620>>04280000
                      BEGIN                                    <<03620>>04282000
                      MOVE TRK'STARTB(I*2):=TRK'STARTB((I+1)*2)<<03620>>04284000
                                          ,((NUMENTRIES-I)*2); <<03620>>04286000
                      MOVE TRK'ENDB(I*2):=TRK'ENDB((I+1)*2),   <<03620>>04288000
                                        ((NUMENTRIES-I)*2);    <<03620>>04290000
                      END;                                     <<03620>>04292000
                      I := I - 1;                              <<04290>>04294000
                      NUMENTRIES := NUMENTRIES-1;              <<03620>>04296000
                      END;                                     <<03620>>04298000
                     <<------------------------------------>>  <<03620>>04300000
                     << PRINT PHYSICAL AND LOGICAL SECTOR  >>  <<03620>>04302000
                     << ADDRESS                            >>  <<03620>>04304000
                     <<------------------------------------>>  <<03620>>04306000
                     PBUF := " "; MOVE PBUF(1) := PBUF,(71);   <<03620>>04308000
                     LEN := DASCII(PHYSICAL'START,10,BBUF);    <<03620>>04310000
                     MOVE PBUF(20-LEN) := BBUF,(LEN),2;        <<03620>>04312000
                     IF PHYSICAL'END > PHYSICAL'START THEN     <<03620>>04314000
                      BEGIN                                    <<03620>>04316000
                      LEN := DASCII(PHYSICAL'END,10,BBUF);     <<03620>>04318000
                      MOVE * := " - ",2;                       <<03620>>04320000
                      MOVE * := BBUF,(LEN),2;                  <<03620>>04322000
                      END;                                     <<03620>>04324000
                     DEL;                                      <<03620>>04326000
                     LEN := DASCII(LOGICAL'START,10,BBUF);     <<03620>>04328000
                     MOVE PBUF(44-LEN) := "(",2;               <<03620>>04330000
                     MOVE * := BBUF,(LEN),2;                   <<03620>>04332000
                     IF LOGICAL'END > LOGICAL'START THEN       <<03620>>04334000
                      BEGIN                                    <<03620>>04336000
                      LEN := DASCII(LOGICAL'END,10,BBUF);      <<03620>>04338000
                      MOVE * := " - ",2;                       <<03620>>04340000
                      MOVE * := BBUF,(LEN),2;                  <<03620>>04342000
                      END;                                     <<03620>>04344000
                     MOVE * := ")";                            <<03620>>04346000
                     FWRITE(OUTF,PBUFW,-60,0);                 <<03620>>04348000
                     IF NUMENTRIES = 0 THEN                    <<03620>>04350000
                      BEGIN                                    <<03620>>04352000
                      RPARMS := -1;<<STOP SCAN>>               <<03620>>04354000
                      GOTO XIT;                                <<03620>>04356000
                      END;                                     <<03620>>04358000
                     END;   <<LOOP OF DTT CHANGES>>            <<03620>>04360000
                    END;  << OF ...THISVOL... >>               <<00239>>04362000
                 END;  << OF EXTENT IN USE >>                  <<00239>>04364000
        DTRACK'RECIP:=1;  <<CONTINUE>>                         <<00239>>04366000
        END; << OF FILE LEVEL >>                               <<00239>>04368000
        BEGIN  << GROUP LEVEL >>                               <<00239>>04370000
        DTRACK'RECIP:=1;  <<CONTINUE>>                         <<00239>>04372000
        END; << OF GROUP LEVEL >>                              <<00239>>04374000
        BEGIN << OF ACCOUNT LEVEL >>                           <<00239>>04376000
        DTRACK'RECIP:=1;  <<CONTINUE>>                         <<00239>>04378000
        END;  << OF ACCOUNT LEVEL >>                           <<00239>>04380000
                                                               <<00239>>04382000
     END;  << OF CASE >>                                       <<00239>>04384000
XIT:                                                           <<03620>>04386000
     DTRACK'RECIP := 1;  <<SET CONTINUE SCANN>>                <<00866>>04388000
     EXCHANGEDB(DIRDST);                                       <<00239>>04390000
END << DTRACK'RECIP >>;                                        <<00239>>04392000
                                                               <<00239>>04394000
                                                               <<00239>>04396000
LOGICAL PROCEDURE ONLY'ONE'ON;                                 <<00239>>04398000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>04400000
BEGIN                                                          <<00239>>04402000
   INTEGER PCBGLOBLOC;                                         <<06529>>04404000
   LOGICAL ARRAY QARRAY (*) = Q + 0;                           <<06529>>04406000
   INTEGER ARRAY JMATARR (*) = BUFF;                           <<06529>>04408000
   INTEGER ARRAY JITARR (*)  = BUFF;                           <<06529>>04410000
   INTEGER ARRAY JDTARR (*)  = BUFF;                           <<06529>>04412000
                                                               <<06529>>04414000
   SUBROUTINE DEF'MOVE'FROM'DST;                               <<06529>>04416000
                                                               <<06529>>04418000
   PXGLOBAL;                                                   <<06529>>04420000
   ONLY'ONE'ON := TRUE;                                        <<06529>>04422000
                                                               <<06529>>04424000
   << Check if only one session/job                         >> <<06529>>04426000
                                                               <<06529>>04428000
   MOVE'FROM'DST (@JMATARR, JMATDST, 0, JMATHEADERSIZE);       <<06529>>04430000
   IF (JMATSNUM + JMATJNUM) <> 1 THEN                          <<06529>>04432000
      ONLY'ONE'ON := FALSE;                                    <<06529>>04434000
                                                               <<06529>>04436000
   << Check if no temprorary files                          >> <<06529>>04438000
                                                               <<06529>>04440000
   MOVE'FROM'DST (@JDTARR, PXG'JDTDST, 0, JDTHEADERSIZE);      <<06529>>04442000
   IF JDTJTFDPTR <> JDTJTFEQPTR THEN                           <<06529>>04444000
      ONLY'ONE'ON := FALSE;                                    <<06529>>04446000
                                                               <<06529>>04448000
   << Check if no $OLDPASS                                  >> <<06529>>04450000
                                                               <<06529>>04452000
   MOVE'FROM'DST (@JITARR, PXG'JITDST, 0, JIT'ENTRY'SIZE);     <<06529>>04454000
   IF JITPASSFILE <> 0 OR JITPASSFILEPTR2 <> 0 THEN            <<l7750>>04456000
      ONLY'ONE'ON := FALSE;                                    <<06529>>04458000
                                                               <<06529>>04460000
END; << OF ONLY'ONE'ON >>                                      <<00239>>04462000
$PAGE    "PVINIT - CS80 TRACK HANDLING UTILITY PROCEDURES"     <<03620>>04464000
<<=====================================================>>      <<03620>>04466000
<<       PROCEDURE - GET LAST ENTRY FORM DSCT          >>      <<03620>>04468000
<<=====================================================>>      <<03620>>04470000
LOGICAL PROCEDURE GET'DSCT'ENTRY(DISC'ADDR);                   <<03620>>04472000
   COMMENT                                                     <<03620>>04474000
   THIS PROCEDURE RETURNS THE CURRENT LAST ENTRY IN THE DSCT.  <<03620>>04476000
   IT DOES NOT REMOVE THE ENTRY FROM THE DSCT. IF THERE ARE    <<03620>>04478000
   NO ENTRIES IN THE TABLE, IT RETURNS FALSE, OTEHRWISE TRUE.  <<03620>>04480000
   ;                                                           <<03620>>04482000
DOUBLE DISC'ADDR;   <<RETURN DISC ADDRESS - SECTOR>>           <<03620>>04484000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04486000
BEGIN                                                          <<03620>>04488000
IF DTT(DSCT'NUMBER'OF'ENTRIES) > 0 THEN                        <<03620>>04490000
   BEGIN                                                       <<03620>>04492000
   DISC'ADDR := DTTD(DTT(DSCT'FIRST'ENTRY'INDEX)/              <<03620>>04494000
                DTT(DSCT'ENTRY'SIZE)+                          <<03620>>04496000
                DTT(DSCT'NUMBER'OF'ENTRIES)-1);                <<03620>>04498000
   GET'DSCT'ENTRY := TRUE;                                     <<03620>>04500000
   END                                                         <<03620>>04502000
   ELSE GET'DSCT'ENTRY := FALSE;                               <<03620>>04504000
END;   <<GET'DSCT'ENTRY>>                                      <<03620>>04506000
<<====================================================>>       <<03620>>04508000
<<       PROCEDURE - REMOVE LAST ENTRY FROM DSCT      >>       <<03620>>04510000
<<====================================================>>       <<03620>>04512000
LOGICAL PROCEDURE REMOVE'DSCT'ENTRY(TRACK,SPARED);             <<03620>>04514000
   COMMENT                                                     <<03620>>04516000
   THIS PROCEDURE REMOVES THE LAST ENTRY OR ALL ENTRIES        <<03620>>04518000
   (WHICH BELONG TO THE SAME TRACK) IN THE DSCT.               <<03620>>04520000
   UPDATES THE TABLE HEADER.                                   <<03620>>04522000
   IT DOES NOT POST THE DSCT TO DISC.                          <<03620>>04524000
   IF SPARE SECTOR PROCESS FAILED BECAUSE THERE IS NO          <<03620>>04526000
   SPARE TRACKS AVAILABLE THEN SUSPECT SECTOR ENTRY            <<03620>>04528000
   IS NOT PURGED FROM DSCT. HOWEVER THE DSCT NUMBER OF         <<03620>>04530000
   ENTRIES COUNT WILL BE DECREMENTED. BEFORE DTRAK             <<03620>>04532000
   EXITS IT WILL CHECK IF THERE ARE ANY UNPURGED ENTRIES       <<03620>>04534000
   IN DSCT IF SO IT WILL RESET DSCT AND MARKED                 <<03620>>04536000
   UNAVAILABLE SECTORS IN BIT MAP.                             <<03620>>04538000
   ;                                                           <<03620>>04540000
VALUE TRACK,SPARED;                                            <<03620>>04542000
LOGICAL TRACK,  <<0 - SECTOR; 1 - TRACK>>                      <<03620>>04544000
        SPARED;   <<FALSE - NO SPARE TRACK AVAILABLE>>         <<03620>>04546000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04548000
BEGIN                                                          <<03620>>04550000
DOUBLE ADDR;                                                   <<03620>>04552000
INTEGER INDEX;                                                 <<03620>>04554000
IF DTT(DSCT'NUMBER'OF'ENTRIES) > 0 THEN                        <<03620>>04556000
DO                                                             <<03620>>04558000
   BEGIN                                                       <<03620>>04560000
   INDEX := DTT(DSCT'FIRST'ENTRY'INDEX)/                       <<03620>>04562000
            DTT(DSCT'ENTRY'SIZE)+                              <<03620>>04564000
            DTT(DSCT'NUMBER'OF'ENTRIES)-1;                     <<03620>>04566000
   ADDR := DTTD(INDEX);                                        <<03620>>04568000
   IF SPARED THEN DTTD(INDEX) := 0D;   <<PURGE ENTRY>>         <<03620>>04570000
   DTT(DSCT'NUMBER'OF'ENTRIES):=DTT(DSCT'NUMBER'OF'ENTRIES)-1; <<03620>>04572000
   END                                                         <<03620>>04574000
   UNTIL  NOT TRACK OR DTT(DSCT'NUMBER'OF'ENTRIES) <= 0 OR     <<03620>>04576000
         ADDR/DBL(SECTRK) <> DTTD(INDEX-1)/DBL(SECTRK);        <<03620>>04578000
END;   <<REMOVE'DSCT'ENTRY>>                                   <<03620>>04580000
<<====================================================>>       <<03620>>04582000
<<         PROCEDURE - SORT DSCT ENTRIES              >>       <<03620>>04584000
<<====================================================>>       <<03620>>04586000
LOGICAL PROCEDURE SORT'DSCT;                                   <<03620>>04588000
   COMMENT                                                     <<03620>>04590000
   THIS PROCEDURE SORTS ENTRIES IN DEFECTIVE SECTOR TABLE      <<03620>>04592000
   IN DESCENDING OREDER.                                       <<03620>>04594000
   UNUSED PART OF DSCT IS CLEARED. IT IS NECESSARY TO          <<03620>>04596000
   REMOVE ALL GARBAGE.  NON-ZERO ENTRY IN DSCT WILL INDICATE   <<03620>>04598000
   THAT SECTOR WAS UNSPARED.                                   <<03620>>04600000
   ;                                                           <<03620>>04602000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04604000
BEGIN                                                          <<03620>>04606000
INTEGER I,J,SECOND'EL,LAST'EL;                                 <<03620>>04608000
DOUBLE TEMP;                                                   <<03620>>04610000
SECOND'EL := DTT(DSCT'FIRST'ENTRY)/                            <<03620>>04612000
             DTT(DSCT'ENTRY'SIZE)+1;                           <<03620>>04614000
LAST'EL := SECOND'EL+DTT(DSCT'NUMBER'OF'ENTRIES)-2;            <<03620>>04616000
I := (LAST'EL+1)*DTT(DSCT'ENTRY'SIZE);                         <<03620>>04618000
IF I < SECTOR'SIZE THEN                                        <<03620>>04620000
   BEGIN   <<CLEAR REST OF DSCT>>                              <<03620>>04622000
   DTT(I) := 0;                                                <<03620>>04624000
   MOVE DTT(I+1) := DTT(I),(SECTOR'SIZE-I-1);                  <<03620>>04626000
   END;                                                        <<03620>>04628000
IF DTT(DSCT'NUMBER'OF'ENTRIES) <= 1 THEN RETURN;               <<03620>>04630000
FOR I := LAST'EL STEP -1 UNTIL SECOND'EL DO                    <<03620>>04632000
FOR J := SECOND'EL UNTIL I DO                                  <<03620>>04634000
   BEGIN                                                       <<03620>>04636000
   IF DTTD(J) > DTTD(J-1) THEN                                 <<03620>>04638000
      BEGIN                                                    <<03620>>04640000
      TEMP := DTTD(J);                                         <<03620>>04642000
      DTTD(J) := DTTD(J-1);                                    <<03620>>04644000
      DTTD(J-1) := TEMP;                                       <<03620>>04646000
      END;                                                     <<03620>>04648000
   END;                                                        <<03620>>04650000
END;   <<SORT'DSCT>>                                           <<03620>>04652000
<<====================================================>>       <<03620>>04654000
<< PROCEDURE - ENTER CHANGES INTO DTT'CHANGES TABLE   >>       <<03620>>04656000
<<====================================================>>       <<03620>>04658000
LOGICAL PROCEDURE ENT'DTT'CHANGES(ADDR,SIZE);                  <<03620>>04660000
   COMMENT                                                     <<03620>>04662000
   ANY LOST SECTOR ARE ENTERED INTO DTT'CHANGES TABLE.         <<03620>>04664000
   DTT'CHANGES FIRST WORD REPRESENT NUMBER OF ENTRIS.          <<03620>>04666000
   FOR CS80 EACH ENTRY CONSIST WITH TWO ELEMENT : STARTING     <<03620>>04668000
   SECTOR ADDRESS OF DEFECTIVE AREA (LOST DATA) AND SIZE       <<03620>>04670000
   (NUMBER OF SECTORS). THIS TABLE IS USED BY PROCEDURE -      <<03620>>04672000
   PROCESS'BAD'TRKS. IF TABLE IS FULL AFTER ENTRY IS INSERTED  <<03620>>04674000
   IT RETURNS FALSE . PROCESS OF SPARING WILL BE INTERRUPTED.  <<03620>>04676000
   DTRAK PROCEDURE BEFORE EXIT IT WILL EXAMINE FOR CS80        <<03620>>04678000
   DISCS IF THE DSCT IS EMPTY. IF THE DSCT WILL HAVE           <<03620>>04680000
   ANY UNPROCESSED ENTRY THE SPARING PROCESS WILL BE           <<03620>>04682000
   CONTINUED                                                   <<03620>>04684000
   ;                                                           <<03620>>04686000
VALUE SIZE,ADDR;                                               <<03620>>04688000
DOUBLE ADDR;    <<SECTOR ADDRESS>>                             <<03620>>04690000
INTEGER SIZE;    <<NUMBER OF SECTORS>>                         <<03620>>04692000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04694000
BEGIN                                                          <<03620>>04696000
INTEGER TEMP1 = ADDR, TEMP2 = ADDR+1, INDEX;                   <<03620>>04698000
INDEX := DTT'CHANGES*3+1;                                      <<03620>>04700000
ENT'DTT'CHANGES := TRUE;                                       <<03620>>04702000
IF INDEX < MAX'DTT'CHANGES THEN                                <<03620>>04704000
   BEGIN                                                       <<03620>>04706000
   DTT'CHANGES(INDEX) := TEMP1;                                <<03620>>04708000
   DTT'CHANGES(INDEX+1) := TEMP2; <<DEPOSIT DISC ADDRESS>>     <<03620>>04710000
   DTT'CHANGES(INDEX+2) := SIZE;  <<DEPOSIT NUMBER OF SEC>>    <<03620>>04712000
   DTT'CHANGES := DTT'CHANGES+1;                               <<03620>>04714000
   IF INDEX+3 >= MAX'DTT'CHANGES THEN                          <<03620>>04716000
      BEGIN                                                    <<03620>>04718000
      ENT'DTT'CHANGES := FALSE;                                <<03620>>04720000
      END;                                                     <<03620>>04722000
   END                                                         <<03620>>04724000
   ELSE ENT'DTT'CHANGES := FALSE;                              <<03620>>04726000
END;   <<ENT'DTT'CHANGES>>                                     <<03620>>04728000
<<=====================================================>>      <<03620>>04730000
<<         PROCEDURE - NO SPARE TRACK AVAILABLE        >>      <<03620>>04732000
<<=====================================================>>      <<03620>>04734000
LOGICAL PROCEDURE NO'SPARE'TRACK(TRACK,TRACK'LOST);            <<03620>>04736000
   COMMENT                                                     <<03620>>04738000
   THIS PROCEDURE REMOVE ALL ENTRIES FROM DSCT WHICH BELONG    <<03620>>04740000
   TO UNSPARED TRACK. ENTRIES ARE NOT DELETED FORM DSCT BUT    <<03620>>04742000
   ONLY DSCT NUMBER OF ENTRIES COUNT IS ADJUSTED SO WHEN       <<03620>>04744000
   DTRAK IS COMPLETED UNSPARED ENTRIES WILL BE MARKED IN BIT   <<03620>>04746000
   MAP. ALSO DTT'CHANGES TABLE IS UPDATED. IF AFTER LAST       <<03620>>04748000
   UPDATE THE DTT'CHANGES IS FULL IT RETURNS FALSE, OTHERWISE  <<03620>>04750000
   TRUE.                                                       <<03620>>04752000
   ;                                                           <<03620>>04754000
VALUE TRACK,TRACK'LOST;                                        <<03620>>04756000
LOGICAL TRACK,TRACK'LOST;                                      <<03620>>04758000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04760000
BEGIN                                                          <<03620>>04762000
DOUBLE ADDR1,ADDR2;                                            <<03620>>04764000
EQUATE NO'SPARED = 0;                                          <<03620>>04766000
GET'DSCT'ENTRY(ADDR1);  <<GET LAST ENTRY FROM DSCT>>           <<03620>>04768000
NO'SPARE'TRACK := TRUE;   <<SET INITIAL VALUE>>                <<03620>>04770000
WHILE GET'DSCT'ENTRY(ADDR2) DO                                 <<03620>>04772000
   BEGIN                                                       <<03620>>04774000
   IF ADDR1/DBL(SECTRK) <> ADDR2/DBL(SECTRK) THEN RETURN       <<03620>>04776000
   ELSE                                                        <<03620>>04778000
      BEGIN                                                    <<03620>>04780000
      GENMSG(PVMSGSET,VIWARN105,%20000,@ADDR2);                <<03620>>04782000
      REMOVE'DSCT'ENTRY(TRACK,NO'SPARED);                      <<03620>>04784000
      IF NOT TRACK THEN <<SECTOR - INDICATE IN DTT'CHANGES>>   <<03620>>04786000
      IF NOT ENT'DTT'CHANGES(ADDR2,1) THEN <<FULL>>            <<03620>>04788000
         BEGIN                                                 <<03620>>04790000
         NO'SPARE'TRACK := FALSE;                              <<03620>>04792000
         RETURN;                                               <<03620>>04794000
         END;                                                  <<03620>>04796000
      END;                                                     <<03620>>04798000
    END;                                                       <<03620>>04800000
IF TRACK'LOST THEN  <<ONLY IF RW-ERT TEST FAILED >>            <<03620>>04802000
   NO'SPARE'TRACK :=                                           <<03620>>04804000
   ENT'DTT'CHANGES(ADDR2/DBL(SECTRK)*DBL(SECTRK),SECTOR'SIZE); <<03620>>04806000
END;   <<NO'SPARE'TRACK>>                                      <<03620>>04808000
<<=====================================================>>      <<03620>>04810000
<<          PROCEDURE - CS80'SPARE                     >>      <<03620>>04812000
<<=====================================================>>      <<03620>>04814000
PROCEDURE CS80'SPARE;                                          <<03620>>04816000
   COMMENT                                                     <<03620>>04818000
   THIS PROCEDURE SPARES SUSPECT SECTORS FORM DEFECTIVE        <<03620>>04820000
   SECTORE TABLE (DSCT).                                       <<03620>>04822000
   ON EACH TRACK OF CS80 DISCS THERE IS ONE EXTRA PHYSICAL     <<03620>>04824000
   SECTOR. THIS SECTOR IS USED FOR THE FIRST SPARE OPERATION   <<03620>>04826000
   DONE ON EACH TRACK. WHEN A SECTOR IS SPARED, ALL OFF THE    <<03620>>04828000
   SECTORES ON THE TRACK ARE PHYSICALLY RESHUFFLED TO          <<03620>>04830000
   MINIMIZE THE TIME FOR CONTIGIOUS READS AND WRITES OF MORE   <<03620>>04832000
   THAN ONE SECTOR. IF MORE THAN ONE BAD SECTOR OCCURS ON      <<03620>>04834000
   A TRACK, THE WHOLE TRACK MUST BE SPARED. NUMBER OF SPARED   <<03620>>04836000
   TRACKS ARE FIXED AND CANNOT BE CHANGED BY THE USER.         <<03620>>04838000
                                                               <<03620>>04840000
   THIS PROCEDURE FOR EVERY SUSPECT SECTOR IN DSCT IS          <<03620>>04842000
   PERFORMING THE FOLLOWING SPARE SEQUENCE:                    <<03620>>04844000
   1. A READ WITH MAXIMUM RETRY TIME (800 MS) IS DONE ON THE   <<03620>>04846000
      SUSPECT SECTOR. THE RESULTING DATA IS STORED EVEN        <<03620>>04848000
      AN UNRECOVERABLE DATA ERROR IS RETURNED.                 <<03620>>04850000
   2. A WRITE/READ ERROR TEST IS RUN ON SUSPECT SECTOR. IF IT  <<03620>>04852000
      EXHIBITS ANY READ ABNORMALITIES, THE SECTORE WILL BE     <<03620>>04854000
      SPARED, OTERWISE, GO TO STEP 7.                          <<03620>>04856000
   3. A "SPARE RETAINNING DATA" COMMAND IS ISSUED TO THE       <<03620>>04858000
      SECTOR ADDRESS. IF IT IS SUCCESFUL, ONLY THE SUSPECT     <<03620>>04860000
      SECTOR'S DATA IS LOST, SO GO TO STEP 7. OTHERWISE        <<03620>>04862000
      PROCEED TO NEXT STEP.                                    <<03620>>04864000
   4. A READ WITH MAXIMUM RETRY TIME IS ISSUED TO THE ENTIRE   <<03620>>04866000
      TRACK ON WHICH THE SECTOR LIES, AND THE DATA STORED.     <<03620>>04868000
   5. A "SPARE NOT RETAINING DATA" COMMAND IS ISSUED ON        <<03620>>04870000
      SUSPECT SECTOR.                                          <<03620>>04872000
   6. A WRITE/READ ERROR RATE TEST IS RUN ON THE SPARED AREA.  <<03620>>04874000
      IF ANY OTHER BAD SECTORS ARE DISCOVERD, GO TO STEP 5.    <<03620>>04876000
   7. PREVIOUS SAVED DATA IS WRITTEN BACK TO ITS ORIGINAL      <<03620>>04878000
      ADDRESS.                                                 <<03620>>04880000
   8. THE DSCT ENTRY(IES) IS(ARE) REMOVED. IF SPARE SECTOR     <<03620>>04882000
      FAILED BECAUSE ALL SPARE TRACKS ARE USED, THE ENTRY      <<03620>>04884000
      WILL REMAIN IN DSCT.                                     <<03620>>04886000
                                                               <<03620>>04888000
   THIS PROCEDURE UPDATES THE DTT'CHANGES TABLE WHICH          <<03620>>04890000
   CONTAINS ALL INFORMATION ABOUT BAD SECTORS.                 <<03620>>04892000
   THE DTT'CHANGES TABLE IS USED TO DETERMENT WHICH FILES      <<03620>>04894000
   LOST DATA.                                                  <<03620>>04896000
   ;                                                           <<03620>>04898000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04900000
BEGIN                                                          <<03620>>04902000
INTEGER IOSTATUS,                                              <<03620>>04904000
        LEN,                                                   <<03620>>04906000
        SEC'INDEX,                                             <<03620>>04908000
        SEC'NUM,                                               <<03620>>04910000
        AREA'SIZE,                                             <<03620>>04912000
        OFFSET;                                                <<03620>>04914000
LOGICAL TRACK'LOST,                                            <<03620>>04916000
        SECTOR'LOST;                                           <<03620>>04918000
DOUBLE  DISC'ADDR,                                             <<03620>>04920000
        START'ADDR;                                            <<03620>>04922000
ARRAY   TRK'BUF(0:SECTOR'SIZE*92); <<BFD SECTRK = 92>>         <<03620>>04924000
EQUATE                                                         <<03620>>04926000
        NO'WARN = 2,                                           <<03620>>04928000
        SPARED = 1,                                            <<03620>>04930000
        NO'SPARED = 0,                                         <<03620>>04932000
        SECTOR = 0,                                            <<03620>>04934000
        TRACK  = 1;                                            <<03620>>04936000
DEFINE                                                         <<03620>>04938000
       EXIT'PROCEDURE = ASSEMBLE( EXIT 0)#;                    <<03620>>04940000
                                                               <<03620>>04942000
LOGICAL SUBROUTINE CHECK'IO'ERROR;                             <<03620>>04944000
        BEGIN                                                  <<03620>>04946000
        IF IOSTATUS.TSTATUS = SUCCESSFUL OR                    <<03620>>04948000
           IOSTATUS.TSTATUS = TRKERR OR                        <<03620>>04950000
           IOSTATUS.TSTATUS = TIMEOUT OR                       <<03620>>04952000
           IOSTATUS.TSTATUS = NO'SPARE THEN RETURN;            <<03620>>04954000
        STATUS := IOSTATUS.TSTATUS;  <<SAVE STATUS>>           <<03620>>04956000
        LEN := ASCII(STATUS,8,PBUF(20));                       <<03620>>04958000
        MOVE PBUF := PBUF(26-LEN),(6-LEN);                     <<03620>>04960000
        PBUF(LEN) := 0;                                        <<03620>>04962000
        GENMSG(PVMSGSET,VIERR106,@PBUF);                       <<03642>>04964000
        EXIT'PROCEDURE;                                        <<03620>>04966000
        END;                                                   <<03620>>04968000
<<------------------------------------------------------>>     <<03620>>04970000
<< SORT DEFECTIVE SECTOR TABLE IN DESCENDING ORDER      >>     <<03620>>04972000
<<------------------------------------------------------>>     <<03620>>04974000
SORT'DSCT;                                                     <<03620>>04976000
<<------------------------------------------------------>>     <<03620>>04978000
<< TRY TO SPARE EVERY SUSPECT SECTOR IN DSCT            >>     <<03620>>04980000
<<------------------------------------------------------>>     <<03620>>04982000
WHILE GET'DSCT'ENTRY(DISC'ADDR) DO                             <<03620>>04984000
   BEGIN                                                       <<03620>>04986000
   SECTOR'LOST := TRACK'LOST := FALSE;                         <<04290>>04988000
   <<--------------------------------------------------->>     <<03620>>04990000
   << READ DATA FROM SUSPECT SECTOR                     >>     <<03620>>04992000
   <<--------------------------------------------------->>     <<03620>>04994000
   IOSTATUS := NO'WARN;                                        <<03620>>04996000
   DISCIO(LDEV,R,TRK'BUF,DISC'ADDR,SECTOR'SIZE,IOSTATUS);      <<03620>>04998000
   IF <> THEN                                                  <<04290>>05000000
      BEGIN                                                    <<04290>>05002000
      CHECK'IO'ERROR;                                          <<04290>>05004000
      SECTOR'LOST := TRUE;                                     <<04290>>05006000
      END;                                                     <<04290>>05008000
   <<--------------------------------------------------->>     <<03620>>05010000
   << RUN W/R ERROR TEST ON DEFECTIVE SECTOR            >>     <<03620>>05012000
   <<--------------------------------------------------->>     <<03620>>05014000
   IOSTATUS := NO'WARN;                                        <<03620>>05016000
   DISCIO(LDEV,INIT'UTIL,DISC'ADDR,RW'ERT,SECTOR,IOSTATUS);    <<03620>>05018000
   IF = THEN    << SUSPECT SECTOR OK >>                        <<03620>>05020000
      BEGIN                                                    <<03620>>05022000
   <<--------------------------------------------------->>     <<03620>>05024000
   << REMOVE SUSPECT SECTOR ENTRY; WRITE DATA BACK      >>     <<03620>>05026000
   <<--------------------------------------------------->>     <<03620>>05028000
      REMOVE'DSCT'ENTRY(SECTOR,SPARED);                        <<03620>>05030000
      IOSTATUS := NO'WARN;                                     <<03620>>05032000
      DISCIO(LDEV,W,TRK'BUF,DISC'ADDR,SECTOR'SIZE,IOSTATUS);   <<03620>>05034000
      IF <> THEN  <<IF DTT'CHANGES TABLE FULL THEN EXIT>>      <<03620>>05036000
         BEGIN                                                 <<03620>>05038000
         CHECK'IO'ERROR;                                       <<03620>>05040000
         IF NOT ENT'DTT'CHANGES(DISC'ADDR,1) THEN GOTO XIT;    <<03620>>05042000
         END                                                   <<04290>>05044000
      ELSE                                                     <<04290>>05046000
         IF SECTOR'LOST THEN                                   <<04290>>05048000
            IF NOT ENT'DTT'CHANGES(DISC'ADDR,1) THEN           <<04290>>05050000
               GOTO XIT;                                       <<04290>>05052000
      GENMSG (PVMSGSET,VIWARN137,%20000,@DISC'ADDR);                    05054000
      GOTO NEXT'DSCT'ENTRY;                                             05056000
      END;   <<SUSPECT SECTOR RECOVERED>>                               05058000
                                                                        05060000
   <<--------------------------------------------------->>     <<03620>>05062000
   << IF SECTOR IS STILL BAD THEN SPARES SECTOR WITH    >>     <<03620>>05064000
   << RETAINING DATA                                    >>     <<03620>>05066000
   <<--------------------------------------------------->>     <<03620>>05068000
   IOSTATUS := NO'WARN;   << NO EXTRA WARNINGS >>              <<03620>>05070000
   DISCIO(LDEV,SPARE'BLOCK,DISC'ADDR,RETAIN'DATA,0,IOSTATUS);  <<03620>>05072000
   IF = THEN   << SPARE SINGLE SECTOR >>                       <<03620>>05074000
      BEGIN                                                    <<03620>>05076000
      <<------------------------------------------------>>     <<03620>>05078000
      << WRITE SAVED DATA BACK                          >>     <<03620>>05080000
      <<------------------------------------------------>>     <<03620>>05082000
      IOSTATUS := NO'WARN;                                     <<03620>>05084000
      DISCIO(LDEV,W,TRK'BUF,DISC'ADDR,SECTOR'SIZE,IOSTATUS);   <<03620>>05086000
      IF <> THEN                                               <<03620>>05088000
         BEGIN                                                 <<03620>>05090000
         CHECK'IO'ERROR;                                       <<03620>>05092000
         SECTOR'LOST := TRUE;                                  <<03620>>05094000
         END;                                                  <<03620>>05096000
      <<------------------------------------------------>>     <<03620>>05098000
      << RUN READ ONLY ERROR TEST ON SPARED SECTOR      >>     <<03620>>05100000
      <<------------------------------------------------>>     <<03620>>05102000
      IOSTATUS := NO'WARN;                                     <<03620>>05104000
      DISCIO(LDEV,INIT'UTIL,DISC'ADDR,RO'ERT,TRACK,IOSTATUS);  <<03620>>05106000
      IF = THEN                                                <<03620>>05108000
         BEGIN                                                 <<03620>>05110000
         REMOVE'DSCT'ENTRY(TRACK,SPARED);                      <<03620>>05112000
         IF SECTOR'LOST THEN                                   <<03620>>05114000
         IF NOT ENT'DTT'CHANGES(DISC'ADDR,1) THEN GOTO XIT;    <<03620>>05116000
         GOTO NEXT'DSCT'ENTRY;                                 <<03620>>05118000
         END;                                                  <<03620>>05120000
      END;   <<SPARE SINGLE SECTOR>>                           <<03620>>05122000
                                                               <<03620>>05124000
   <<--------------------------------------------------->>     <<03620>>05126000
   << MORE THAN ONE SUSPECT SECTOR ON TRACK             >>     <<03620>>05128000
   << READ ALL DATA FROM BAD TRACK AND SAVE THEM        >>     <<03620>>05130000
   << INDICATE BAD SECTORS IN DTT'CHANGES TABLE         >>     <<03620>>05132000
   <<--------------------------------------------------->>     <<03620>>05134000
   IF <> THEN CHECK'IO'ERROR;                                  <<03620>>05136000
   IF IOSTATUS.TSTATUS = NO'SPARE THEN                         <<03620>>05138000
      IF NOT NO'SPARE'TRACK(TRACK,TRACK'LOST) THEN GOTO XIT;   <<03620>>05140000
   SEC'NUM := AREA'SIZE := OFFSET := 0;                        <<03620>>05142000
   START'ADDR := DISC'ADDR/DBL(SECTRK)*DBL(SECTRK);            <<03620>>05144000
   FOR SEC'NUM := 1 UNTIL SECTRK DO                            <<03620>>05146000
      BEGIN                                                    <<03620>>05148000
      DISCIO(LDEV,R,TRK'BUF(OFFSET),START'ADDR,SECTOR'SIZE,    <<03620>>05150000
                                       IOSTATUS);              <<03620>>05152000
      IF <> THEN   <<BAD SECTOR>>                              <<03620>>05154000
         BEGIN                                                 <<03620>>05156000
         CHECK'IO'ERROR;                                       <<03620>>05158000
         IF AREA'SIZE = 0 THEN   <<FIRST SECTOR IN BAD AREA>>  <<03620>>05160000
            BEGIN                                              <<03620>>05162000
            AREA'SIZE := 1;   <<SET BAD AREA = 1 SECTOR>>      <<03620>>05164000
            SEC'INDEX := SEC'NUM;   <<SET SECTOR INDEX>>       <<03620>>05166000
            DISC'ADDR := START'ADDR;   <<SET START ADDRESS>>   <<03620>>05168000
            END                                                <<03620>>05170000
            ELSE   <<MORE THAN ONE BAD SEC. IN BAD AREA>>      <<03620>>05172000
            IF SEC'INDEX = SEC'NUM-1 THEN                      <<03620>>05174000
               AREA'SIZE := AREA'SIZE+1   <<CONTIGIOUS>>       <<03620>>05176000
               ELSE  <<MARK PREVIOUS BAD AREA>>                <<03620>>05178000
               BEGIN                                           <<03620>>05180000
               IF NOT ENT'DTT'CHANGES(DISC'ADDR,AREA'SIZE) THEN<<03620>>05182000
                  GOTO XIT;                                    <<03620>>05184000
               AREA'SIZE := 1;                                 <<03620>>05186000
               SEC'INDEX := SEC'NUM;                           <<03620>>05188000
               DISC'ADDR := START'ADDR;                        <<03620>>05190000
               END;                                            <<03620>>05192000
         END;                                                  <<03620>>05194000
      START'ADDR := START'ADDR + 1D; <<SET ADDR TO NEXT SEC>>  <<03620>>05196000
      OFFSET := OFFSET +SECTOR'SIZE;                           <<03620>>05198000
   END;   <<LOOP>>                                             <<03620>>05200000
   IF AREA'SIZE <> 0 THEN                                      <<03620>>05202000
      IF NOT ENT'DTT'CHANGES(START'ADDR,AREA'SIZE) THEN        <<03620>>05204000
         GOTO XIT;                                             <<03620>>05206000
   <<--------------------------------------------------->>     <<03620>>05208000
   << SPARE BLOCK WITHOUT RETAINING DATA                >>     <<03620>>05210000
   <<--------------------------------------------------->>     <<03620>>05212000
TRY'AGAIN:                                                     <<03620>>05214000
   IOSTATUS := NO'WARN;   <<NO EXTRA WARNING>>                 <<03620>>05216000
   DISCIO(LDEV,SPARE'BLOCK,DISC'ADDR,NO'RETAIN'DATA,0,         <<03620>>05218000
                                         IOSTATUS);            <<03620>>05220000
   IF <> THEN CHECK'IO'ERROR;                                  <<03620>>05222000
   IF IOSTATUS.TSTATUS = NO'SPARE THEN                         <<03620>>05224000
      IF NOT NO'SPARE'TRACK(TRACK,TRACK'LOST) THEN GOTO XIT;   <<03620>>05226000
   <<--------------------------------------------------->>     <<03620>>05228000
   << RUN WRITE/READ ERROR TEST ON SPARED TRACK         >>     <<03620>>05230000
   <<--------------------------------------------------->>     <<03620>>05232000
   IOSTATUS := NO'WARN;                                        <<03620>>05234000
   DISCIO(LDEV,INIT'UTIL,DISC'ADDR,RW'ERT,TRACK,IOSTATUS);     <<03620>>05236000
   IF <> THEN   <<NEW TRACK ALSO BAD>>                         <<03620>>05238000
      BEGIN                                                    <<03620>>05240000
      CHECK'IO'ERROR;                                          <<03620>>05242000
      TRACK'LOST := TRUE;                                      <<03620>>05244000
      GOTO TRY'AGAIN;                                          <<03620>>05246000
      END;                                                     <<03620>>05248000
   <<--------------------------------------------------->>     <<03620>>05250000
   << REMOVE ALL SUSPECT SECTORS WHICH BELONG TO        >>     <<03620>>05252000
   << THE SAME TRACK AND WRITE ALL DATA BACK            >>     <<03620>>05254000
   <<--------------------------------------------------->>     <<03620>>05256000
   REMOVE'DSCT'ENTRY(TRACK,SPARED);                            <<03620>>05258000
   IOSTATUS := NO'WARN;                                        <<03620>>05260000
   DISCIO(LDEV,W,TRK'BUF,DISC'ADDR,SECTOR'SIZE*SECTRK,IOSTATUS)<<03620>>05262000
   ;                                                           <<03620>>05264000
   IF <> THEN                                                  <<03620>>05266000
      BEGIN                                                    <<03620>>05268000
      CHECK'IO'ERROR;                                          <<03620>>05270000
      IF NOT ENT'DTT'CHANGES(DISC'ADDR,SECTRK) THEN GOTO XIT;  <<03620>>05272000
      END;                                                     <<03620>>05274000
NEXT'DSCT'ENTRY:                                               <<03620>>05276000
   END;   <<END OF DSCT ENTRY LOOP>>                           <<03620>>05278000
XIT:                                                           <<03620>>05280000
END;   <<CS80'SPARE>>                                          <<03620>>05282000
$PAGE "PVINIT - TRACK HANDLING UTILITY PROCEDURES"             <<00239>>05284000
$CONTROL SEGMENT=NEWPACK                                       <<RK3PV>>05286000
INTEGER PROCEDURE ALTTRACK(LDN,TRACK);                                  05288000
VALUE LDN,TRACK;                                                        05290000
INTEGER LDN,TRACK;                                                      05292000
OPTION PRIVILEGED,UNCALLABLE;                                           05294000
BEGIN                                                                   05296000
     INTEGER I,SUBTYPE,TRKCYL,STHEAD;                                   05298000
     INTEGER type;                                             <<03510>>05300000
     LOGICAL L,SECTRK;                                                  05302000
     DOUBLE SECTOR;                                                     05304000
     LOGICAL      proc'status                                  <<03510>>05306000
                 ;                                             <<03510>>05308000
     ARRAY STAT'ADDR(0:3) = Q;                                 <<00239>>05310000
     INTEGER STATUS1 = STAT'ADDR + 2;                          <<00239>>05312000
     INTEGER IOSTATUS;                                         <<00239>>05314000
     INTEGER ARRAY B(0:140) = Q;                                        05316000
        <<THIS PROCEDURE RETURNS LOGICAL (NOT PHYSICAL) TRACK>><<RK.08>>05318000
                                                                        05320000
     CC := CCE;                                                <<00239>>05322000
     L:=0;                                                              05324000
     proc'status:=Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,   <<03510>>05326000
                  sectrk,,,trkcyl,sthead);                     <<03510>>05328000
     IF NOT(proc'status) THEN                                  <<03510>>05330000
        BEGIN                                                  <<03510>>05332000
           cc:=ccl;                                            <<03510>>05334000
           RETURN;                                             <<03510>>05336000
        END;                                                   <<03510>>05338000
     SECTOR:=LOGICAL(TRACK)**SECTRK;                                    05340000
     IF type=mh'disc'type AND                                  <<03510>>05342000
        (rp'7905 <= subtype <= st'7906) THEN                   <<03510>>05344000
     BEGIN                                                     <<00239>>05346000
     WHILE (L:=L+1) < SECTRK DO                                         05348000
     BEGIN                                                              05350000
          DISCIO(LDN,RFS,B,SECTOR+DOUBLE(L-1),FSCNT);                   05352000
          IF < THEN  <<DISC I/O ERROR>>                                 05354000
          BEGIN                                                         05356000
               CC:=CCL;                                                 05358000
               RETURN;                                                  05360000
          END;                                                          05362000
          IF B(1) = B(139) THEN  <<CYLINDER MATCH>>                     05364000
          IF B(2).HEADF = B(140).HEADF THEN  <<HEAD MATCH>>             05366000
          BEGIN  << VALID ALTERNATE ADDRESS >>                          05368000
               ALTTRACK:=IF B(1) = -1 THEN -1 ELSE                      05370000
                         IF B(1) = 0 AND B(2).HEADF = 0 THEN 0          05372000
                         ELSE (B(1)*TRKCYL+B(2).HEADF-STHEAD);          05374000
               RETURN;                                                  05376000
          END;                                                          05378000
     END;                                                               05380000
     END                                                       <<00239>>05382000
  ELSE                                                         <<00239>>05384000
     IF type=floppy'disc'type AND                              <<03510>>05386000
        subtype = floppy'disc'subtype THEN                     <<03510>>05388000
     BEGIN                                                     <<00239>>05390000
     IOSTATUS := 2;                                            <<00239>>05392000
     DISCIO(LDN,VM,STAT'ADDR,SECTOR,SECTRK,IOSTATUS);          <<00239>>05394000
     IF < THEN                                                 <<00239>>05396000
        BEGIN                                                  <<00239>>05398000
        CC := CCL;                                             <<00239>>05400000
        RETURN;                                                <<00239>>05402000
        END;                                                   <<00239>>05404000
     ALTTRACK := IF STATUS1.(8:8) = 0 THEN 0 ELSE              <<00239>>05406000
                    IF STATUS1.(8:8) = %21 THEN -1             <<00239>>05408000
                       ELSE -2;                                <<00239>>05410000
     RETURN;                                                   <<00239>>05412000
     END;                                                      <<00239>>05414000
     ALTTRACK:=-2;  <<NO GOOD ALT TRACK READ>>                          05416000
END  << ALTTRACK >>;                                                    05418000
                                                                        05420000
DOUBLE PROCEDURE ADRCONV(LDN,LOGADR);                                   05422000
VALUE LDN,LOGADR;                                                       05424000
INTEGER LDN;                                                            05426000
DOUBLE LOGADR;  <<LOGICAL ADDRESS>>                                     05428000
OPTION PRIVILEGED,UNCALLABLE;                                           05430000
BEGIN                                                                   05432000
     << THIS PROCEDURE CONVERTS A LOGICAL SECTOR ADDRESS INTO           05434000
        PHYSICAL HEAD,SECTOR, AND CYLINDER. THE RESULTS ARE             05436000
        RETURNED IN ADRCONV AS FOLLOWS:                                 05438000
                                                                        05440000
        ADRCONV   = CYLINDER,                                           05442000
        ADRCONV+1 = HEAD/SECTOR.                                        05444000
     >>                                                                 05446000
     INTEGER SUBTYPE;                                                   05448000
     INTEGER     type                                          <<03510>>05450000
                ,trkcyl                                        <<03510>>05452000
                ,sectrk                                        <<03510>>05454000
                ,headbase                                      <<03510>>05456000
                ;                                              <<03510>>05458000
     INTEGER ARRAY mh'headbase(rp'7905:fp'7906)=PB:=           <<03510>>05460000
         0,%1000,0,0,0,0,0,%1000;                              <<03510>>05462000
                                                                        05464000
     Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,                <<03510>>05466000
                   sectrk,,,trkcyl);                           <<03510>>05468000
     IF type = mh'disc'type AND                                <<03510>>05470000
        rp'7905 <= subtype <= rp'7906 THEN                     <<03510>>05472000
           headbase:=mh'headbase(subtype)                      <<03510>>05474000
     ELSE                                                      <<03510>>05476000
           headbase:=0;                                        <<03510>>05478000
     CC := CCE;                                                <<00239>>05480000
     TOS:=LOGADR;                                                       05482000
     TOS:=trkcyl*sectrk;  << sect/cyl >>                       <<03510>>05484000
     ASSEMBLE(LDIV);                                                    05486000
     IF OVERFLOW THEN  <<INVALID DISC ADDRESS>>                         05488000
     BEGIN                                                              05490000
          CC:=CCL;                                                      05492000
          RETURN;                                                       05494000
     END;                                                               05496000
     TOS:=sectrk;                                              <<03510>>05498000
     ASSEMBLE(DIV,XCH);                                                 05500000
     TOS:=TOS & lsl(8) + headbase + TOS;                       <<03510>>05502000
     ADRCONV:=TOS;                                                      05504000
END << ADRCONV >>;                                                      05506000
                                                                        05508000
PROCEDURE TRACKINIT(LDN,SECT,ADDRECSECT,WC,DISP,OPTN);                  05510000
VALUE LDN,SECT,ADDRECSECT,WC,DISP,OPTN;                                 05512000
DOUBLE SECT,ADDRECSECT;                                                 05514000
INTEGER LDN,WC,DISP;                                                    05516000
LOGICAL OPTN;                                                           05518000
OPTION VARIABLE;                                                        05520000
OPTION PRIVILEGED,UNCALLABLE;                                           05522000
BEGIN                                                                   05524000
     LOGICAL PMAP = Q-4;                                                05526000
     INTEGER BITS;                                                      05528000
     LOGICAL VERIFY;                                                    05530000
                                                               <<RK1PV>>05532000
  << DISP BIT 15 ==> D  (DISP=1) >>                            <<RK1PV>>05534000
  << DISP BIT 14 ==> P  (DISP=2) >>                            <<RK1PV>>05536000
  << DISP BIT 13 ==> S  (DISP=4) >>                            <<RK1PV>>05538000
  << OPTN BIT 15 ==> SEEK TO SPARED TRACK >>                   <<RK1PV>>05540000
  << TRACKINIT TAKES LOGICAL SECTOR ADDRESSES AS INPUT >>      <<RK.08>>05542000
  << THIS PROCEDURE SHOULD ONLY BE CALLED FOR A 7905-7925 >>   <<00239>>05544000
                                                                        05546000
     CC:=CCE;  <<ASSUME NO TRACK ERRORS>>                               05548000
     TOS:=REQSTATUS(LDN);                                      <<RK1PV>>05550000
     ASSEMBLE(DELB);                                           <<RK1PV>>05552000
     IF TOS.(9:2) <> 1 THEN                                    <<RK1PV>>05554000
        BEGIN                                                  <<RK1PV>>05556000
              GENMSG(PVMSGSET,VIERR33);                        <<RK1PV>>05558000
              GENMSG(PVMSGSET,VIERR0);                         <<RK1PV>>05560000
              CC:=CCL;                                         <<RK1PV>>05562000
              RETURN;                                          <<RK1PV>>05564000
        END;                                                   <<RK1PV>>05566000
     VERIFY:=IF PMAP THEN OPTN.(15:1) ELSE 0;                           05568000
     BITS:=IF PMAP.(14:1) THEN DISP ELSE 0;                             05570000
     BUFF(-3):=(BITS & LSL(1)) + INTEGER(VERIFY.(15:1));       <<RK1PV>>05572000
     BUFF(-2):=BUFF(-1):=0;                                    <<RK1PV>>05574000
     IF ADDRECSECT = -1D THEN BUFF(-2):=-1 ELSE                <<RK1PV>>05576000
     IF ADDRECSECT =  0D THEN BUFF(-2):= 0 ELSE                <<RK1PV>>05578000
     BEGIN                                                              05580000
          TOS:=ADRCONV(LDN,ADDRECSECT);  <<LOG. TO PHYS. ADDRESS>>      05582000
          BUFF(-1):=TOS;  <<HEAD/SECTOR>>                      <<RK1PV>>05584000
          BUFF(-2):=TOS;  <<CYLINDER>>                         <<RK1PV>>05586000
     END;                                                               05588000
     DISCIO(LDN,IN,BUFF,SECT,WC);                                       05590000
     IF < THEN CC:=CCL;  <<DISC I/O ERROR>>                             05592000
END  << TRACKINIT >>;                                                   05594000
                                                                        05596000
PROCEDURE FLAGTRACK(LDN,TRACK,ALT);                                     05598000
VALUE LDN,TRACK,ALT;                                                    05600000
INTEGER LDN,TRACK,ALT;                                                  05602000
OPTION PRIVILEGED,UNCALLABLE;                                           05604000
BEGIN                                                                   05606000
     <<  TRACK - LOGICAL (!) TRACK ADDRESS OF BAD TRACK >>     <<RK.08>>05608000
     <<  ALT   - LOGICAL (!) TRACK ADDRESS OF NEW TRACK >>     <<RK.08>>05610000
     <<PROCEDURE ASSUMES DTT ARRAY CONTAINS THE DTT FOR LDN>>           05612000
     << FLAGTRACK WORKS WITH LOGICAL (!) TRACKS INPUT PARMS >> <<RK.08>>05614000
     INTEGER I,SUBTYPE,IOSTATUS;                               <<RK2PV>>05616000
     INTEGER type;                                             <<03510>>05618000
     LOGICAL SECTRK,OLDALT;                                             05620000
     DOUBLE PADR,SECTOR,ALTSECTOR;                                      05622000
     INTEGER PADR1 = PADR;  <<CYLINDER PART OF PHYSICAL ADDRESS>>       05624000
     LOGICAL TRKSIZE;                                          <<RK1PV>>05626000
     EQUATE                                                             05628000
          D      =   1,     <<DEFECTIVE TRACK>>                         05630000
          SP     =   4;     <<SPARE TRACK>>                             05632000
                                                                        05634000
     CC:=CCE;  <<ASSUME NO DISC I/O ERRORS>>                            05636000
     Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,                <<03510>>05638000
                    sectrk);                                   <<03510>>05640000
     trksize:=sectrk * sector'size;                            <<03510>>05642000
     SECTOR:=LOGICAL(TRACK)**SECTRK;                                    05644000
     ALTSECTOR:=LOGICAL(ALT)**SECTRK;                                   05646000
     IF type = mh'disc'type AND                                <<03510>>05648000
        (rp'7905 <= subtype <= st'7906) THEN                   <<03510>>05650000
     BEGIN                                                              05652000
          TOS:=ALTTRACK(LDN,TRACK);                                     05654000
          IF < THEN  <<DISC I/O ERROR>>                                 05656000
          BEGIN                                                         05658000
               CC:=CCL;                                                 05660000
               RETURN;                                                  05662000
          END;                                                          05664000
          IF INTEGER(OLDALT:=TOS) > 0 THEN                     <<RK3PV>>05666000
             <<NOT DELETED OR NORMAL SPARE -- NORMAL OR REA >> <<RK3PV>>05668000
          BEGIN                                                         05670000
     IF OLDALT <> LOGICAL(TRACK) THEN                          <<RK.08>>05672000
               BEGIN                                           <<00239>>05674000
               TRACKINIT(LDN,(OLDALT**SECTRK),-1D,TRKSIZE,SP); <<RK.08>>05676000
               <<DELETE OLD SPARE IF THERE WAS ONE>>           <<RK1PV>>05678000
               IF < THEN  <<DISC I/O ERROR>>                            05680000
               BEGIN                                                    05682000
                    CC:=CCL;                                            05684000
                    RETURN;                                             05686000
               END;                                                     05688000
               END;  << OF OLDALT <> LOGICAL(TRACK) >>         <<00239>>05690000
          END;                                                          05692000
          IF ALT <> 0 THEN <<POINT ALTERNATE AT DEFECTIVE TRK>><<RK1PV>>05694000
          BEGIN                                                <<00239>>05696000
          TRACKINIT(LDN,ALTSECTOR,SECTOR,TRKSIZE,SP);          <<RK1PV>>05698000
          IF < THEN  <<DISC I/O ERROR>>                        <<RK1PV>>05700000
          BEGIN                                                <<RK1PV>>05702000
               CC:=CCL;                                        <<RK1PV>>05704000
               RETURN;                                         <<RK1PV>>05706000
          END;                                                 <<RK1PV>>05708000
          END;  << OF IF ALT<>0 >>                             <<00239>>05710000
          IF ALT = 0 THEN  <<DELETE>>                                   05712000
          BEGIN                                                         05714000
               PADR:=ADRCONV(LDN,SECTOR);  <<LOG. TO PHYS. ADDRESS>>    05716000
               I:=IF PADR1 >= DTT(DTTLPS) THEN SP ELSE D;      <<RK1PV>>05718000
               TRACKINIT(LDN,SECTOR,-1D,TRKSIZE,I);            <<RK1PV>>05720000
               IF < THEN  <<DISC I/O ERROR>>                            05722000
               BEGIN                                                    05724000
                    CC:=CCL;                                            05726000
                    RETURN;                                             05728000
               END;                                                     05730000
          END ELSE         <<REASSIGN>>                                 05732000
          BEGIN                                                         05734000
               TRACKINIT(LDN,SECTOR,ALTSECTOR,TRKSIZE,D);      <<RK1PV>>05736000
               IF < THEN  <<DISC I/O ERROR>>                            05738000
               BEGIN                                                    05740000
                    CC:=CCL;                                            05742000
                    RETURN;                                             05744000
               END;                                                     05746000
          END;                                                          05748000
     END                                                       <<00239>>05750000
     ELSE IF type = floppy'disc'type AND                       <<03510>>05752000
            subtype = floppy'disc'subtype THEN << floppy >>    <<03510>>05754000
     BEGIN   << FLOPPY CAN ONLY BE MARKED DEFECTIVE >>         <<00239>>05756000
          DISCIO(LDN,IT,BUFF,SECTOR,0);                        <<00239>>05758000
          IF < THEN <<DISC I/O ERROR>>                         <<00239>>05760000
             BEGIN                                             <<00239>>05762000
                  CC:=CCL;                                     <<00239>>05764000
                  RETURN;                                      <<00239>>05766000
             END;                                              <<00239>>05768000
     END;                                                      <<00239>>05770000
END  << FLAGTRACK >>;                                                   05772000
                                                                        05774000
                                                                        05776000
DOUBLE PROCEDURE cylinderhead(track,ldev);                     <<03510>>05778000
   VALUE track,ldev;                                           <<03510>>05780000
   INTEGER track,ldev;                                         <<03510>>05782000
OPTION PRIVILEGED,UNCALLABLE;                                           05784000
BEGIN                                                                   05786000
                                                               <<03510>>05788000
     << changed the 2nd parm from subtype to ldev to >>        <<03510>>05790000
     << reference the procedure Get'Disc'Info to get >>        <<03510>>05792000
     << all the pertinent info about disc            >>        <<03510>>05794000
     INTEGER     trkcyl                                        <<03510>>05796000
                ,trkmult                                       <<03510>>05798000
                ,sthead                                        <<03510>>05800000
                ;                                              <<03510>>05802000
     INTEGER                                                            05804000
          HEAD     = CYLINDERHEAD,                                      05806000
          CYLINDER = CYLINDERHEAD+1;                                    05808000
                                                                        05810000
     Get'Disc'Info(ldev,,,,,,,,,,,,,,,,,                       <<03510>>05812000
                   trkcyl,sthead,trkmult);                     <<03510>>05814000
                                                               <<03510>>05816000
     << the hokey trkmult only means anything for    >>        <<03510>>05818000
     << 7900 disc, both platters. There are really   >>        <<03510>>05820000
     << heads 0-3 but hardware only sees 0 & 2       >>        <<03510>>05822000
     CYLINDER := TRACK/TRKCYL*TRKMULT+STHEAD;                  <<03779>>05824000
     HEAD := TRACK MOD TRKCYL;                                 <<03779>>05826000
END << CYLINDERHEAD >>;                                                 05828000
                                                                        05830000
INTEGER PROCEDURE ADDDTTENTRY(TRACK);                                   05832000
VALUE TRACK;                                                            05834000
INTEGER TRACK;                                                          05836000
OPTION PRIVILEGED,UNCALLABLE;                                           05838000
BEGIN                                                                   05840000
     INTEGER I:=0;                                                      05842000
                                                                        05844000
     CC:=CCE;  <<ASSUME DTT NOT FULL>>                                  05846000
     IF DTT = 120 THEN  <<TABLE FULL>>                                  05848000
     BEGIN                                                              05850000
          CC:=CCL;                                                      05852000
          ADDDTTENTRY:=2;                                               05854000
          RETURN;                                                       05856000
     END;                                                               05858000
     WHILE (I:=I+1) <= DTT DO                                           05860000
     BEGIN  <<FIND WHERE IT GOES>>                                      05862000
          IF (DTT(I)&LSR(2)) = (TRACK&LSR(2)) THEN RETURN;  <<DUP ENT>> 05864000
          IF > THEN                                                     05866000
          BEGIN  <<MAKE ROOM FOR IT>>                                   05868000
               MOVE DTT(DTT+1):=DTT(DTT),(I-DTT-1);                     05870000
               GO TO ADD;                                               05872000
          END;                                                          05874000
     END;                                                               05876000
ADD: DTT(I):=TRACK;                                                     05878000
     DTT:=DTT+1;                                                        05880000
     ADDDTTENTRY:=1;                                                    05882000
END << ADDDTTENTRY >>;                                                  05884000
                                                               <<RK3PV>>05886000
PROCEDURE EOF;                                                 <<RK3PV>>05888000
   BEGIN                                                       <<RK3PV>>05890000
      MOVE MSG:="EOF DETECTED";                                <<RK3PV>>05892000
      PRINT(MSGW,6,0);                                         <<RK.08>>05894000
      QUIT(0);                                                 <<RK3PV>>05896000
      RETURN;                                                  <<RK3PV>>05898000
   END;                                                        <<RK3PV>>05900000
                                                               <<RK3PV>>05902000
PROCEDURE ADDENTRY(MAXHEAD,MAXCYL);                            <<RK3PV>>05904000
VALUE MAXHEAD,MAXCYL;                                          <<RK3PV>>05906000
INTEGER MAXHEAD,MAXCYL;                                        <<RK3PV>>05908000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>05910000
BEGIN                                                          <<RK3PV>>05912000
   LOGICAL INTERACTIVE,TRACK;                                  <<RK3PV>>05914000
   INTEGER LEN,CYL,HEAD;                                       <<RK3PV>>05916000
                                                               <<RK3PV>>05918000
   WHO(INTERACTIVE);                                           <<RK3PV>>05920000
   IF NOT INTERACTIVE THEN RETURN;                             <<RK3PV>>05922000
   MOVE MSG:=("ARE THERE ANY KNOWN BAD TRACKS",%15,%12,        <<RK.05>>05924000
   "THAT YOU WANT TO REASSIGN? ");                             <<RK.05>>05926000
L1:PRINT(MSGW,-59,%320);                                       <<RK.08>>05928000
   LEN:=READ(RBUFW,-10);                                       <<RK.08>>05930000
   IF <> THEN EOF;                                             <<RK3PV>>05932000
   IF LEN=0 OR RBUF="N" OR RBUF = "n" THEN RETURN ELSE         <<00092>>05934000
      IF RBUF<>"Y" AND RBUF<>"y" THEN GOTO L1;                 <<00092>>05936000
   MOVE MSG:="CYL?  HEAD?   ";                                 <<RK3PV>>05938000
L2:PRINT(MSGW,-5,%320);                                        <<RK.08>>05940000
   LEN:=READ(RBUFW,-10);                                       <<RK.08>>05942000
   IF <> THEN EOF;                                             <<RK3PV>>05944000
   IF LEN=0 THEN RETURN;                                       <<RK3PV>>05946000
   CYL:=BINARY(RBUF,LEN);                                      <<RK3PV>>05948000
   IF <> THEN GOTO L2;                                         <<RK3PV>>05950000
   IF CYL<0 OR CYL>MAXCYL THEN                                 <<RK3PV>>05952000
      BEGIN                                                    <<RK3PV>>05954000
      GENMSG(PVMSGSET,VIERR35);                                <<RK3PV>>05956000
      GOTO L2;                                                 <<RK3PV>>05958000
      END;                                                     <<RK3PV>>05960000
L3:PRINT(MSGW(3),-6,%320);                                     <<RK.08>>05962000
   LEN:=READ(RBUFW,-10);                                       <<RK.08>>05964000
   IF <> THEN EOF;                                             <<RK3PV>>05966000
   IF LEN=0 THEN RETURN;                                       <<RK3PV>>05968000
   HEAD:=BINARY(RBUF,LEN);                                     <<RK3PV>>05970000
   IF HEAD<0 OR HEAD>MAXHEAD THEN                              <<RK3PV>>05972000
      BEGIN                                                    <<RK3PV>>05974000
      GENMSG(PVMSGSET,VIERR36);                                <<RK3PV>>05976000
      GOTO L3;                                                 <<RK3PV>>05978000
      END;                                                     <<RK3PV>>05980000
   TRACK:=(LOGICAL(CYL)*LOGICAL(MAXHEAD+1)+LOGICAL(HEAD))*4;   <<RK3PV>>05982000
   TOS:=ADDDTTENTRY(TRACK);                                    <<RK3PV>>05984000
   IF < THEN GENMSG(PVMSGSET,VIERR37);                         <<RK3PV>>05986000
   IF TOS=0 THEN GENMSG(PVMSGSET,VIWARN4);                     <<RK3PV>>05988000
   GOTO L2;                                                    <<RK3PV>>05990000
   END; <<OF ADDENTRY>>                                        <<RK3PV>>05992000
                                                               <<RK3PV>>05994000
                                                                        05996000
INTEGER PROCEDURE DELDTTENTRY(TRACK);                                   05998000
VALUE TRACK;                                                            06000000
INTEGER TRACK;                                                          06002000
OPTION PRIVILEGED,UNCALLABLE;                                           06004000
BEGIN                                                                   06006000
     INTEGER I:=0;                                                      06008000
                                                                        06010000
     WHILE (I:=I+1) <= DTT DO                                           06012000
     IF DTT(I) = TRACK THEN                                             06014000
     BEGIN  <<FOUND IT>>                                                06016000
          DELDTTENTRY:=-1;                                              06018000
          MOVE DTT(I):=DTT(I+1),(DTT-I);                                06020000
          DTT:=DTT-1;                                                   06022000
          I:=DTT;  <<STOP LOOP>>                                        06024000
     END;                                                               06026000
END << DELDTTENTRY >>;                                                  06028000
                                                                        06030000
$CONTROL SEGMENT=NEWPACK                                       <<RK1PV>>06032000
PROCEDURE SORT'DTT(DTT);                                       <<00239>>06034000
INTEGER ARRAY DTT;                                             <<00239>>06036000
BEGIN                                                          <<00239>>06038000
   INTEGER I,J,K,T;                                            <<00239>>06040000
                                                               <<00239>>06042000
   IF DTT <= 1 THEN RETURN;                                    <<00239>>06044000
   FOR I := DTT STEP -1 UNTIL 2 DO                             <<00239>>06046000
   FOR J := 2 UNTIL I DO                                       <<00239>>06048000
      BEGIN                                                    <<00239>>06050000
      IF DTT(J) < DTT(J-1) THEN                                <<00239>>06052000
         BEGIN                                                 <<00239>>06054000
         T := DTT(J);                                          <<00239>>06056000
         DTT(J) := DTT(J-1);                                   <<00239>>06058000
         DTT(J-1) := T;                                        <<00239>>06060000
         END;                                                  <<00239>>06062000
      END;                                                     <<00239>>06064000
   FOR I := 1 UNTIL (DTT-1) DO                                 <<00239>>06066000
      IF DTT(I) = DTT(I+1) THEN                                <<00239>>06068000
         BEGIN                                                 <<00239>>06070000
         MOVE DTT(I) := DTT(I+1),(DTT-I);                      <<00239>>06072000
         DTT := DTT - 1;                                       <<00239>>06074000
         END;                                                  <<00239>>06076000
END;  << END OF SORT'DTT >>                                    <<00239>>06078000
                                                               <<00239>>06080000
                                                               <<00239>>06082000
PROCEDURE dttanalysis(ldn,diradr,dirsz,bitmapadr,descradr);    <<03510>>06084000
   VALUE ldn,diradr,dirsz,bitmapadr,descradr;                  <<03510>>06086000
   INTEGER ldn,dirsz;                                          <<03510>>06088000
   DOUBLE diradr,bitmapadr,descradr;                           <<03510>>06090000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                      <<03510>>06092000
BEGIN                                                                   06094000
<<   >>                                                        <<01353>>06096000
   << make calling procedure variable, only check the Dirc   >><<03510>>06098000
   << bitmap, and Descriptor addr if these are present. Both >><<03510>>06100000
   << format and init do not send these 4 args because format>><<03510>>06102000
   << a disc doesnt create any of these structures and init  >><<03510>>06104000
   << can place these anywhere. Before the FST(old DFSM) and >><<03510>>06106000
   << Directory                                              >><<03510>>06108000
   << were always next to each other and the FST ALWAYS start>><<03510>>06110000
   << at sector 30. Dtrack passes these 4 args because a user>><<03510>>06112000
   << needs to know if any suspect/deleted tracks are in     >><<03510>>06114000
   << these areas                                            >><<03510>>06116000
   << if pass Diradr then ASSUMES also passed dirsz          >><<03510>>06118000
<<  >>                                                         <<01353>>06120000
     INTEGER ENT:=0;                                                    06122000
     INTEGER I,J,K,ALT,CNT,LOC,LEN,TRK,RLEN,SIZE,ALTTRK,                06124000
             TRKCYL,MAXLPS,SUBTYPE,TRKSIZE;                             06126000
     LOGICAL NODISP,SECTRK,IOSTATUS,DISPMASK,ALTNEEDED=NODISP;          06128000
     DOUBLE ADDR,DTEMP,FSECT,LSECT;                                     06130000
     INTEGER                                                            06132000
          ADDR1  = ADDR,                                                06134000
          ADDR2  = ADDR+1,                                              06136000
          DTEMP1 = DTEMP,                                               06138000
          DTEMP2 = DTEMP+1;                                             06140000
   INTEGER     bit'map'sz        << in sectors >>              <<03510>>06142000
              ,descr'sz          << in sectors >>              <<03510>>06144000
              ,type                                            <<03510>>06146000
              ,def'log'pack'sz  << in cylinders >>             <<03510>>06148000
              ,bit'map'size'pages                              <<03510>>06150000
              ,dt'size'words                                   <<03510>>06152000
              ;                                                <<03510>>06154000
   LOGICAL     only'rec                                        <<03510>>06156000
              ,proc'status  << status from procedures >>       <<03510>>06158000
              ;                                                <<03510>>06160000
   DOUBLE      enddiradr                                       <<03510>>06162000
              ,endbitmapadr                                    <<03510>>06164000
              ,enddescradr                                     <<03510>>06166000
              ;                                                <<03510>>06168000
                                                               <<03510>>06170000
     << use this define to exit proc from subr >>              <<03510>>06172000
                                                               <<03510>>06174000
     DEFINE exit'procedure = ASSEMBLE(exit 8)#;                <<03510>>06176000
                                                               <<03510>>06178000
     DEFINE VALIDISP = NOT NODISP#;                                     06180000
     LOGICAL FLAGGED;                                          <<00239>>06182000
     BYTE ARRAY ANS(0:8)=PB:="REC","DEL","REA";                         06184000
      BYTE array disp(0:23)=pb:="RECOVER ","DELETE  ",         <<03510>>06186000
                               "REASSIGN";                              06188000
     INTEGER ARRAY DISPSIZE(0:2)=PB:=7,6,8;                    <<RK1PV>>06190000
     BYTE ARRAY BBUF(0:10);    <<WORK AREA >>                           06192000
     EQUATE BLANK = %6440;                                              06194000
     LOGICAL REA'OR'DEL;                                       <<00239>>06196000
     EQUATE REA = 8,                                           <<00239>>06198000
            DEL' = 4,                                          <<00239>>06200000
            REC = 2;                                           <<00239>>06202000
      LOGICAL    pmap=q-4;                                     <<03510>>06204000
      DEFINE     check'dirc=    pmap.(12:1)=1#;                <<03510>>06206000
      DEFINE     check'bitmap=  pmap.(14:1)#;                  <<03510>>06208000
      DEFINE     check'descr=   pmap.(15:1)#;                  <<03510>>06210000
                                                               <<03510>>06212000
                                                                        06214000
     SUBROUTINE leave(err);                                    <<03510>>06216000
        VALUE err;                                             <<03510>>06218000
        LOGICAL err;                                           <<03510>>06220000
                                                               <<03510>>06222000
     BEGIN                                                     <<03510>>06224000
                                                               <<03510>>06226000
$IF X3=ON                                                      <<03510>>06228000
         debug;                                                <<03510>>06230000
$IF                                                            <<03510>>06232000
        genmsg(pvmsgset,vierr34);                              <<03510>>06234000
        exit'procedure;                                        <<03510>>06236000
                                                               <<03510>>06238000
     END;                                                      <<03510>>06240000
     SUBROUTINE PRINTRACKINFO;                                          06242000
     BEGIN                                                              06244000
          TOS:=@PBUF;  <<INITIAL BUFFER PTR>>                           06246000
          IF K<2 THEN MOVE *:=" SUSPECT",2                              06248000
          ELSE MOVE *:="UNREADABLE",2;                                  06250000
          IF K>0 THEN MOVE *:=" ALT",2;                                 06252000
          MOVE *:=" TRK  LDEV #",2;                                     06254000
          TOS:=ASCII(LDN,10,BPS0);                                      06256000
          ASSEMBLE(ADD);  <<UPDATE BUFFER PTR>>                         06258000
          MOVE *:=" CYL=",2;                                            06260000
          dtemp:=cylinderhead(trk,ldn);                        <<03510>>06262000
          TOS:=ASCII(DTEMP2,10,BPS0);                                   06264000
          ASSEMBLE(ADD);                                                06266000
          MOVE *:=" HEAD=",2;                                           06268000
          TOS:=ASCII(DTEMP1,10,BPS0);                                   06270000
          ASSEMBLE(ADD); <<UPDATE BUFFER PTR>>                          06272000
          MOVE *:=" (SECTORS %",2;                                      06274000
          LEN:=DASCII(FSECT,8,BBUF);                                    06276000
          MOVE *:=BBUF(11-LEN),(LEN),2;                                 06278000
          MOVE *:="-%",2;                                               06280000
          LEN:=DASCII(LSECT,8,BBUF);                                    06282000
          MOVE *:=BBUF(11-LEN),(LEN),2;                                 06284000
          MOVE * :=")",2;                                               06286000
          LEN:=TOS-@PBUF;                                               06288000
          PRINT(PBUFW,-LEN,0);                                 <<RK.08>>06290000
     END <<PRINTRACKINFO>>;                                             06292000
                                                                        06294000
     INTEGER SUBROUTINE DELDTTENTRIES(TRACK);                           06296000
     VALUE TRACK;                                                       06298000
     INTEGER TRACK;                                                     06300000
     BEGIN                                                              06302000
          I:=J:=0;                                                      06304000
          WHILE (I:=I+1) <= DTT DO                                      06306000
          IF (DTT(I)&LSR(2)) = TRACK THEN                               06308000
          BEGIN                                                         06310000
               WHILE (DTT(I) & LSR(2)) = TRACK DO                       06312000
               BEGIN                                                    06314000
                    I:=I+1;                                             06316000
                    J:=J+1;                                             06318000
               END;                                                     06320000
               MOVE DTT(I-J):=DTT(I),(DTT-I+1);                         06322000
               DTT:=DTT-J;                                              06324000
               DELDTTENTRIES:=-J;                                       06326000
               I:=DTT;  <<STOP LOOP>>                                   06328000
          END;                                                          06330000
     END <<DELDTTENTRIES>> ;                                            06332000
                                                                        06334000
     INTEGER SUBROUTINE GETDISP(LEGAL);                                 06336000
     VALUE LEGAL;                                                       06338000
     LOGICAL LEGAL;                                                     06340000
     BEGIN                                                              06342000
          I:=CNT:=LOC:=0;   K:=-1;                             <<RK1PV>>06344000
          DISPMASK:=LEGAL & LSR(1);  <<SKIP IGNORE BIT>>                06346000
          WHILE DISPMASK <> 0 DO                                        06348000
          BEGIN                                                         06350000
               IF I = 0 THEN K:=K+1;     <<BIT LOC>>                    06352000
               IF DISPMASK THEN I:=I+1;  <<BIT COUNT>>                  06354000
               DISPMASK:=DISPMASK & LSR(1);                             06356000
          END;                                                          06358000
          CNT:=I+INTEGER(LEGAL.(15:1));  <<NUMBER OF CHOICES ALLOWED>>  06360000
          DISPMASK:=LEGAL & LSR(1);                                     06362000
          TOS:=@PBUF+1;                                                 06364000
          WHILE DISPMASK <> 0 DO                                        06366000
          BEGIN                                                         06368000
               IF DISPMASK THEN                                         06370000
               BEGIN                                           <<RV.PV>>06372000
               MOVE * :=DISP(LOC*8),(DISPSIZE(LOC)),2;         <<RK1PV>>06374000
               I:=I-1;                                                  06376000
               CASE *I OF                                               06378000
               BEGIN                                                    06380000
                    ;                                                   06382000
                    MOVE * :=" OR ",2;                                  06384000
                    MOVE * :=",",2;                                     06386000
               END;                                                     06388000
               END;                                            <<RK1PV>>06390000
               LOC:=LOC+1;                                     <<RK1PV>>06392000
               DISPMASK:=DISPMASK & LSR(1);                    <<RV.PV>>06394000
          END;                                                          06396000
          IF CNT=1 THEN <<NO CHOICE ANYWAY>>                   <<RK4PV>>06398000
             BEGIN                                             <<RK4PV>>06400000
             IF K=1 THEN MOVE *:="D",2                         <<RK4PV>>06402000
                ELSE MOVE *:="ED",2;                           <<RK4PV>>06404000
             LEN:=TOS-@PBUF;                                   <<RK4PV>>06406000
             PRINT(PBUFW,-LEN,0);                              <<RK.08>>06408000
             GETDISP:=K+1;                                     <<RK4PV>>06410000
             RETURN;                                           <<RK4PV>>06412000
             END;                                              <<RK4PV>>06414000
          MOVE * :="? ",2;                                              06416000
          LEN:=TOS-@PBUF;                                               06418000
          NODISP:=TRUE;                                                 06420000
          WHILE NODISP DO                                               06422000
          BEGIN                                                         06424000
               PRINT(PBUFW,-LEN,%320);                         <<RK.08>>06426000
               RLEN:=READ(RBUFW,-10);                          <<RK.08>>06428000
               IF <> THEN EOF;                                 <<RK3PV>>06430000
               RBUF(RLEN):=0;                                  <<00092>>06432000
               MOVE RBUF:=RBUF WHILE ANS;                      <<00092>>06434000
               IF RLEN=0 THEN                                  <<RK1PV>>06436000
               BEGIN  <<ASSUME "IGNORE" OR "NO">>                       06438000
                    I:=-1;  <<FOR X CHECK BELOW>>                       06440000
                    NODISP:=FALSE;                                      06442000
               END ELSE                                                 06444000
               BEGIN                                                    06446000
                    IF CNT = 1 THEN  <<"YES" OR "NO" EXPECTED>>         06448000
                    BEGIN                                               06450000
                         NODISP:=FALSE;  <<ASSUME VALID RESP>>          06452000
                         IF RBUF="Y" THEN I:=K ELSE                     06454000
                         IF RBUF="N" THEN I:=-1 ELSE                    06456000
                         IF RLEN>=3 AND RBUF=ANS(K*3),(3)      <<RK1PV>>06458000
                            THEN I:=K ELSE                     <<RK1PV>>06460000
                         NODISP:=TRUE;  <<RESPONSE WAS INVALID>>        06462000
                    END ELSE                                            06464000
                    BEGIN                                               06466000
                         J:=0;                                          06468000
                         DO  <<LOOK FOR DISP MATCH>>                    06470000
                           IF RBUF = ANS(J*3),(3) THEN                  06472000
                           BEGIN                                        06474000
                                NODISP:=FALSE;                          06476000
                                I:=J;  <<SAVE MATCH>>                   06478000
                                J:=2;  <<STOP LOOP>>                    06480000
                           END                                          06482000
                         UNTIL (J:=J+1) = 3;                            06484000
                    END;                                                06486000
               END;                                                     06488000
               IF VALIDISP THEN                                         06490000
               BEGIN                                                    06492000
                    X:=14-I;                                            06494000
                    BEGIN                                               06496000
                         TOS:=LEGAL;                                    06498000
                         ASSEMBLE(TBC 0,X);                             06500000
                         IF = THEN NODISP:=TRUE;                        06502000
                         DELETE;                                        06504000
                    END;                                                06506000
                    GETDISP:=15-X;                                      06508000
               END ELSE                                                 06510000
               BEGIN                                                    06512000
                    GENMSG(PVMSGSET,VIERR2);                            06514000
               END;                                                     06516000
          END;                                                          06518000
     END <<GETDISP>>;                                                   06520000
                                                                        06522000
     SUBROUTINE SETDISP(TRACK,DISP);                                    06524000
     VALUE TRACK,DISP; INTEGER TRACK,DISP;                              06526000
     BEGIN                                                              06528000
          CASE *DISP OF                                                 06530000
          BEGIN                                                         06532000
               RETURN;  <<DISP = 0 - IGNORE>>                           06534000
                                                                        06536000
               BEGIN    <<DISP = 1 - RECOVER>>                          06538000
                    DELDTTENTRY(DTT(ENT));                     <<RK4PV>>06540000
                    RETURN;                                             06542000
               END;                                                     06544000
                                                                        06546000
               ALT:=0;  <<DISP = 2 - DELETE>>                           06548000
                                                                        06550000
               BEGIN    <<DISP = 3 - REASSIGN>>                         06552000
                    ALTNEEDED:=TRUE;                                    06554000
                    WHILE ALTNEEDED DO                                  06556000
                    BEGIN                                               06558000
                         IF DTT(DTTALT)=(MAXLPS*TRKCYL) THEN            06560000
                         BEGIN  <<NO ALTERNATES AVAILABLE>>             06562000
                              GENMSG(PVMSGSET,VIERR10);                 06564000
                              GENMSG(PVMSGSET,VIERR12);        <<RK1PV>>06566000
                              RETURN;                                   06568000
                         END;                                           06570000
                         I:=0;                                          06572000
                         ALTNEEDED:=FALSE;                              06574000
                         WHILE (I:=I+1) <= DTT DO                       06576000
                         IF DTT(I)&LSR(2)=DTT(DTTALT) THEN              06578000
                         BEGIN  <<AVAILABLE ALTERNATE IS BAD>>          06580000
                              DTT(X):=DTT(DTTALT)+1;                    06582000
                              ALTNEEDED:=TRUE;                          06584000
                              I:=DTT;  <<STOP LOOP>>                    06586000
                         END;                                           06588000
                    END;                                                06590000
                    ALT:=DTT(DTTALT);                                   06592000
                    DTT(X):=DTT(X)+1;                                   06594000
               END;                                                     06596000
                                                                        06598000
          END <<CASE>>;                                                 06600000
          DELDTTENTRIES(TRACK);                                <<RK4PV>>06602000
          ADDDTTENTRY(TRACK&LSL(2)+DISP);                      <<RK4PV>>06604000
                                                               <<00239>>06606000
          X := DTT'CHANGES := DTT'CHANGES + 1;                 <<00239>>06608000
          DTT'CHANGES(X) := (TRACK & LSL(2)) + DISP;           <<00239>>06610000
          DTT'DISP(X) := ALT;                                  <<00239>>06612000
                                                               <<00239>>06614000
                                                               <<00239>>06616000
     END <<SETDISP>>;                                                   06618000
                                                                        06620000
     CC:=CCE;  <<ASSUME NO DTT ENTRIES>>                                06622000
     DTT'CHANGES := 0;                                         <<00239>>06624000
     MOVE DTT'CHANGES(1) := DTT'CHANGES,(DTT'CHANGES'SIZE);    <<03620>>06626000
     proc'status:=Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,   <<03510>>06628000
                      sectrk,def'log'pack'sz,,trkcyl);         <<03510>>06630000
     IF NOT(proc'status) THEN leave(proc'status);              <<03510>>06632000
     size:=def'log'pack'sz * trkcyl; << in tracks, of disc >>  <<03510>>06634000
     IF type = floppy'disc'type AND                            <<03510>>06636000
        subtype = floppy'disc'subtype THEN                     <<03510>>06638000
           rea'or'del:=del'                                    <<03510>>06640000
        ELSE                                                   <<03510>>06642000
           rea'or'del:=rea;                                    <<03510>>06644000
     << compute the ending addresses(in sectors) of any of   >><<03510>>06646000
     << the arguments which are present. This is so that the >><<03510>>06648000
     << addr can be checked to see if they lie in susp areas >><<03510>>06650000
                                                               <<03510>>06652000
     IF check'dirc THEN enddiradr:=diradr + DBL(dirsz) -1D;    <<03510>>06654000
     IF check'bitmap THEN                                      <<03510>>06656000
        BEGIN                                                  <<03510>>06658000
           proc'status:=Get'Disc'Info(ldn,,,,,,,,              <<03510>>06660000
                                  bit'map'size'pages);         <<03510>>06662000
           IF NOT(proc'status) THEN leave(proc'status);        <<03510>>06664000
           bit'map'sz:=bit'map'size'pages * page'size;         <<03510>>06666000
           endbitmapadr:=bitmapadr + DBL(bit'map'sz) -1D;      <<03510>>06668000
        END;                                                   <<03510>>06670000
     IF check'descr THEN                                       <<03510>>06672000
        BEGIN                                                  <<03510>>06674000
           proc'status:=Get'Disc'info(ldn,,,,,,,,,,            <<03510>>06676000
                                 dt'size'words);               <<03510>>06678000
           IF NOT(proc'status) THEN leave(proc'status);        <<03510>>06680000
           descr'sz:=dt'size'words / sector'size;              <<03510>>06682000
           IF (dt'size'words MOD sector'size) <> 0 THEN        <<03510>>06684000
                  descr'sz:=descr'sz+1;                        <<03510>>06686000
           enddescradr:=descradr + DBL(descr'sz) -1D;          <<03510>>06688000
        END;                                                   <<03510>>06690000
                                                               <<03510>>06692000
   IF NOT CS'80 THEN                                           <<03620>>06694000
     BEGIN                                                     <<03620>>06696000
     SORT'DTT(DTT);                                            <<00239>>06698000
     ENT:=DTT+1;                                               <<RK3PV>>06700000
     WHILE (ENT:=ENT-1) > 0 DO                                 <<RK3PV>>06702000
     IF (K:=DTT(ENT).(14:2)) <= 1 THEN  <<SUSPECT TRACK>>               06704000
     BEGIN                                                              06706000
          CC:=CCG;  <<SUSPECT TRACKS FOUND>>                            06708000
          TRK:=DTT(ENT)&LSR(2);  <<TRACK #>>                            06710000
          IF K=0 AND ENT<>DTT AND DTT(ENT+1)&LSR(2)=TRK THEN K:=2;      06712000
          FSECT:=LOGICAL(TRK)**SECTRK;  <<FIRST SECTOR>>                06714000
          LSECT:=FSECT+DOUBLE(SECTRK-1);  <<LAST SECTOR>>               06716000
          PRINTRACKINFO;                                                06718000
          IOSTATUS:=%2;  <<RETURN ERROR, NO ERROR MESSAGES>>            06720000
          FLAGGED:=( ALTTRACK(LDN,TRK) < 0 );                  <<RK4PV>>06722000
          IF LSECT >= (SECTRK**LOGICAL(SIZE)) THEN                      06724000
          BEGIN                                                         06726000
               GENMSG(PVMSGSET,VIWARN1);                                06728000
               IF FLAGGED THEN                                          06730000
               BEGIN                                                    06732000
                    WHILE GETDISP(DEL') = 0 DO  <<DEL>>        <<00239>>06734000
                    BEGIN                                               06736000
                         GENMSG(PVMSGSET,VIERR2);                       06738000
                    END;                                                06740000
                    SETDISP(TRK,2);  <<DEL>>                   <<RK1PV>>06742000
               END ELSE                                                 06744000
               SETDISP(TRK,GETDISP(DEL'+REC));      <<DEL,REC>><<00239>>06746000
          END ELSE                                                      06748000
          IF FLAGGED THEN                                               06750000
             SETDISP(TRK,GETDISP(REA'OR'DEL))                  <<00239>>06752000
          ELSE                                                          06754000
             BEGIN                                             <<03510>>06756000
                only'rec<< recover opt only>>:=false; <<init>> <<03510>>06758000
                IF check'dirc THEN                             <<03510>>06760000
                   BEGIN                                       <<03510>>06762000
                      IF diradr >= fsect AND                   <<03510>>06764000
                         diradr <= lsect THEN only'rec:=true   <<03510>>06766000
                      ELSE                                     <<03510>>06768000
                         IF enddiradr >= fsect AND             <<03510>>06770000
                            enddiradr <= lsect THEN            <<03510>>06772000
                                               only'rec:=true  <<03510>>06774000
                      ELSE                                     <<03510>>06776000
                         IF diradr >= fsect AND                <<03510>>06778000
                            enddiradr <= lsect THEN            <<03510>>06780000
                                     only'rec:=true            <<03510>>06782000
                      ELSE                                     <<03510>>06784000
                         IF fsect >= diradr AND                <<03510>>06786000
                            lsect <= enddiradr THEN            <<03510>>06788000
                                     only'rec:=true;           <<03510>>06790000
                   END;                                        <<03510>>06792000
                IF check'bitmap THEN                           <<03510>>06794000
                   BEGIN                                       <<03510>>06796000
                      IF bitmapadr >= fsect AND                <<03510>>06798000
                         bitmapadr <= lsect THEN only'rec:=true<<03510>>06800000
                      ELSE                                     <<03510>>06802000
                         IF endbitmapadr >=fsect AND           <<03510>>06804000
                            endbitmapadr <=lsect THEN          <<03510>>06806000
                                                only'rec:=true <<03510>>06808000
                      ELSE                                     <<03510>>06810000
                         IF bitmapadr >= fsect AND             <<03510>>06812000
                            endbitmapadr <= lsect THEN         <<03510>>06814000
                                      only'rec:=true           <<03510>>06816000
                      ELSE                                     <<03510>>06818000
                         IF fsect >= bitmapadr AND             <<03510>>06820000
                            lsect <= endbitmapadr THEN         <<03510>>06822000
                                      only'rec:=true;          <<03510>>06824000
                   END;                                        <<03510>>06826000
                IF check'descr THEN                            <<03510>>06828000
                   BEGIN                                       <<03510>>06830000
                      IF descradr >= fsect AND                 <<03510>>06832000
                         descradr <= lsect THEN only'rec:=true <<03510>>06834000
                      ELSE                                     <<03510>>06836000
                         IF enddescradr >=fsect AND            <<03510>>06838000
                            enddescradr <=lsect THEN           <<03510>>06840000
                                                only'rec:=true <<03510>>06842000
                      ELSE                                     <<03510>>06844000
                         IF descradr >= fsect AND              <<03510>>06846000
                            enddescradr <= lsect THEN          <<03510>>06848000
                                  only'rec:=true               <<03510>>06850000
                      ELSE                                     <<03510>>06852000
                         IF fsect >= descradr AND              <<03510>>06854000
                            lsect <= enddescradr THEN          <<03510>>06856000
                                  only'rec:=true               <<03510>>06858000
                   END;                                        <<03510>>06860000
                << In reserved area ??? >>                     <<03527>>06862000
                IF ldn = 1 THEN                                <<03527>>06864000
                   BEGIN  << LDEV 1 >>                         <<03527>>06866000
                      IF ldev1'start'resv'area >= fsect AND    <<03527>>06868000
                      ldev1'start'resv'area <= lsect THEN      <<03527>>06870000
                         only'rec := TRUE;                     <<03527>>06872000
                      IF ldev1'end'resv'area >= fsect AND      <<03527>>06874000
                      ldev1'end'resv'area <= lsect THEN        <<03527>>06876000
                         only'rec := TRUE;                     <<03527>>06878000
                      IF ldev1'start'resv'area >= fsect AND    <<03527>>06880000
                      ldev1'end'resv'area <= lsect THEN        <<03527>>06882000
                         only'rec := TRUE;                     <<03527>>06884000
                      IF fsect >= ldev1'start'resv'area AND    <<03527>>06886000
                      lsect <= ldev1'end'resv'area THEN        <<03527>>06888000
                         only'rec := TRUE;                     <<03527>>06890000
                   END    << LDEV 1 >>                         <<03527>>06892000
                ELSE                                           <<03527>>06894000
                   BEGIN  << Other disc >>                     <<03527>>06896000
                      IF start'resv'area >= fsect AND          <<03527>>06898000
                      start'resv'area <= lsect THEN            <<03527>>06900000
                         only'rec := TRUE;                     <<03527>>06902000
                      IF end'resv'area >= fsect AND            <<03527>>06904000
                      end'resv'area <= lsect THEN              <<03527>>06906000
                         only'rec := TRUE;                     <<03527>>06908000
                      IF start'resv'area >= fsect AND          <<03527>>06910000
                      end'resv'area <= lsect THEN              <<03527>>06912000
                         only'rec := TRUE;                     <<03527>>06914000
                      IF fsect >= start'resv'area AND          <<03527>>06916000
                      lsect <= end'resv'area THEN              <<03527>>06918000
                         only'rec := TRUE;                     <<03527>>06920000
                   END;   << Other disc >>                     <<03527>>06922000
                IF only'rec THEN                               <<03510>>06924000
                   BEGIN                                       <<03510>>06926000
                      genmsg(pvmsgset,viwarn2);                <<03510>>06928000
                      setdisp(trk,getdisp(rec));               <<03510>>06930000
                   END                                         <<03510>>06932000
                ELSE  setdisp(trk,getdisp(rea'or'del + rec) ); <<03510>>06934000
             END;                                              <<03510>>06936000
         END;                                                  <<03620>>06938000
     END                                                       <<03620>>06940000
     ELSE   << CS'80 DISC >>                                   <<03620>>06942000
        BEGIN                                                  <<03620>>06944000
        <<-------------------------------------------->>       <<03620>>06946000
        << SPARE ALL DEFECTIVE SECTORS                >>       <<03620>>06948000
        <<-------------------------------------------->>       <<03620>>06950000
        CS80'SPARE;                                            <<03620>>06952000
        <<-------------------------------------------->>       <<03620>>06954000
        << CHECK IF ANY LOST DATA IN DIRECTORY, BIT   >>       <<03620>>06956000
        << MAP OR BIT MAP DESCRIPTOR                  >>       <<03620>>06958000
        <<-------------------------------------------->>       <<03620>>06960000
        J := 0;                                                <<03620>>06962000
        IF DTT'CHANGES > 0 THEN                                <<03620>>06964000
           BEGIN                                               <<03620>>06966000
           CC := CCG;   <<SUSPECT SECTOR FOUND>>               <<03620>>06968000
           FOR I := 1 UNTIL DTT'CHANGES DO                     <<03620>>06970000
              BEGIN                                            <<03620>>06972000
              ADDR1 := DTT'CHANGES(J:=J+1);                    <<03620>>06974000
              ADDR2 := DTT'CHANGES(J:=J+1);                    <<03620>>06976000
              FSECT := ADDR;                                   <<03620>>06978000
              LSECT := FSECT + DBL(DTT'CHANGES(J:=J+1)-1);     <<03620>>06980000
              IF CHECK'DIRC THEN                               <<03620>>06982000
                 IF DIRADR <= LSECT AND                        <<03620>>06984000
                 ENDDIRADR >= FSECT THEN                       <<03620>>06986000
                 GENMSG(PVMSGSET,VIWARN114);                   <<03620>>06988000
              IF CHECK'BITMAP THEN                             <<03620>>06990000
                 IF BITMAPADR <= LSECT AND                     <<03620>>06992000
                 ENDBITMAPADR >= FSECT THEN                    <<03620>>06994000
                 GENMSG(PVMSGSET,VIWARN115);                   <<03620>>06996000
              IF CHECK'DESCR THEN                              <<03620>>06998000
                 IF DESCRADR <= LSECT AND                      <<03620>>07000000
                 ENDDESCRADR >= FSECT THEN                     <<03620>>07002000
                 GENMSG(PVMSGSET,VIWARN116);                   <<03620>>07004000
              <<CHECK IF IN RESERVED AREA>>                    <<03620>>07006000
              IF START'RESV'AREA <= LSECT AND                  <<03620>>07008000
              END'RESV'AREA >= FSECT THEN                      <<03620>>07010000
              GENMSG(PVMSGSET,VIWARN2);                        <<03620>>07012000
              END;                                             <<03620>>07014000
           END;                                                <<03620>>07016000
     END;                                                               07018000
END << DTTANALYSIS >>;                                                  07020000
                                                               <<00239>>07022000
PROCEDURE ADD'DTT'CHANGES(LDN);                                <<00239>>07024000
VALUE LDN;                                                     <<00239>>07026000
INTEGER LDN;                                                   <<00239>>07028000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>07030000
BEGIN                                                          <<00239>>07032000
INTEGER I;                                                     <<00239>>07034000
                                                               <<00239>>07036000
   CC := CCE;                                                  <<00239>>07038000
   IF DTT'CHANGES = 0 THEN RETURN;                             <<00239>>07040000
   FOR I := 1 UNTIL DTT'CHANGES DO                             <<00239>>07042000
      BEGIN                                                    <<00239>>07044000
      TOS := LDN;                                              <<00239>>07046000
      TOS := DTT'CHANGES(I).(0:14);                            <<00239>>07048000
      TOS := DTT'DISP(I);                                      <<00239>>07050000
      FLAGTRACK(*,*,*);                                        <<00239>>07052000
      IF < THEN                                                <<00239>>07054000
         BEGIN                                                 <<00239>>07056000
         CC := CCL;                                            <<00239>>07058000
         RETURN;                                               <<00239>>07060000
         END;                                                  <<00239>>07062000
      END;                                                     <<00239>>07064000
END;                                                           <<00239>>07066000
$PAGE   "PVINIT - FORMAT FLOPPY PROCEDURES"                    <<04669>>07068000
$PAGE   "PVINIT - FORMAT FLOPPY PROCEDURES"                             07070000
PROCEDURE FORMAT'IBM'FLOPPY(LDN);                                       07072000
   COMMENT                                                              07074000
   THIS PROCEDURE FORMAT AND INITIALIZE A 3740 IBM DISKETTE.            07076000
                                                                        07078000
   THE 3740 IBM DISKETTES ARE SINGLESIDED WITH 77 TRACKS                07080000
   NUMBERED FROM 0 TO 76. EACH TRACK IS DIVIDED INTO 26 SECTORS         07082000
   WITH A STORAGE CAPACITY OF 128 SECTOR BYTES PER SECTOR.              07084000
   TRACK 0, CALLED THE INDEX TRACK, IS RESERVED FOR                     07086000
   INFORMATION DESCRIBING THE DISKETTE'S CONTENTS. THE TRACKS          07088000
   NUMBERED 01 THROUGH 73 ARE USED FOR DATA. EACH SECTOR CAN            07090000
   CONTAIN ONE RECORD. TRACK 74 IS RESERVED AND SHOULD NOT BE           07092000
   USED FOR DATA ENTRY. THE LAST TWO TRACKS (75 AND 76) ARE             07094000
   RESERVED FOR USE AS REPLACEMENT FOR DEFECTIVE TRACKS.                07096000
   EACH RECORD ON THE INDEX TRACK HAS A RECORD LENGTH OF 80             07098000
   BYTES. THE FIRST SEVEN SECTORS OF THE INDEX TRACK MAY                07100000
   CONTAIN SYSTEM INFORMATION OR INFORMATION ABOUT THE DISKETTE         07102000
   E.G. THE 5-TH SECTOR KEEPS DEFECTIVE TRACK TABLE (UP TO              07104000
   TWO TRACKS). THESE SEVEN SECTORS ARE NOT USUALLY USED OR             07106000
   MODIFIED BY THE OPERATOR. THE REMAINING SECTORS (08-26)              07108000
   MAY CONTAIN DATA SET LABELS, WHICH ARE USED TO DEFINE THE            07110000
   DATA SETS RESIDENT ON THE DISC AND ARE INVISIBLE. ALL DATA           07112000
   ARE RECORDED IN EBCIDC.                                              07114000
                                                                        07116000
   THIS PROCEDURE IS FORMATING ENTIRE DISKETTE WITHOUT                  07118000
   INVISIBLE TRACKS. THE INTERLEAVE VALUE IS 1 (IT IS REQUIRED          07120000
   FOR TRACK 0). THE DATA SET LABEL IS INTIALIZED WITH RECORD           07122000
   LENGTH VALUE OF 80 BYTES.                                            07124000
   ;                                                                    07126000
VALUE LDN;                                                              07128000
INTEGER LDN;   <<LOGICAL DEVICE NUMBER>>                                07130000
OPTION PRIVILEGED,UNCALLABLE;                                           07132000
                                                                        07134000
BEGIN                                                                   07136000
ARRAY DUMMY(0:3)=Q;   <<VERIFY RETURNS 4 WORDS>>                        07138000
DOUBLE ADDR=DUMMY;                                                      07140000
BYTE ARRAY VOLNAME(0:5);  <<Volume name>>                               07142000
INTEGER ADDR1=ADDR,ADDR2=ADDR+1;                                        07144000
INTEGER STATUS1=DUMMY+2,STATUS2=DUMMY+3;                                07146000
DOUBLE STATUS=STATUS1;                                                  07148000
INTEGER IOSTATUS,                                                       07150000
        I,                                                              07152000
        OFFSET,                                                         07154000
        SECTRK:=26,     <<26 SECTORS PER TRACK>>                        07156000
        TRKERRCNT:=0,   <<NUMBER OF DEFECTIVE TRACKS>>                  07158000
        TRACK,          <<TRACK NUMBER>>                                07160000
        TRKERR1 := 0,   <<DEFECTIVE TRACK #1>>                          07162000
        TRKERR2 := 0;   <<DEFECTIVE TRACK #2>>                          07164000
EQUATE  IBM'FLOPPY = %10,                                               07166000
        BLANK'DISKETTE = 1;                                             07168000
                                                                        07170000
IF KEYWDLEN = 3 THEN                                                    07172000
   MOVE VOLNAME := "IBMIRD"                                             07174000
ELSE                                                                    07176000
   BEGIN                                                                07178000
   MOVE VOLNAME := "      ";                                            07180000
   KEYWORD(10) := 0;                                                    07182000
   MOVE VOLNAME := KEYWORD(4) WHILE ANS;                                07184000
   IF 4 < KEYWDLEN AND KEYWDLEN <= 10 AND                               07186000
      KEYWORD = "IBM:" AND                                              07188000
      VOLNAME = KEYWORD(4),(KEYWDLEN-4) THEN                            07190000
   ELSE                                                                 07192000
      BEGIN                                                             07194000
      GENMSG(PVMSGSET,VIERR3);                                          07196000
      CC := CCL;                                                        07198000
      RETURN;                                                           07200000
      END;                                                              07202000
   END;                                                                 07204000
                                                                        07206000
CC := CCE;   <<ASSUME SUCCESFUL>>                                       07208000
STATUS := REQSTATUS(LDN);                                               07210000
IF STATUS2.DOUBLESIDED THEN   <<ONLY SINGLESIDED>>                      07212000
   BEGIN                                                                07214000
   GENMSG(PVMSGSET,VIERR123);                                           07216000
   GENMSG(PVMSGSET,VIERR0);                                             07218000
   GOTO XIT;                                                            07220000
   END;                                                                 07222000
                                                                        07224000
<<--------------------------------------------------------->>           07226000
<< FORMAT DISKETTE WITH OVERRIDE OLD FORMAT                >>           07228000
<< THE ENTIRE DISKETTE WILL BE FORMATED WITHOUT INVISIBLE  >>           07230000
<< TRACKS. THE INTERLEAVE VALUE IS SET TO 1.               >>           07232000
<<--------------------------------------------------------->>           07234000
                                                                        07236000
ADDR1 := BLANK'DISKETTE;   <<ALL TRACKS MAKE VISIBLE>>                  07238000
ADDR2 := IBM'FLOPPY;                                                    07240000
DISCIO(LDN,F,BUFF,ADDR,0);                                              07242000
IF < THEN GOTO XIT;                                                     07244000
                                                                        07246000
<<--------------------------------------------------------->>           07248000
<< VERIFY DISKETTE                                         >>           07250000
<< THE BAD TRACK ADDRESS IS SAVED IN THE 5-TH SECTOR.      >>           07252000
<< THE MAX. PERMISSIBLE NUMBER OF BAD TRACKS IS TWO.       >>           07254000
<< ALL BAD TRACKS ARE VISIBLE.                             >>           07256000
<<--------------------------------------------------------->>           07258000
                                                                        07260000
ADDR := 0D;                                                             07262000
LOOP:                                                                   07264000
IOSTATUS := 2;                                                          07266000
DISCIO(LDN,VM,ADDR,ADDR,1,IOSTATUS);   <<VERIFY>>              <<*7687>>07268000
IF IOSTATUS.TSTATUS <> SUCCESSFUL THEN                                  07270000
   IF IOSTATUS.TSTATUS = TRKERR OR                                      07272000
      IOSTATUS.TSTATUS = VERERR THEN   <<MARK BAD TRACK>>               07274000
      BEGIN                                                             07276000
      TRACK := ADDR2/SECTRK;   <<TRACK ADDR>>                           07278000
      TRKERRCNT := TRKERRCNT + 1;                                       07280000
      IF TRKERRCNT > 2 THEN   <<MAX 2 BAD TRACKS>>                      07282000
         BEGIN                                                          07284000
         GENMSG(PVMSGSET,VIWARN124,%10000,TRACK);                       07286000
         GENMSG(PVMSGSET,VIERR65,%10000,(TRKERRCNT-1));                 07288000
         GENMSG(PVMSGSET,VIERR0);                                       07290000
         GOTO XIT;                                                      07292000
         END;                                                           07294000
      <<SAVE BAD TRACK ADDRESS>>                                        07296000
      IF TRKERRCNT = 1 THEN TRKERR1 := TRACK                            07298000
                       ELSE TRKERR2 := TRACK;                           07300000
      <<MARK TRACK AS DEFECTIVE - SET BIT D ON>>                        07302000
      DISCIO(LDN,IT,BUFF,DOUBLE(TRACK),0);  <<D. SIZE = 1664W>>         07304000
      IF < THEN GOTO XIT;                                               07306000
      GENMSG(PVMSGSET,VIWARN124,%10000,TRACK);                          07308000
      ADDR2 := (TRACK+1)*SECTRK;   <<SET TO NEXT TRACK>>                07310000
      IF TRACK < 74 THEN GOTO LOOP;                                     07312000
      END                                                               07314000
   ELSE                                                                 07316000
      BEGIN                                                             07318000
      DISCERROR(LDN,VM,IOSTATUS,ADDR,STAT.(8:8),DELP);                  07320000
      GENMSG(PVMSGSET,VIERR0);                                          07322000
      GOTO XIT;                                                         07324000
      END;                                                              07326000
                                                                        07328000
<<--------------------------------------------------------->>           07330000
<< INITIALIZE INDEX TRACK                                  >>           07332000
<<--------------------------------------------------------->>           07334000
                                                                        07336000
<<INITIALIZE EACH SECTOR OF INDEX TRACK>>                               07338000
<<BYTES 1-80 - BLANKS, BYTES 81-128 - NULL>>                            07340000
                                                                        07342000
BUFF := "  ";MOVE BUFF(1) := BUFF,(1663);   <<INIT. TRACK>>             07344000
FOR I := 0 UNTIL 25 DO                                                  07346000
   BEGIN                                                                07348000
   OFFSET := I*64+40;                                                   07350000
   BUFF(OFFSET) := 0;                                                   07352000
   MOVE BUFF(OFFSET+1) := BUFF(OFFSET),(23);                            07354000
   END;                                                                 07356000
                                                                        07358000
<<--------------------------------------------------------->>           07360000
<< INITIALIZE SECTORS 1-7 OF INDEX TRACK                   >>           07362000
<<--------------------------------------------------------->>           07364000
                                                                        07366000
<< SECTOR 5  -  ERROR MAP >>                                            07368000
                                                                        07370000
OFFSET := 512;   << (5-1)*128 >>                                        07372000
MOVE BUFFB(OFFSET) := "ERMAP";                                          07374000
IF TRKERR1 <> 0 THEN   <<MARK BAD TRACK IN POS. 7 AND 8>>               07376000
   BEGIN                                                                07378000
   MOVE BUFFB(OFFSET+6) := "000";                                       07380000
   ASCII(TRKERR1,-10,BUFFB(OFFSET+7));                                  07382000
   END;                                                                 07384000
IF TRKERR2 <> 0 THEN   <<MARK SEC. BAD TRACK IN POS 11-12>>             07386000
   BEGIN                                                                07388000
   MOVE BUFFB(OFFSET+10) := "000";                                      07390000
   ASCII(TRKERR1,-10,BUFFB(OFFSET+11));                                 07392000
   END;                                                                 07394000
                                                                        07396000
<< SECTOR 7 >>                                                          07398000
                                                                        07400000
OFFSET := 768;   << (7-1)*128 >>                                        07402000
MOVE BUFFB(OFFSET) := "VOL1",2;                                         07404000
MOVE * := VOLNAME,(6);                                                  07406000
BUFFB(OFFSET+79) := "W";                                                07408000
                                                                        07410000
<<--------------------------------------------------------->>           07412000
<< INITIALIZE SECTORS 8 - 26 OF INDEX TRACK                >>           07414000
<<--------------------------------------------------------->>           07416000
                                                                        07418000
FOR I := 7 UNTIL 25 DO                                                  07420000
   BEGIN                                                                07422000
   OFFSET := I*128;                                                     07424000
   IF I=7 THEN                                                          07426000
      BEGIN   << SECTOR 8 >>                                            07428000
      MOVE BUFFB(OFFSET) := "HDR1 DATA";                                07430000
      MOVE BUFFB(OFFSET+24) := "080 01001";                             07432000
      MOVE BUFFB(OFFSET+74) := "01001";                                 07434000
      END                                                               07436000
   ELSE                                                                 07438000
      BEGIN   << SETORS 9-26 >>                                         07440000
      MOVE BUFFB(OFFSET) := "DDR1 DATA00";                              07442000
      ASCII(I+1,-10,BUFFB(OFFSET+10));                                  07444000
      MOVE BUFFB(OFFSET+22) := "080 74001";                             07446000
      MOVE BUFFB(OFFSET+74) := "74001";                                 07448000
      END;                                                              07450000
   MOVE BUFFB(OFFSET+34) := "73026";                                    07452000
   END;                                                                 07454000
                                                                        07456000
   << CONVERT FROM ASCII TO EBCDIC >>                                   07458000
                                                                        07460000
   CTRANSLATE(2,BUFFB,BUFFB,3328);                                      07462000
                                                                        07464000
   << MARK SETORS 8-26 AS INVISIBLE >>                                  07466000
                                                                        07468000
   <<DEACTIVATE (MAKE INVISIBLE) ENTIRE TRACK>>                         07470000
   <<DRIVER FEATURE - IT ALWAYS ASSUMES ENTIRE TRACK>>                  07472000
   DISCIO(LDN,IT,BUFF,0D,0);                                            07474000
   IF < THEN GOTO XIT;                                                  07476000
   <<ACTIVATE SECTOR 1>>                                                07478000
   DISCIO(LDN,WL,BUFF,0D,64);                                           07480000
   IF < THEN GOTO XIT;                                                  07482000
   <<ACTIVATE SECTORS 2-8>>                                             07484000
   DISCIO(LDN,W,BUFF(64),1D,448);                                       07486000
   IF < THEN                                                            07488000
XIT:                                                                    07490000
      BEGIN                                                             07492000
      CC := CCL;                                                        07494000
      RETURN;                                                           07496000
      END;                                                              07498000
END;   <<FORMAT'IBM'FLOPPY>>                                            07500000
PROCEDURE FORMAT'A'FLOPPY(LDN);                                <<00239>>07502000
VALUE LDN;                                                     <<00239>>07504000
INTEGER LDN;                                                   <<00239>>07506000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>07508000
BEGIN                                                          <<00239>>07510000
ARRAY DUMMY(0:3) = Q;  << VM RETURNS 4 WDS>>                   <<00239>>07512000
DOUBLE ADDR = DUMMY + 0;                                       <<00239>>07514000
INTEGER ADDR1=ADDR,ADDR2=ADDR+1;                               <<00239>>07516000
INTEGER STATUS1 = DUMMY + 2,STATUS2 = DUMMY + 3;               <<00239>>07518000
DOUBLE STATUS = STATUS1;                                       <<00239>>07520000
INTEGER IOSTATUS,SECPERCYL,CYL,SECTRK:=30,TRKERRCNT:=0;        <<00239>>07522000
EQUATE      HP'FLOPPY = 2,                                     <<00239>>07524000
       MAKE'INVISIBLE = 8,                                     <<00239>>07526000
       BLANK'DISKETTE = 1;                                     <<00239>>07528000
                                                               <<00239>>07530000
                                                               <<00239>>07532000
   CC := CCE;  <<ASSUME SUCCESSFUL>>                           <<00239>>07534000
   STATUS := REQSTATUS(LDN);                                   <<00239>>07536000
   ADDR1 := BLANK'DISKETTE;                                    <<00239>>07538000
   ADDR2 := HP'FLOPPY;                                         <<00239>>07540000
   SECPERCYL := IF STATUS2.DOUBLESIDED THEN 60 ELSE 30;        <<00239>>07542000
   DISCIO(LDN,F,BUFF,ADDR,0);  << FORMAT >>                    <<00239>>07544000
   IF < THEN                                                   <<00239>>07546000
      BEGIN                                                    <<00239>>07548000
      CC := CCL;                                               <<00239>>07550000
      RETURN;                                                  <<00239>>07552000
      END;                                                     <<00239>>07554000
   ADDR := 0D;                                                 <<04131>>07556000
LOOP:                                                          <<00239>>07558000
   IOSTATUS := 2;                                              <<00239>>07560000
   DISCIO(LDN,VM,ADDR,ADDR,1,IOSTATUS);<<VERIFY WHOLE FLOPPY>> <<*7687>>07562000
   IF IOSTATUS.TSTATUS <> SUCCESSFUL THEN << GOT AN ERROR >>   <<00239>>07564000
      BEGIN                                                    <<00239>>07566000
      CYL := ADDR2/SECPERCYL;                                  <<00239>>07568000
      TRKERRCNT := TRKERRCNT + 1;                              <<00239>>07570000
      DTT(DTTALT) := DTT(DTTALT) + 1;                          <<00239>>07572000
      IF STATUS2.DOUBLESIDED AND TRKERRCNT > 4 OR              <<00239>>07574000
         STATUS2.SINGLESIDED AND TRKERRCNT > 2 THEN            <<00239>>07576000
            BEGIN                                              <<00239>>07578000
            GENMSG(PVMSGSET,VIERR65,%10000,(TRKERRCNT-1));     <<00239>>07580000
            GENMSG(PVMSGSET,VIERR0);                           <<00239>>07582000
            CC := CCL;                                         <<00239>>07584000
            RETURN;                                            <<00239>>07586000
            END;                                               <<00239>>07588000
      TOS := ADDR2;                                            <<00239>>07590000
      TOS := S0 MOD SECTRK;                                    <<00239>>07592000
      ASSEMBLE(LSUB);                                          <<00239>>07594000
      ADDR2 := TOS;                                            <<00239>>07596000
      DISCIO(LDN,IT,BUFF,ADDR,0); <<MARK TRK DEFECTIVE>>       <<00239>>07598000
      IF < THEN                                                <<00239>>07600000
         BEGIN                                                 <<00239>>07602000
         CC := CCL;                                            <<00239>>07604000
         RETURN;                                               <<00239>>07606000
         END;                                                  <<00239>>07608000
      GENMSG(PVMSGSET,VIWARN11,%11000,CYL,                     <<00239>>07610000
              ( (ADDR2/SECTRK) MOD (SECPERCYL/SECTRK) ) );     <<00239>>07612000
      ADDR2 := ADDR2 + SECTRK;                                 <<00239>>07614000
     IF CYL < 77 THEN GOTO LOOP;                               <<04131>>07616000
      END;                                                     <<00239>>07618000
                                                               <<00239>>07620000
   IF TRKERRCNT <> 0 THEN                                      <<00239>>07622000
      BEGIN                                                    <<00239>>07624000
      GENMSG(PVMSGSET,VIWARN3,%10000,TRKERRCNT);               <<00239>>07626000
      END;                                                     <<00239>>07628000
                                                               <<00239>>07630000
   ADDR1 := MAKE'INVISIBLE;                                    <<00239>>07632000
   ADDR2 := HP'FLOPPY;                                         <<00239>>07634000
   DISCIO(LDN,F,BUFF,ADDR,0);                                  <<00239>>07636000
   IF < THEN                                                   <<00239>>07638000
      BEGIN                                                    <<00239>>07640000
      CC := CCL;                                               <<00239>>07642000
      RETURN;                                                  <<00239>>07644000
      END;                                                     <<00239>>07646000
END;  << OF FORMAT'A'FLOPPY >>                                 <<00239>>07648000
$PAGE "INITDSCT PROCEDURE FOR CS'80 DISCS."                    <<03537>>07650000
LOGICAL PROCEDURE INITDSCT(LDEV);                              <<03537>>07652000
                                                               <<03537>>07654000
VALUE                                                          <<03537>>07656000
  LDEV;                                                        <<03537>>07658000
                                                               <<03537>>07660000
INTEGER                                                        <<03537>>07662000
  LDEV;                                                        <<03537>>07664000
                                                               <<03537>>07666000
BEGIN                                                          <<03537>>07668000
<<  Initializes the Defective Sectors Table for a CS'80 disc >><<03537>>07670000
<<                                                           >><<03537>>07672000
<<  This is as follows:                                      >><<03537>>07674000
<<                                                           >><<03537>>07676000
<<   1.  Zero the table in a buffer and initialize the       >><<03537>>07678000
<<       overhead words.                                     >><<03537>>07680000
<<                                                           >><<03537>>07682000
<<   2.  Invoke the driver (disc) VERIFY function.  This     >><<03537>>07684000
<<       proceeds until it gets an error.                    >><<03537>>07686000
<<                                                           >><<03537>>07688000
<<   3.  If the error is a TRACK/SECTOR error, save the      >><<03537>>07690000
<<       sector number in the DSCT and restart the verify    >><<03537>>07692000
<<       with the NEXT sector.  Continue this until          >><<03537>>07694000
<<       END-OF-VOLUME.                                      >><<03537>>07696000
<<                                                           >><<03537>>07698000
<<   4.  Then, spare each sector found without retaining     >><<03537>>07700000
<<       data and clear the DSCT.  Write the (clear) DSCT    >><<03537>>07702000
<<       out to the disc.                                    >><<03537>>07704000
<<                                                           >><<03537>>07706000
<<       Unusual errors (unit failure, DSCT full, etc)       >><<03537>>07708000
<<       are fatal and cause an error message and return     >><<03537>>07710000
                                                               <<03537>>07712000
  DOUBLE                                                       <<03537>>07714000
    VOL'LIMIT,                                                 <<03537>>07716000
    ADDR,                                                      <<03537>>07718000
    DTEMP;                                                     <<03537>>07720000
                                                               <<03537>>07722000
  INTEGER                                                      <<03537>>07724000
    I;                                                         <<03537>>07726000
                                                               <<03537>>07728000
  LOGICAL                                                      <<03537>>07730000
    DSCTFULL,                                                  <<03642>>07732000
    IOSTATUS;                                                  <<03537>>07734000
                                                               <<03642>>07736000
LOGICAL SUBROUTINE CHECK'IO'ERROR;                             <<03642>>07738000
        BEGIN                                                  <<03642>>07740000
        IF IOSTATUS.TSTATUS = SUCCESSFUL OR                    <<03642>>07742000
           IOSTATUS.TSTATUS = TRKERR OR                        <<03642>>07744000
           IOSTATUS.TSTATUS = NO'SPARE THEN RETURN;            <<03642>>07746000
        I := ASCII(IOSTATUS.TSTATUS,8,BUFFB);                  <<03642>>07748000
        BUFFB(6) := 0;                                         <<03642>>07750000
        GENMSG(PVMSGSET,VIERR106,0,@BUFFB(6-I));               <<03642>>07752000
        GENMSG(PVMSGSET,0);                                    <<03642>>07754000
        ASSEMBLE(EXIT 0);                                      <<03642>>07756000
        END;                                                   <<03642>>07758000
                                                               <<03642>>07760000
INITDSCT := FALSE;  <<ASSUME FAILURE>>                         <<03642>>07762000
                                                               <<03642>>07764000
<<INITIALIZE THE DSCT>>                                        <<03642>>07766000
                                                               <<03537>>07768000
  DTT := 0;                                                    <<03537>>07770000
  MOVE DTT(1) := DTT, (DTT'SIZE - 1);                          <<03537>>07772000
  DTT(DSCT'FIRST'ENTRY'INDEX) := DSCT'OFFSET'TO'FIRST'ENTRY;   <<03537>>07774000
  DTT(DSCT'ENTRY'SIZE) := DSCT'SIZE'OF'ENTRY;                  <<03537>>07776000
  DTT(DSCT'MAX'NUMBER'OF'ENTRIES) := DSCT'MAX'ENTRIES;         <<03537>>07778000
                                                               <<03642>>07780000
  DISCIO(LDEV,W,DTT,1D,128); <<WRITE OUT DTT FOR VERIFY>>      <<03642>>07782000
                                                               <<03537>>07784000
  ADDR := 0D;  << Where to start verify >>                     <<03537>>07786000
                                                               <<03537>>07788000
  GENMSG(PVMSGSET,VIWARN88);  << "BEGIN VERIFY" >>             <<03537>>07790000
                                                               <<03537>>07792000
  << Get maximum sector address >>                             <<03537>>07794000
  IOSTATUS := %(2)111;  << Print messages, return status >>    <<03537>>07796000
  DISCIO(LDEV,REQ'VOL'LIMIT,VOL'LIMIT,0D,2,IOSTATUS);          <<03537>>07798000
  IF (IOSTATUS LAND %377) <> SUCCESSFUL THEN RETURN;           <<03537>>07800000
VER:                                                           <<03642>>07802000
  DSCTFULL := FALSE;                                           <<03642>>07804000
  DO                                                           <<03537>>07806000
    BEGIN  << Basic verify loop >>                             <<03537>>07808000
    IOSTATUS := %(2)010;  << No messages, return status >>     <<03537>>07810000
    DTEMP := VOL'LIMIT * DBL (SECTOR'SIZE&LSL(1));             <<06059>>07812000
    DISCIO(LDEV,VERIFY'CS'80,DTEMP,ADDR,2,IOSTATUS);           <<04670>>07814000
    IOSTATUS := IOSTATUS LAND %377;<< Clear junk in hi byte >> <<03537>>07816000
    IF IOSTATUS.GSTATUS <> SUCCESSFUL THEN                     <<03537>>07818000
      BEGIN  << Here's an error >>                             <<03537>>07820000
      IF IOSTATUS = TRKERR THEN                                <<03537>>07822000
        BEGIN  << Track/Sector error >>                        <<03537>>07824000
        IF DTT(DSCT'NUMBER'OF'ENTRIES) <                       <<03537>>07826000
           DTT(DSCT'MAX'NUMBER'OF'ENTRIES) THEN                <<03537>>07828000
          BEGIN  << Room in table, add sector address >>       <<03537>>07830000
          DTTD(DTT(DSCT'FIRST'ENTRY'INDEX) / 2 +               <<03642>>07832000
               DTT(DSCT'NUMBER'OF'ENTRIES)) := DTEMP;          <<03642>>07834000
          DTT(DSCT'NUMBER'OF'ENTRIES) :=                       <<03537>>07836000
            DTT(DSCT'NUMBER'OF'ENTRIES) + 1;  << Inc count >>  <<03537>>07838000
          ADDR := DTEMP + 1D;  << Restart verify at next sec >><<03537>>07840000
          IF DTT(DSCT'NUMBER'OF'ENTRIES) =                     <<03642>>07842000
             DTT(DSCT'MAX'NUMBER'OF'ENTRIES) THEN              <<03642>>07844000
             BEGIN                                             <<03642>>07846000
             DSCTFULL := TRUE;                                 <<03642>>07848000
             IOSTATUS := SUCCESSFUL;  <<LEAVE LOOP>>           <<03642>>07850000
             END;                                              <<03642>>07852000
          END  << Room in table >>                             <<03537>>07854000
        ELSE                                                   <<03537>>07856000
          BEGIN  << DSCT is full! >>                           <<03537>>07858000
          GENMSG(PVMSGSET,VIERR37);  << DTT (!) full >>        <<03537>>07860000
          GENMSG(PVMSGSET,VIWARN0);  << Function aborted >>    <<03537>>07862000
          RETURN;  << Leave procedure >>                       <<03537>>07864000
          END;  << DSCT full case >>                           <<03537>>07866000
        END  << Track/Sector error >>                          <<03537>>07868000
      ELSE                                                     <<03537>>07870000
        BEGIN  << NOT Track/Sector error >>                    <<03537>>07872000
        DISCERROR(LDEV,VERIFY'CS'80,IOSTATUS,ADDR,             <<03537>>07874000
                  STAT.(8:8),DELP);  << Print I/O err msg >>   <<03537>>07876000
        GENMSG(PVMSGSET,VIWARN0);  << Function aborted >>      <<03537>>07878000
        RETURN;  << Leave procedure >>                         <<03537>>07880000
        END;  << NOT Track/Sector error >>                     <<03537>>07882000
      END;  << Got an error >>                                 <<03537>>07884000
    END                                                        <<03537>>07886000
                                                               <<03537>>07888000
<< Keep verifying until done >>                                <<03537>>07890000
                                                               <<03537>>07892000
  UNTIL IOSTATUS = SUCCESSFUL OR ADDR > VOL'LIMIT;             <<03537>>07894000
                                                               <<03537>>07896000
<<All defective sectors from DSCT are being processed.>>       <<03642>>07898000
<<On each entry form DSCT write/read error test is performed>> <<03642>>07900000
<<If it successful then entry is removed, otherwise wiil be>>  <<03642>>07902000
<<spared. Proccess is continued even media is out of spare>>   <<03642>>07904000
<<tracks. Spare is done without retaining data.>>              <<03642>>07906000
                                                               <<03642>>07908000
  SORT'DSCT;                                                   <<03642>>07910000
  WHILE GET'DSCT'ENTRY(ADDR) DO                                <<03642>>07912000
     BEGIN                                                     <<03642>>07914000
     IOSTATUS := 2;  <<NO WARNING>>                            <<03642>>07916000
     DISCIO(LDEV,INIT'UTIL,ADDR,RW'ERT,0,IOSTATUS);            <<03642>>07918000
     IF <> THEN                                                <<03642>>07920000
       BEGIN                                                   <<03642>>07922000
       CHECK'IO'ERROR;                                         <<03642>>07924000
       IOSTATUS := 2;                                          <<03642>>07926000
       DISCIO(LDEV,SPARE'BLOCK,ADDR,NO'RETAIN'DATA,0,IOSTATUS);<<03642>>07928000
       IF <> THEN                                              <<03642>>07930000
         BEGIN                                                 <<03642>>07932000
         CHECK'IO'ERROR;                                       <<03642>>07934000
         IF IOSTATUS.TSTATUS = NO'SPARE THEN                   <<03642>>07936000
         GENMSG(PVMSGSET,VIWARN105,%20000,@ADDR) ELSE;         <<03642>>07938000
         END                                                   <<03642>>07940000
         ELSE GENMSG(PVMSGSET,VIWARN89,%20000,@ADDR);          <<03642>>07942000
       END;                                                    <<03642>>07944000
     REMOVE'DSCT'ENTRY(0,1);                                   <<03642>>07946000
     END;                                                      <<03642>>07948000
                                                               <<03642>>07950000
  IF DSCTFULL THEN GOTO VER;  <<TRY AGAIN IF DSCT WAS FULL>>   <<03642>>07952000
                                                               <<03537>>07954000
  << Caller will write it out >>                               <<03537>>07956000
                                                               <<03537>>07958000
  INITDSCT := TRUE;  << All OK >>                              <<03537>>07960000
                                                               <<03537>>07962000
  END  << INITDSCT proc >>;                                    <<03537>>07964000
                                                                        07966000
$PAGE "PVINIT - USER COMMANDS: INITIALIZE "                    <<RK.08>>07968000
                                                                        07970000
PROCEDURE INIT;                                                         07972000
OPTION PRIVILEGED,UNCALLABLE;                                           07974000
BEGIN                                                                   07976000
                                                               <<03510>>07978000
     << initializes the private volume by             >>       <<03510>>07980000
     << creating a defective tracks table-assumes     >>       <<03510>>07982000
     << the disc has already been formatted           >>       <<03510>>07984000
     << creates a DFSM & alloc space for bit map,     >>       <<03510>>07986000
     << descr + Dirc if mv                            >>       <<03510>>07988000
     << updates the vol label and vol entry           >>       <<03510>>07990000
     << (also generate a log entry)                   >>       <<03510>>07992000
     << create directory if this is the master volume >>       <<03510>>07994000
     << of the volume set                             >>       <<03510>>07996000
     INTEGER ENT:=0,GEN:=0;                                    <<DE>>   07998000
     LOGICAL D,VSDIRSIZE:=0,DIRCSIZE:=0;                       <<DE>>   08000000
     DOUBLE  VSDDIRSIZE;                                       <<DE>>   08002000
     DOUBLE MAX'DIR'SIZE:=65000D,DISC'SIZE;                    <<06059>>08004000
     INTEGER I,J,K,ALT,CNT,ERR,LOC,LEN,LPS,TRK,HEAD,LDEV,RLEN,SIZE,     08006000
             INDEX,TRACK,ALTTRK,TRKCYL,MAXLPS,SUBTYPE,TRKSIZE,          08008000
             LPSTRK,NEXT;                                      <<RK1PV>>08010000
     INTEGER     type                                          <<03510>>08012000
                ;                                              <<03510>>08014000
     LOGICAL     initd                                         <<03510>>08016000
                ,proc'status                                   <<03510>>08018000
                ;                                              <<03510>>08020000
     INTEGER PVERR = I;  <<ERROR NUMBER FOR GENMSG>>                    08022000
     DOUBLE DIRADR; <<Dirc start addr>>                        <<01353>>08024000
     LOGICAL A,SECTRK,IOSTATUS,MASTERVOL,                               08026000
             NOHIGHER'ADDR;                                             08028000
     DOUBLE DTEMP,FSECT,LSECT,SECTRKD;                                  08030000
     DOUBLE VTABINFO;                                                   08032000
     INTEGER                                                            08034000
          VTABINFO1 = VTABINFO,                                         08036000
          VTBAINFO2 = VTABINFO+1;                                       08038000
     DOUBLE ADDR;                                                       08040000
     INTEGER                                                            08042000
          ADDR1 = ADDR,                                                 08044000
          ADDR2 = ADDR+1;                                               08046000
     DOUBLE RSTATUS;                                                    08048000
     INTEGER                                                            08050000
          RSTATUS1 = RSTATUS,                                           08052000
          RSTATUS2 = RSTATUS+1;                                         08054000
     ARRAY VSDIR(*) = BUFF;                                             08056000
     BYTE ARRAY VSDIRB(*) = BUFF;                                       08058000
     LOGICAL ARRAY VLAB(0:127);  <<VOLUME LABEL>>              <<DE>>   08060000
     BYTE ARRAY VLABB(*) = VLAB;                                        08062000
     ARRAY VSDEFN(0:VDSENTSIZE);                                        08064000
     BYTE ARRAY VSDEFNB(*) = VSDEFN;                                    08066000
     BYTE POINTER NAME;                                                 08068000
     EQUATE MVNAME = VDVENTSIZEB;                                       08070000
     EQUATE STOPPER = %077776;                                 <<RK1PV>>08072000
                                                               <<03510>>08074000
     << use this to exit procedure from subr >>                <<03510>>08076000
                                                               <<03510>>08078000
     DEFINE exit'procedure = ASSEMBLE(exit 0)#;                <<03510>>08080000
                                                               <<03510>>08082000
                                                                        08084000
     SUBROUTINE check'error(err);                              <<03510>>08086000
        VALUE err;                                             <<03510>>08088000
        LOGICAL err;                                           <<03510>>08090000
                                                               <<03510>>08092000
     BEGIN                                                     <<03510>>08094000
$IF X3=ON                                                      <<03510>>08096000
          debug;                                               <<03510>>08098000
$IF                                                            <<03510>>08100000
        IF err = get'dst'error OR err = get'vm'error           <<03510>>08102000
           THEN                                                <<03510>>08104000
              genmsg(pvmsgset,vierr90)                         <<03510>>08106000
        ELSE                                                   <<03510>>08108000
              genmsg(pvmsgset,vierr34);                        <<03510>>08110000
        exit'procedure;                                        <<03510>>08112000
                                                               <<03510>>08114000
     END;                                                      <<03510>>08116000
     LOGICAL SUBROUTINE INVALIDVOL;                                     08118000
     BEGIN                                                              08120000
          INVALIDVOL:=TRUE;  <<ASSUME VOL IS NOT PART OF VSET>>         08122000
          I:=0;                                                         08124000
          WHILE (I:=I+1) <= MAXVOLNUM DO                                08126000
          BEGIN                                                         08128000
               @NAME:=@VSDEFNB((I*VDVENTSIZE) & LSL(1));                08130000
               IF VNAME = NAME,(8) THEN                                 08132000
               BEGIN                                                    08134000
                    INVALIDVOL:=FALSE;                                  08136000
                    IF VNAME = VSDEFNB(MVNAME),(8) THEN  <<MASTER>>     08138000
                    BEGIN                                               08140000
                         MASTERVOL:=TRUE;                               08142000
                         MOVE MSG:=" ENTER DIRECTORY SIZE",2;  <<RK4PV>>08144000
                         MOVE *:=" (SECTORS - 384 TO 65000): ";<<DE>>   08146000
                         IF DISC'SIZE < MAX'DIR'SIZE THEN      <<06059>>08148000
                         MAX'DIR'SIZE:=DISC'SIZE-              <<06059>>08150000
                         DISC'SIZE/127D-DISC'SIZE/384D-12D;    <<06059>>08152000
                         LEN:=DASCII(MAX'DIR'SIZE,10,MSG(40)); <<06059>>08154000
                         MOVE MSG(40+LEN) := "):     ";        <<06059>>08156000
                         WHILE VSDIRSIZE = 0 DO  <<ASK FOR SIZE>>       08158000
                         BEGIN                                          08160000
                              PRINT (MSGW,-48,%320);           <<DE>>   08162000
                              MOVE rbuf:=10(" ");              <<03510>>08164000
                              read(rbufw,-10);                 <<03510>>08166000
                              IF <> THEN EOF;                  <<RK3PV>>08168000
                              len:=10;                         <<03510>>08170000
                              WHILE len >=0 AND                <<03510>>08172000
                                 rbuf(len-1) =  " " DO         <<03510>>08174000
                                 len:=len-1;                   <<03510>>08176000
                              VSDDIRSIZE := DBINARY(RBUF,LEN); <<DE>>   08178000
                              IF <> THEN                                08180000
                              BEGIN                                     08182000
                                   VSDIRSIZE:=0;                        08184000
                                   MOVE PBUF:=" ** INVALID INTEGER",2;  08186000
                                   MOVE   * :=" VALUE **";              08188000
                                   PRINT(PBUFW,-28,0);         <<RK.08>>08190000
                              END ELSE                                  08192000
                              IF (VSDDIRSIZE < 384D <<MIN>> OR <<DE>>   08194000
                                   VSDDIRSIZE > MAX'DIR'SIZE)  <<06059>>08196000
                              THEN BEGIN                       <<DE>>   08198000
                                   VSDIRSIZE:=0;                        08200000
                                   MOVE PBUF:=" ** ILLEGAL DIRECTORY",2;08202000
                                   MOVE   * :=" SIZE **";               08204000
                                   PRINT(PBUFW,-29,0);         <<RK.08>>08206000
                                   END                         <<DE>>   08208000
                              ELSE                             <<DE>>   08210000
                                 BEGIN                         <<07097>>08212000
                                 <<-------------------------->><<07097>>08214000
                                 << If dir. > 6112 then dir. >><<07097>>08216000
                                 << bit map is 32 sec. long. >><<07097>>08218000
                                 << The dir. cannot be in    >><<07097>>08220000
                                 << range (6113-6141).       >><<07097>>08222000
                                 <<-------------------------->><<07097>>08224000
                                 VSDIRSIZE :=                  <<07097>>08226000
                                    LOGICAL (VSDDIRSIZE);      <<07097>>08228000
                                 IF 6112 < VSDIRSIZE AND       <<07097>>08230000
                                    VSDIRSIZE < 6142 THEN      <<07097>>08232000
                                    VSDIRSIZE := 6112 + 29 + 1;<<07097>>08234000
                                 <<-------------------------->><<07097>>08236000
                                 << The size must be multiple>><<07097>>08238000
                                 << of 32 because MVTAB entry>><<07097>>08240000
                                 << has only 11 bits to hold >><<07097>>08242000
                                 << the dir. size. It is used>><<07097>>08244000
                                 << by Dir. Space Management.>><<07097>>08246000
                                 <<-------------------------->><<07097>>08248000
                                 VSDIRSIZE :=                  <<07097>>08250000
                                 (VSDIRSIZE+31)&LSR(5)&LSL(5); <<07097>>08252000
                                 END;                          <<07097>>08254000
                         END;                                           08256000
                    END;                                                08258000
                    I:=MAXVOLNUM;  <<STOP LOOP>>                        08260000
               END;                                                     08262000
          END;                                                          08264000
     END  <<INVALIDVOL>>;                                               08266000
                                                                        08268000
$PAGE "INIT COMMAND-INITDTT SUBROUTINE FOR FLOPPIES/MAC DISCS."<<03537>>08270000
     SUBROUTINE INITDTT;                                                08272000
     BEGIN                                                              08274000
          dtt:=0;                                              <<03510>>08276000
          MOVE dtt(1):=dtt,(dtt'size-1);                       <<03510>>08278000
          IF TYPE = CS'80'TYPE THEN                            <<03537>>08280000
            BEGIN                                              <<03537>>08282000
            IF (SUBTYPE = ST'9110 LOR SUBTYPE = ST'9144) THEN  <<*8114>>08284000
               BEGIN   << Linus or Buffalo >>                  <<*8114>>08286000
               GENMSG(PVMSGSET,VIERR8,%10000,LDEV);            <<06059>>08288000
               GENMSG(PVMSGSET,VIERR0);                        <<06059>>08290000
               EXIT'PROCEDURE;                                 <<06059>>08292000
               END;                                            <<06059>>08294000
            IF NOT INITDSCT(LDEV) THEN                         <<03537>>08296000
              EXIT'PROCEDURE  << INIDSCT failed >>             <<03537>>08298000
            END                                                <<03537>>08300000
          ELSE                                                 <<03510>>08302000
             BEGIN                                             <<03510>>08304000
          proc'status:=Get'Disc'Info(ldev,,,,,,,,,,,,,,        <<03510>>08306000
                                sectrk,lps,                    <<03510>>08308000
                                maxlps,trkcyl);                <<03510>>08310000
          IF NOT(proc'status) THEN check'error(proc'status);   <<03510>>08312000
          trksize:=sectrk * sector'size;  << in wds >>         <<03510>>08314000
          dtt(dtt'logical'pack'size):=lps;                     <<03510>>08316000
          dtt(dtt'next'alt'track):=size:=lps * trkcyl;         <<03510>>08318000
          IF type=floppy'disc'type AND                         <<03510>>08320000
             subtype=floppy'disc'subtype THEN                  <<03510>>08322000
             BEGIN                                             <<00239>>08324000
             FORMAT'A'FLOPPY(LDEV);                            <<00239>>08326000
             IF < THEN ASSEMBLE(EXIT 0);                       <<00239>>08328000
             END                                               <<00239>>08330000
          ELSE                                                 <<00239>>08332000
             BEGIN  << 7920 FAMILY >>                          <<00239>>08334000
               TRACK:=-1;                                      <<RK2PV>>08336000
               WHILE (TRACK:=TRACK+1) < MAXLPS*TRKCYL DO       <<RK2PV>>08338000
               BEGIN  <<CHECK EACH TRACK FOR DEFECTIVE>>                08340000
                    ADDR:=LOGICAL(TRACK)**SECTRK;                       08342000
                    IOSTATUS:=%2;  <<RETURN ERROR, NO ERROR MESSAGES>>  08344000
                    DISCIO(LDEV,RSPD,BUFF,ADDR,128,IOSTATUS);           08346000
                    IF IOSTATUS.GSTATUS <> SUCCESSFUL THEN              08348000
                    BEGIN                                               08350000
                         ERR:=IOSTATUS.QSTATUS;  <<ACTUAL ERROR>>       08352000
                         IF NOT (%7<=ERR<=%11 LOR %17<=ERR<=%21) THEN   08354000
                         BEGIN                                          08356000
                              DISCERROR(LDEV,R,IOSTATUS,ADDR,  <<RK.08>>08358000
                                        STAT.(8:8),DELP);      <<RK.08>>08360000
                              GENMSG(PVMSGSET,VIERR0);                  08362000
                              ASSEMBLE(EXIT 0);                         08364000
                         END;                                           08366000
                         IF ERR = SPT THEN  <<SPARE TRACK>>             08368000
                         BEGIN                                          08370000
                              TOS:=ALTTRACK(LDEV,TRACK);                08372000
                              IF < THEN ASSEMBLE(EXIT 0);  <<I/O ERROR>>08374000
                              IF TOS >= 0 THEN  <<A FORMER SPARE TRACK>>08376000
                              BEGIN                                     08378000
                                   IF TRACK >= LPS*TRKCYL THEN <<RK2PV>>08380000
                                   TRACKINIT(LDEV,ADDR,0D,TRKSIZE,%4)   08382000
                                 ELSE                                   08384000
                                   TRACKINIT(LDEV,ADDR,ADDR,TRKSIZE,0); 08386000
                                   IF < THEN ASSEMBLE(EXIT 0);          08388000
                              END ELSE ERR:=DFT;                        08390000
                         END;                                           08392000
                         IF ERR = DFT THEN                              08394000
                         BEGIN                                          08396000
                              IF TRACK >= LPS*TRKCYL THEN      <<RK2PV>>08398000
                              TRACKINIT(LDEV,ADDR,-1D,TRKSIZE,%4) <<RH>>08400000
                            ELSE                                        08402000
                              TRACKINIT(LDEV,ADDR,-1D,TRKSIZE,%1);<<RH>>08404000
                              IF < THEN ASSEMBLE(EXIT 0);               08406000
                         END;                                           08408000
                         IF ERR <> SPT THEN  <<SUSPECT/DEFECT>><<RH.PV>>08410000
                         ADDDTTENTRY(TRACK & LSL(2));  <<SUSPECT ENTRY>>08412000
                    END ELSE                                            08414000
                    IF TRACK >= LPS*TRKCYL THEN <<ITS A SPARE>><<RK2PV>>08416000
                    BEGIN                                               08418000
                         TRACKINIT(LDEV,ADDR,0D,TRKSIZE,%4);            08420000
                         IF < THEN ASSEMBLE(EXIT 0); <<DISC I/O ERROR>> 08422000
                    END;                                                08424000
               END;                                                     08426000
          ADDENTRY((TRKCYL-1),(MAXLPS-1));                     <<RK3PV>>08428000
          dttanalysis(ldev);                                   <<03510>>08430000
          IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>               08432000
               IF DTT'CHANGES <> 0 THEN ADD'DTT'CHANGES(LDEV); <<00239>>08434000
               IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>> <<00239>>08436000
             END; << OF 7920 >>                                <<00239>>08438000
          END;  << not a cs'80 >>                              <<03510>>08440000
                                                               <<03510>>08442000
          DISCIO(LDEV,W,DTT,1D,128);  <<WRITE OUT DTT>>                 08444000
          IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>               08446000
     END <<INITDTT>>;                                                   08448000
                                                                        08450000
$PAGE "INIT COMMAND-INITDIR - SETS UP DIRECTORY ON MASTER VOL."<<03537>>08452000
SUBROUTINE INITDIR;                                            <<07097>>08454000
                                                               <<07097>>08456000
<<----------------------------------------------------------->><<07097>>08458000
<< This subroutine initializes directory bit map and creates >><<07097>>08460000
<< account index block. The rest of the directory is zeroed. >><<07097>>08462000
<< If directory is less than 6112 sectors then the           >><<07097>>08464000
<< bit map will occupy 3 sectors. If directory is greater    >><<07097>>08466000
<< than 6112 sectors yhen the bit map will have allocated 32 >><<07097>>08468000
<< sectors of the directory space. Each bit in the dir. bit  >><<07097>>08470000
<< map represent one sector of the directory space ( "1"  -  >><<07097>>08472000
<< indicates free sector). However only 3 sectors of the dir.>><<07097>>08474000
<< bit map a represented in the bit map itself. For dir. with>><<07097>>08476000
<< size < 6112 the directory address (saved in disc label)   >><<07097>>08478000
<< represents the beginning of the directory space. However  >><<07097>>08480000
<< for dir. > 6112 sectors the dir. address is set to 29 sec.>><<07097>>08482000
<< of the directory space. The account index will always used>><<07097>>08484000
<< 3-rd relative (to dir. addr.) sector.                     >><<07097>>08486000
<<----------------------------------------------------------->><<07097>>08488000
                                                               <<07097>>08490000
BEGIN                                                          <<07097>>08492000
BUFF := 0;                                                     <<07097>>08494000
MOVE BUFF (1) := BUFF, (BUFFSIZE - 1);                         <<07097>>08496000
                                                               <<07097>>08498000
<<----------------------------------------------------------->><<07097>>08500000
<< Initialize directory bit map                              >><<07097>>08502000
<<----------------------------------------------------------->><<07097>>08504000
                                                               <<07097>>08506000
BUFF := (VSDIRSIZE + 15) / 16;        << Last word in bit map>><<07097>>08508000
IF VSDIRSIZE > 6112 THEN                                       <<07097>>08510000
   BUFF := (VSDIRSIZE - 29 + 15) / 16;                         <<07097>>08512000
BUFF (1) := 2;                  << First available word in BM>><<07097>>08514000
BUFF (2) := %1777;              << BM and acct. index alloc. >><<07097>>08516000
BUFF (3) := %177777;                                           <<07097>>08518000
MOVE BUFF (4) := BUFF (3), (BUFF - 2);                         <<07097>>08520000
<<----------------------------------------------------------->><<07097>>08522000
<< Set last word of the dir. bit map                         >><<07097>>08524000
<<----------------------------------------------------------->><<07097>>08526000
I := VSDIRSIZE;                                                <<07097>>08528000
IF VSDIRSIZE > 6112 THEN                                       <<07097>>08530000
   I := I - 29;                                                <<07097>>08532000
IF (X := I &LSL (12) &LSR(12)) <> 0 THEN                       <<07097>>08534000
   BEGIN                                                       <<07097>>08536000
   TOS := 0;                                                   <<07097>>08538000
   WHILE (X := X - 1) >= 0 DO                                  <<07097>>08540000
      ASSEMBLE (TSBC 0, X);                                    <<07097>>08542000
   BUFF (BUFF + 1) := TOS;               << Store last word  >><<07097>>08544000
   END;                                                        <<07097>>08546000
                                                               <<07097>>08548000
<<----------------------------------------------------------->><<07097>>08550000
<< Set account index block                                   >><<07097>>08552000
<<----------------------------------------------------------->><<07097>>08554000
I := 3 * 128;                                                  <<07097>>08556000
IF VSDIRSIZE > 6112 THEN                                       <<07097>>08558000
   I := 32 * 128;                                              <<07097>>08560000
BUFF (I) := %110143;                      << Account         >><<07097>>08562000
BUFF (I + 4) := %010743;                                       <<07097>>08564000
LEN := BUFFSIZE &LSR (7);                                      <<07097>>08566000
DISCIO (LDEV, W, BUFF, DIRADR, LEN &LSL (7));                  <<07097>>08568000
I := VSDIRSIZE - LOGICAL (LEN);                                <<07097>>08570000
ADDR := DIRADR + DOUBLE (LOGICAL (LEN));                       <<07097>>08572000
                                                               <<07097>>08574000
<<----------------------------------------------------------->><<07097>>08576000
<< Zero rest of the directory                                >><<07097>>08578000
<<----------------------------------------------------------->><<07097>>08580000
BUFF := 0;                                                     <<07097>>08582000
MOVE BUFF (1) := BUFF, (BUFFSIZE - 1);                         <<07097>>08584000
WHILE LOGICAL (I) > 0 DO                                       <<07097>>08586000
   BEGIN                                                       <<07097>>08588000
   IF LOGICAL (I) < LOGICAL (LEN) THEN                         <<07097>>08590000
      LEN := I;                                                <<07097>>08592000
   DISCIO (LDEV, W, BUFF, ADDR, LEN &LSL(7));                  <<07097>>08594000
   ADDR := ADDR + DOUBLE (LOGICAL (LEN));                      <<07097>>08596000
   I := I - LEN;                                               <<07097>>08598000
   END;                                                        <<07097>>08600000
                                                               <<07097>>08602000
END;  << INITDIR >>                                            <<07097>>08604000
                                                                        08606000
$PAGE "INIT COMMAND - UPDATEVTAB SUBROUTINE."                  <<03537>>08608000
     SUBROUTINE UPDATEVTAB;                                             08610000
     BEGIN                                                              08612000
          GETABENTRY(VTABDST,VTABINFO1.(8:8),BUFF);                     08614000
          MOVE BUFFB:=VNAME,(8),2;                                      08616000
          MOVE * := VSID(8),(16);  <<GROUP/ACCOUNT>>                    08618000
          BUFF(12).(14:2):=2;  <<MARK AS NON-SYSTEM DOMAIN>>   <<RK.09>>08620000
          BUFF(13):=0;                                                  08622000
          LPDT'RDY'SER'FRN'DISC := FALSE;                      <<06276>>08624000
          LPDT'SERIAL'OR'FOREIGN := LPDT'SERIAL;               <<06276>>08626000
          PUTABENTRY(VTABDST,VTABINFO1.(8:8),BUFF);                     08628000
     END <<UPDATEVTAB>>;                                                08630000
                                                                        08632000
                                                                        08634000
$PAGE "INIT COMMAND - CHGVTAB SUBROUTINE."                     <<03537>>08636000
     SUBROUTINE chgvtab;                                       <<03510>>08638000
     BEGIN                                                              08640000
          A:=GETSIR(VTABSIR);                                           08642000
          I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX>>                     08644000
          IF (VTABINFO:=VTABINDEX(VNAME,VSID,LDEV,I)) = 0D THEN         08646000
          BEGIN                                                         08648000
               GENMSG(PVMSGSET,VIERR38,%10000,LDEV);           <<RK.05>>08650000
               RELSIR(VTABSIR,A);                                       08652000
               RETURN;                                                  08654000
          END;                                                          08656000
                                                               <<DE>>   08658000
          UPDATEVTAB;  <<PUT NEW LABEL INTO VTAB>>                      08660000
          RELSIR(VTABSIR,A);                                            08662000
          <<ADD LOG ENTRY TO INDICATE PRESENCE OF NEW VOLUME>>          08664000
          I:=2 CAT VTABINFO1(0:8:8);                                    08666000
          J:=SUBTYPE CAT LDEV(0:8:8);                                   08668000
          MOVE BUFF:=VLAB(LVNAMELOC'),(4),2;                            08670000
          MOVE *:=VLAB(LVSACCNTLOC'),(12);                              08672000
          LOG12(I,J,BUFF,16,PVPMOUNT);                                  08674000
   END;   << chgvtab >>                                        <<03510>>08676000
$PAGE "INIT COMMAND - MAIN PROCEDURE."                         <<03537>>08678000
     diradr:=0D;   << initialize  >>                           <<03510>>08680000
     IF KEYWDSPEC THEN  <<CHECK FOR VALID KEYWORD>>                     08682000
     IF KEYWORD <> "GEN" THEN                                           08684000
     BEGIN                                                              08686000
          GENMSG(PVMSGSET,VIERR3);                                      08688000
          RETURN;                                                       08690000
     END ELSE                                                           08692000
     IF KEYPARMSPEC THEN GEN:=KEYPARMVAL;                               08694000
     IF NOT VALIDVSID THEN                                              08696000
     BEGIN                                                              08698000
          GENMSG(PVMSGSET,VIERR4);                                      08700000
          RETURN;                                                       08702000
     END;                                                               08704000
     LDEV:=DEVPARM(2);                                                  08706000
     GET'DISC'INFO(LDEV,,,,TYPE,SUBTYPE,DISC'SIZE);            <<06059>>08708000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN << DO IT >> ELSE     <<00239>>08710000
     << device must be "downed" to init a pv    >>             <<03510>>08712000
                                                               <<03510>>08714000
     IF DEVSTATUS(2).DOWNF = 0 THEN                                     08716000
     BEGIN                                                              08718000
          TOS:=SCRATCHVOL(LDEV);                                        08720000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         08722000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>08724000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>08726000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>08728000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>08730000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>08732000
          RETURN;                                              <<01615>>08734000
     END                                                       <<RK.08>>08736000
     ELSE IF NOT OVERWRITE(LDEV,1) THEN RETURN;                <<RK.08>>08738000
     GETVSDEFN(VSIDW,VSDEFN,,PVERR);                           <<RK.08>>08740000
     IF <> THEN                                                         08742000
     BEGIN                                                              08744000
          GENMSG(PVMSGSET,PVERR);                                       08746000
          RETURN;                                                       08748000
     END;                                                               08750000
     IF INVALIDVOL THEN                                                 08752000
     BEGIN                                                              08754000
          GENMSG(PVMSGSET,VIERR7);                             <<RK.08>>08756000
          RETURN;                                                       08758000
     END;                                                               08760000
     INITDTT;                                                           08762000
                                                               <<03510>>08764000
     << create a partial vol label- initdfsm will >>           <<03510>>08766000
     << complete it and write it out              >>           <<03510>>08768000
                                                               <<03510>>08770000
     VLAB:=0; MOVE VLAB(1):=VLAB,(127);                        <<03510>>08772000
     VLAB(disc'lab'gen'index):=GEN;  <<GENERATION INDEX>>      <<03510>>08774000
     VLAB(disc'lab'type'word).disc'lab'type:=type;             <<03510>>08776000
     VLAB(disc'lab'type'word).disc'lab'subtype:=subtype;       <<03510>>08778000
     MOVE VLABB(disc'lab'volume'name*2):=VNAME,(8);            <<03510>>08780000
     VLAB(disc'lab'init'date):=CALENDAR;                       <<03510>>08782000
     MOVE VLABB(disc'lab'accnt'name*2):=VSID(16),(8),2;        <<03510>>08784000
     MOVE * :=VSID(8),(8),2;  <<GROUP>>                        <<03510>>08786000
     MOVE * :=VSID,(8);  <<SET NAME>>                          <<03510>>08788000
     IF MASTERVOL THEN  <<ADD MASTER VOLUME INFO>>             <<03510>>08790000
     BEGIN                                                     <<03510>>08792000
        VLAB(disc'lab'type'word).disc'lab'mv:=1;               <<03510>>08794000
        MOVE VLAB(disc'lab'set):=VSDEFN,(VDSENTSIZE);          <<03510>>08796000
     END;                                                      <<03510>>08798000
     initd:=initdfsm(ldev,mastervol,                           <<03510>>08800000
                     vsdirsize,diradr,vlab);                   <<03510>>08802000
     IF NOT(initd) THEN check'error(initd);                    <<03510>>08804000
     chgvtab;                                                  <<03510>>08806000
     IF mastervol THEN initdir;                                <<03510>>08808000
END << INIT >>;                                                         08810000
$PAGE "PROCEDURE FORMAT"                                       <<03537>>08812000
                                                                        08814000
PROCEDURE FORMAT;                                                       08816000
OPTION PRIVILEGED,UNCALLABLE;                                           08818000
BEGIN                                                                   08820000
     INTEGER I,TRK,LDEV,VTABX,MAXLPS,TRKCYL,SUBTYPE,TRKSIZE,            08822000
             LPS,                                              <<RK1PV>>08824000
             TRKERRCNT:=0;                                              08826000
     INTEGER type;                                             <<03510>>08828000
     LOGICAL A,SECTRK,IOSTATUS;                                         08830000
     DOUBLE ADDR;                                                       08832000
     INTEGER                                                            08834000
          ADDR1 = ADDR,                                                 08836000
          ADDR2 = ADDR+1;                                               08838000
     DOUBLE VTABINFO;                                                   08840000
     INTEGER                                                            08842000
          VTABINFO1 = VTABINFO,                                         08844000
          VTBAINFO2 = VTABINFO+1;                                       08846000
     INTEGER Spares := 0;<< Indicates type of sparing wanted.>><<03537>>08848000
                      << 0 - Retain All, 1 - Retain Factory, >><<03537>>08850000
                      << 2 - Physical Format - HP7935 only.  >><<03537>>08852000
     LOGICAL         proc'status  << returned from procedures ><<03510>>08854000
                    ;                                          <<03510>>08856000
     << use this define to exit proc from subr >>              <<03510>>08858000
                                                               <<03510>>08860000
     DEFINE exit'procedure = ASSEMBLE(exit 0)#;                <<03510>>08862000
                                                               <<03510>>08864000
     LOGICAL HP := TRUE;   <<HP MEDIA>>                        <<04669>>08866000
                                                                        08868000
     SUBROUTINE leave(err);                                    <<03510>>08870000
        VALUE err;                                             <<03510>>08872000
        LOGICAL err;                                           <<03510>>08874000
                                                               <<03510>>08876000
     BEGIN                                                     <<03510>>08878000
$IF X3=ON                                                      <<03510>>08880000
          debug;                                               <<03510>>08882000
$IF                                                            <<03510>>08884000
          genmsg(pvmsgset,vierr34);                            <<03510>>08886000
          exit'procedure;                                      <<03510>>08888000
     END;                                                      <<03510>>08890000
     SUBROUTINE MAKESCRATCH;                                            08892000
     BEGIN                                                              08894000
          <<UPDATE VOLUME TABLE>>                                       08896000
          A:=GETSIR(VTABSIR);                                           08898000
          GETABENTRY(VTABDST,VTABX,BUFF);                               08900000
          MOVE BUFFB:="SCRATCH ",2;   <<VOLUME NAME >>                  08902000
          ASSEMBLE(DUP,DECA);                                           08904000
          MOVE * := *,(16);  <<BLANK REST OF VOLUME NAME>>              08906000
          BUFF(12).(14:2):=3;<<MARK AS NON-SYS DEVICE,SCRATCH>><<RK0PV>>08908000
          BUFF(13):=0;                                                  08910000
          LPDT'RDY'SER'FRN'DISC := FALSE;                      <<06276>>08912000
          PUTABENTRY(VTABDST,VTABX,BUFF);                               08914000
          RELSIR(VTABSIR,A);                                            08916000
          <<UPDATE VOLUME LABEL>>                                       08918000
          SETSCRATCH(LDEV,%3);                                          08920000
     IF < THEN exit'procedure;                                 <<03510>>08922000
     END <<MAKESCRATCH>>;                                               08924000
                                                                        08926000
     LDEV:=DEVPARM(1);                                                  08928000
     IF KEYWDSPEC THEN  <<Check for undocumented keywords    >><<03537>>08930000
     BEGIN                                                     <<03537>>08932000
        IF KEYWORD="PHYSICAL" THEN                             <<03537>>08934000
           Spares := Physical'Format                           <<03537>>08936000
                                                               <<03537>>08938000
        ELSE IF KEYWORD="PHYS" THEN                            <<03537>>08940000
           Spares := Physical'Format                           <<03537>>08942000
                                                               <<03537>>08944000
        ELSE IF KEYWORD="PRIMARY" THEN                         <<03537>>08946000
           Spares := Retain'Factory'Spares                     <<03537>>08948000
                                                               <<03537>>08950000
        <<Check if format IBM floppy>>                         <<04669>>08952000
        ELSE IF KEYWORD = "IBM" THEN                           <<04669>>08954000
           HP := FALSE  <<IBM FLOPPY>>                         <<04669>>08956000
                                                               <<04669>>08958000
        ELSE  <<WRONG KEYWORD>>                                <<04669>>08960000
INVKEY:                                                        <<04669>>08962000
           BEGIN                                               <<04669>>08964000
              GENMSG(PVMSGSET,VIERR3);                         <<04669>>08966000
              RETURN;                                          <<04669>>08968000
           END;                                                <<04669>>08970000
     END;                                                      <<04669>>08972000
                                                               <<04669>>08974000
     CARTRIDGE := IS'IT'CARTRIDGE(LDEV);                       <<*8114>>08976000
     IF UNREADABLE'LABEL(LDEV,TRUE) THEN << DO IT >> ELSE      <<00239>>08978000
     IF DEVSTATUS(1).DOWNF = 0 THEN                                     08980000
     BEGIN                                                              08982000
          TOS:=SCRATCHVOL(LDEV);                                        08984000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         08986000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>08988000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>08990000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>08992000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>08994000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>08996000
          RETURN;                                              <<01615>>08998000
     END                                                       <<RK.08>>09000000
     ELSE IF NOT OVERWRITE(LDEV,2) THEN RETURN;                <<RK.08>>09002000
     IF NOT CARTRIDGE THEN << Cartridge doesn't have user    >><<*8114>>09004000
                           << accessible Spare Track Tables. >><<*8114>>09006000
     BEGIN <<jumps all DTT & Formatting code if Linus/Buffalo>><<*8114>>09008000
     Get'Disc'Info(ldev,,,,type,subtype);                      <<03537>>09010000
     proc'status:=Get'Disc'Info(ldev,,,,,,,,,,,,,,sectrk,lps,  <<03510>>09012000
                        maxlps,trkcyl);                        <<03510>>09014000
     IF NOT(proc'status) THEN leave(proc'status);              <<03510>>09016000
     trksize:=sectrk * sector'size; << in words >>             <<03510>>09018000
     DTT:=0; MOVE DTT(1):=DTT,(127); <<ZERO BUFFER>>           <<RK1PV>>09020000
     dtt(dtt'logical'pack'size):=lps;                          <<03510>>09022000
     dtt(dtt'next'alt'track):=lps * trkcyl;                    <<03510>>09024000
IF type=floppy'disc'type AND                                   <<03510>>09026000
   subtype=floppy'disc'subtype THEN                            <<03510>>09028000
   IF NOT HP THEN   <<IBM>>                                    <<04669>>09030000
      BEGIN                                                    <<04669>>09032000
      FORMAT'IBM'FLOPPY(LDEV);                                 <<04669>>09034000
      RETURN;                                                  <<04669>>09036000
      END                                                      <<04669>>09038000
   ELSE   <<HP DISKETTE>>                                      <<04669>>09040000
   BEGIN                                                       <<00239>>09042000
   FORMAT'A'FLOPPY(LDEV);                                      <<00239>>09044000
   IF < THEN RETURN;                                           <<00239>>09046000
   END                                                         <<00239>>09048000
ELSE IF NOT HP THEN GOTO INVKEY  <<FLOPPY ONLY>>               <<04669>>09050000
ELSE IF TYPE = MH'DISC'TYPE THEN                               <<03537>>09052000
   BEGIN  << HP7920 FAMILY >>                                  <<00239>>09054000
     FOR I:=(TRKSIZE-1) STEP -3 UNTIL -1 DO                    <<RK1PV>>09056000
     BEGIN                                                     <<RK1PV>>09058000
           BUFF(I-2)  :=%066666;                               <<RK1PV>>09060000
           BUFF(I-1):=%155555;                                 <<RK1PV>>09062000
           BUFF(I):=%133333;                                   <<RK1PV>>09064000
     END;                                                      <<RK1PV>>09066000
     BUFF(-3):=%10;<<SET SPARE>>                               <<RK2PV>>09068000
     BUFF(-2):=0;  <<CYL=0>>                                   <<RK2PV>>09070000
     BUFF(-1):=0;  <<HEAD/SECTOR=0>>                           <<RK2PV>>09072000
     TOS:=REQSTATUS(LDEV);                                     <<RK1PV>>09074000
     ASSEMBLE(DELB);                                           <<RK1PV>>09076000
     IF TOS.(9:2) <> 1 THEN                                    <<RK1PV>>09078000
        BEGIN                                                  <<RK1PV>>09080000
              GENMSG(PVMSGSET,VIERR33);                        <<RK1PV>>09082000
              GENMSG(PVMSGSET,VIERR0);                         <<RK1PV>>09084000
              RETURN;                                          <<RK1PV>>09086000
        END;                                                   <<RK1PV>>09088000
     FOR TRK:= 0 UNTIL ((MAXLPS*TRKCYL)-1) DO                           09090000
     BEGIN                                                              09092000
          ADDR:=LOGICAL(TRK)**SECTRK;                                   09094000
          IOSTATUS:=%2;  <<RETURN ERROR, NO ERROR MESSAGES>>            09096000
          DISCIO(LDEV,F,BUFF,ADDR,TRKSIZE,IOSTATUS);           <<RK1PV>>09098000
          IF IOSTATUS.QSTATUS <> 0 THEN                        <<RK1PV>>09100000
          BEGIN                                                <<RK1PV>>09102000
                TRKERRCNT:=TRKERRCNT+1;                        <<RK1PV>>09104000
                IF DTT<120 THEN DTT:=DTT+1;                    <<RK1PV>>09106000
                DTT(DTT):=TRK&LSL(2);                          <<RK1PV>>09108000
                IF TRK>=DTT(DTTALT) THEN DTT(DTT):=DTT(DTT)+1; <<RK1PV>>09110000
          END;                                                 <<RK1PV>>09112000
          IF TRK >= LPS*TRKCYL THEN                            <<RK2PV>>09114000
             BEGIN                                             <<00112>>09116000
             DISCIO(LDEV,IN,BUFF,ADDR,TRKSIZE);<<ABORT IF CCL>><<RK2PV>>09118000
             IF < THEN RETURN;                                 <<00112>>09120000
             END;                                              <<00112>>09122000
     END;                                                               09124000
   END  << MH disc formatting >>                               <<03537>>09126000
ELSE      << CS'80 but non-cartridge tape >>                   <<*8114>>09128000
IF TYPE = CS'80'TYPE AND (SUBTYPE > ST'9110 LAND               <<*8114>>09130000
                          SUBTYPE <> ST'9144) THEN             <<*8114>>09132000
  BEGIN  << Request to format a 7935 >>                        <<03537>>09134000
  IOSTATUS := %(2)111;  << Print msg, return status >>         <<03537>>09136000
  IF DIAG'ENTRY THEN                                           <<03537>>09138000
    BEGIN  << Test for special keywords >>                     <<03537>>09140000
      Addr1 := Spares;                                         <<03537>>09142000
    END  << DIAG entry used >>                                 <<03537>>09144000
  ELSE                                                         <<03537>>09146000
    BEGIN  << Set sparing options >>                           <<03537>>09148000
      ADDR1 := RETAIN'ALL'SPARES;                              <<03537>>09150000
    END;                                                       <<03537>>09152000
  ADDR2 := DEFAULT'INTERLEAVE;                                 <<03537>>09154000
  Format'Msg(Addr1); << Tell user what we're doing           >><<03537>>09156000
  DISCIO(LDEV,F,BUFF,ADDR,0,IOSTATUS);                         <<03537>>09158000
  IOSTATUS := IOSTATUS LAND %377;  << Clear hi byte >>         <<03537>>09160000
  IF IOSTATUS <> SUCCESSFUL THEN RETURN;                       <<03537>>09162000
                                                               <<03537>>09164000
<< Disc is formatted at this point.  INIT handles DSCT >>      <<03537>>09166000
                                                               <<03537>>09168000
  END;  << 7935 formatting >>                                  <<03537>>09170000
                                                               <<03537>>09172000
     END                                                       <<03537>>09174000
     ELSE  <<We are(is?) a Cartridge.                        >><<*8114>>09176000
     BEGIN                                                     <<03537>>09178000
        Format'A'Cartridge(Ldev,Spares,Default'Interleave);    <<*8114>>09180000
                << The above function really Initializes It. >><<03537>>09182000
        IF < THEN RETURN;                                      <<03537>>09184000
     END;                                                      <<03537>>09186000
     I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX SEARCH>>                   09188000
     MOVE BUFFB:="  "; <<FORCE MISMATCH ON NAME>>              <<PV.BV>>09190000
     IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,LDEV,I)) = 0D THEN             09192000
     BEGIN                                                              09194000
          GENMSG(PVMSGSET,VIERR38,%10000,LDEV);                <<RK.05>>09196000
          RETURN;                                                       09198000
     END;                                                               09200000
     VTABX:=VTABINFO1.(8:8);  <<VTAB INDEX OF "TO" DEVICE>>             09202000
     MAKESCRATCH;  <<UPDATE VTAB AND VOLUME LABEL>>                     09204000
     IF CARTRIDGE THEN RETURN;    << We're done! >>            <<*8114>>09206000
     IF TRKERRCNT <> 0 THEN                                             09208000
     BEGIN                                                              09210000
          GENMSG(PVMSGSET,VIWARN3,%10000,TRKERRCNT);                    09212000
     END;                                                               09214000
IF type <> floppy'disc'type THEN                               <<03510>>09216000
   BEGIN                                                       <<00239>>09218000
     ADDENTRY((TRKCYL-1),(MAXLPS-1));                          <<RK3PV>>09220000
     dttanalysis(ldev);                                        <<03510>>09222000
     IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>           <<RK1PV>>09224000
     IF DTT'CHANGES <> 0 THEN ADD'DTT'CHANGES(LDEV);           <<00239>>09226000
     IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>           <<00239>>09228000
   END;                                                        <<00239>>09230000
     DISCIO(LDEV,W,DTT,1D,128);  <<WRITE OUT DTT>>             <<RK1PV>>09232000
     IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>           <<RK1PV>>09234000
END << FORMAT >>;                                                       09236000
                                                                        09238000
$PAGE "PROCEDURE SCRATCH"                                      <<03537>>09240000
$CONTROL SEGMENT=VINITCI                                       <<RK1PV>>09242000
PROCEDURE SCRATCH;                                                      09244000
OPTION PRIVILEGED,UNCALLABLE;                                           09246000
BEGIN                                                                   09248000
     INTEGER LDEV;                                                      09250000
     LOGICAL STATE:=1;  <<ASSUME SCRATCH>>                              09252000
     INTEGER     vtabrelsir                                    <<03510>>09254000
                ,vtabx                                         <<03510>>09256000
                ;                                              <<03510>>09258000
     ARRAY Vlab(*) = Buff;                                     <<03537>>09260000
     LOGICAL ARRAY LDT (*) = BUFF;                             <<06276>>09262000
     INTEGER Qmisc := 0;                                       <<03537>>09264000
     LOGICAL Dummy;                                            <<03537>>09266000
     INTEGER Dtype := 0;                                       <<03537>>09268000
                                                               <<06276>>09270000
     SUBROUTINE DEF'MOVE'FROM'DST;                             <<06276>>09272000
                                                                        09274000
     IF KEYWDSPEC THEN  <<CHECK FOR VALID KEYWORD>>                     09276000
     IF KEYWORD="RESET" THEN STATE:=0 ELSE                              09278000
     BEGIN                                                              09280000
          GENMSG(PVMSGSET,VIERR3);                                      09282000
          RETURN;                                                       09284000
     END;                                                               09286000
     LDEV:=DEVPARM(1);                                                  09288000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01115>>09290000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN ELSE          <<00239>>09292000
     IF DEVSTATUS(1).DOWNF = 0 THEN                                     09294000
     BEGIN                                                              09296000
          TOS:=SCRATCHVOL(LDEV);                                        09298000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         09300000
          IF NOT TOS THEN                                               09302000
          BEGIN                                                         09304000
               GENMSG(PVMSGSET,VIERR5,%10000,LDEV);                     09306000
               GENMSG(PVMSGSET,VIERR0);                                 09308000
               RETURN;                                                  09310000
          END;                                                          09312000
     END                                                       <<RK.08>>09314000
     ELSE IF NOT OVERWRITE(LDEV,3) THEN RETURN;                <<RK.08>>09316000
     << set the vol table entry to scratch/reset >>            <<03510>>09318000
     vtabrelsir:=getsir(vtabsir);                              <<03510>>09320000
     << get the vtab index from ldt, use global >>             <<03510>>09322000
     << buffer buff                             >>             <<03510>>09324000
     MOVE'FROM'DST (@LDT, LDT'DST, LDEV * SIZE'OF'LDT'ENTRY,   <<06276>>09326000
        SIZE'OF'LDT'ENTRY);                                    <<06276>>09328000
     VTABX := LDT'VOLUME'TBL'INDEX;                            <<06276>>09330000
     << now get the vtab entry >>                              <<03510>>09332000
     getabentry(vtabdst,vtabx,buff);                           <<03510>>09334000
     << make vol label reflect state >>                        <<03510>>09336000
     buff(12).(15:1):=state;                                   <<03510>>09338000
     putabentry(vtabdst,vtabx,buff);                           <<03510>>09340000
     SETSCRATCH(LDEV,STATE);                                            09342000
     relsir(vtabsir,vtabrelsir);                               <<03537>>09344000
     IF State = 1 THEN                                         <<03537>>09346000
        BEGIN                                                  <<06276>>09348000
        LPDT'RDY'SER'FRN'DISC := FALSE;                        <<06276>>09350000
        LPDT'SERIAL'OR'FOREIGN := LPDT'SERIAL;                 <<06276>>09352000
        END                                                    <<06276>>09354000
     ELSE << State was 0 - Reseting some former volume       >><<03537>>09356000
     BEGIN                                                     <<03537>>09358000
                                                               <<03537>>09360000
<< The reason we are here is to reset the                    >><<03537>>09362000
<< bits in the LPDT to indicate what kind of                 >><<03537>>09364000
<< device is now mounted.                                    >><<03537>>09366000
                                                               <<03537>>09368000
        IF Is'It'Cartridge(Ldev) THEN                          <<*8114>>09370000
        BEGIN                                                  <<03537>>09372000
           Cartridge'Io(Ldev,Qmisc,Vlab,R,Cartridge'Sector,    <<*8114>>09374000
                        Disc'Label'Address,Blocked'IO,         <<*8114>>09376000
                        NO'SPARING,Default'Errinfo,Dummy);     <<*8114>>09378000
        END                                                    <<03537>>09380000
        ELSE                                                   <<03537>>09382000
           Discio(Ldev,R,Vlab,0D,128);                         <<03537>>09384000
        IF < THEN RETURN;                                      <<03537>>09386000
        Dtype := Disctype(Ldev,Vlab);                          <<03537>>09388000
                                                               <<03537>>09390000
<< Although Disctype can return several different            >><<03537>>09392000
<< Disc Types, only 3 of them are interesting.               >><<03537>>09394000
<< Rather than writing a bunch of code that                  >><<03537>>09396000
<< never gets executed, I will document here.                >><<03537>>09398000
<< Return value 4 - is for Foreign Volume.                   >><<03537>>09400000
<< Return value 3 - is for Scratch Volume.                   >><<03537>>09402000
<< Return value 2 - is for Serial Discs.                     >><<03537>>09404000
<< Return value 1 - is for a PV.                             >><<03537>>09406000
<< Return value 0 - is for a System Disc.                    >><<03537>>09408000
                                                               <<03537>>09410000
<< P.S. Disctype is external,defined in Pvsys.               >><<03537>>09412000
                                                               <<03537>>09414000
<< Disctype will only work this way after the                >><<03537>>09416000
<< scratch bits are reset, otherwise you always              >><<03537>>09418000
<< get 3 back.                                               >><<03537>>09420000
                                                               <<03537>>09422000
<< The only case we are interested in here is                >><<03537>>09424000
<< 2 (Successfully Scratch;reset of a Serial                 >><<03537>>09426000
<< Disc.                                                     >><<03537>>09428000
<< Case 1 - Cannot be implemented because we                 >><<03537>>09430000
<<          are never able to set and clear bit              >><<03537>>09432000
<<          #4 in the second word of LPDT.                   >><<03537>>09434000
<<          (if we cleared the bit PVPROC never              >><<03537>>09436000
<<           gets woke up by DEVREC.)                        >><<03537>>09438000
<< Case 3 - Doesn't make sense to Scratch;Reset              >><<03537>>09440000
<<          a previously scratch volume.                     >><<03537>>09442000
<< Case 0 - Don't know what to do with this case.            >><<03537>>09444000
<< Case 4 - We never enter this code.                        >><<03537>>09446000
                                                               <<03537>>09448000
        IF Dtype = 2 THEN                                      <<03537>>09450000
           BEGIN                                               <<06276>>09452000
           LPDT'RDY'SER'FRN'DISC := TRUE;                      <<06276>>09454000
           LPDT'SERIAL'OR'FOREIGN := LPDT'SERIAL;              <<06276>>09456000
           END                                                 <<06276>>09458000
        ELSE IF Dtype = 3 LOR Dtype = 4 THEN                   <<03537>>09460000
             BEGIN                                             <<03537>>09462000
                Genmsg(Pvmsgset,Viwarn94);                     <<03537>>09464000
             END;                                              <<03537>>09466000
     END                                                       <<03537>>09468000
END << SCRATCH >>;                                                      09470000
                                                                        09472000
$PAGE "   PROCEDURE CHECK'BAD'FILES"                           <<04670>>09474000
INTEGER PROCEDURE CHECK'BAD'FILES (LDEV,NAME'SW,FILE'DISP);    <<04670>>09476000
VALUE LDEV;                                                    <<04670>>09478000
INTEGER LDEV;                                                  <<04670>>09480000
ARRAY NAME'SW,FILE'DISP;                                       <<04670>>09482000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<04670>>09484000
                                                               <<04670>>09486000
<<This procedure checks what files have bad data using as   >> <<04670>>09488000
<<an input DTT'CHANGES table (ONLY PERMANENT FILES).        >> <<04670>>09490000
<<It scans directory and if any of DTT'CHANGES entry lies in>> <<04670>>09492000
<<in a file extent it is printed and also entered into      >> <<04670>>09494000
<<NAMESW table. The file dispositon (1-bad file labels or   >> <<04670>>09496000
<<2-file with bad extents) are saved in FILEDISP table. This>> <<04670>>09498000
<<tables can be used by such procedure like DTRACK. During  >> <<04670>>09500000
<<searching the directory and file integrity sirs are locked>> <<04670>>09502000
<<The value returns by procedure means as follow: 0-OK,     >> <<04670>>09504000
<<-1 - volume not mounted and others - error.               >> <<04670>>09506000
<<The DTT'CHANGES is also updated and it contains only      >> <<04670>>09508000
<<which does not belongs entirely to any permanent file.    >> <<04670>>09510000
<<Note. The DTT'CHANGES table has diffrent format for CS80  >> <<04670>>09512000
<<than for non-CS80 discs.                                  >> <<04670>>09514000
                                                               <<04670>>09516000
BEGIN                                                          <<04670>>09518000
INTEGER I,J,K,NUMENTRIES;                                      <<04670>>09520000
INTEGER MVTABX := 0,THISVOL := 0;                              <<04670>>09522000
ARRAY NAMESW (0:((MAXSECTTRK+2)*12+11));                       <<04670>>09524000
INTEGER ARRAY FILEDISP(0:(MAXSECTTRK+2));                      <<04670>>09526000
DOUBLE ARRAY TRACK'START (0:120);                              <<04670>>09528000
DOUBLE ARRAY TRACK'END (0:120);                                <<04670>>09530000
INTEGER ARRAY DIRPARMS (0:9);                                  <<04670>>09532000
ARRAY VOL'SET'LDEV (0:MAX'DISCS);                              <<04670>>09534000
ARRAY DUM(0:10);                                               <<04670>>09536000
DOUBLE ADDR;                                                   <<04670>>09538000
INTEGER ADDR1 = ADDR;                                          <<04670>>09540000
INTEGER ADDR2 = ADDR+1;                                        <<04670>>09542000
LOGICAL A,B,DEL'ENTRY;                                         <<04670>>09544000
LOGICAL PMAP = Q-4;                                            <<04670>>09546000
DEFINE NAME'SW'F = PMAP.(14:1)#;                               <<04670>>09548000
DEFINE FILE'DISP'F =PMAP.(15:1)#;                              <<04670>>09550000
                                                               <<04670>>09552000
CHECK'BAD'FILES := 0;                                          <<04670>>09554000
IF DTT'CHANGES = 0 THEN                                        <<04670>>09556000
   RETURN;                                                     <<04670>>09558000
                                                               <<04670>>09560000
IF CS'80 THEN                                                  <<04670>>09562000
   BEGIN                                                       <<04670>>09564000
   J := 0;                                                     <<04670>>09566000
   FOR I := 1 UNTIL DTT'CHANGES DO                             <<04670>>09568000
      BEGIN                                                    <<04670>>09570000
      ADDR1 := DTT'CHANGES (J:=J+1);                           <<04670>>09572000
      ADDR2 := DTT'CHANGES (J:=J+1);                           <<04670>>09574000
      TRACK'START (I) := ADDR;                                 <<04670>>09576000
      TRACK'END (I) := ADDR + DBL (DTT'CHANGES(J:=J+1)-1);     <<04670>>09578000
      END;                                                     <<04670>>09580000
   END                                                         <<04670>>09582000
ELSE  <<Non - CS80 discs>>                                     <<04670>>09584000
   FOR I:= 1 UNTIL DTT'CHANGES DO                              <<04670>>09586000
      BEGIN                                                    <<04670>>09588000
      TRACK'START(I) := DBL(DTT'CHANGES(I).DTCF)*DBL(SECTRK);  <<04670>>09590000
      TRACK'END(I) := TRACK'START(I)+DBL(SECTRK-1);            <<04670>>09592000
      END;                                                     <<04670>>09594000
                                                               <<04670>>09596000
IF NOT VOLUME'MOUNTED(LDEV,THISVOL,MVTABX,VOL'SET'LDEV) THEN   <<04670>>09598000
   BEGIN                                                       <<04670>>09600000
   CHECK'BAD'FILES := -1;                                      <<04670>>09602000
   RETURN;                                                     <<04670>>09604000
   END;                                                        <<04670>>09606000
                                                               <<04670>>09608000
A := GETSIR (FILESIR);                                         <<04670>>09610000
B := GETSIR (DIRSIR);                                          <<04670>>09612000
                                                               <<04670>>09614000
CHECK'DIR:                                                     <<04670>>09616000
                                                               <<04670>>09618000
NAMESW := "  ";                                                <<04670>>09620000
MOVE NAMESW(1) := NAMESW,((MAXSECTTRK+2)*12+11);               <<04670>>09622000
FILEDISP := 0;                                                 <<04670>>09624000
MOVE FILEDISP(1) := FILEDISP,(MAXSECTTRK);                     <<04670>>09626000
DIRPARMS    := 0;                                              <<04670>>09628000
DIRPARMS(1) := @VOL'SET'LDEV;                                  <<04670>>09630000
DIRPARMS(2) := THISVOL;           <<Volume index>>             <<04670>>09632000
DIRPARMS(3) := DTT'CHANGES;       <<# of entries>>             <<04670>>09634000
DIRPARMS(4) := @TRACK'START;                                   <<04670>>09636000
DIRPARMS(5) := @TRACK'END;                                     <<04670>>09638000
DIRPARMS(6) := @NAMESW;                                        <<04670>>09640000
DIRPARMS(7) := @FILEDISP;                                      <<04670>>09642000
DIRPARMS(8) := 0;                                              <<04670>>09644000
                                                               <<04670>>09646000
DIRECSCAN (%120,0D,DUM,DUM,DUM,DTRACK'RECIP,DIRPARMS,MVTABX);  <<04670>>09648000
IF <> THEN                                                     <<04670>>09650000
   BEGIN                                                       <<04670>>09652000
   CHECK'BAD'FILES := DIRECERR;                                <<04670>>09654000
   GOTO ERROR;                                                 <<04670>>09656000
   END;                                                        <<04670>>09658000
                                                               <<04670>>09660000
NUMENTRIES := DIRPARMS(3);                                     <<04670>>09662000
IF FILE'DISP >= MAXSECTTRK THEN                                <<04670>>09664000
   IF NUMENTRIES <> 0 THEN                                     <<04670>>09666000
      IF NOT NAME'SW'F THEN                                    <<04670>>09668000
         GOTO CHECK'DIR      <<NAMESW table was full>>         <<04670>>09670000
      ELSE                                                     <<04670>>09672000
         BEGIN  <<Remove used entries from DTT'CHANGES>>       <<04670>>09674000
         J := 0;                                               <<04670>>09676000
         FOR I := 1 UNTIL DTT'CHANGES DO                       <<04670>>09678000
            BEGIN                                              <<04670>>09680000
            DEL'ENTRY := TRUE;                                 <<04670>>09682000
            IF CS'80 THEN                                      <<04670>>09684000
               BEGIN                                           <<04670>>09686000
               ADDR1 := DTT'CHANGES (J:=J+1);                  <<04670>>09688000
               ADDR2 := DTT'CHANGES (J:=J+1);                  <<04670>>09690000
               J := J+1;   <<Skip size>>                       <<04670>>09692000
               END                                             <<04670>>09694000
            ELSE                                               <<04670>>09696000
               ADDR := DBL(DTT'CHANGES(I).DTCF)*DBL(SECTRK);   <<04670>>09698000
            FOR K := 1 UNTIL NUMENTRIES DO                     <<04670>>09700000
               IF ADDR = TRACK'START(K) THEN                   <<04670>>09702000
                  BEGIN                                        <<04670>>09704000
                  DEL'ENTRY := FALSE;                          <<04670>>09706000
                  K := NUMENTRIES;                             <<04670>>09708000
                  END;                                         <<04670>>09710000
            IF DEL'ENTRY THEN                                  <<04670>>09712000
               IF I <> DTT'CHANGES THEN                        <<04670>>09714000
                  BEGIN                                        <<04670>>09716000
                  IF CS'80 THEN                                <<04670>>09718000
                     MOVE DTT'CHANGES(J:=J-3) :=               <<04670>>09720000
                          DTT'CHANGES(J+3),(DTT'CHANGES*3-J)   <<04670>>09722000
                  ELSE                                         <<04670>>09724000
                     MOVE DTT'CHANGES(I) :=                    <<04670>>09726000
                          DTT'CHANGES(I+1),(DTT'CHANGES-1);    <<04670>>09728000
                  I := I-1;                                    <<04670>>09730000
                  DTT'CHANGES := DTT'CHANGES-1;                <<04670>>09732000
                  END;                                         <<04670>>09734000
            END;                                               <<04670>>09736000
         END                                                   <<04670>>09738000
   ELSE                                                        <<04670>>09740000
      DTT'CHANGES := 0                                         <<04670>>09742000
ELSE                                                           <<04670>>09744000
   DTT'CHANGES := 0;                                           <<04670>>09746000
                                                               <<04670>>09748000
XIT :                                                          <<04670>>09750000
IF NAME'SW'F THEN                                              <<04670>>09752000
   MOVE NAME'SW := NAMESW,(FILEDISP*12);                       <<04670>>09754000
IF FILE'DISP'F THEN                                            <<04670>>09756000
   MOVE FILE'DISP := FILEDISP,(FILEDISP+1);                    <<04670>>09758000
ERROR:                                                         <<04670>>09760000
RELSIR (DIRSIR,B);                                             <<04670>>09762000
RELSIR (FILESIR,A);                                            <<04670>>09764000
END;                                                           <<04670>>09766000
$PAGE "   COPY FUNCTION   -   SORT'ENTRIES PROCEDURE"          <<04670>>09768000
PROCEDURE SORT'ENTRIES;                                        <<04670>>09770000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>09772000
                                                               <<04670>>09774000
<<This procedure sorts DTT/DSCT entries.                    >> <<04670>>09776000
                                                               <<04670>>09778000
BEGIN                                                          <<04670>>09780000
INTEGER I,J,SECOND'EL,LAST'EL;                                 <<04670>>09782000
DOUBLE TEMP;                                                   <<04670>>09784000
INTEGER TEMP1 = TEMP;                                          <<04670>>09786000
                                                               <<04670>>09788000
IF DTT <= 1 THEN                                               <<04670>>09790000
   RETURN;                                                     <<04670>>09792000
                                                               <<04670>>09794000
IF CS'80 OR FORVOL THEN                                        <<04670>>09796000
   BEGIN                                                       <<04670>>09798000
   SECOND'EL := DTT(DSCT'FIRST'ENTRY)/DTT(DSCT'ENTRY'SIZE)+1;  <<04670>>09800000
   LAST'EL := SECOND'EL+DTT(DSCT'NUMBER'OF'ENTRIES)-2;         <<04670>>09802000
   I := (LAST'EL+1) * DTT(DSCT'ENTRY'SIZE);                    <<04670>>09804000
   FOR I := LAST'EL STEP -1 UNTIL SECOND'EL DO                 <<04670>>09806000
      FOR J := SECOND'EL UNTIL I DO                            <<04670>>09808000
         BEGIN                                                 <<04670>>09810000
         IF DTTD(J) < DTTD(J-1) THEN                           <<04670>>09812000
            BEGIN                                              <<04670>>09814000
            TEMP := DTTD(J);                                   <<04670>>09816000
            DTTD(J) := DTTD(J-1);                              <<04670>>09818000
            DTTD(J-1) := TEMP;                                 <<04670>>09820000
            END;                                               <<04670>>09822000
         END;                                                  <<04670>>09824000
   END                                                         <<04670>>09826000
ELSE <<NON CS80 DEVICES>>                                      <<04670>>09828000
   BEGIN                                                       <<04670>>09830000
   SECOND'EL := 2;                                             <<04670>>09832000
   LAST'EL := DTT;                                             <<04670>>09834000
   FOR I := LAST'EL STEP -1 UNTIL SECOND'EL DO                 <<04670>>09836000
      FOR J := SECOND'EL UNTIL I DO                            <<04670>>09838000
         BEGIN                                                 <<04670>>09840000
         IF DTT(J) < DTT(J-1) THEN                             <<04670>>09842000
            BEGIN                                              <<04670>>09844000
            TEMP1 := DTT(J);                                   <<04670>>09846000
            DTT(J) := DTT(J-1);                                <<04670>>09848000
            DTT(J-1) := TEMP1;                                 <<04670>>09850000
            END;                                               <<04670>>09852000
         END;                                                  <<04670>>09854000
   END;                                                        <<04670>>09856000
END;                                                           <<04670>>09858000
$PAGE "   COPY FUNCTION    -   PROCEDURE REMOVE'ENTRY"         <<04670>>09860000
PROCEDURE REMOVE'ENTRY (ADDR,TRACK);                           <<04670>>09862000
VALUE ADDR,TRACK;                                              <<04670>>09864000
LOGICAL TRACK;                                                 <<04670>>09866000
DOUBLE ADDR;                                                   <<04670>>09868000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>09870000
                                                               <<04670>>09872000
<<This procedure removes single entry or if TRACK is true   >> <<04670>>09874000
<<then it removes all entries which belong to the same track>> <<04670>>09876000
                                                               <<04670>>09878000
BEGIN                                                          <<04670>>09880000
INTEGER I;                                                     <<04670>>09882000
LOGICAL SUSPECT;   <<True if suspect/deleted sector/track>>    <<04670>>09884000
DOUBLE ADDRX,ADDRS;                                            <<04670>>09886000
                                                               <<04670>>09888000
IF DTT = 0 THEN                                                <<04670>>09890000
   RETURN;                                                     <<04670>>09892000
IF TRACK THEN                                                  <<04670>>09894000
   ADDR := ADDR - DBL(ADDR MODD LOGICAL(SECTRK));              <<04670>>09896000
                                                               <<04670>>09898000
FOR I := 1 UNTIL DTT DO                                        <<04670>>09900000
   BEGIN                                                       <<04670>>09902000
   IF CS'80 OR FORVOL THEN                                     <<04670>>09904000
      BEGIN                                                    <<04670>>09906000
      ADDRX := DTTD(DTT(DSCT'FIRST'ENTRY'INDEX)/               <<04670>>09908000
                    DTT(DSCT'ENTRY'SIZE) + I - 1);             <<04670>>09910000
      ADDRS := ADDRX - DBL(ADDRX MODD LOGICAL(SECTRK));        <<04670>>09912000
      SUSPECT := TRUE;                                         <<04670>>09914000
      END                                                      <<04670>>09916000
   ELSE                                                        <<04670>>09918000
      BEGIN                                                    <<04670>>09920000
      ADDRX := ADDRS := DBL(DTT(I).TRKF) * DBL(SECTRK);                 09922000
      SUSPECT := IF DTT(I).DTCF <> 3 THEN TRUE ELSE FALSE;     <<04670>>09924000
      END;                                                     <<04670>>09926000
                                                               <<04670>>09928000
   IF TRACK AND (ADDR = ADDRS) AND SUSPECT OR                  <<04670>>09930000
      NOT TRACK AND (ADDR = ADDRX) AND SUSPECT THEN            <<04670>>09932000
      BEGIN                                                    <<04670>>09934000
      IF I <> DTT THEN                                         <<04670>>09936000
         IF CS'80 OR FORVOL THEN                               <<04670>>09938000
            MOVE                                               <<04670>>09940000
            DTT(DTT(DSCT'FIRST'ENTRY'INDEX) + (I-1)*2) :=      <<04670>>09942000
            DTT(DTT(DSCT'FIRST'ENTRY'INDEX) + (I)*2),          <<04670>>09944000
            (DTT'SIZE-I*2)                                     <<04670>>09946000
         ELSE                                                  <<04670>>09948000
            MOVE DTT(I) := DTT(I+1),(DTT'SIZE-I-3)             <<*9055>>09950000
      ELSE                                                     <<04670>>09952000
         IF CS'80 OR FORVOL THEN                               <<04670>>09954000
            DTTD(DTT(DSCT'FIRST'ENTRY'INDEX)/                  <<04670>>09956000
                 DTT(DSCT'ENTRY'SIZE) + I - 1) := 0D           <<04670>>09958000
         ELSE                                                  <<04670>>09960000
            DTT(I) := 0;                                       <<04670>>09962000
      DTT := DTT - 1;                                          <<04670>>09964000
      END;                                                     <<04670>>09966000
   END;                                                        <<04670>>09968000
END;                                                           <<04670>>09970000
$PAGE "   COPY FUNCTION   -   PROCEDURE GET'ENTRY"             <<04670>>09972000
LOGICAL PROCEDURE GET'ENTRY (ADDR,SIZE);                       <<04670>>09974000
DOUBLE ADDR,SIZE;                                              <<04670>>09976000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>09978000
                                                               <<04670>>09980000
<<This procedure extracts entry from the DTT/DSCT.          >> <<04670>>09982000
                                                               <<04670>>09984000
BEGIN                                                          <<04670>>09986000
INTEGER I;                                                     <<04670>>09988000
DEFINE SECTOR = FALSE#;                                        <<04670>>09990000
IF DTT = 0 THEN                                                <<04670>>09992000
   BEGIN                                                       <<04670>>09994000
   GET'ENTRY := FALSE;                                         <<04670>>09996000
   RETURN;                                                     <<04670>>09998000
   END;                                                        <<04670>>10000000
                                                               <<04670>>10002000
GET'ENTRY := TRUE;                                             <<04670>>10004000
IF CS'80 OR FORVOL THEN                                        <<04670>>10006000
   BEGIN                                                       <<04670>>10008000
   ADDR := DTTD (DTT(DSCT'FIRST'ENTRY'INDEX)/                  <<04670>>10010000
                 DTT(DSCT'ENTRY'SIZE));                        <<04670>>10012000
   SIZE := 1D;                                                 <<04670>>10014000
   END                                                         <<04670>>10016000
ELSE                                                           <<04670>>10018000
   BEGIN                                                       <<04670>>10020000
   ADDR := 0D;                                                 <<04670>>10022000
   FOR I := 1 UNTIL DTT DO                                     <<04670>>10024000
      IF DTT(I).DTCF <> 3 THEN                                 <<04670>>10026000
         BEGIN                                                 <<04670>>10028000
         SIZE := DBL (SECTRK);                                          10030000
         ADDR := DBL (DTT(I).TRKF) * SIZE;                              10032000
         I := DTT;                                             <<04670>>10034000
         END;                                                  <<04670>>10036000
   IF ADDR = 0D THEN                                           <<04670>>10038000
      BEGIN                                                    <<04670>>10040000
      GET'ENTRY := FALSE;                                      <<04670>>10042000
      RETURN;                                                  <<04670>>10044000
      END;                                                     <<04670>>10046000
   END;                                                        <<04670>>10048000
REMOVE'ENTRY(ADDR,SECTOR);                                     <<04670>>10050000
END;                                                           <<04670>>10052000
                                                               <<04670>>10054000
                                                               <<04670>>10056000
$PAGE "   COPY FUNCTION   -   PROCEDURE BUILD'DSCT"            <<04670>>10058000
PROCEDURE BUILD'DSCT;                                          <<04670>>10060000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10062000
                                                               <<04670>>10064000
<<This procedure bulids Defective Sector Table in memory.   >> <<04670>>10066000
                                                               <<04670>>10068000
BEGIN                                                          <<04670>>10070000
DTT := 0;                                                      <<04670>>10072000
MOVE DTT(1) := DTT,(DTT'SIZE-1);                               <<04670>>10074000
DTT(DSCT'FIRST'ENTRY'INDEX) := DSCT'OFFSET'TO'FIRST'ENTRY;     <<04670>>10076000
DTT(DSCT'ENTRY'SIZE) := DSCT'SIZE'OF'ENTRY;                    <<04670>>10078000
DTT(DSCT'MAX'NUMBER'OF'ENTRIES) := DSCT'MAX'ENTRIES;           <<04670>>10080000
END;                                                           <<04670>>10082000
                                                               <<04670>>10084000
$PAGE "   COPY FUNCTION - PROCEDURE CREATE'AND'LOCK'DFS'DST"   <<04670>>10086000
LOGICAL PROCEDURE CREATE'AND'LOCK'DFS'DST (LDEV);              <<04670>>10088000
VALUE LDEV;                                                    <<04670>>10090000
INTEGER LDEV;                                                  <<04670>>10092000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10094000
                                                               <<04670>>10096000
<<This procedure creates and locks disc free space data     >> <<04670>>10098000
<<segment. If device is downed (copy function required) the >> <<04670>>10100000
<<DFS segment does not exist. The DOWN command releases     >> <<04670>>10102000
<<DFS DST.                                                  >> <<04670>>10104000
                                                               <<04670>>10106000
BEGIN                                                          <<04670>>10108000
ARRAY LDT (0:SIZE'OF'LDT'ENTRY-1);                             <<06276>>10110000
                                                               <<06276>>10112000
SUBROUTINE DEF'MOVE'FROM'DST;                                  <<06276>>10114000
                                                               <<06276>>10116000
MOVE'FROM'DST (@LDT, LDT'DST, LDEV * SIZE'OF'LDT'ENTRY,        <<06276>>10118000
   SIZE'OF'LDT'ENTRY);                                         <<06276>>10120000
IF LDT'AVAIL'TO'SYS THEN                                       <<06276>>10122000
   DOWNDEV := FALSE                                            <<06276>>10124000
ELSE                                                           <<06276>>10126000
   DOWNDEV := TRUE;                                            <<06276>>10128000
IF DOWNDEV AND                                                 <<04670>>10130000
   CREATE'DFS'DATA'SEG(LDEV,,,IF SYS THEN TRUE ELSE FALSE) AND <<04670>>10132000
   LOCK'DFS'DATA'SEG (LDEV) OR                                 <<04670>>10134000
   LOCK'DFS'DATA'SEG (LDEV) THEN                               <<04670>>10136000
   CREATE'AND'LOCK'DFS'DST := TRUE                             <<04670>>10138000
ELSE                                                           <<04670>>10140000
   CREATE'AND'LOCK'DFS'DST := FALSE;                           <<04670>>10142000
END;                                                           <<04670>>10144000
$PAGE "   COPY FUNCTION - PROCEDURE UNLOCK'AND'DELETE'DFS'DST" <<04670>>10146000
PROCEDURE UNLOCK'AND'DELETE'DFS'DST (LDEV);                    <<04670>>10148000
VALUE LDEV;                                                    <<04670>>10150000
INTEGER LDEV;                                                  <<04670>>10152000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10154000
                                                               <<04670>>10156000
<<This procedure unlocks and removes disc free space data   >> <<04670>>10158000
<<segment.                                                  >> <<04670>>10160000
                                                               <<04670>>10162000
BEGIN                                                          <<04670>>10164000
UNLOCK'DFS'DATA'SEG;                                           <<04670>>10166000
IF DOWNDEV THEN                                                <<04670>>10168000
   BEGIN                                                       <<04670>>10170000
   DEALLOCATE'DFS'DATA'SEG (LDEV);                             <<04670>>10172000
   DELETE'DFS'DATA'SEG (LDEV);                                 <<04670>>10174000
   END;                                                        <<04670>>10176000
END;                                                           <<04670>>10178000
$PAGE "   COPY FUNCTION   -   PROCEDURE REASSIGN'TRACK"        <<04670>>10180000
LOGICAL PROCEDURE REASSIGN'TRACK (LDEV,ADDR);                  <<04670>>10182000
VALUE LDEV,ADDR;                                               <<04670>>10184000
INTEGER LDEV;                                                  <<04670>>10186000
DOUBLE ADDR;                                                   <<04670>>10188000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10190000
                                                               <<04670>>10192000
<<This procedure reassigns track for NON CS80 discs.         >><<04670>>10194000
<<TRK represents entry from the DTT (track address +         >><<04670>>10196000
<<disposition field). Before the track is reassigned it tries>><<04670>>10198000
<<to recover (read) suspect sector. If track is reassigned   >><<04670>>10200000
<<that its entry is inputed into destination DTT. The deleted>><<04670>>10202000
<<tracks, if any, are reassigned because read will fail.     >><<04670>>10204000
                                                               <<04670>>10206000
BEGIN                                                          <<04670>>10208000
INTEGER ALT,IOSTATUS,TRACK;                                    <<04670>>10210000
DOUBLE DISC'ADDR;                                              <<04670>>10212000
LOGICAL GOODTRACK := FALSE;                                    <<*9055>>10214000
INTEGER I;                                                     <<*9055>>10216000
ARRAY DTT'TEMP (0:DTT'SIZE);                                   <<04670>>10218000
DEFINE DTRK=4#;   <<Defective track>>                          <<04670>>10220000
DEFINE SECTOR=0#;                                              <<04670>>10222000
                                                               <<04670>>10224000
REASSIGN'TRACK := TRUE;                                        <<04670>>10226000
                                                               <<04670>>10228000
<<Reassign track>>                                             <<04670>>10230000
                                                               <<04670>>10232000
ALT := DTT(DTTALT);                                            <<04670>>10234000
WHILE NOT GOODTRACK DO                                         <<*9055>>10236000
   BEGIN                                                       <<*9055>>10238000
   GOODTRACK := TRUE;                                          <<*9055>>10240000
   I := 0;                                                     <<*9055>>10242000
   WHILE (I:=I+1) <= DTT(DTT'NUMBER'OF'ENTRIES) DO             <<*9055>>10244000
      IF DTT(I).DTT'TRACK'NUMBER = ALT THEN                    <<*9055>>10246000
      << This alternate track is in the DTT; it's bad >>       <<*9055>>10248000
         BEGIN                                                 <<*9055>>10250000
         GOODTRACK := FALSE;                                   <<*9055>>10252000
         ALT := ALT + 1; << Try testing next alternate track >><<*9055>>10254000
         I := DTT(DTT'NUMBER'OF'ENTRIES);  << stop loop >>     <<*9055>>10256000
         END;                                                  <<*9055>>10258000
   END;                                                        <<*9055>>10260000
IF ALT >= (MAXLPS * TRKCYL) THEN                               <<04670>>10262000
   BEGIN                                                       <<04670>>10264000
   REASSIGN'TRACK := FALSE;                                    <<04670>>10266000
   RETURN;                                                     <<04670>>10268000
   END;                                                        <<04670>>10270000
TRACK := INT(ADDR/DBL(SECTRK));                                <<04670>>10272000
                                                               <<04670>>10274000
<<Enter reassigned track addr. into destination disc DTT>>     <<04670>>10276000
                                                               <<04670>>10278000
MOVE DTT'TEMP := DTT,(DTT+1);  <<Save original DTT>>           <<04670>>10280000
IOSTATUS := 1;                                                 <<04670>>10282000
DISCIO (LDEV,R,DTT,1D,DTT'SIZE,IOSTATUS);                      <<04670>>10284000
IF <> THEN                                                     <<04670>>10286000
   GOTO ERR;                                                   <<04670>>10288000
REMOVE'ENTRY (ADDR,SECTOR);                                    <<04670>>10290000
IOSTATUS := 2;                                                 <<04670>>10292000
DISCIO (LDEV,R,BUFF,ADDR,SECTRK*SECSIZE,IOSTATUS);             <<04670>>10294000
IF <> THEN                                                     <<04670>>10296000
   BEGIN                                                       <<04670>>10298000
   ADDDTTENTRY (TRACK&LSL(2) + 3);                             <<04670>>10300000
   IF < THEN                                                   <<04670>>10302000
      BEGIN                                                    <<04670>>10304000
      GENMSG(PVMSGSET,VIERR37);                                <<04670>>10306000
      GOTO ERR;                                                <<04670>>10308000
      END                                                      <<04670>>10310000
   ELSE                                                        <<04670>>10312000
      BEGIN                                                    <<04670>>10314000
      FLAGTRACK (LDEV,TRACK,ALT);                              <<04670>>10316000
      IF <> THEN                                               <<04670>>10318000
         GOTO ERR;                                             <<04670>>10320000
      DTT(DTTALT) := ALT + 1;   << Update ALT >>               <<*9055>>10322000
      END;                                                     <<04670>>10324000
   END;                                                        <<04670>>10326000
IOSTATUS := 1;                                                 <<04670>>10328000
DISCIO (LDEV,W,DTT,1D,DTT'SIZE,IOSTATUS);                      <<04670>>10330000
IF <> THEN                                                     <<04670>>10332000
   BEGIN                                                       <<04670>>10334000
   TRACKINIT (LDEV,ADDR,-1D,SECTRK*SECSIZE,DTRK);              <<04670>>10336000
ERR:                                                           <<04670>>10338000
   MOVE DTT := DTT'TEMP,(DTT'TEMP+1);                          <<04670>>10340000
   REASSIGN'TRACK := FALSE;                                    <<04670>>10342000
   RETURN;                                                     <<04670>>10344000
   END;                                                        <<04670>>10346000
                                                               <<04670>>10348000
MOVE DTT := DTT'TEMP,(DTT'TEMP+1);                             <<04670>>10350000
                                                               <<04670>>10352000
<<Check reassigned track>>                                     <<04670>>10354000
IOSTATUS := 2;                                                 <<04670>>10356000
DISCIO (LDEV,R,BUFF,ADDR,SECTRK*SECSIZE,IOSTATUS);             <<04670>>10358000
IF <> THEN                                                     <<04670>>10360000
   REASSIGN'TRACK := REASSIGN'TRACK (LDEV,ADDR);               <<04670>>10362000
                                                               <<04670>>10364000
END;                                                           <<04670>>10366000
$PAGE "   COPY FUNCTION   -   PROCEDURE SPARE'SECTOR"          <<04670>>10368000
LOGICAL PROCEDURE SPARE'SECTOR (LDEV,ADDR);                    <<04670>>10370000
VALUE LDEV,ADDR;                                               <<04670>>10372000
INTEGER LDEV;                                                  <<04670>>10374000
DOUBLE ADDR;                                                   <<04670>>10376000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10378000
                                                               <<04670>>10380000
<<This procedure spare suspect sector (if it cannot recover)>> <<04670>>10382000
<<and remove entry from the DSCT.                           >> <<04670>>10384000
                                                               <<04670>>10386000
BEGIN                                                          <<04670>>10388000
INTEGER IOSTATUS;                                              <<04670>>10390000
ARRAY DTT'TEMP (0:DTT'SIZE);                                   <<04670>>10392000
LOGICAL SPARE;                                                 <<04670>>10394000
DEFINE SECTOR = 0#;                                            <<04670>>10396000
                                                               <<04670>>10398000
SPARE := SPARE'SECTOR := TRUE;                                 <<04670>>10400000
                                                               <<04670>>10402000
<<Check if sector is recoverable - test full track>>           <<04670>>10404000
                                                               <<04670>>10406000
IOSTATUS := 2;                                                 <<04670>>10408000
DISCIO (LDEV,INIT'UTIL,ADDR,RW'ERT,1,IOSTATUS);                <<04670>>10410000
IF <> THEN                                                     <<04670>>10412000
   BEGIN                                                       <<04670>>10414000
                                                               <<04670>>10416000
<<Spare sector>>                                               <<04670>>10418000
                                                               <<04670>>10420000
   IOSTATUS := 1;                                              <<04670>>10422000
   DISCIO (LDEV,SPARE'BLOCK,ADDR,NO'RETAIN'DATA,0,IOSTATUS);   <<04670>>10424000
   IF <> THEN                                                  <<04670>>10426000
      BEGIN                                                    <<04670>>10428000
      SPARE'SECTOR := FALSE;                                   <<04670>>10430000
      RETURN;                                                  <<04670>>10432000
      END;                                                     <<04670>>10434000
                                                               <<04670>>10436000
   <<Check spared sector>>                                     <<04670>>10438000
                                                               <<04670>>10440000
   SPARE := SPARE'SECTOR := SPARE'SECTOR (LDEV,ADDR);          <<04670>>10442000
   END;                                                        <<04670>>10444000
                                                               <<04670>>10446000
<<Remove entry from DSCT>>                                     <<04670>>10448000
                                                               <<04670>>10450000
IF NOT FORVOL AND SPARE THEN                                   <<04670>>10452000
   BEGIN                                                       <<04670>>10454000
   MOVE DTT'TEMP := DTT,(DTT'SIZE);  <<Save>>                  <<04670>>10456000
   IOSTATUS := 1;                                              <<04670>>10458000
   DISCIO (LDEV,R,DTT,1D,DTT'SIZE,IOSTATUS);                   <<04670>>10460000
   IF = THEN                                                   <<04670>>10462000
      BEGIN                                                    <<04670>>10464000
      REMOVE'ENTRY (ADDR,SECTOR);                              <<04670>>10466000
      IOSTATUS := 1;                                           <<04670>>10468000
      DISCIO (LDEV,W,DTT,1D,DTT'SIZE,IOSTATUS)                 <<04670>>10470000
      END;                                                     <<04670>>10472000
   MOVE DTT := DTT'TEMP,(DTT'SIZE);  <<Restore>>               <<04670>>10474000
   END;                                                        <<04670>>10476000
END;                                                           <<04670>>10478000
                                                               <<04670>>10480000
$PAGE "   COPY FUNCTION   -   PROCEDURE RECOVER'SPACE"         <<04670>>10482000
LOGICAL PROCEDURE RECOVER'SPACE (LDEV,ADDR);                   <<04670>>10484000
VALUE LDEV,ADDR;                                               <<04670>>10486000
INTEGER LDEV;                                                  <<04670>>10488000
DOUBLE ADDR;                                                   <<04670>>10490000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10492000
                                                               <<04670>>10494000
<<This procedure reassign track for non CS80 discs or spares>> <<04670>>10496000
<<sector (CS80 discs).                                      >> <<04670>>10498000
                                                               <<04670>>10500000
BEGIN                                                          <<04670>>10502000
IF CS'80 THEN                                                  <<04670>>10504000
   RECOVER'SPACE := SPARE'SECTOR (LDEV,ADDR)                   <<04670>>10506000
ELSE                                                           <<04670>>10508000
   RECOVER'SPACE := IF FLOPPY OR FORVOL THEN                   <<04670>>10510000
                       FALSE                                   <<04670>>10512000
                    ELSE                                       <<04670>>10514000
                       REASSIGN'TRACK(LDEV,ADDR);              <<04670>>10516000
END;                                                           <<04670>>10518000
$PAGE "   COPY FUNCTION   -   PROCEDURE ADD'DTT'ENTRY"         <<04670>>10520000
PROCEDURE ADD'DTT'ENTRY (FDEV,TDEV,ADDR);                      <<04670>>10522000
VALUE FDEV,TDEV,ADDR;                                          <<04670>>10524000
INTEGER FDEV,TDEV;                                             <<04670>>10526000
DOUBLE ADDR;                                                   <<04670>>10528000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10530000
                                                               <<04670>>10532000
<<This procedure enters suspect sector/track into DTT/DSCT. >> <<04670>>10534000
                                                               <<04670>>10536000
BEGIN                                                          <<04670>>10538000
INTEGER FIRST'ENTRY,INDEX:=0,TRACK,IOSTAT:=1;                  <<04670>>10540000
INTEGER ARRAY DTTF(0:DTT'SIZE-1);                              <<04670>>10542000
                                                               <<04670>>10544000
IF CS'80 OR FORVOL THEN                                        <<04670>>10546000
                                                               <<04670>>10548000
<<Update DSCT - CS80 devices only>>                            <<04670>>10550000
                                                               <<04670>>10552000
   BEGIN                                                       <<04670>>10554000
   FIRST'ENTRY := DTT(DSCT'FIRST'ENTRY'INDEX)/                 <<04670>>10556000
                  DTT(DSCT'SIZE'OF'ENTRY);                     <<04670>>10558000
   FOR INDEX := FIRST'ENTRY UNTIL FIRST'ENTRY+DTT-1 DO         <<04670>>10560000
      IF ADDR = DTTD(INDEX) THEN                               <<04670>>10562000
         RETURN;                                               <<04670>>10564000
   IF DTT >= DTT (DSCT'MAX'NUMBER'OF'ENTRIES) THEN             <<04670>>10566000
      BEGIN                                                    <<04670>>10568000
      GENMSG(PVMSGSET,VIERR37);                                <<04670>>10570000
      RETURN;                                                  <<04670>>10572000
      END;                                                     <<04670>>10574000
   DTT := DTT + 1;                                             <<04670>>10576000
   DTTD (INDEX) := ADDR;                                       <<04670>>10578000
   END                                                         <<04670>>10580000
ELSE                                                           <<04670>>10582000
                                                               <<04670>>10584000
<<Update DTT - NON CS80 devices>>                              <<04670>>10586000
                                                               <<04670>>10588000
   BEGIN                                                       <<04670>>10590000
                                                               <<04670>>10592000
   <<Check if not a deleted track>>                            <<04670>>10594000
                                                               <<04670>>10596000
   DTTF := 1;                                                  <<04670>>10598000
   DISCIO(FDEV,R,DTTF,1D,DTT'SIZE,IOSTAT);                     <<04670>>10600000
   IF = THEN                                                   <<04670>>10602000
      BEGIN                                                    <<04670>>10604000
      TRACK := INTEGER(ADDR//LOGICAL(SECTRK));                 <<04670>>10606000
      WHILE (INDEX:=INDEX+1) <= DTTF DO                        <<04670>>10608000
         IF DTTF(INDEX) = TRACK&LSL(2)+2 THEN                  <<04670>>10610000
            INDEX := DTTF + 2;                                 <<04851>>10612000
      END;                                                     <<04670>>10614000
   IF INDEX <> (DTTF + 1) THEN                                 <<04851>>10616000
      BEGIN                                                    <<04670>>10618000
      ADDDTTENTRY (TRACK&LSL(2));                              <<04670>>10620000
      IF < THEN                                                <<04670>>10622000
         GENMSG(PVMSGSET,VIERR37);                             <<04670>>10624000
      END;                                                     <<04670>>10626000
    END;                                                       <<04670>>10628000
                                                               <<04670>>10630000
END;                                                           <<04670>>10632000
$PAGE "   COPY FUNCTION   -   PROCEDURE CHECK'PV'ADDR"         <<04670>>10634000
LOGICAL PROCEDURE CHECK'PV'ADDR (LDEV,ADDR,SIZE);              <<04670>>10636000
VALUE LDEV,ADDR,SIZE;                                          <<04670>>10638000
INTEGER LDEV;                                                  <<04670>>10640000
DOUBLE ADDR,SIZE;                                              <<04670>>10642000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10644000
                                                               <<04670>>10646000
<<This procedure checks if sector(s) is(are) used by File   >> <<04670>>10648000
<<System. For private volumes it checks with disc free space>> <<04670>>10650000
<<bit map.                                                  >> <<04670>>10652000
                                                               <<04670>>10654000
BEGIN                                                          <<04670>>10656000
INTEGER LCRIT;                                                 <<04670>>10658000
CHECK'PV'ADDR := TRUE;                                         <<04670>>10660000
LCRIT := SETCRITICAL;                                          <<04670>>10662000
IF CREATE'DFS'DATA'SEG(LDEV,,,IF SYS THEN TRUE ELSE FALSE) THEN<<04670>>10664000
   BEGIN                                                       <<04670>>10666000
   IF GET'SPECIFIC'DISC'SPACE (LDEV,ADDR,SIZE) = 0 THEN        <<04670>>10668000
      BEGIN                                                    <<04670>>10670000
      CHECK'PV'ADDR := FALSE;                                  <<04670>>10672000
      RETURN'DISC'SPACE (LDEV,ADDR,SIZE);                      <<04670>>10674000
      END                                                      <<04670>>10676000
   ELSE                                                        <<04670>>10678000
      CHECK'PV'ADDR := TRUE;                                   <<04670>>10680000
   UNLOCK'AND'DELETE'DFS'DST (LDEV);                           <<04670>>10682000
   END;                                                        <<04670>>10684000
RESETCRITICAL (LCRIT);                                         <<04670>>10686000
END;                                                           <<04670>>10688000
$PAGE "   COPY FUNCTION   -   CHECK'SD'ADDR"                   <<04670>>10690000
LOGICAL PROCEDURE CHECK'SD'ADDR (LDEV,START'ADDR,SIZE);        <<04670>>10692000
VALUE LDEV,START'ADDR,SIZE;                                    <<04670>>10694000
INTEGER LDEV;                                                  <<04670>>10696000
DOUBLE START'ADDR,SIZE;                                        <<04670>>10698000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10700000
                                                               <<04670>>10702000
<<This procedure checks if sector(s) belongs to valid part  >> <<04670>>10704000
<<of serial disc. If a sector(s) lies in a "hole" it returns>> <<04670>>10706000
<<false otherwise true.                                     >> <<04670>>10708000
                                                               <<04670>>10710000
BEGIN                                                          <<04670>>10712000
INTEGER INDEX,G'TYPE,IOSTAT,SECBUF,I;                          <<04670>>10714000
DOUBLE END'ADDR,B'HOLE,E'HOLE,GTAB'ADDR;                       <<04670>>10716000
INTEGER B'HOLE1 = B'HOLE;                                      <<04670>>10718000
INTEGER E'HOLE1 = E'HOLE;                                      <<04670>>10720000
ARRAY GTAB (*) = BUFF;                                         <<04670>>10722000
DOUBLE ARRAY GTABD (*) = GTAB;                                 <<04670>>10724000
DEFINE GTAB'START = 4D#;                                       <<04670>>10726000
DEFINE GTAB'SIZE = INT(GTAB(-3))#;  <<Set by CALC'SD'SIZE>>    <<04670>>10728000
DEFINE GTAB'SEC = GTABD(-1)#;  <<Set by CALC'SD'SIZE>>         <<04670>>10730000
END'ADDR := START'ADDR + SIZE - 1D;                            <<04670>>10732000
CHECK'SD'ADDR := TRUE;                                         <<04670>>10734000
SECBUF := BUFFSIZE/SECSIZE-1; <<One extra sector>>             <<04670>>10736000
GTAB'ADDR := 0D;                                               <<04670>>10738000
                                                               <<04670>>10740000
<<Check if the bad sector lies in the gap table.            >> <<04670>>10742000
                                                               <<04670>>10744000
IF END'ADDR < (GTAB'START + DOUBLE (GTAB'SIZE)) OR             <<04670>>10746000
   START'ADDR < (GTAB'START + DOUBLE (GTAB'SIZE)) THEN         <<04670>>10748000
   RETURN;                                                     <<04670>>10750000
                                                               <<04670>>10752000
<<Read SECBUF number of gap table sector to buffer and look >> <<04670>>10754000
<<for begin of hole.                                        >> <<04670>>10756000
                                                               <<04670>>10758000
DO                                                             <<04670>>10760000
   BEGIN                                                       <<04670>>10762000
   IOSTAT := 2;                                                <<04670>>10764000
   IF (INT (GTAB'ADDR) + SECBUF) > GTAB'SIZE THEN              <<04670>>10766000
      SECBUF := GTAB'SIZE - (INT(GTAB'ADDR) + SECBUF);         <<04670>>10768000
   IF GTAB'ADDR <> GTAB'SEC THEN                               <<04670>>10770000
      IF NOT DLIO (LDEV,R,GTAB,GTAB'ADDR+GTAB'START,           <<04670>>10772000
                   (SECBUF+1)*SECSIZE,IOSTAT) THEN             <<04670>>10774000
         RETURN;                                               <<04670>>10776000
   GTAB'SEC := GTAB'ADDR;                                      <<04670>>10778000
   I := IF GTAB'SEC = 0D THEN 2 ELSE 0;                        <<04670>>10780000
   FOR INDEX := I UNTIL (SECBUF*SECSIZE-1)&LSR(1) DO           <<04670>>10782000
      BEGIN                                                    <<04670>>10784000
      B'HOLE := GTABD(INDEX);                                  <<04670>>10786000
      G'TYPE := B'HOLE1.(0:3);                                 <<04670>>10788000
      IF G'TYPE = 1 OR G'TYPE = 7 THEN                         <<04670>>10790000
         RETURN;                                               <<04670>>10792000
      B'HOLE1.(0:3) := 0;                                      <<04670>>10794000
      IF G'TYPE = 2 THEN                                       <<04670>>10796000
         BEGIN  <<Beginning of hole>>                          <<04670>>10798000
         E'HOLE := GTABD(INDEX+1);  <<End of hole>>            <<04670>>10800000
         E'HOLE1.(0:3) := 0;                                   <<04670>>10802000
         IF B'HOLE <= START'ADDR AND                           <<04670>>10804000
            E'HOLE >= END'ADDR THEN                            <<04670>>10806000
               BEGIN                                           <<04670>>10808000
               CHECK'SD'ADDR := FALSE;                         <<04670>>10810000
               RETURN;                                         <<04670>>10812000
               END;                                            <<04670>>10814000
         END;                                                  <<04670>>10816000
      END;                                                     <<04670>>10818000
   GTAB'ADDR := GTAB'ADDR + DOUBLE (SECBUF);                   <<04670>>10820000
   END                                                         <<04670>>10822000
UNTIL (GTAB'ADDR < DOUBLE (GTAB'SIZE));                        <<04670>>10824000
END;                                                           <<04670>>10826000
$PAGE "   COPY FUNCTION   -   PROCEDURE USED'SPACE"            <<04670>>10828000
LOGICAL PROCEDURE USED'SPACE (LDEV,ADDR,SIZE);                 <<04670>>10830000
VALUE LDEV,ADDR,SIZE;                                          <<04670>>10832000
INTEGER LDEV;                                                  <<04670>>10834000
DOUBLE ADDR,SIZE;                                              <<04670>>10836000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10838000
                                                               <<04670>>10840000
<<This procedure checks if a sector(s) lies in valid portion>> <<04670>>10842000
<<of data. It returns value of TRUE if yes.                 >> <<04670>>10844000
                                                               <<04670>>10846000
BEGIN                                                          <<04670>>10848000
IF PVOL OR SYS THEN                                            <<04670>>10850000
   USED'SPACE := CHECK'PV'ADDR (LDEV,ADDR,SIZE)                <<04670>>10852000
ELSE                                                           <<04670>>10854000
   IF SERIALD THEN                                             <<04670>>10856000
      USED'SPACE := CHECK'SD'ADDR (LDEV,ADDR,SIZE)             <<04670>>10858000
   ELSE                                                        <<04670>>10860000
      USED'SPACE := TRUE;                                      <<04670>>10862000
END;                                                           <<04670>>10864000
$PAGE "   COPY FUNCTION   -   PROCEDURE CHECK'SECTOR"          <<04670>>10866000
PROCEDURE CHECK'SECTOR (LDEV,START'ADDR,SIZE);                 <<04670>>10868000
VALUE LDEV,START'ADDR,SIZE;                                    <<04670>>10870000
INTEGER LDEV;                                                  <<04670>>10872000
DOUBLE START'ADDR,SIZE;                                        <<04670>>10874000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10876000
                                                               <<04670>>10878000
<<This procedure checks if a sector(s) lies in bit map or in>> <<04670>>10880000
<<bit map descriptor for private volumes or system volumes. >> <<04670>>10882000
<<For PV master volume it checks if a sectors belongs to    >> <<04670>>10884000
<<directory.                                                >> <<04670>>10886000
                                                               <<04670>>10888000
BEGIN                                                          <<04670>>10890000
INTEGER BMSIZE,DTSIZE,LEN;                                     <<04670>>10892000
DOUBLE START'DIR,END'DIR,START'BM,START'DT,END'ADDR;           <<04670>>10894000
ARRAY TEXT(0:20);                                              <<04670>>10896000
ARRAY VLAB (*) = BUFF;                                         <<04670>>10898000
DOUBLE HEAD'CYL;                                               <<04670>>10900000
INTEGER HEAD = HEAD'CYL;                                       <<04670>>10902000
INTEGER CYL  = HEAD'CYL + 1;                                   <<04670>>10904000
                                                               <<04670>>10906000
END'ADDR := START'ADDR + SIZE-1D;                              <<04670>>10908000
TEXT := 0;                                                     <<04670>>10910000
IF PVOL OR SYS THEN                                            <<04670>>10912000
   IF GET'DISC'INFO (LDEV,VLAB,TRUE,,,,,START'BM,BMSIZE,       <<04670>>10914000
                     START'DT,DTSIZE) THEN                     <<04670>>10916000
      BEGIN                                                    <<04670>>10918000
      START'DIR := DBL(VLAB(DISC'LAB'DIRBASE));                <<04670>>10920000
      END'DIR := START'DIR+DBL(VLAB(DISC'LAB'DIRSIZE))-1D;     <<04670>>10922000
                                                               <<04670>>10924000
      <<Check directory - PV master volume only>>              <<04670>>10926000
                                                               <<04670>>10928000
      IF PVOL AND VLAB(DISC'LAB'TYPE'WORD).DISC'LAB'MV AND     <<04670>>10930000
         START'DIR <= END'ADDR AND                             <<04670>>10932000
         END'DIR >= START'ADDR THEN                            <<04670>>10934000
            BEGIN                                              <<04670>>10936000
            MOVE TEXT := ("     * (DIRECTORY) *",%0);          <<04670>>10938000
            LEN := -20;                                        <<04670>>10940000
            END                                                <<04670>>10942000
      ELSE                                                     <<04670>>10944000
                                                               <<04670>>10946000
         <<Check bit map>>                                     <<04670>>10948000
                                                               <<04670>>10950000
         IF START'BM <= END'ADDR AND                           <<04670>>10952000
            START'BM+DBL(BMSIZE*PAGE'SIZE-1) >= START'ADDR     <<04670>>10954000
            THEN                                               <<04670>>10956000
               BEGIN                                           <<04670>>10958000
               MOVE TEXT := ("     * (DISC BIT MAP) *",0);     <<04670>>10960000
               LEN := -23;                                     <<04670>>10962000
               END                                             <<04670>>10964000
         ELSE                                                  <<04670>>10966000
                                                               <<04670>>10968000
            <<Check bit map descriptor>>                       <<04670>>10970000
                                                               <<04670>>10972000
            IF START'DT <= END'ADDR AND                        <<04670>>10974000
               START'DT+DBL((DTSIZE+SECSIZE-1)/SECSIZE-1) >=   <<04670>>10976000
               START'ADDR THEN                                 <<04670>>10978000
                  BEGIN                                        <<04670>>10980000
                  MOVE TEXT:=                                  <<04670>>10982000
                  ("     * (DISC BIT MAP DESCRIPTOR *",0);     <<04670>>10984000
                  LEN := -33;                                  <<04670>>10986000
                  END                                          <<04670>>10988000
            ELSE                                               <<04670>>10990000
                                                               <<04670>>10992000
            <<Enter DTT'CHANGES table for PROC'BAD'TRACK>>     <<04670>>10994000
                                                               <<04670>>10996000
               ENT'DTT'CHANGES (START'ADDR,INT(SIZE))          <<04670>>10998000
      END                                                      <<04670>>11000000
   ELSE  <<Get'Disc'Info error>>                               <<04670>>11002000
         ENT'DTT'CHANGES (START'ADDR,INT(SIZE));               <<04670>>11004000
                                                               <<04670>>11006000
HEAD'CYL := CYLINDERHEAD(INT(START'ADDR/DBL(SECTRK)),LDEV);    <<04670>>11008000
GENMSG (PVMSGSET,VIWARN131,%22110,@START'ADDR,                 <<04670>>11010000
        @END'ADDR,CYL,HEAD,,-OUTF);                            <<04670>>11012000
IF TEXT <> 0 THEN                                              <<04670>>11014000
   FWRITE (OUTF,TEXT,LEN,0);                                   <<04670>>11016000
                                                               <<04670>>11018000
END;                                                           <<04670>>11020000
$PAGE "   COPY FUNCTION   -   PROCEDURE VERIFY'MEDIA"          <<04670>>11022000
LOGICAL PROCEDURE VERIFY'MEDIA (LDEV,DISC'SIZE);               <<04670>>11024000
VALUE LDEV,DISC'SIZE;                                          <<04670>>11026000
INTEGER LDEV;                                                  <<04670>>11028000
DOUBLE DISC'SIZE;                                              <<04670>>11030000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11032000
                                                               <<04670>>11034000
<<This procedure reads/verifies data in used part of media  >> <<04670>>11036000
<<Any encouterd bad sector address is recorded in DTT/DSCT  >> <<04670>>11038000
<<However for Cartridge Tape it keeps DSCT in memory.       >> <<*8114>>11040000
                                                               <<04670>>11042000
BEGIN                                                          <<04670>>11044000
INTEGER SIZE,IOSTAT,FUNC,LEN,INDEX;                            <<04851>>11046000
INTEGER ARRAY DTT (0:DTT'SIZE);                                <<04851>>11048000
INTEGER ARRAY DTT'C(*) = DTTD;                                          11050000
DOUBLE ADDR := 0D;                                             <<04851>>11052000
DEFINE GTAB'SEC = BUFFD(-1)#;                                  <<04851>>11054000
                                                               <<04851>>11056000
VERIFY'MEDIA := TRUE;                                          <<04851>>11058000
IF CARTRIDGE OR FORVOL THEN                                    <<*8114>>11060000
   MOVE DTT := DTT'C,(DTT'SIZE)                                         11062000
ELSE                                                                    11064000
BEGIN                                                                   11066000
DISCIO (LDEV,R,DTT,1D,DTT'SIZE);                               <<04851>>11068000
IF <> THEN                                                     <<04851>>11070000
   BEGIN                                                       <<04851>>11072000
   VERIFY'MEDIA := FALSE;                                      <<04851>>11074000
   RETURN;                                                     <<04851>>11076000
   END;                                                        <<04851>>11078000
END;                                                                    11080000
IF SERIALD AND NOT CS'80 THEN                                  <<04851>>11082000
   GTAB'SEC := -1D;                                            <<04851>>11084000
                                                               <<04851>>11086000
WHILE ADDR < DISC'SIZE DO                                      <<04851>>11088000
   BEGIN                                                       <<04851>>11090000
   IOSTAT := 2;                                                <<04851>>11092000
   IF CS'80 THEN                                               <<04851>>11094000
                                                               <<04851>>11096000
<<CS80 DEVICES>>                                               <<04851>>11098000
                                                               <<04851>>11100000
      BEGIN                                                    <<04851>>11102000
      BUFFD := (DISC'SIZE - ADDR) * DBL(SECSIZE&LSL(1));       <<04851>>11104000
      DLIO(LDEV,FUNC:=VERIFY'CS'80,BUFF,ADDR,2,IOSTAT);        <<04851>>11106000
      IF IOSTAT.GSTATUS = SUCCESSFUL THEN                      <<04851>>11108000
         RETURN;                                               <<04851>>11110000
      END                                                      <<04851>>11112000
   ELSE                                                        <<04851>>11114000
                                                               <<04851>>11116000
<<NON CS80 DEVICES>>                                           <<04851>>11118000
                                                               <<04851>>11120000
      BEGIN                                                    <<04851>>11122000
      SIZE:=IF (DISC'SIZE-ADDR)*DBL(SECSIZE) >= DBL(BUFFSIZE+1)<<04851>>11124000
               THEN BUFFSIZE + 1                               <<04851>>11126000
            ELSE INT (DISC'SIZE-ADDR) * SECSIZE;               <<04851>>11128000
      LEN:=DISCIO(LDEV,FUNC:=R,BUFF,ADDR,SIZE,IOSTAT);         <<04851>>11130000
      BUFFD := ADDR + DBL (LEN/SECSIZE - 1);                   <<04851>>11132000
      END;                                                     <<04851>>11134000
   IF IOSTAT.GSTATUS <> SUCCESSFUL THEN                        <<04851>>11136000
      <<Check if read error. In case of deleted track an    >> <<04851>>11138000
      <<invalid address error status is returned.           >> <<04851>>11140000
      IF NOT (IOSTAT.TSTATUS = TRKERR LOR                      <<04851>>11142000
         IOSTAT.TSTATUS = INVADDR) THEN                        <<04851>>11144000
         BEGIN                                                 <<04851>>11146000
         DISCERROR (LDEV,FUNC,IOSTAT,ADDR,STAT.(8:8),DELP);    <<04851>>11148000
         GENMSG (PVMSGSET,VIERR0);                             <<04851>>11150000
         VERIFY'MEDIA := FALSE;                                <<04851>>11152000
         RETURN;                                               <<04851>>11154000
         END                                                   <<04851>>11156000
      ELSE                                                     <<04851>>11158000
         BEGIN                                                 <<04851>>11160000
         <<Check what sector in the buffer causes problems. >> <<04851>>11162000
         <<Unfortunatly the 7920/25 drivers does not return >> <<04851>>11164000
         <<actual number of transmited bytes/words.         >> <<04851>>11166000
         INDEX := 0;                                           <<04851>>11168000
         WHILE (INDEX := INDEX + 1) <= SIZE/SECSIZE DO         <<04851>>11170000
            BEGIN                                              <<04851>>11172000
            IOSTAT := 2;                                       <<04851>>11174000
            DISCIO(LDEV,R,BUFF,ADDR,SECSIZE,IOSTAT);           <<04851>>11176000
            IF <> THEN                                         <<04851>>11178000
               INDEX := SIZE/SECSIZE + 2;                      <<04851>>11180000
            ADDR := ADDR + 1D;                                 <<04851>>11182000
            END;                                               <<04851>>11184000
         ADDR := ADDR - 1D;                                    <<04851>>11186000
         BUFFD := ADDR;                                        <<04851>>11188000
         IF INDEX <> SIZE/SECSIZE + 1 THEN                     <<04851>>11190000
            <<Check if an encountered bad sector belongs to >> <<04851>>11192000
            <<deleted track by scanning a Defective Track   >> <<04851>>11194000
            <<Table.                                        >> <<04851>>11196000
            BEGIN                                              <<04851>>11198000
            INDEX := 0;                                        <<04851>>11200000
            WHILE (INDEX := INDEX + 1) <= DTT DO               <<04851>>11202000
               IF DTT(INDEX) =                                 <<04851>>11204000
                  INT(ADDR//LOGICAL(SECTRK))&LSL(2)+2 THEN     <<04851>>11206000
                  INDEX := DTT + 2;                            <<04851>>11208000
            IF INDEX = DTT + 1 THEN                            <<04851>>11210000
               ADD'DTT'ENTRY (LDEV,LDEV,BUFFD);                <<04851>>11212000
            END;                                               <<04851>>11214000
         END;                                                  <<04851>>11216000
                                                               <<04851>>11218000
   ADDR := BUFFD + 1D;                                         <<04851>>11220000
   END;                                                        <<04851>>11222000
                                                               <<04851>>11224000
END;                                                           <<04670>>11226000
$PAGE "   COPY FUNCTION   -   PROCEDURE PROC'IO'ERROR"         <<04670>>11228000
LOGICAL PROCEDURE PROC'IO'ERROR                                <<04670>>11230000
               (FDEV,TDEV,ADDR,DST,OFFSET,LEN,BUFSIZE,IOSTAT); <<04670>>11232000
VALUE FDEV,TDEV,ADDR,DST,OFFSET,LEN,BUFSIZE,IOSTAT;            <<04670>>11234000
INTEGER FDEV,TDEV,DST,OFFSET,LEN,BUFSIZE,IOSTAT;               <<04670>>11236000
DOUBLE ADDR;                                                   <<04670>>11238000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11240000
<<This procedure processes READ IO error.                   >> <<04670>>11242000
<<It reads rest of data to buffer and enters suspect sectors>> <<04670>>11244000
<<into destination DTT.                                     >> <<04670>>11246000
                                                               <<04670>>11248000
BEGIN                                                          <<04670>>11250000
INTEGER POINTER BUFP;                                          <<04670>>11252000
INTEGER RC;                                                    <<04670>>11254000
DOUBLE ADDRX;                                                  <<04670>>11256000
                                                               <<04670>>11258000
PROC'IO'ERROR := TRUE;                                         <<04670>>11260000
IF IOSTAT.TSTATUS <> TRKERR AND                                <<07328>>11262000
   IOSTAT.TSTATUS <> INVADDR THEN                              <<07328>>11264000
   BEGIN                                                       <<04670>>11266000
   DISCERROR (FDEV,R,IOSTAT,ADDR,STAT.(8:8),DELP);             <<07328>>11268000
   GENMSG(PVMSGSET,VIERR0);                                    <<04670>>11270000
   PROC'IO'ERROR := FALSE;                                     <<04670>>11272000
   RETURN;                                                     <<04670>>11274000
   END;                                                        <<04670>>11276000
ADDRX := ADDR+DOUBLE(OFFSET/SECSIZE)-1D; <<TEMP!!!!!>>         <<04670>>11278000
FOR LEN := OFFSET STEP 128 UNTIL BUFSIZE DO                    <<04670>>11280000
   BEGIN                                                       <<04670>>11282000
   IOSTAT:=2;                                                  <<04670>>11284000
   BUFFD := -1D;                                               <<04670>>11286000
   DISCIO(FDEV,R,BUFF,ADDRX:=ADDRX+1D,128,IOSTAT,DST);         <<07328>>11288000
   LEN := BUFSIZE;                                             <<07328>>11290000
   END;                                                        <<04670>>11292000
                                                               <<07328>>11294000
OFFSET:=0;                                                     <<04670>>11296000
LEN := LEN/SECSIZE*SECSIZE;                                    <<04670>>11298000
OFFSET := OFFSET + LEN;                                        <<04670>>11300000
ADDRX := ADDR + DOUBLE (OFFSET/SECSIZE);                       <<04670>>11302000
IF USED'SPACE (FDEV,ADDRX,1D) THEN                             <<04670>>11304000
   BEGIN                                                       <<04670>>11306000
   ADD'DTT'ENTRY (FDEV,TDEV,ADDRX);                            <<04670>>11308000
   CHECK'SECTOR (FDEV,ADDRX,1D);                               <<04670>>11310000
   END;                                                        <<04670>>11312000
OFFSET := OFFSET + SECSIZE;                                    <<04670>>11314000
@BUFP := OFFSET;                                               <<04670>>11316000
IOSTAT := 2;                                                   <<04670>>11318000
RC := BUFSIZE - OFFSET;                                        <<04670>>11320000
LEN := DISCIO(FDEV,R,BUFP,ADDRX+1D,RC,IOSTAT,DST);             <<04670>>11322000
IF IOSTAT.GSTATUS <> SUCCESSFUL THEN                           <<04670>>11324000
   PROC'IO'ERROR :=                                            <<04670>>11326000
   PROC'IO'ERROR (FDEV,TDEV,ADDR,DST,OFFSET,LEN,BUFSIZE,       <<04670>>11328000
                 IOSTAT);                                      <<04670>>11330000
END;                                                           <<04670>>11332000
$PAGE "   COPY FUNCTION   -   PROCEDURE COPY'TRACK"            <<04670>>11334000
LOGICAL PROCEDURE COPY'TRACK (FDEV,TDEV,BUFSIZE,ADDR,DST);     <<04670>>11336000
VALUE FDEV,TDEV,BUFSIZE,ADDR,DST;                              <<04670>>11338000
INTEGER FDEV,TDEV,BUFSIZE,DST;                                 <<04670>>11340000
DOUBLE ADDR;                                                   <<04670>>11342000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11344000
                                                               <<04670>>11346000
<<This procedure tries to recover bad sector/track on       >> <<04670>>11348000
<<disc. If sector/track is not recoverable, it spares or    >> <<04670>>11350000
<<reassigns sector/track and copies again an entire track   >> <<04670>>11352000
                                                               <<04670>>11354000
BEGIN                                                          <<04670>>11356000
INTEGER IOSTAT,WC,SECBUF,SIZE,LEN;                             <<04670>>11358000
INTEGER POINTER BP;                                            <<04670>>11360000
DEFINE TRACK = TRUE#;                                          <<04670>>11362000
                                                               <<04670>>11364000
DO'IT'AGAIN:                                                   <<04670>>11366000
COPY'TRACK := TRUE;                                            <<04670>>11368000
IF NOT RECOVER'SPACE(TDEV,ADDR) THEN                           <<04670>>11370000
   BEGIN                                                       <<04670>>11372000
   CHECK'SECTOR(LDEV,ADDR,DBL(SECTRK));                        <<04670>>11374000
   RETURN;                                                     <<04670>>11376000
   END;                                                        <<04670>>11378000
                                                               <<04670>>11380000
SIZE := SECTRK;                                                <<04670>>11382000
ADDR := ADDR - DBL(ADDR MODD LOGICAL(SECTRK));                 <<04670>>11384000
SECBUF := BUFSIZE/SECSIZE;                                     <<04670>>11386000
DO                                                             <<04670>>11388000
   BEGIN                                                       <<04670>>11390000
   IF SECBUF > SIZE THEN                                       <<04670>>11392000
      SECBUF := SIZE;                                          <<04670>>11394000
   @BP := 0;                                                   <<04670>>11396000
   IOSTAT := 2;                                                <<04670>>11398000
   LEN := DISCIO(FDEV,R,BP,ADDR,BUFSIZE,IOSTAT,DST);           <<04670>>11400000
   IF IOSTAT.GSTATUS <> SUCCESSFUL AND NOT PROC'IO'ERROR       <<04670>>11402000
      (FDEV,TDEV,ADDR,DST,0,LEN,BUFSIZE,IOSTAT) THEN           <<04670>>11404000
      GOTO ERR;                                                <<04670>>11406000
   IOSTAT := 5;                                                <<04670>>11408000
   DISCIO (TDEV,W,BP,ADDR,BUFSIZE,IOSTAT,DST);                 <<04670>>11410000
   IF <> THEN                                                  <<04670>>11412000
      BEGIN                                                    <<04670>>11414000
ERR:                                                           <<04670>>11416000
      COPY'TRACK := FALSE;                                     <<04670>>11418000
      RETURN;                                                  <<04670>>11420000
      END;                                                     <<04670>>11422000
   IOSTAT := 2;                                                <<04670>>11424000
   DISCIO (TDEV,R,BP,ADDR,BUFSIZE,IOSTAT,DST);                 <<04670>>11426000
   IF <> THEN                                                  <<04670>>11428000
      GOTO DO'IT'AGAIN;                                        <<04670>>11430000
   REMOVE'ENTRY (ADDR,TRACK);                                  <<04670>>11432000
   ADDR := ADDR + DBL(SECBUF);                                 <<04670>>11434000
   END                                                         <<04670>>11436000
UNTIL (SIZE := SIZE - SECBUF) = 0;                             <<04670>>11438000
END;                                                           <<04670>>11440000
$PAGE "   COPY FUNCTION   -   PROCEDURE ALLOC'DATA'SEG"        <<04670>>11442000
LOGICAL PROCEDURE ALLOC'DATA'SEG (DST1,DST2,BUFSIZE);          <<04670>>11444000
INTEGER DST1,DST2,BUFSIZE;                                     <<04670>>11446000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11448000
                                                               <<04670>>11450000
<<This procedure tries to allocate two data segments with   >> <<04670>>11452000
<<maximum size (1K granularity).                            >> <<04670>>11454000
                                                               <<04670>>11456000
BEGIN                                                          <<04670>>11458000
INTEGER I;                                                     <<04670>>11460000
ALLOC'DATA'SEG := TRUE;                                        <<04670>>11462000
DST1 := GETDATASEG (BUFSIZE,BUFSIZE);                          <<04670>>11464000
IF = THEN                                                      <<04670>>11466000
   BEGIN                                                       <<04670>>11468000
   DST2 := GETDATASEG (BUFSIZE,BUFSIZE);                       <<04670>>11470000
   IF <> THEN                                                  <<04670>>11472000
      BEGIN                                                    <<04670>>11474000
      RELDATASEG (DST1);                                       <<04670>>11476000
      ALLOC'DATA'SEG := FALSE;                                 <<04670>>11478000
      DST1 := DST2 := 0;                                       <<04670>>11480000
      END;                                                     <<04670>>11482000
   END                                                         <<04670>>11484000
ELSE                                                           <<04670>>11486000
   DST1 := 0;                                                  <<04670>>11488000
END;                                                           <<04670>>11490000
$PAGE "   COPY FUNCTION   -   PROCEDURE PROCESS'DTT"           <<04670>>11492000
LOGICAL PROCEDURE PROCESS'DTT (LDEV);                          <<04670>>11494000
VALUE LDEV;                                                    <<04670>>11496000
INTEGER LDEV;                                                  <<04670>>11498000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11500000
                                                               <<04670>>11502000
<<This procedure reassigns suspect or deleted tracks and for>> <<04670>>11504000
<<NON-CS80 discs or spares suspect sectors for CS80 discs.  >> <<04670>>11506000
                                                               <<04670>>11508000
BEGIN                                                          <<04670>>11510000
INTEGER I,IOSTAT := 1,TRACK;                                   <<*9055>>11512000
DOUBLE ADDR,SIZE,LSECT,FSECT,DISC'SIZE;                        <<*9055>>11514000
LOGICAL SECTRK;                                                <<*9055>>11516000
PROCESS'DTT := TRUE;                                           <<04670>>11518000
IF CARTRIDGE OR FORVOL THEN                                    <<*8114>>11520000
   BUILD'DSCT                                                  <<04670>>11522000
ELSE                                                           <<04670>>11524000
   BEGIN                                                       <<04670>>11526000
   DISCIO (LDEV,R,DTT,1D,DTT'SIZE,IOSTAT);                     <<04670>>11528000
   IF = AND (DTT <> 0) THEN                                    <<04670>>11530000
      BEGIN                                                    <<04670>>11532000
      IF CS'80 THEN                                            <<04670>>11534000
         BEGIN                                                 <<04670>>11536000
         GENMSG (PVMSGSET,VIWARN132,%10000,LDEV);              <<04670>>11538000
         CS80'SPARE;                                           <<04670>>11540000
         IOSTAT := 1;                                          <<04670>>11542000
         DISCIO (LDEV,W,DTT,1D,DTT'SIZE,IOSTAT);               <<04670>>11544000
         END                                                   <<04670>>11546000
      ELSE                                                     <<04670>>11548000
         FOR I := 1 UNTIL DTT DO                               <<04670>>11550000
            IF DTT(I).DTCF <> 3 THEN                           <<04670>>11552000
               BEGIN                                           <<04670>>11554000
               I := DTT;                                       <<04670>>11556000
               GENMSG (PVMSGSET,VIWARN132,%10000,LDEV);        <<04670>>11558000
               WHILE GET'ENTRY (ADDR,SIZE) DO                  <<04670>>11560000
                  BEGIN                                        <<*9055>>11562000
  << if track is in spare area, don't reassign it!!!!! >>      <<*9055>>11564000
                  GET'DISC'INFO(LDEV,,,,,,DISC'SIZE,,,,,,,,    <<*9055>>11566000
                                SECTRK);                       <<*9055>>11568000
                  TRACK := INT(ADDR/DBL(SECTRK));              <<*9055>>11570000
                  FSECT := LOGICAL(TRACK)**SECTRK; <<1st sect>><<*9055>>11572000
                  LSECT := FSECT + DOUBLE(SECTRK - 1);<<last >><<*9055>>11574000
                  IF LSECT < DISC'SIZE  THEN                   <<*9055>>11576000
<< track isn't in spare region, try to reassign it  >>         <<*9055>>11578000
                      IF NOT REASSIGN'TRACK (LDEV,ADDR) THEN   <<*9055>>11580000
                        BEGIN                                  <<*9055>>11582000
                        GENMSG (PVMSGSET,VIERR125);            <<*9055>>11584000
                        GENMSG (PVMSGSET,VIERR0);              <<*9055>>11586000
                        PROCESS'DTT := FALSE;                  <<*9055>>11588000
                        RETURN;                                <<*9055>>11590000
                        END;                                   <<*9055>>11592000
                  END; << while >>                             <<*9055>>11594000
               END;                                            <<04670>>11596000
      END;                                                     <<04670>>11598000
   END;                                                        <<04670>>11600000
END;                                                           <<04670>>11602000
$PAGE "   COPY FUNCTION   -   PROCEDURE CALC'PV'SIZE"          <<04670>>11604000
DOUBLE PROCEDURE CALC'PV'SIZE (LDEV);                          <<04670>>11606000
VALUE LDEV;                                                    <<04670>>11608000
INTEGER LDEV;                                                  <<04670>>11610000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11612000
                                                               <<04670>>11614000
<<This procedure calculates the data size of private volume  >><<04670>>11616000
<<or system disc to be copied. For NON-CS80 discs the default>><<04670>>11618000
<<value is a logical pack size and for CS80 discs it is the  >><<04670>>11620000
<<physical disc size. However, for private volumes, this     >><<04670>>11622000
<<procedure calculates the data size to be copied using      >><<04670>>11624000
<<a disc free space bit map (DFS data segment). It cannot be >><<04670>>11626000
<<done for system discs because mounted physicaly system     >><<04670>>11628000
<<discs and not included in the system volume table do not   >><<04670>>11630000
<<have the DFS data segment. The system disc which is        >><<04670>>11632000
<<included in the system volume table cannot be copied.      >><<04670>>11634000
                                                               <<04670>>11636000
BEGIN                                                          <<04670>>11638000
INTEGER LCRIT,PAGE'SIZE,LAST'PAGE'SIZE;                        <<04670>>11640000
DOUBLE DISC'SIZE,CALC'SIZE;                                    <<04670>>11642000
                                                               <<04670>>11644000
GET'DISC'INFO (LDEV,,,,,,DISC'SIZE);                           <<04670>>11646000
CALC'PV'SIZE := DISC'SIZE;                                     <<04670>>11648000
                                                               <<04670>>11650000
<<Claculate data size>>                                        <<04670>>11652000
                                                               <<04670>>11654000
LCRIT := SETCRITICAL;                                          <<04670>>11656000
IF (PVOL OR SYS) AND CREATE'AND'LOCK'DFS'DST (LDEV) THEN       <<04670>>11658000
   BEGIN                                                       <<04670>>11660000
   CALC'SIZE := DISC'SIZE;                                     <<04670>>11662000
   LAST'PAGE'SIZE := DISC'SIZE MODD BITS'PER'PAGE;             <<04670>>11664000
   DS'PAGE'NUMBER := DS'LAST'PAGE'OF'MAP + 1;                  <<04670>>11666000
   DO                                                          <<04670>>11668000
      BEGIN                                                    <<04670>>11670000
      DS'PAGE'NUMBER := DS'PAGE'NUMBER - 1;                    <<04670>>11672000
      PAGE'SIZE := DS'DESCRIPTOR'TABLE (DS'PAGE'NUMBER *       <<04670>>11674000
                   DT'ENTRY'SIZE + STARTING'SPACE);            <<04670>>11676000
      END                                                      <<04670>>11678000
   UNTIL (DS'PAGE'NUMBER <> DS'LAST'PAGE'OF'MAP) AND           <<04670>>11680000
         (PAGE'SIZE <> BITS'PER'PAGE) OR                       <<04670>>11682000
         (DS'PAGE'NUMBER = DS'LAST'PAGE'OF'MAP) AND            <<04670>>11684000
         (PAGE'SIZE <> LAST'PAGE'SIZE);                        <<04670>>11686000
XIT:                                                           <<04670>>11688000
   DS'PAGE'NUMBER := DS'PAGE'NUMBER + 1;                       <<04670>>11690000
   DS'WORD'NUMBER := 0;                                        <<04670>>11692000
   DS'BIT'NUMBER := 0;                                         <<04670>>11694000
   CALC'SIZE := CONVERT'MAP'TO'ADDRESS;                        <<04670>>11696000
   UNLOCK'AND'DELETE'DFS'DST (LDEV);                           <<04670>>11698000
   CALC'PV'SIZE := IF DISC'SIZE < CALC'SIZE THEN               <<04670>>11700000
                      DISC'SIZE                                <<04670>>11702000
                   ELSE                                        <<04670>>11704000
                      CALC'SIZE;                               <<04670>>11706000
   END;                                                        <<04670>>11708000
RESETCRITICAL (LCRIT);                                         <<04670>>11710000
END;                                                           <<04670>>11712000
$PAGE "   COPY FUNCTION   -   PROCEDURE CALC'SDISC'SIZE"       <<04670>>11714000
DOUBLE PROCEDURE CALC'SDISC'SIZE (LDEV);                       <<04670>>11716000
VALUE LDEV;                                                    <<04670>>11718000
INTEGER LDEV;                                                  <<04670>>11720000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11722000
                                                               <<04670>>11724000
<<This procedure calculates end of data for serial disc by  >> <<04670>>11726000
<<scanning gap table.                                       >> <<04670>>11728000
                                                               <<04670>>11730000
BEGIN                                                          <<04670>>11732000
INTEGER I,J,K,SIZE,IOSTAT;                                     <<04670>>11734000
ARRAY GTAB (*) = BUFF;                                         <<04670>>11736000
ARRAY VTAB (*) = BUFF;                                         <<04670>>11738000
DOUBLE ARRAY GTABD (*) = GTAB;                                 <<04670>>11740000
DEFINE GTAB'SEC = BUFFD(-1)#;                                  <<04670>>11742000
DEFINE GTAB'SIZE = BUFF(-3)#;                                  <<04670>>11744000
DEFINE GTAB'START = 4D#;                                       <<04670>>11746000
                                                               <<04670>>11748000
GTAB'SEC := -1D;   <<Initialize - gap buffer empty>>           <<04670>>11750000
CALC'SDISC'SIZE := 0D;                                         <<04670>>11752000
IOSTAT := 1;                                                   <<04670>>11754000
IF NOT DLIO (LDEV,R,VTAB,0D,SECSIZE,IOSTAT) THEN               <<04670>>11756000
   RETURN;                                                     <<04670>>11758000
GTAB'SIZE := BUFF(16);                                         <<04670>>11760000
                                                               <<04670>>11762000
<<Scan gap table - read gap table sector by sector.         >> <<04670>>11764000
                                                               <<04670>>11766000
FOR I := 0 UNTIL INT(GTAB'SIZE) - 1 DO                         <<04670>>11768000
   BEGIN                                                       <<04670>>11770000
   IOSTAT := 2;                                                <<04670>>11772000
   GTAB'SEC := DBL(I) + GTAB'START;                            <<04670>>11774000
   IF NOT DLIO (LDEV,R,GTAB,GTAB'SEC,SECSIZE,IOSTAT)           <<04670>>11776000
      THEN                                                     <<04670>>11778000
      GOTO ERR;                                                <<04670>>11780000
   K := 0;                                                     <<04670>>11782000
   IF I = 0 THEN                                               <<04670>>11784000
      BEGIN   <<First sector>>                                 <<04670>>11786000
      K := 4;  <<Skip header>>                                 <<04670>>11788000
      IF GTAB = -1 THEN                                        <<04670>>11790000
         BEGIN   <<No data>>                                   <<04670>>11792000
         GENMSG (PVMSGSET,VIWARN120);                          <<04670>>11794000
         RETURN;                                               <<04670>>11796000
         END;                                                  <<04670>>11798000
      END;                                                     <<04670>>11800000
   FOR J := K STEP 2 UNTIL SECSIZE - 1 DO                      <<04670>>11802000
      BEGIN                                                    <<04670>>11804000
      IF GTAB (J) = -1 THEN                                    <<04670>>11806000
         GOTO ERR;                                             <<04670>>11808000
      IF GTAB (J).(0:3) = 1 THEN                               <<04670>>11810000
         BEGIN                                                 <<04670>>11812000
         GTAB (J).(0:3) := 0;                                  <<04670>>11814000
         CALC'SDISC'SIZE := GTABD(J&LSR(1));                   <<04670>>11816000
         RETURN;                                               <<04670>>11818000
         END;                                                  <<04670>>11820000
      END;                                                     <<04670>>11822000
   END;                                                        <<04670>>11824000
ERR:                                                           <<04670>>11826000
GENMSG (PVMSGSET,VIERR119);                                    <<04670>>11828000
END;                                                           <<04670>>11830000
                                                               <<04670>>11832000
DOUBLE PROCEDURE CALC'DISC'SIZE (LDEV);                        <<04670>>11834000
VALUE LDEV;                                                    <<04670>>11836000
INTEGER LDEV;                                                  <<04670>>11838000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11840000
                                                               <<04670>>11842000
<<This procedure calculates the highest sector address      >> <<04670>>11844000
<<occupied by valid data.                                   >> <<04670>>11846000
                                                               <<04670>>11848000
BEGIN                                                          <<04670>>11850000
CALC'DISC'SIZE := IF SERIALD THEN                              <<04670>>11852000
                     CALC'SDISC'SIZE (LDEV)                    <<04670>>11854000
                  ELSE                                         <<04670>>11856000
                     CALC'PV'SIZE (LDEV);                      <<04670>>11858000
END;                                                           <<04670>>11860000
                                                               <<04670>>11862000
$PAGE "   COPY FUNCTION   -   PROCEDURE GET'COPY'KEYWORD"      <<04670>>11864000
LOGICAL PROCEDURE GET'COPY'KEYWORD (FDEV,TDEV,GEN,VER,BUFSIZE);<<04670>>11866000
INTEGER FDEV,TDEV,GEN,BUFSIZE;                                 <<04670>>11868000
LOGICAL VER;                                                   <<04670>>11870000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11872000
                                                               <<04670>>11874000
<<This procedure parses COPY command keywords : GEN and     >> <<04670>>11876000
<<VERIFY and BUF.                                           >> <<04670>>11878000
                                                               <<04670>>11880000
BEGIN                                                          <<04670>>11882000
INTEGER I,BUF;                                                 <<04670>>11884000
BYTE POINTER P'KEYWORD;                                        <<04670>>11886000
                                                               <<04670>>11888000
@P'KEYWORD := @KEYWORD;                                        <<04670>>11890000
GEN := -1;                                                     <<04670>>11892000
VER := FALSE;                                                  <<04670>>11894000
BUFSIZE := %77600;                                             <<04670>>11896000
I := -1;                                                       <<04670>>11898000
WHILE KEYWDSPEC (I:=I+1) AND I <= 2 DO                         <<04670>>11900000
   BEGIN                                                       <<04670>>11902000
   IF P'KEYWORD = "GEN" THEN                                   <<04670>>11904000
      IF KEYPARMSPEC (I) THEN                                  <<04670>>11906000
         GEN := KEYPARMVAL (I)                                 <<04670>>11908000
      ELSE                                                     <<04670>>11910000
   ELSE                                                        <<04670>>11912000
      IF P'KEYWORD = "VER" THEN                                <<04670>>11914000
         VER := TRUE                                           <<04670>>11916000
      ELSE                                                     <<04670>>11918000
         IF P'KEYWORD = "BUF" AND                              <<04670>>11920000
            KEYPARMSPEC (I) AND                                <<04670>>11922000
            (BUF:=KEYPARMVAL(I)) > 0 AND BUF <= 32 THEN        <<04670>>11924000
            IF BUF < 32 THEN                                   <<04670>>11926000
               BUFSIZE := BUF * 1024                           <<04670>>11928000
            ELSE                                               <<04670>>11930000
         ELSE                                                  <<04670>>11932000
            BEGIN                                              <<04670>>11934000
            GET'COPY'KEYWORD := FALSE;                         <<04670>>11936000
            GENMSG (PVMSGSET,VIERR3);                          <<04670>>11938000
            RETURN;                                            <<04670>>11940000
            END;                                               <<04670>>11942000
   @P'KEYWORD := @P'KEYWORD + MAX'KEYWORD'LEN;                 <<04670>>11944000
   END;                                                        <<04670>>11946000
                                                               <<04670>>11948000
FDEV := DEVPARM(1);                                            <<04670>>11950000
TDEV := DEVPARM(2);                                            <<04670>>11952000
GET'COPY'KEYWORD := TRUE;                                      <<04670>>11954000
END;                                                           <<04670>>11956000
$PAGE "   COPY FUNCTION   -   MAIN PROCEDURE"                  <<04670>>11958000
PROCEDURE COPY;                                                         11960000
OPTION PRIVILEGED,UNCALLABLE;                                           11962000
                                                               <<04670>>11964000
<<This procedure copies data from one disc to another.       >><<04670>>11966000
<<It copies system discs, private volumes, serial discs,     >><<04670>>11968000
<<foreign discs and scratch volumes. The source and          >><<04670>>11970000
<<destination discs must be down during copy. However, if    >><<04670>>11972000
<<user copy configured system disc (active) then such disc   >><<04670>>11974000
<<cannot be downed. During copy of active system disc the    >><<04670>>11976000
<<logging facility are disable to prevent log file expension >><<04670>>11978000
<<and only one user is on the system and no temporary files  >><<04670>>11980000
<<Only logical portion of data are copied. That is true for  >><<04670>>11982000
<<private volume, system discs and serial discs. If discs has>><<04670>>11984000
<<a scratch label or it is a foreign disc then the entire    >><<04670>>11986000
<<media is copied and all bad tracks/sectors are reported.   >><<04670>>11988000
<<If the destination disc has deleted or suspected tracks/   >><<04670>>11990000
<<sectors then they are reassigned or spared (CS80).         >><<04670>>11992000
<<The COPY command has an option VERify. It allows to        >><<04670>>11994000
<<validate a data written on destination discs. If any error >><<04670>>11996000
<<(read) occurs it tries to copy again sector or track. If   >><<04670>>11998000
<<during disc to disc copy any read error occurs on source   >><<04670>>12000000
<<disc it will be entered into Defective Track/Sector Table  >><<04670>>12002000
<<of destination disc so, that user can perform a VINIT      >><<04670>>12004000
<<VERIFY command to check e.g. what files have lost data     >><<04670>>12006000
<<(it is only applicable for logicaly mounted private        >><<04670>>12008000
<<volumes or system discs.                                   >><<04670>>12010000
                                                               <<04670>>12012000
BEGIN                                                                   12014000
     INTEGER I:=-1,GEN:=-1,TRK:=-1;                                     12016000
     INTEGER TR,WC,ENT,ERR,FDEV,TDEV,FLPS,TLPS,INDEX,          <<04670>>12018000
             BUFSIZE,LEN,RIOQ,WIOQ,DST1:=0,DST2:=0,RDST,WDST,  <<04670>>12020000
             RWC,WWC,SAVLOGINFO,SAVFLAGF,INTERVAL := 1,TEMP,   <<04670>>12022000
             LPSTRK,                                           <<RK1PV>>12024000
             trklen,fsubtype,tsubtype;                         <<03510>>12026000
     INTEGER       ttype                                       <<03510>>12028000
                  ,ftype                                       <<03510>>12030000
                  ,lpage                                       <<03510>>12032000
                  ;                                            <<03510>>12034000
     DOUBLE        loc'bit'cnt                                 <<03510>>12036000
                  ;                                            <<03510>>12038000
     LOGICAL       lcrit'set                                   <<03510>>12040000
                  ,dfs'status                                  <<03510>>12042000
                  ,more                                        <<03510>>12044000
                  ,proc'status                                 <<03510>>12046000
                  ,lcrit                                       <<03510>>12048000
                  ,dfs'locked                                  <<03510>>12050000
                  ,cont                                        <<03510>>12052000
                  ,HAVE'DIR'SIR := FALSE                       <<06365>>12054000
                  ,DIRSIRRET                                   <<06365>>12056000
                  ;                                            <<03510>>12058000
     LOGICAL VER;   <<VERIFY FLAG>>                            <<04670>>12060000
     LOGICAL A,TFORVOL,IOSTAT;                                 <<04670>>12062000
     LOGICAL LOGGING'OFF := FALSE;                             <<04670>>12064000
     DOUBLE ADDR,DISC'ADDR,DISC'SIZE,SIZE,SECBUF;              <<04670>>12066000
     INTEGER POINTER BP := 0;                                  <<04670>>12068000
     DOUBLE VTABINFO;                                                   12070000
     INTEGER                                                            12072000
          VTABINFO1 = VTABINFO,                                         12074000
          VTBAINFO2 = VTABINFO+1;                                       12076000
     ARRAY VLAB(0:127);                                        <<RK.08>>12078000
     BYTE ARRAY VLABB(*) = VLAB;                               <<RK.08>>12080000
     << use this define to exit proc from subr >>              <<03510>>12082000
                                                               <<03510>>12084000
     DEFINE exit'procedure = ASSEMBLE(exit 0)#;                <<03510>>12086000
     DEFINE DISABLE'INT    = ASSEMBLE (SED 0)#;                <<04670>>12088000
     DEFINE ENABLE'INT     = ASSEMBLE (SED 1)#;                <<04670>>12090000
     EQUATE LOGINFO        = SYSDB + %167;                     <<04670>>12092000
     EQUATE FLAGF          = SYSDB + %176;                     <<04670>>12094000
     DEFINE LOGGINGFLAG    = (15:1)#;                          <<04670>>12096000
     DEFINE SOFTPREEMPTLOG = (11:1)#;                          <<04670>>12098000
                                                               <<06276>>12100000
                                                               <<06276>>12102000
                                                               <<03510>>12104000
                                                               <<04670>>12106000
SUBROUTINE DISABLE'LOGGING;                                    <<04670>>12108000
   BEGIN                                                       <<04670>>12110000
   <<Disable system logging>>                                  <<04670>>12112000
   GENMSG (PVMSGSET,VIWARN127);                                <<04670>>12114000
   DISABLE'INT;                                                <<04670>>12116000
   SAVLOGINFO := ABSOLUTE(LOGINFO).LOGGINGFLAG;                <<04670>>12118000
   ABSOLUTE(LOGINFO).LOGGINGFLAG := 0;                         <<04670>>12120000
   SAVFLAGF := ABSOLUTE(FLAGF).SOFTPREEMPTLOG;                 <<04670>>12122000
   ABSOLUTE(FLAGF).SOFTPREEMPTLOG := 1;                        <<04670>>12124000
   ENABLE'INT;                                                 <<04670>>12126000
   LOGGING'OFF := TRUE;                                        <<04670>>12128000
   END;                                                        <<04670>>12130000
                                                               <<04670>>12132000
SUBROUTINE ENABLE'LOGGING;                                     <<04670>>12134000
   BEGIN                                                       <<04670>>12136000
   DISABLE'INT;                                                <<04670>>12138000
   ABSOLUTE(LOGINFO).LOGGINGFLAG := SAVLOGINFO;                <<04670>>12140000
   ABSOLUTE(FLAGF).SOFTPREEMPTLOG := SAVFLAGF;                 <<04670>>12142000
   ENABLE'INT;                                                 <<04670>>12144000
   GENMSG (PVMSGSET,VIWARN128);                                <<04670>>12146000
   LOGGING'OFF := FALSE;                                       <<04670>>12148000
   END;                                                        <<04670>>12150000
                                                               <<04670>>12152000
SUBROUTINE UPDATEVTAB;                                         <<04670>>12154000
                                                               <<04670>>12156000
   <<This subroutine updates entry in volume table>>           <<04670>>12158000
                                                               <<04670>>12160000
   BEGIN                                                       <<04670>>12162000
   DISCIO (TDEV,R,VLAB,0D,SECSIZE);                            <<04670>>12164000
   IF <> THEN                                                  <<04670>>12166000
      RETURN;                                                  <<04670>>12168000
   BUFF := "  ";                                               <<04670>>12170000
   IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,TDEV,I))=0D THEN        <<04670>>12172000
   BEGIN                                                       <<04670>>12174000
      IF NOT SYS THEN                                          <<06365>>12176000
         GENMSG (PVMSGSET,VIERR38,%10000,TDEV);                <<06365>>12178000
      RETURN;                                                  <<04670>>12180000
   END;                                                        <<04670>>12182000
   INDEX := VTABINFO1.(8:8);                                   <<04670>>12184000
   A := GETSIR (VTABSIR);                                      <<04670>>12186000
   GETABENTRY (VTABDST,INDEX,BUFF);                            <<04670>>12188000
   MOVE BUFFB := VLABB (LVNAMELOC),(8),2;  <<VOLUME NAME>>     <<04670>>12190000
   MOVE * := VLABB (LVSGROUPLOC),(8),2;    <<GROUP NAME >>     <<04670>>12192000
   MOVE * := VLABB (LVSACCNTLOC),(8);      <<ACCOUNT NAME>>    <<04670>>12194000
   BUFF(12).(12:4):=IF SCRVOL THEN 3 ELSE 2;                   <<04670>>12196000
   BUFF (13) := 0;                                             <<04670>>12198000
   IF SERIALD OR FORVOL THEN                                   <<06276>>12200000
      BEGIN                                                    <<06276>>12202000
      LPDT'RDY'SER'FRN'DISC := TRUE;                           <<06276>>12204000
      IF SERIALD THEN                                          <<06276>>12206000
         LPDT'SERIAL'OR'FOREIGN := LPDT'SERIAL                 <<06276>>12208000
      ELSE                                                     <<06276>>12210000
         LPDT'SERIAL'OR'FOREIGN := LPDT'FOREIGN;               <<06276>>12212000
      END;                                                     <<06276>>12214000
   PUTABENTRY (VTABDST,INDEX,BUFF);                            <<04670>>12216000
   RELSIR (VTABSIR,A);                                         <<04670>>12218000
   END;  <<UPDATEVATB>>                                        <<04670>>12220000
                                                               <<04670>>12222000
                                                               <<04670>>12224000
                                                               <<04670>>12226000
     IF NOT GET'COPY'KEYWORD (FDEV,TDEV,GEN,VER,BUFSIZE) THEN  <<04670>>12228000
        RETURN;                                                <<04670>>12230000
                                                               <<04670>>12232000
     IF NOT GET'DEV'INFO (TDEV,TTYPE,TSUBTYPE) THEN            <<04670>>12234000
        RETURN;                                                <<04670>>12236000
     TFORVOL := FORVOL;                                        <<04670>>12238000
     IF NOT GET'DEV'INFO (FDEV,FTYPE,FSUBTYPE) THEN            <<04670>>12240000
        RETURN;                                                <<04670>>12242000
     IF (FTYPE <> TTYPE) OR (FSUBTYPE <> TSUBTYPE) OR          <<04670>>12244000
        CARTRIDGE THEN                                         <<*8114>>12246000
        BEGIN                                                  <<04670>>12248000
        GENMSG (PVMSGSET,VIERR8);                              <<04670>>12250000
        GENMSG (PVMSGSET,VIERR0);                              <<04670>>12252000
        RETURN;                                                <<04670>>12254000
        END;                                                   <<04670>>12256000
     IF NOT FORVOL AND TFORVOL THEN                            <<04670>>12258000
        INAPPROPRIATE;                                         <<04670>>12260000
     LDEV := TDEV;   <<Spare CS80>>                            <<04670>>12262000
                                                               <<06276>>12264000
     IF LPDT'MOUNTED'PV THEN                                   <<06276>>12266000
        BEGIN                                                  <<06276>>12268000
        GENMSG (PVMSGSET, DEVERR12, %10000, TDEV);             <<06276>>12270000
        GENMSG (PVMSGSET, VIERR0);                             <<06276>>12272000
        RETURN;                                                <<06276>>12274000
        END;                                                   <<06276>>12276000
                                                               <<04670>>12278000
     DOWNDEV := DEVSTATUS(1).DOWNF;                            <<04670>>12280000
     IF NOT DOWNDEV THEN                                       <<04670>>12282000
        IF NOT SYS OR NOT VOLUME'MOUNTED (FDEV) THEN           <<04670>>12284000
           BEGIN                                               <<04670>>12286000
           GENMSG (PVMSGSET,VIERR5,%10000,FDEV);               <<04670>>12288000
           GENMSG (PVMSGSET,VIERR0);                           <<04670>>12290000
           RETURN;                                             <<04670>>12292000
           END                                                 <<04670>>12294000
        ELSE  <<MOUNTED SYSTEM VOLUME>>                        <<04670>>12296000
           IF NOT ONLY'ONE'ON THEN                             <<04670>>12298000
              BEGIN                                            <<04670>>12300000
              GENMSG (PVMSGSET,VIERR135);                      <<04670>>12302000
              GENMSG (PVMSGSET,VIERR0);                        <<04670>>12304000
              RETURN;                                          <<04670>>12306000
              END                                              <<04670>>12308000
           ELSE                                                <<04670>>12310000
              IF ABSOLUTE(LOGINFO).LOGGINGFLAG THEN            <<04670>>12312000
                 <<Disable system logging to prevent a log  >> <<04670>>12314000
                 <<file expantion.                          >> <<04670>>12316000
                 DISABLE'LOGGING;                              <<04670>>12318000
     IF DEVSTATUS(2).DOWNF = 0 THEN                            <<04670>>12320000
        BEGIN                                                  <<04670>>12322000
        GENMSG (PVMSGSET,VIERR5,%10000,TDEV);                  <<04670>>12324000
        GENMSG (PVMSGSET,VIERR0);                              <<04670>>12326000
        GOTO XIT;                                              <<04670>>12328000
        END                                                    <<04670>>12330000
     ELSE                                                      <<04670>>12332000
        IF NOT OVERWRITE(TDEV,4) THEN                          <<04670>>12334000
           GOTO XIT;                                           <<04670>>12336000
                                                               <<04670>>12338000
     IF NOT GET'DISC'INFO(FDEV,,,,,,SIZE,,,,,,,,,,MAXLPS) THEN <<04670>>12340000
        GOTO ER;                                               <<04670>>12342000
     IF NOT GET'DISC'INFO (TDEV,,,,,,DISC'SIZE) THEN           <<04670>>12344000
        GOTO ER;                                               <<04670>>12346000
                                                               <<*8114>>12348000
  << For COPY command, sizes of to and from discs must match >><<*8114>>12350000
     IF SIZE <> DISC'SIZE THEN                                 <<04670>>12352000
        BEGIN                                                  <<04670>>12354000
        GENMSG (PVMSGSET,VIERR9);                              <<04670>>12356000
ER:     GENMSG (PVMSGSET,VIERR0);                              <<04670>>12358000
        GOTO XIT;                                              <<04670>>12360000
        END;                                                   <<04670>>12362000
                                                               <<04670>>12364000
     IF NOT ALLOC'DATA'SEG (DST1,DST2,BUFSIZE) THEN            <<04670>>12366000
        BEGIN                                                  <<04670>>12368000
        GENMSG(PVMSGSET,VIERR0);                               <<04670>>12370000
        GOTO XIT;                                              <<04670>>12372000
        END;                                                   <<04670>>12374000
                                                               <<04670>>12376000
     IF NOT PROCESS'DTT (TDEV) THEN                            <<04670>>12378000
     RETURN;                                                   <<04670>>12380000
                                                               <<04670>>12382000
     IF (DISC'SIZE := CALC'DISC'SIZE(FDEV)) = 0D THEN          <<04670>>12384000
        BEGIN                                                  <<04670>>12386000
        GENMSG(PVMSGSET,VIERR0);                               <<04670>>12388000
        GOTO XIT;                                              <<04670>>12390000
        END;                                                   <<04670>>12392000
     IF NOT SYS THEN                                           <<06365>>12394000
        ENABLE'BREAK                                           <<06365>>12396000
     ELSE                                                      <<06365>>12398000
        BEGIN                                                  <<06365>>12400000
        HAVE'DIR'SIR := TRUE;                                  <<06365>>12402000
        DIRSIRRET := GETSIR (DIRSIR);                          <<06365>>12404000
        END;                                                   <<06365>>12406000
                                                               <<04670>>12408000
     IF (PVOL OR SYS) AND NOT VOLUME'MOUNTED(FDEV) THEN        <<04670>>12410000
        GENMSG (PVMSGSET,VIWARN129,%10000,FDEV);               <<04670>>12412000
     LEN := INT(DISC'SIZE*100D/SIZE);                          <<04670>>12414000
     IF LEN = 0 THEN                                           <<04670>>12416000
        LEN := 1;                                              <<04670>>12418000
     IF LEN <= 10 THEN   << If <10% then no msg >>             <<04670>>12420000
        INTERVAL := 6;                                         <<04670>>12422000
     GENMSG (PVMSGSET,VIWARN134,%10000,LEN);                   <<04670>>12424000
     SECBUF := DOUBLE(BUFSIZE/SECSIZE);                        <<04670>>12426000
     RWC := WWC := BUFSIZE;                                    <<04670>>12428000
     ADDR := IF FORVOL THEN 0D ELSE 2D;                        <<04670>>12430000
     RDST := WDST := DST2;                                     <<04670>>12432000
     DTT'CHANGES := 0;                                         <<04670>>12434000
                                                               <<04670>>12436000
     <<Scratch volume temprorary during copy>>                 <<04670>>12438000
                                                               <<04670>>12440000
     IF NOT FORVOL THEN                                        <<04670>>12442000
        BEGIN                                                  <<04670>>12444000
        SETSCRATCH (TDEV,%3);                                  <<04670>>12446000
        TEMP := SCRVOL;                                        <<04670>>12448000
        SCRVOL := 1;                                           <<04670>>12450000
        UPDATEVTAB;  <<Update VTAB >>                          <<04670>>12452000
        SCRVOL := TEMP;                                        <<04670>>12454000
        END;                                                   <<04670>>12456000
                                                               <<04670>>12458000
     << Read first 255 sectors with wait >>                    <<04670>>12460000
                                                               <<04670>>12462000
     IOSTAT := 2;                                              <<04670>>12464000
     LEN := DISCIO(FDEV,R,BP,ADDR,RWC,IOSTAT,RDST);            <<04670>>12466000
     IF (IOSTAT.GSTATUS <> SUCCESSFUL) AND NOT PROC'IO'ERROR   <<04670>>12468000
        (FDEV,TDEV,ADDR,RDST,0,LEN,RWC,IOSTAT) THEN            <<04670>>12470000
        GOTO XIT;                                              <<04670>>12472000
                                                               <<04670>>12474000
     RDST := DST1;                                             <<04670>>12476000
     ADDR := ADDR + SECBUF;                                    <<04670>>12478000
                                                               <<04670>>12480000
     DO                                                        <<04670>>12482000
        BEGIN                                                  <<04670>>12484000
                                                               <<04670>>12486000
        RIOQ := WIOQ := %407;                                  <<04670>>12488000
        RWC := IF (ADDR + SECBUF) < DISC'SIZE THEN             <<04670>>12490000
               BUFSIZE ELSE                                    <<04670>>12492000
               INTEGER(DISC'SIZE - ADDR) * SECSIZE;            <<04670>>12494000
                                                               <<04670>>12496000
        DISCIO(FDEV,R,BP,ADDR,RWC,RIOQ,RDST);                  <<04670>>12498000
        IF <> THEN                                             <<04670>>12500000
           GOTO XIT;                                           <<04670>>12502000
                                                               <<04670>>12504000
        DISCIO(TDEV,W,BP,ADDR-SECBUF,WWC,WIOQ,WDST);           <<04670>>12506000
        IF <> THEN                                             <<04670>>12508000
           GOTO XIT;                                           <<04670>>12510000
                                                               <<04670>>12512000
        TOS := WAITFORIO(RIOQ);                                <<04670>>12514000
        LEN := TOS;                                            <<04670>>12516000
        IOSTAT := TOS;                                         <<04670>>12518000
        IF (IOSTAT.GSTATUS <> SUCCESSFUL) AND NOT PROC'IO'ERROR<<04670>>12520000
           (FDEV,TDEV,ADDR,RDST,0,LEN,RWC,IOSTAT) THEN         <<04670>>12522000
           GOTO XIT;                                           <<04670>>12524000
                                                               <<04670>>12526000
        TOS := WAITFORIO(WIOQ);                                <<04670>>12528000
        DELETE;                                                <<04670>>12530000
        IOSTAT := TOS;                                         <<04670>>12532000
        IF IOSTAT.GSTATUS <> SUCCESSFUL THEN                   <<04670>>12534000
           BEGIN                                               <<04670>>12536000
           DISCERROR(TDEV,W,IOSTAT,ADDR-SECBUF,STAT.(8:8),DELP)<<04670>>12538000
           ;                                                   <<04670>>12540000
           GENMSG(PVMSGSET,VIERR0);                            <<04670>>12542000
           GOTO XIT;                                           <<04670>>12544000
           END;                                                <<04670>>12546000
                                                               <<04670>>12548000
        IF INT(ADDR*5D/DISC'SIZE) = INTERVAL THEN              <<04670>>12550000
           BEGIN                                               <<04670>>12552000
           INTERVAL := INTERVAL + 1;                           <<04670>>12554000
           GENMSG (PVMSGSET,VIWARN133,%10000,                  <<04670>>12556000
                   INT(ADDR*100D/DISC'SIZE));                  <<04670>>12558000
           END;                                                <<04670>>12560000
        IOSTAT := RDST;                                        <<04670>>12562000
        RDST := WDST;                                          <<04670>>12564000
        WDST := IOSTAT;                                        <<04670>>12566000
                                                               <<04670>>12568000
        END                                                    <<04670>>12570000
     UNTIL (ADDR := ADDR + SECBUF) > DISC'SIZE;                <<04670>>12572000
                                                               <<04670>>12574000
     WWC := RWC;                                               <<04670>>12576000
     IOSTAT := 5;                                              <<04670>>12578000
     DISCIO(TDEV,W,BP,ADDR-SECBUF,WWC,IOSTAT,WDST);            <<04670>>12580000
     IF <> THEN                                                <<04670>>12582000
        GOTO XIT;                                              <<04670>>12584000
     IF LOGGING'OFF THEN                                       <<04670>>12586000
        ENABLE'LOGGING;                                        <<04670>>12588000
                                                               <<04670>>12590000
<<Release buffers data segments                             >> <<04670>>12592000
                                                               <<04670>>12594000
     RELDATASEG(DST2);                                         <<04670>>12596000
     DST2 := 0;                                                <<04670>>12598000
                                                               <<04670>>12600000
<<Update volume label and volume table                      >> <<04670>>12602000
                                                               <<04670>>12604000
        DISCIO(FDEV,R,VLAB,0D,128);                            <<04670>>12606000
        IF < THEN GOTO XIT;                                    <<04670>>12608000
        IF PVOL THEN                                           <<06365>>12610000
           VLAB(LGENINDEX) := IF GEN >= 0 THEN                 <<06365>>12612000
                                 GEN                           <<06365>>12614000
                              ELSE                             <<06365>>12616000
                                 VLAB (LGENINDEX) + 1;         <<06365>>12618000
                                                               <<06365>>12620000
        DISCIO(TDEV,WL,VLAB,0D,128);                           <<04670>>12622000
        IF < THEN GOTO XIT;                                    <<04670>>12624000
     UPDATEVTAB;                                               <<04670>>12626000
     IF VER THEN                                               <<04670>>12628000
                                                               <<04670>>12630000
<< VERIFY >>                                                   <<04670>>12632000
                                                               <<04670>>12634000
        BEGIN                                                  <<04670>>12636000
        GENMSG (PVMSGSET,VIWARN88);                            <<04670>>12638000
                                                               <<04670>>12640000
        IF NOT VERIFY'MEDIA (TDEV,DISC'SIZE) THEN              <<04670>>12642000
           GOTO XIT;                                           <<04670>>12644000
                                                               <<04670>>12646000
        SORT'ENTRIES;   <<SORT DTT/DSCT>>                      <<04670>>12648000
                                                               <<04670>>12650000
        DTT'CHANGES := 0;                                      <<04670>>12652000
        WHILE GET'ENTRY (ADDR,SIZE) DO                         <<04670>>12654000
           IF USED'SPACE (FDEV,ADDR,SIZE) THEN                 <<04670>>12656000
           IF NOT COPY'TRACK (FDEV,TDEV,BUFSIZE,ADDR,DST1)     <<04670>>12658000
              THEN BEGIN                                       <<04670>>12660000
              GENMSG (PVMSGSET,VIERR0);                        <<04670>>12662000
              GOTO XIT;                                        <<04670>>12664000
              END;                                             <<04670>>12666000
           END;                                                <<04670>>12668000
     IF DTT'CHANGES <> 0 AND                                   <<04670>>12670000
        (ERR := CHECK'BAD'FILES (FDEV)) <> 0 THEN              <<04670>>12672000
        IF ERR = -1 THEN                                       <<04670>>12674000
           GENMSG (PVMSGSET,VIWARN130,%10000,FDEV)             <<04670>>12676000
        ELSE                                                   <<04670>>12678000
           GENMSG (PVMSGSET,ERR);                              <<04670>>12680000
                                                               <<04670>>12682000
XIT:                                                           <<04670>>12684000
     IF HAVE'DIR'SIR THEN                                      <<06365>>12686000
        RELSIR (DIRSIR, DIRSIRRET);                            <<06365>>12688000
     IF DST1 <> 0 THEN                                         <<04670>>12690000
        RELDATASEG (DST1);                                     <<04670>>12692000
     IF DST2 <> 0 THEN                                         <<04670>>12694000
        RELDATASEG (DST2);                                     <<04670>>12696000
     IF LOGGING'OFF THEN                                       <<04670>>12698000
        ENABLE'LOGGING;                                        <<04670>>12700000
END  <<COPY>>;                                                 <<04670>>12702000
                                                                        12704000
$PAGE "PVINIT - USER COMMANDS: CONDENSE"                       <<RK.08>>12706000
$CONTROL SEGMENT=CONDENSE                                      <<00239>>12708000
PROCEDURE cond;                                                <<03510>>12710000
   OPTION privileged,uncallable;                               <<03510>>12712000
                                                               <<03510>>12714000
BEGIN                                                          <<03510>>12716000
                                                               <<03510>>12718000
   INTEGER        ldev                                         <<03510>>12720000
                                                               <<03510>>12722000
                 ;                                             <<03510>>12724000
                                                               <<03510>>12726000
   LOGICAL                                                     <<03510>>12728000
                  recover                                      <<03510>>12730000
                                                               <<03510>>12732000
                 ;                                             <<03510>>12734000
                                                               <<03510>>12736000
                                                               <<03510>>12738000
                                                               <<03510>>12740000
   ldev:=devparm(1);   << what device to condense >>           <<03510>>12742000
   IF foreign then inappropriate;                              <<03510>>12744000
                                                               <<03510>>12746000
   IF keywdspec THEN     << only one allowed is recover >>     <<03510>>12748000
      BEGIN                                                    <<03510>>12750000
         IF keyword <> "RECOVER" THEN                          <<03510>>12752000
            BEGIN                                              <<03510>>12754000
               genmsg(pvmsgset,vierr3);                        <<03510>>12756000
               RETURN;                                         <<03510>>12758000
            END                                                <<03510>>12760000
         ELSE    recover:=true;                                <<03510>>12762000
      END                                                      <<03510>>12764000
   ELSE    recover:=false;                                     <<03510>>12766000
                                                               <<03510>>12768000
   <<  bad disc label? >>                                      <<03510>>12770000
                                                               <<03510>>12772000
   IF unreadable'label(ldev,false) THEN RETURN;                <<03510>>12774000
                                                               <<03510>>12776000
                                                               <<03510>>12778000
   condense'disc(ldev,recover);                                <<03510>>12780000
                                                               <<03510>>12782000
                                                               <<03510>>12784000
END;     << cond >>                                            <<03510>>12786000
                                                                        12788000
$PAGE "PVINIT - USER COMMANDS: DTRACK FUNCTION "               <<00239>>12790000
$CONTROL SEGMENT=CONDENSE                                      <<00239>>12792000
PROCEDURE PROCESS'BAD'TRKS(LDEV);                              <<00239>>12794000
VALUE LDEV;                                                    <<00239>>12796000
INTEGER LDEV;                                                  <<00239>>12798000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>12800000
BEGIN                                                          <<00239>>12802000
     INTEGER i,j,k,pverr,                                      <<03510>>12804000
          NUMENTRIES;                                          <<00239>>12806000
     INTEGER MVTABX:=0,THISVOL:=0;                             <<00239>>12808000
     INTEGER fnum,subtype,type;                                <<03510>>12810000
     BYTE ARRAY TEMP(0:29);                                    <<00239>>12812000
     BYTE ARRAY TEMP1(0:9);                                    <<00239>>12814000
     LOGICAL A,B,C;  <<SIRS LOCKED>>                           <<00239>>12816000
     LOGICAL lcrit     << returned from setcritical >>         <<03510>>12818000
            ,dfs'status                                        <<03510>>12820000
            ,proc'status                                       <<03510>>12822000
            ,dfs'locked                                        <<03510>>12824000
            ,lcrit'set                                         <<03510>>12826000
            ,logging'off                                       <<03510>>12828000
            ,purge                                             <<03620>>12830000
            ,purge'all                                         <<03620>>12832000
            ;                                                  <<03510>>12834000
     INTEGER savloginfo      << save logging bit >>            <<03510>>12836000
            ,savflagf        << save soft error  >>            <<03510>>12838000
            ;                                                  <<03510>>12840000
     INTEGER ARRAY VDTAB(0:32) = Q;                            <<00239>>12842000
     ARRAY VTAB(*) = DB+0;                                     <<00239>>12844000
     ARRAY                                                     <<00239>>12846000
          VLAB(*)      = BUFF,                                 <<00239>>12848000
          VSDEFN(*)    = BUFF,                                 <<00239>>12850000
          MVTABENT(*)  = BUFF;                                 <<00239>>12852000
     DOUBLE ARRAY MVTABENT'3D(*) = MVTABENT(3);                <<00239>>12854000
     ARRAY VSID(0:11);                                         <<00239>>12856000
     ARRAY DUM(*) = VSID;  <<DUMMY PARAMETER TO DIRSCAN>>      <<00239>>12858000
     INTEGER POINTER VTABENT;                                  <<00239>>12860000
     INTEGER ARRAY DIRPARMS(0:9);                              <<00239>>12862000
     INTEGER VOL'COUNT;                                        <<00239>>12864000
    <<NOTE--NAMESW AND FILE'DISP ARRAYS HAVE 2 EXTRA ENTRIES>> <<00866>>12866000
    <<THIS IS A FUDGE FACTOR TO AVOID POSSIBLE OVERFLOW>>      <<00866>>12868000
     ARRAY NAMESW(0:(((MAXSECTTRK+2)*12)+11));                 <<00866>>12870000
     BYTE ARRAY NAMES(*) = NAMESW;                             <<00239>>12872000
     ARRAY FNAME(*) = NAMESW(0);                               <<00239>>12874000
     ARRAY GNAME(*) = NAMESW(4);                               <<00239>>12876000
     ARRAY ANAME(*) = NAMESW(8);                               <<00239>>12878000
     DOUBLE ARRAY TRACK'START(0:120);                          <<00239>>12880000
     DOUBLE ARRAY TRACK'END(0:120);                            <<00239>>12882000
     DOUBLE  qtrack'start; << track'start(i),in split stack >> <<03510>>12884000
     DOUBLE ADDR;                                              <<03620>>12886000
     INTEGER ADDR1 = ADDR,                                     <<03620>>12888000
             ADDR2 = ADDR+1;                                   <<03620>>12890000
     INTEGER ARRAY FILE'DISP(0:(MAXSECTTRK+2));                <<00866>>12892000
     EQUATE FOPTIONS = %2001,                                  <<00239>>12894000
            AOPTIONS = %10501,                                 <<00239>>12896000
            DELETE'FILE = 4;  << FOR FCLOSE >>                 <<00239>>12898000
                                                               <<00239>>12900000
     << use this define to exit proc from subr >>              <<03510>>12902000
                                                               <<03510>>12904000
     DEFINE exit'procedure = ASSEMBLE(exit 1)#;                <<03510>>12906000
                                                               <<03510>>12908000
                                                               <<00239>>12910000
     << used to define enable/disable logging  >>              <<03510>>12912000
                                                               <<03510>>12914000
     DEFINE disable'int= ASSEMBLE(sed 0)#;                     <<03510>>12916000
     DEFINE enable'int = ASSEMBLE(sed 1)#;                     <<03510>>12918000
     EQUATE loginfo= sysdb +%167;                              <<03510>>12920000
     EQUATE flagf  = sysdb +%176;                              <<03510>>12922000
     DEFINE loggingflag = (15:1)#;  << = 0 no logging >>       <<03510>>12924000
     DEFINE softpreemptlog = (11:1)#;                          <<03510>>12926000
                          << = 1 keep stats, but dont >>       <<03510>>12928000
                            <<log-used when know will >>       <<03510>>12930000
                   << eventually recover from "error" >>       <<03510>>12932000
                                                               <<03510>>12934000
     SUBROUTINE LEAVE(MSGNUM);                                 <<00239>>12936000
     VALUE MSGNUM;                                             <<00239>>12938000
     INTEGER MSGNUM;                                           <<00239>>12940000
     BEGIN                                                     <<00239>>12942000
         IF logging'off THEN                                   <<03510>>12944000
             BEGIN                                             <<03510>>12946000
               << now enable logging if it was previously >>   <<03510>>12948000
               << enabled                                 >>   <<03510>>12950000
               disable'int;                                    <<03510>>12952000
               ABSOLUTE(loginfo).loggingflag:=savloginfo;      <<03510>>12954000
               ABSOLUTE(flagf).softpreemptlog:=savflagf;       <<03510>>12956000
               enable'int;                                     <<03510>>12958000
            END;                                               <<03510>>12960000
                                                               <<03510>>12962000
          RELSIR (LDT'SIR, C);                                 <<06276>>12964000
          RELSIR (DIRSIR, B);                                  <<06276>>12966000
          RELSIR(FILESIR,A);                                   <<00239>>12968000
          IF MSGNUM > 0 THEN                                   <<00239>>12970000
             GENMSG(PVMSGSET,MSGNUM);                          <<00239>>12972000
          CC := IF MSGNUM < 0 THEN CCE                         <<00239>>12974000
                ELSE CCL;  << DIDN'T FINISH >>                 <<00239>>12976000
         << generate a message to say logging enabled if >>    <<03510>>12978000
         << it was before                                >>    <<03510>>12980000
                                                               <<03510>>12982000
         IF logging'off THEN                                   <<03510>>12984000
            BEGIN                                              <<03510>>12986000
               genmsg(pvmsgset,viwarn87,,,,,,,0);              <<03510>>12988000
               logging'off:=false;                             <<03510>>12990000
            END;                                               <<03510>>12992000
                                                               <<03510>>12994000
          exit'procedure;                                      <<03510>>12996000
     END <<LEAVE>>;                                            <<00239>>12998000
     SUBROUTINE call'leave(err);                               <<03510>>13000000
        value err;                                             <<03510>>13002000
        LOGICAL err;                                           <<03510>>13004000
                                                               <<03510>>13006000
     BEGIN                                                     <<03510>>13008000
                                                               <<03510>>13010000
$IF X3=ON                                                      <<03510>>13012000
         debug;                                                <<03510>>13014000
$IF                                                            <<03510>>13016000
        IF dfs'locked THEN Unlock'Dfs'Data'Seg;                <<03510>>13018000
        IF lcrit'set THEN resetcritical(lcrit);                <<03510>>13020000
        leave(vierr34);                                        <<03510>>13022000
     END;                                                      <<03510>>13024000
<< Procedure to flag the tracks as defective or reassigned   >><<03510>>13026000
<< IT will only work for private volumes which are up or     >><<03510>>13028000
<< have a down pending or logically mounted                  >><<03510>>13030000
<< Before this routine is called, "getfunction" checks to mak>><<03510>>13032000
<< sure this is true or will error off. "dtrack" checks for  >><<03510>>13034000
<< only'one'on. Spoolfiles around are ok cuz can only do this>><<03510>>13036000
<< for pv, and they are never spooled.                       >><<03510>>13038000
<< Also shouldn't have temp files alloc on LDEV,             >><<03510>>13040000
<< only'one'on checks for any temp files                     >><<03510>>13042000
<< Get the file,ldt,and dirc sir. Verify that "ldev" is in   >><<03510>>13044000
<< mounted vol table. Convert the track addresses of what is >><<03510>>13046000
<< being chged to sector addresses. THen run through the dirc>><<03510>>13048000
<< looking for files on those addresses(delete these files)  >><<03510>>13050000
<< Then for these deleted tracks, call DFSM routines to      >><<03510>>13052000
<< mark this track as allocated. NOTE ther may be lost space >><<03510>>13054000
<< on this track so call "Must'Set'Reset'Bit'Map             >><<03510>>13056000
<< NOTICE that this routine operates in split stack mode     >><<03510>>13058000
<< in two places-mvtab access and When calling the DFSM      >><<03510>>13060000
<< routines!!!                                               >><<03510>>13062000
                                                               <<03510>>13064000
                                                               <<00239>>13066000
     dfs'locked:=false;  << initialize >>                      <<03510>>13068000
     lcrit'set:=false;                                         <<03510>>13070000
     logging'off:=false;   << initialize >>                    <<03510>>13072000
     Get'Disc'Info(ldev,,,,type,subtype);                      <<03510>>13074000
     IF (type=fh'disc'type LAND                                <<03510>>13076000
             st'2660'2m <=subtype <=st'2660'4m )               <<03510>>13078000
        OR                                                     <<03510>>13080000
        (type=mh'disc'type LAND                                <<03510>>13082000
             up'7900 <=subtype <=st'2888 ) THEN RETURN;        <<03510>>13084000
                                                               <<03510>>13086000
     << logging enabled >>                                     <<03510>>13088000
                                                               <<03510>>13090000
     IF ABSOLUTE(loginfo).loggingflag THEN                     <<03510>>13092000
        BEGIN                                                  <<03510>>13094000
                                                               <<03510>>13096000
        << going to disable system logging because i dont wan>><<03510>>13098000
        << to get hung up on file sir if log file needs ext  >><<03510>>13100000
           << first generate a message to console/log file   >><<03510>>13102000
           genmsg(pvmsgset,viwarn86,,,,,,,0);                  <<03510>>13104000
                                                               <<03510>>13106000
           disable'int;                                        <<03510>>13108000
           savloginfo:=ABSOLUTE(loginfo).loggingflag;          <<03510>>13110000
           ABSOLUTE(loginfo).loggingflag:=0;                   <<03510>>13112000
           savflagf:=ABSOLUTE(flagf).softpreemptlog;           <<03510>>13114000
           ABSOLUTE(flagf).softpreemptlog:=1;                  <<03510>>13116000
           enable'int;                                         <<03510>>13118000
           logging'off:=true;                                  <<03510>>13120000
        END;                                                   <<03510>>13122000
                                                               <<03510>>13124000
     A:=GETSIR(FILESIR);                                       <<00239>>13126000
     B := GETSIR (DIRSIR);                                     <<06276>>13128000
     C := GETSIR (LDT'SIR);                                    <<06276>>13130000
     IF NOT ONLY'ONE'ON THEN                                   <<00239>>13132000
        BEGIN                                                  <<00239>>13134000
        GENMSG(PVMSGSET,VIWARN9);                              <<00239>>13136000
        LEAVE(0);                                              <<00239>>13138000
        END;                                                   <<00239>>13140000
     IF type <> floppy'disc'type AND                           <<03510>>13142000
        subtype <> floppy'disc'subtype THEN                    <<03510>>13144000
     BEGIN << HP7920 TYPE FAMILY >>                            <<01533>>13146000
        TOS := REQSTATUS (LDEV);                               <<01533>>13148000
        ASSEMBLE (DELB);                                       <<01533>>13150000
        IF TOS.(9:2) <> 1 THEN  << REQUIRES FORMAT SWITCH >>   <<01533>>13152000
        BEGIN                                                  <<01533>>13154000
           GENMSG (PVMSGSET,VIERR33);                          <<01533>>13156000
           GENMSG (PVMSGSET,VIERR0);                           <<01533>>13158000
           LEAVE(0);                                           <<01533>>13160000
        END;                                                   <<01533>>13162000
     END;                                                      <<01533>>13164000
     VDTAB:=0; MOVE VDTAB(1):=VDTAB,(32);<<ZERO VOL-DEV TABLE>><<00239>>13166000
     IF LPDT'NON'SYS'DOMAIN THEN                               <<06276>>13168000
     BEGIN                                                     <<00239>>13170000
          DISCIO(LDEV,R,VLAB,0D,128);                          <<00239>>13172000
          IF < THEN leave(vierr85); << i/o err >>              <<03510>>13174000
          MOVE VSID   :=VLAB(LVOLDIR),(4);       <<SET>>       <<00239>>13176000
          MOVE VSID(4):=VLAB(LVSGROUPLOC'),(4);  <<GROUP>>     <<00239>>13178000
          MOVE VSID(8):=VLAB(LVSACCNTLOC'),(4);  <<ACCOUNT>>   <<00239>>13180000
          GETVSDEFN(VSID,VSDEFN,,PVERR);                       <<00239>>13182000
          IF <> THEN                                           <<00239>>13184000
          BEGIN                                                <<00239>>13186000
               GENMSG(PVMSGSET,PVERR);                         <<00239>>13188000
               leave(vierr85);                                 <<03510>>13190000
          END;                                                 <<00239>>13192000
          MVTABX:=VSDEFN(VDMISC).MVTABXF;                      <<00239>>13194000
          IF = THEN  <<VOLUME SET NOT MOUNTED>>                <<00239>>13196000
          BEGIN                                                <<00239>>13198000
               GENMSG(PVMSGSET,VIWARN5);                       <<00239>>13200000
               LEAVE(0);                                       <<00239>>13202000
          END;                                                 <<00239>>13204000
          VOL'COUNT := VSDEFN(VDINFO).NUMVOL;                  <<00239>>13206000
          GETMVTABENTRY(MVTABX,MVTABENT);                      <<00239>>13208000
          FOR I:=1 UNTIL VOL'COUNT DO                          <<00239>>13210000
          BEGIN                                                <<00239>>13212000
               IF MVTABENT'3D(I) <> 0D THEN  <<VOL MOUNTED>>   <<00239>>13214000
               BEGIN                                           <<00239>>13216000
                    VDTAB(I):=MVTABENT((I & LSL(1))+3).LDEVF;  <<00239>>13218000
                    IF VDTAB(I) = LDEV THEN THISVOL:=I;        <<00239>>13220000
               END                                             <<00239>>13222000
               ELSE                                            <<00239>>13224000
               BEGIN                                           <<00239>>13226000
                    GENMSG(PVMSGSET,VIWARN5);                  <<00239>>13228000
                    LEAVE(0);                                  <<00239>>13230000
               END;                                            <<00239>>13232000
          END;                                                 <<00239>>13234000
          IF THISVOL = 0 THEN  <<THIS DEV NOT PART OF SET>>    <<00239>>13236000
          BEGIN                                                <<00239>>13238000
               GENMSG(PVMSGSET,VIERR39);                       <<00239>>13240000
               leave(vierr85);                                 <<03510>>13242000
          END;                                                 <<00239>>13244000
     END ELSE                                                  <<00239>>13246000
     BEGIN                                                     <<00239>>13248000
           << this code makes no sense since "getfunction" >>  <<03510>>13250000
           << never allows a sys disc to come here & the   >>  <<03510>>13252000
           << algorithm used doesn't know about spool files>>  <<03510>>13254000
           << which may be on sys discs                    >>  <<03510>>13256000
          I:=0;                                                <<00239>>13258000
          MVTABX := 0;                                         <<00239>>13260000
          GETMVTABENTRY(MVTABX,MVTABENT);                      <<00239>>13262000
          EXCHANGEDB(VTABDST);                                 <<00239>>13264000
          WHILE (I:=I+1) <= INTEGER(VTAB(2)) DO                <<00239>>13266000
          BEGIN                                                <<00239>>13268000
               @VTABENT:=@VTAB(I*INTEGER(VTAB.(8:8)));         <<00239>>13270000
               IF VTABENT(12).LDEVF <> 0 THEN  <<ENTRY IN USE>><<00239>>13272000
               BEGIN                                           <<00239>>13274000
                    VDTAB(I):=VTABENT(12).LDEVF;               <<00239>>13276000
                    IF VDTAB(I) = LDEV THEN THISVOL:=I;        <<00239>>13278000
               END;                                            <<00239>>13280000
          END;                                                 <<00239>>13282000
          EXCHANGEDB(0);                                       <<00239>>13284000
     END;                                                      <<00239>>13286000
                                                               <<00239>>13288000
   IF CS'80 THEN                                               <<03620>>13290000
     BEGIN                                                     <<03620>>13292000
     J := 0;                                                   <<03620>>13294000
     FOR I := 1 UNTIL DTT'CHANGES DO                           <<03620>>13296000
        BEGIN                                                  <<03620>>13298000
        ADDR1 := DTT'CHANGES(J:=J+1);                          <<03620>>13300000
        ADDR2 := DTT'CHANGES(J:=J+1);                          <<03620>>13302000
        TRACK'START(I) := ADDR;                                <<03620>>13304000
        TRACK'END(I) := ADDR + DBL(DTT'CHANGES(J:=J+1)-1);     <<03620>>13306000
        END;                                                   <<03620>>13308000
     END                                                       <<03620>>13310000
     ELSE                                                      <<03620>>13312000
     FOR I := 1 UNTIL DTT'CHANGES DO                           <<00239>>13314000
        BEGIN                                                  <<00239>>13316000
       track'start(i):=DBL(sectrk) * DBL( dtt'changes(i).      <<03510>>13318000
                                        dtt'track'number );    <<03510>>13320000
        TRACK'END(I) := TRACK'START(I) + DBL(SECTRK-1);        <<03620>>13322000
        END;                                                   <<00239>>13324000
                                                               <<00866>>13326000
     << "maxsecttrk" was an arbitrary choice- leave it for   >><<03510>>13328000
     << now- the def won't be true when BFD is added         >><<03510>>13330000
    DO   <<CAN ONLY PROCESS A FINITE NUMBER OF FILES, SO...>>  <<00866>>13332000
    BEGIN  <<PROCESS UP TO MAXSECTTRK FILES>>                  <<00866>>13334000
     NUMENTRIES := DTT'CHANGES;                                <<00239>>13336000
     NAMESW := "  ";                                           <<00239>>13338000
     MOVE NAMESW(1) := NAMESW, ((MAXSECTTRK+1)*12);            <<00239>>13340000
     FILE'DISP := 0;                                           <<00239>>13342000
     MOVE FILE'DISP(1) := FILE'DISP(0),(MAXSECTTRK-1);         <<00866>>13344000
                                                               <<00239>>13346000
     DIRPARMS(1):=@VDTAB;                                      <<00239>>13348000
     DIRPARMS(2):=THISVOL;                                     <<00239>>13350000
     DIRPARMS(3):=NUMENTRIES;                                  <<00239>>13352000
     DIRPARMS(4):=@TRACK'START;                                <<00239>>13354000
     DIRPARMS(5):=@TRACK'END;                                  <<00239>>13356000
     DIRPARMS(6):=@NAMESW;                                     <<00239>>13358000
     DIRPARMS(7):=@FILE'DISP;                                  <<00239>>13360000
     DIRPARMS(8):=0;                                           <<03620>>13362000
                                                               <<00239>>13364000
     DIRPARMS:=0;  <<RECIP TYPE>>                              <<00239>>13366000
     DIRECSCAN(%120,0D,DUM,DUM,DUM,                            <<00239>>13368000
               DTRACK'RECIP,DIRPARMS,MVTABX);                  <<00239>>13370000
     IF <> THEN                                                <<00239>>13372000
     BEGIN                                                     <<00239>>13374000
          GENMSG(PVMSGSET,DIRECERR);                           <<00239>>13376000
          GENMSG(PVMSGSET,VIERR0);                             <<00239>>13378000
          leave(vierr85);                                      <<03510>>13380000
     END;                                                      <<00239>>13382000
     IF DIRPARMS < -1  THEN   <<DISC ERROR IN DTRACK'RECIP>>   <<00866>>13384000
     BEGIN                                                     <<00239>>13386000
          leave(vierr85);                                      <<03510>>13388000
     END;                                                      <<00239>>13390000
                                                               <<00239>>13392000
    IF FILE'DISP <> 0 THEN   <<ARE THERE ANY FILE TO PURGE ?>> <<03620>>13394000
      BEGIN                                                    <<03620>>13396000
      << DO YOU WANT DELETE ALL BAD FILES (Y/N) ? >>           <<03620>>13398000
      GENMSG(PVMSGSET,VIWARN107,0,,,,,,,,,,%100000);           <<03620>>13400000
      I := READ(PBUFW,-10);                                    <<03620>>13402000
      PURGE'ALL := IF I > 0 AND PBUF = "Y" THEN TRUE           <<03620>>13404000
                                           ELSE FALSE;         <<03620>>13406000
      END;                                                     <<03620>>13408000
     TEMP1(8) := " ";                                          <<00239>>13410000
    I := 0;                                                    <<00239>>13412000
     WHILE (I:=I+1) <= FILE'DISP DO                            <<00239>>13414000
        BEGIN                                                  <<00239>>13416000
        J := -1;                                               <<00239>>13418000
        TOS := @TEMP;                                          <<00239>>13420000
        WHILE (J:=J+1) < 3 DO                                  <<00239>>13422000
           BEGIN                                               <<00239>>13424000
           MOVE TEMP1 := NAMES(I*24+J*8),(8);                  <<00239>>13426000
           MOVE * := TEMP1 WHILE AN,1;                         <<00239>>13428000
           IF J < 2 THEN MOVE * := ".",2                       <<00239>>13430000
              ELSE MOVE * := 0,2;                              <<00239>>13432000
           END;  << OF WHILE J < 3 >>                          <<00239>>13434000
        DEL;  << STACKED @TEMP >>                              <<00239>>13436000
        IF FILE'DISP(I) = 1 THEN << FLAB ON BADTRACK >>        <<00239>>13438000
           BEGIN                                               <<00239>>13440000
           TOS := DIRECPURGE(0,0D,ANAME(I*12),GNAME(I*12),     <<00239>>13442000
                             FNAME(I*12),MVTABX);              <<00239>>13444000
           J := TOS;                                           <<00239>>13446000
           K := TOS;                                           <<00239>>13448000
           IF <> THEN                                          <<00239>>13450000
              BEGIN                                            <<00239>>13452000
              GENMSG(PVMSGSET,VIERR71,%11000,J,K,@TEMP);       <<00239>>13454000
              END                                              <<00239>>13456000
           ELSE GENMSG(PVMSGSET,VIWARN8,0,@TEMP);              <<00239>>13458000
           END << OF FLAB ON BADTRACK >>                       <<00239>>13460000
        ELSE                                                   <<00239>>13462000
           IF NOT PURGE'ALL THEN                               <<03620>>13464000
             BEGIN                                             <<03620>>13466000
             << DO YOU WANT SAVE FILE xxx (Y/N) ? >>           <<03620>>13468000
             GENMSG(PVMSGSET,VIWARN108,0,@TEMP,,,,,,,,,        <<03620>>13470000
                    %100000);                                  <<03620>>13472000
             K := READ(PBUFW,-10);                             <<03620>>13474000
             PURGE := IF K>0 AND PBUF="Y" THEN FALSE           <<03620>>13476000
                                          ELSE TRUE;           <<03620>>13478000
             END;                                              <<03620>>13480000
           IF PURGE'ALL OR PURGE THEN                          <<03620>>13482000
           BEGIN << EXTENT ON BAD TRACK >>                     <<00239>>13484000
           FNUM := MUSTOPEN(TEMP,FOPTIONS,AOPTIONS);           <<00239>>13486000
           IF = THEN                                           <<00239>>13488000
              BEGIN                                            <<00239>>13490000
              FCLOSE(FNUM,DELETE'FILE,0);                      <<00239>>13492000
              IF <> THEN                                       <<00239>>13494000
                 GENMSG(PVMSGSET,VIERR73,0,@TEMP)              <<00239>>13496000
              ELSE GENMSG(PVMSGSET,VIWARN8,0,@TEMP);           <<00239>>13498000
              END  << OF IF = ... >>                           <<00239>>13500000
           ELSE GENMSG(PVMSGSET,VIERR72,0,@TEMP);              <<00239>>13502000
           END; << OF EXTENTS ON BAD TRACK >>                  <<00239>>13504000
        END;  << OF FOR I := 1 UNTIL FILEDISP >>               <<00239>>13506000
    END    <<PROCESS UP TO MAXSECTTRK FILES>>                  <<00866>>13508000
    UNTIL  FILE'DISP < MAXSECTTRK;  <<NO MORE TO DO>>          <<00866>>13510000
   IF CS'80 THEN                                               <<03620>>13512000
      <<CHECK ALL DSCT ENTRIES IF THERE ARE ONO ZERO>>         <<03620>>13514000
      <<THIS VALUES REPRESENTS UNSPARED SECTORS     >>         <<03620>>13516000
      <<IF ANY UNSPARED SECTORS THEN DELETE FROM    >>         <<03620>>13518000
      <<BIT MAP                                     >>         <<03620>>13520000
      ELSE                                                     <<03620>>13522000
      BEGIN                                                    <<03620>>13524000
     << now that all files have been deleted(if they lie on  >><<03510>>13526000
     << a deleted trk -                                      >><<03510>>13528000
     << take the whole deleted track out of DFSM             >><<03510>>13530000
     i:=1;                                                     <<03510>>13532000
     WHILE i <= dtt'changes                                    <<03510>>13534000
     DO BEGIN                                                  <<03510>>13536000
        IF dtt'disp (i) = 0 THEN    << disp is deleted >>      <<06276>>13538000
           BEGIN                                               <<03510>>13540000
              lcrit:=setcritical;                              <<03510>>13542000
              lcrit'set:=true;                                 <<03510>>13544000
              qtrack'start:=track'start(i); << q rel >>        <<03510>>13546000
              dfs'status:=Lock'Dfs'Data'Seg(ldev);             <<03510>>13548000
              IF NOT(dfs'status) THEN call'leave(dfs'status);  <<03510>>13550000
              dfs'locked:=true;                                <<03510>>13552000
              <<==   in SPLIT STACK MODE   ==>>                <<03510>>13554000
              ds'disc'address:=qtrack'start;                   <<03510>>13556000
              Convert'Address'To'Map;                          <<03510>>13558000
              ds'number'of'sectors:=DBL(sectrk);               <<03510>>13560000
              Must'Set'Reset'Bit'Map(false);                   <<03510>>13562000
              IF NOT(ds'error'status) THEN                     <<03510>>13564000
                        call'leave(ds'error'status);           <<03510>>13566000
              Unlock'Dfs'Data'Seg;                             <<03510>>13568000
              dfs'locked:=false;                               <<03510>>13570000
              resetcritical(lcrit);                            <<03510>>13572000
              lcrit'set:=false;                                <<03510>>13574000
              <<==   NOT in SPLIT STACK    ==>                 <<03510>>13576000
           END;                                                <<03510>>13578000
        flagtrack(ldev,dtt'changes(i).(0:14),dtt'disp(i));     <<03510>>13580000
        i:=i+1;                                                <<03510>>13582000
    END;                                                       <<03510>>13584000
      END;                                                     <<03620>>13586000
     LEAVE(-1);                                                <<00239>>13588000
     END; << OF PROCESS'BAD'TRACKS >>                          <<00239>>13590000
                                                               <<00239>>13592000
PROCEDURE DTRACK;                                                       13594000
OPTION PRIVILEGED,UNCALLABLE;                                           13596000
BEGIN                                                                   13598000
     << looks at the defective tracks table                  >><<03510>>13600000
     << there are 5 types of discs:                          >><<03510>>13602000
     << 1 foreign - inappropiate (GETFUNCTION caught)        >><<03510>>13604000
     << 2 serial  - inappropiate (GETFUNCTION caught)        >><<03510>>13606000
     << 3 scratch - no dirc, no bit map, no descr            >><<03510>>13608000
     << 4 sys disc- old code would check for dirc in         >><<03510>>13610000
     <<             disc label in fields that dont exist     >><<03510>>13612000
     <<             in sys disc label therefore no dirc      >><<03510>>13614000
     <<             but descr and bit map                    >><<03510>>13616000
     << 5 pv      - maybe dirc, has bit map, descr           >><<03510>>13618000
     INTEGER TYPE;                                             <<03620>>13620000
     INTEGER disckind;                                         <<03510>>13622000
     INTEGER I, N'OF'SEC;                                      <<04290>>13624000
     EQUATE d'system = 0,   << returned from disktype >>       <<03510>>13626000
            d'private = 1,                                     <<03510>>13628000
            d'serial = 2,                                      <<03510>>13630000
            d'scratch = 3,                                     <<03510>>13632000
            d'foreign = 4                                      <<03510>>13634000
           ;                                                   <<03510>>13636000
     DOUBLE     bmaddr    << bit map address >>                <<03510>>13638000
               ,dtaddr    << descr address   >>                <<03510>>13640000
               ;                                               <<03510>>13642000
                                                                        13644000
     LDEV:=DEVPARM(1);                                                  13646000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01115>>13648000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN;              <<00239>>13650000
     DISCIO(LDEV,R,BUFF,0D,128);  <<LABEL>>                             13652000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13654000
     TOS:=buff(disc'lab'map'high);                             <<03510>>13656000
     TOS:=buff(disc'lab'map'low);                              <<03510>>13658000
     bmaddr:=TOS;                                              <<03510>>13660000
     TOS:=buff(disc'lab'dt'high);                              <<03510>>13662000
     TOS:=buff(disc'lab'dt'low);                               <<03510>>13664000
     dtaddr:=TOS;                                              <<03510>>13666000
     disckind:=disctype(ldev,buff);                            <<03510>>13668000
     IF disckind = d'serial THEN << GETFUNCTION already >>     <<03510>>13670000
        BEGIN << caught, just to make code clearer >>          <<03510>>13672000
           genmsg(pvmsgset,deverr8);                           <<03510>>13674000
           RETURN;                                             <<03510>>13676000
        END;                                                   <<03510>>13678000
     GET'DISC'INFO(LDEV,,,,TYPE,,,,,,,,,,SECTRK);              <<03620>>13680000
     CS'80 := FALSE;                                           <<03620>>13682000
     IF TYPE =CS'80'TYPE THEN                                  <<03620>>13684000
        BEGIN                                                  <<03620>>13686000
        CS'80 := TRUE;                                         <<03620>>13688000
        END;                                                   <<03620>>13690000
     DISCIO(LDEV,R,DTT,1D,128);                                         13692000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13694000
     N'OF'SEC := DTT;                                          <<04290>>13696000
TRY'AGAIN:                                                     <<03620>>13698000
     IF disckind = d'scratch THEN                              <<03510>>13700000
        dttanalysis(ldev)                                      <<03510>>13702000
     ELSE                                                      <<03510>>13704000
        BEGIN                                                  <<03510>>13706000
           IF disckind = d'system THEN                         <<03510>>13708000
              dttanalysis(ldev,,,bmaddr,                       <<03510>>13710000
                          dtaddr)                              <<03510>>13712000
           ELSE                                                <<03510>>13714000
              BEGIN                                            <<03510>>13716000
                 IF buff(disc'lab'type'word).disc'lab'mv THEN  <<03510>>13718000
                    dttanalysis(ldev,                          <<03510>>13720000
                                 DBL( buff(disc'lab'dirbase) ),<<03510>>13722000
                                 buff(disc'lab'dirsize)        <<03510>>13724000
                                ,bmaddr                        <<03510>>13726000
                                ,dtaddr )                      <<03510>>13728000
                 ELSE                                          <<03510>>13730000
                    dttanalysis(ldev,,,bmaddr,                 <<03510>>13732000
                                dtaddr );                      <<03510>>13734000
              END;  << pv >>                                   <<03510>>13736000
        END;                                                   <<03510>>13738000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13740000
     IF = THEN  <<NO DTT ENTRIES>>                                      13742000
     BEGIN                                                              13744000
          MOVE MSG:="** NO SUSPECT TRACKS/SECTORS FOUND";      <<03620>>13746000
          PRINT(MSGW,-34,0);                                   <<03620>>13748000
     END ELSE                                                           13750000
     BEGIN                                                     <<00239>>13752000
          IF DTT'CHANGES <> 0 THEN PROCESS'BAD'TRKS(LDEV);     <<00239>>13754000
          IF < THEN RETURN;                                    <<00239>>13756000
           IF STATUS = 0 THEN                                  <<03620>>13758000
              IF DTT <> 0 THEN GOTO TRY'AGAIN                  <<03620>>13760000
              ELSE                                             <<03620>>13762000
              ELSE IF DTT <> 0 THEN                            <<03620>>13764000
              BEGIN                                            <<03620>>13766000
              MOVE PBUF :=                                     <<03620>>13768000
              "IO ERROR DURING SPARING - DTRACK TERMINATED ";  <<03620>>13770000
              FWRITE(OUTF,PBUFW,-44,0);                        <<03620>>13772000
              END;                                             <<03620>>13774000
     END;                                                      <<00239>>13776000
     << CS'80 discs only.                                    >><<04290>>13778000
     << The lack of spare tracks will cause that some of     >><<04290>>13780000
     << suspect sectors are not spared and will remain in    >><<04290>>13782000
     << the DSCT. However the DSCT count must be updated and >><<04290>>13784000
     << items in the DSCT must be sorted to eliminate empty  >><<04290>>13786000
     << slots. The updated DSCT is written back to the disc. >><<04290>>13788000
     IF CS'80 THEN                                             <<04290>>13790000
        BEGIN                                                  <<04290>>13792000
        DTT := N'OF'SEC;                                       <<04290>>13794000
        SORT'DSCT;                                             <<04290>>13796000
        DTT := 0;                                              <<04290>>13798000
        I := DTT(DSCT'FIRST'ENTRY'INDEX)/                      <<04290>>13800000
             DTT(DSCT'ENTRY'SIZE)-1;                           <<04290>>13802000
        N'OF'SEC := N'OF'SEC + I;                              <<04290>>13804000
        WHILE DTTD( I := I+1 ) <> 0D AND I <= N'OF'SEC DO      <<04290>>13806000
           DTT := DTT + 1;                                     <<04290>>13808000
        END;                                                   <<04290>>13810000
     DISCIO(LDEV,W,DTT,1D,128);  <<WRITE UPDATED DTT>>                  13812000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13814000
END << DTRACK >>;                                                       13816000
                                                                        13818000
$PAGE "PVINIT - USER COMMANDS: STATUS FUNCTIONS"               <<00239>>13820000
PROCEDURE DELVOL;                                                       13822000
OPTION PRIVILEGED,UNCALLABLE;                                           13824000
BEGIN                                                                   13826000
END << DELVOL >>;                                                       13828000
                                                                        13830000
$CONTROL SEGMENT=PVSTATUS                                      <<RK1PV>>13832000
PROCEDURE DSTAT;                                                        13834000
OPTION PRIVILEGED,UNCALLABLE;                                           13836000
BEGIN                                                                   13838000
     INTEGER DEV:=0,ERRNUM;                                             13840000
     LOGICAL STATUS;                                                    13842000
                                                                        13844000
     IF KEYWDSPEC THEN  <<CHECK PARAMETER>>                             13846000
     BEGIN                                                              13848000
          IF KEYWDLEN > 3 THEN                                          13850000
          BEGIN                                                         13852000
               GENMSG(PVMSGSET,VIERR3);                                 13854000
               RETURN;                                                  13856000
          END;                                                          13858000
          IF KEYWORD = "ALL" OR KEYWORD = "@" THEN DEV:=-1 ELSE<<RK.08>>13860000
          BEGIN                                                         13862000
               DEV:=BINARY(KEYWORD,KEYWDLEN);                           13864000
               IF <> OR DEV <= 0 THEN                                   13866000
               BEGIN                                                    13868000
                    GENMSG(PVMSGSET,VIERR15);                           13870000
                    RETURN;                                             13872000
               END;                                                     13874000
          END;                                                          13876000
     END;                                                               13878000
                                                                        13880000
     ERRNUM:=DSTATCOM(2,DEV);                                           13882000
     IF <> THEN                                                         13884000
     BEGIN                                                              13886000
          IF (DEVERR1<=ERRNUM<=DEVERR9) THEN                            13888000
             BEGIN                                                      13890000
                  CHECKDISC(DEV,STATUS);                                13892000
                  DEVERROR(DEV,STATUS)                                  13894000
             END;                                                       13896000
     END;                                                               13898000
END << DSTAT >>;                                                        13900000
                                                                        13902000
$PAGE "PVINIT - USER COMMANDS: PRINT FUNCTIONS"                         13904000
                                                                        13906000
PROCEDURE PDEFN;                                                        13908000
OPTION PRIVILEGED,UNCALLABLE;                                           13910000
BEGIN                                                                   13912000
     INTEGER I,LEN,INDEX,NAMELEN;                                       13914000
     INTEGER PVERR = I;  <<ERROR NUMBER FOR GENMSG>>                    13916000
     LOGICAL VMASK;                                                     13918000
     DOUBLE DIRESULT;                                                   13920000
     INTEGER                                                            13922000
          DIRESULT1 = DIRESULT,                                         13924000
          DIRESULT2 = DIRESULT+1;                                       13926000
     ARRAY VSDEFN(0:59);                                                13928000
     BYTE ARRAY VSDEFNB(*) = VSDEFN;                                    13930000
     BYTE ARRAY TEMP(0:27);                                    <<00112>>13932000
                                                                        13934000
     IF VSID = "*" THEN  <<LOOK FOR HOME VOLUME SET>>                   13936000
     BEGIN                                                              13938000
          DIRESULT:=DIRECFIND (%10,0D,VSIDW(8),VSIDW(4),       <<RK.08>>13940000
                               VSIDW,VSDEFN);                  <<RK.08>>13942000
          IF <> THEN                                                    13944000
          BEGIN                                                         13946000
               PVERR:=IF DIRESULT2 = 2 THEN (DIRESULT1+SYSTEMUSE)<<.09>>13948000
                      ELSE DIRECERR;                                    13950000
               GENMSG(PVMSGSET,PVERR);                                  13952000
               RETURN;                                                  13954000
          END;                                                          13956000
          IF VSDEFNB(68) = "  " THEN  <<NO NHOME VOLUME SET>>           13958000
          BEGIN                                                         13960000
               I:=0; MSG(8):=" ";                                       13962000
               TOS:=@PBUF;                                              13964000
               WHILE (I:=I+1) <= 2 DO                                   13966000
               BEGIN                                                    13968000
                    MOVE MSG:=VSID(I*8),(8);                            13970000
                    MOVE  * :=MSG WHILE AN,1;                           13972000
                    MOVE  * :=".",2;                                    13974000
               END;                                                     13976000
               LEN:=TOS-@PBUF-1;                                        13978000
               PBUF(LEN):=0;  <<GENMSG STOPPER>>                        13980000
               GENMSG(PVMSGSET,NOHVSET,0,@PBUF);                        13982000
               RETURN;                                                  13984000
          END;                                                          13986000
          MOVE VSID:=VSDEFNB(68),(8),2;                                 13988000
          MOVE * :=VSDEFNB(60),(8),2;                                   13990000
          MOVE * :=VSDEFNB(52),(8);                                     13992000
     END;                                                               13994000
    DIRESULT:=DIRECFIND(%40,0D,VSIDW(8),VSIDW(4),VSIDW,VSDEFN);<<RK.08>>13996000
     IF <> THEN                                                         13998000
     BEGIN                                                              14000000
          PVERR:=IF DIRESULT2 = 2 THEN (DIRESULT1+SYSTEMUSE)   <<RK.09>>14002000
                 ELSE DIRECERR;                                         14004000
          GENMSG(PVMSGSET,PVERR);                                       14006000
          RETURN;                                                       14008000
     END;                                                               14010000
     I:=-1;                                                             14012000
     TOS:=@MSG;                                                         14014000
     WHILE (I:=I+1) < 3 DO                                              14016000
     BEGIN                                                              14018000
          MOVE * := VSID(I*8),(8),2;                                    14020000
          MOVE * := " ",2;                                              14022000
     END;                                                               14024000
     I:=-1;                                                             14026000
     TOS:=@TEMP;                                               <<00112>>14028000
     WHILE (I:=I+1) < 3 DO                                              14030000
     BEGIN                                                              14032000
          MOVE * :=MSG(I*9) WHILE AN,1;                                 14034000
          IF I <> 2 THEN MOVE * :=".",2;                                14036000
     END;                                                               14038000
     NAMELEN:=TOS-@TEMP;                                       <<00112>>14040000
     IF VSDEFN(4).(0:1) THEN                                            14042000
     BEGIN                                                              14044000
          MOVE PBUF:=" CLASS DEFINITION: ",2;                           14046000
          MOVE * :=TEMP,(NAMELEN),2;                           <<00112>>14048000
          LEN:=TOS-@PBUF;                                               14050000
     END ELSE                                                           14052000
     BEGIN                                                              14054000
          MOVE PBUF:=" SET DEFINITION: ",2;                             14056000
          MOVE * :=TEMP,(NAMELEN),2;                           <<00112>>14058000
          MOVE * := "     MVTAB INDEX: ",2;                             14060000
          LEN:=TOS-@PBUF;                                               14062000
          LEN:=LEN+ASCII(VSDEFN(VDMISC).MVTABXF,10,PBUF(LEN));          14064000
     END;                                                               14066000
     FWRITE(OUTF,PBUFW,-LEN,0);                                <<RK.08>>14068000
     MOVE PBUF:=" NUMBER OF VOLUMES:     VOLUME MASK: %         ";      14070000
     ASCII(VSDEFN(VDINFO).(0:4),10,PBUF(20));                           14072000
     ASCII(VSDEFN(VDINFO).(8:8), 8,PBUF(38));                           14074000
     FWRITE(OUTF,PBUFW,-44,0);                                 <<RK.08>>14076000
     IF VSDEFN(VDMISC).(0:1) THEN  <<CLASS ENTRY>>                      14078000
     BEGIN                                                              14080000
          MOVE PBUF:=" MASTER REFERENCE:   ";                           14082000
          MOVE PBUF(19):=VSDEFNB(28),(8),2;                             14084000
          MOVE *:=".",2;                                                14086000
          MOVE *:=VSDEFNB(20),(8),2;                                    14088000
          MOVE *:=".",2;                                                14090000
          MOVE *:=VSDEFNB(12),(8);                                      14092000
          FWRITE(OUTF,PBUFW,-45,0);                            <<RK.08>>14094000
          RETURN;                                                       14096000
     END;                                                               14098000
     MOVE PBUF:=" INDEX   MEMBER   SUBTYPE";                            14100000
     FWRITE(OUTF,PBUFW,-25,0);                                 <<RK.08>>14102000
     MOVE PBUF:=" -----  --------  -------";                            14104000
     FWRITE(OUTF,PBUFW,-25,0);                                 <<RK.08>>14106000
     INDEX:=0;                                                          14108000
     VMASK:=VSDEFN(VDINFO).(8:8);                                       14110000
     WHILE VMASK <> 0 DO                                                14112000
     BEGIN                                                              14114000
          INDEX:=INDEX+1;                                               14116000
          IF VMASK THEN                                                 14118000
          BEGIN                                                         14120000
               PBUF:=" "; MOVE PBUF(1):=PBUF,(24);                      14122000
               MOVE PBUF(8):=VSDEFNB((INDEX*6) & LSL(1)),(8);           14124000
               ASCII(INDEX,10,PBUF(3));                                 14126000
               ASCII(VSDEFN((INDEX*6)+5).(0:8),10,PBUF(21));            14128000
               FWRITE(OUTF,PBUFW,-23,0);                       <<RK.08>>14130000
          END;                                                          14132000
          VMASK:=VMASK & LSR(1);                                        14134000
     END;                                                               14136000
END << PDEFN >>;                                                        14138000
                                                                        14140000
$PAGE "PROCEDURE PLABEL"                                       <<03537>>14142000
PROCEDURE PLABEL;                                                       14144000
OPTION PRIVILEGED,UNCALLABLE;                                           14146000
BEGIN                                                                   14148000
     INTEGER I,LOC,LDEV;                                                14150000
     ARRAY VLAB(*) = BUFF;                                              14152000
     BYTE ARRAY VLABB(*) = BUFF;                                        14154000
     LOGICAL SCRATCH'PACK;                                     <<00145>>14156000
     INTEGER Qmisc := 0;                                       <<03537>>14158000
     LOGICAL Dummy;                                            <<03537>>14160000
     DEFINE                                                             14162000
          MV      = VLAB(LDEVINFO).MVF#,                                14164000
          SERIALF = (2:1)#,                                    <<RK.03>>14166000
          SERIAL  = VLAB(LDEVINFO).SERIALF#,                   <<RK.03>>14168000
          SYSTEM  = DEVSTATUS(1).(10:1)#,                               14170000
          SCRATCH = VLAB(LDEVINFO).SCRATCHF#;                           14172000
                                                                        14174000
                                                                        14176000
     Vlab := 0;                                                <<*8114>>14178000
     MOVE Vlab(1) := Vlab,(Cartridge'Sector - 1);              <<*8114>>14180000
     LDEV:=DEVPARM(1);                                                  14182000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01278>>14184000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN;              <<00239>>14186000
     IF Is'It'Cartridge(Ldev) THEN                             <<*8114>>14188000
     BEGIN                                                     <<03537>>14190000
          Cartridge'Io(Ldev,Qmisc,Vlab,R,Cartridge'Sector,     <<*8114>>14192000
                       Disc'Label'Address,Blocked'IO,          <<*8114>>14194000
                       NO'SPARING,Default'Errinfo,Dummy);      <<*8114>>14196000
     END                                                       <<03537>>14198000
     ELSE                                                      <<03537>>14200000
          DISCIO(Ldev,R,Vlab,0D,128);                          <<03537>>14202000
     IF < THEN RETURN;                                                  14204000
     SPACE(1);                                                 <<00239>>14206000
     MOVE PBUF := " Ldev    ";                                 <<03537>>14208000
     ASCII(LDEV,10,PBUF(6));                                            14210000
     FWRITE(OUTF,PBUFW,-8,0);                                  <<RK.08>>14212000
     MOVE PBUF:=(" Volume Name:          , Type:  , Subtype: ",<<03537>>14214000
               "            ");                                <<RK.05>>14216000
     ASCII(VLAB(LDEVINFO).(6:6),10,PBUF(31));                           14218000
     ASCII(VLAB(LDEVINFO).(12:4),10,PBUF(43));                          14220000
     SCRATCH'PACK := SCRATCHVOL(LDEV);                         <<00145>>14222000
     IF < THEN RETURN;                                         <<00145>>14224000
     IF DISCTYPE(LDEV,VLAB) = 4 THEN                           <<03537>>14226000
          MOVE PBUF(14) := "*Foreign*"                         <<03537>>14228000
     ELSE                                                      <<03537>>14230000
     IF SCRATCH'PACK THEN                                      <<03537>>14232000
          MOVE PBUF(14) := "*Scratch*"                         <<03537>>14234000
     ELSE                                                      <<03537>>14236000
     IF DISCTYPE(LDEV,VLAB) = 2 THEN                           <<03537>>14238000
          MOVE PBUF(14) := "*Serial*"                          <<03537>>14240000
     ELSE                                                      <<03537>>14242000
     BEGIN                                                              14244000
          MOVE PBUF(14):=VLABB(LVNAMELOC),(8);                          14246000
          IF LPDT'NON'SYS'DOMAIN THEN                          <<06276>>14248000
          BEGIN                                                         14250000
               FWRITE(OUTF,PBUFW,-45,0);                       <<RK.08>>14252000
               MOVE PBUF:=                                     <<03537>>14254000
               " Create Date:         , Generation:      ";    <<03537>>14256000
               DATECONV(VLAB(LINITDATE),PBUF(14));                      14258000
               ASCII(VLAB(LGENINDEX),10,PBUF(36));                      14260000
               FWRITE(OUTF,PBUFW,-40,0);                       <<RK.08>>14262000
               MOVE PBUF :=                                    <<03537>>14264000
               " VS Name:         , Group:         ,";         <<03537>>14266000
               MOVE PBUF(36) := " Account:         ";          <<03537>>14268000
               MOVE PBUF(10):=VLABB(LVOLDIRLOC),(8);                    14270000
               MOVE PBUF(27):=VLABB(LVSGROUPLOC),(8);                   14272000
               MOVE PBUF(46):=VLABB(LVSACCNTLOC),(8);                   14274000
               IF MV THEN                                               14276000
               BEGIN                                                    14278000
                    FWRITE(OUTF,PBUFW,-54,0);                  <<RK.08>>14280000
                    MOVE PBUF :=" Master Volume Information -";<<03537>>14282000
                    FWRITE(OUTF,PBUFW,-28,0);                  <<RK.08>>14284000
                    MOVE PBUF :=                               <<03537>>14286000
                    "  Dir. Base:     , Dir. Size:     ";      <<03537>>14288000
                    ASCII(VLAB(LDIRBASE),10,PBUF(13));                  14290000
                    ASCII(VLAB(LDIRSIZE),10,PBUF(30));                  14292000
                    FWRITE(OUTF,PBUFW,-34,0);                  <<RK.08>>14294000
                    MOVE PBUF :=                               <<03537>>14296000
                    "  Volume Directory";                      <<03537>>14298000
                    FWRITE(OUTF,PBUFW,-18,0);                  <<RK.08>>14300000
                    MOVE PBUF := "    Name     Subtype ";      <<03537>>14302000
                    FWRITE(OUTF,PBUFW,-21,0);                  <<RK.08>>14304000
                    MOVE PBUF:="  --------   ------- ";                 14306000
                    LOC:=LVOLDIRLOC;                                    14308000
                    FOR I:=1 UNTIL INTEGER(VLAB(LVDIRINFO).(0:4)) DO    14310000
                    BEGIN                                               14312000
                         FWRITE(OUTF,PBUFW,-21,0);             <<RK.08>>14314000
                         LOC:=LOC+(VOLDIRENTSIZE & LSL(1));             14316000
                         PBUF:=" "; MOVE PBUF(1):=PBUF,(53);            14318000
                         MOVE PBUF(2):=VLABB(LOC),(8);  <<NAME>>        14320000
                         ASCII(VLAB(LOC&LSR(1)+5).(0:8),10,PBUF(16));   14322000
                    END;                                                14324000
               END;                                                     14326000
          END;                                                          14328000
     END;                                                               14330000
     FWRITE(OUTF,PBUFW,-54,0);                                 <<RK.08>>14332000
END << PLABEL >>;                                                       14334000
                                                                        14336000
$PAGE "PROCEDURE PDTRACK"                                      <<03536>>14338000
PROCEDURE PDTRACK;                                                      14340000
OPTION PRIVILEGED,UNCALLABLE;                                           14342000
BEGIN                                                                   14344000
     INTEGER I,ALT,LEN,LDEV,DISP,TRACK,INDEX,MAXLPS,SUBTYPE;            14346000
     INTEGER      sectrk                                       <<03510>>14348000
                 ,lps          << in cylinders >>              <<03510>>14350000
                 ,trkcyl                                       <<03510>>14352000
                 ;                                             <<03510>>14354000
     LOGICAL      proc'status                                  <<03510>>14356000
                 ;                                             <<03510>>14358000
     INTEGER Type := 0;                                        <<03536>>14360000
     INTEGER Status := 0;                                      <<03536>>14362000
     DOUBLE CYLHEAD;                                                    14364000
     INTEGER                                                            14366000
          HEAD = CYLHEAD,                                               14368000
          CYL  = CYLHEAD+1;                                             14370000
     BYTE ARRAY MHEAD1(0:53)=PB:=                                       14372000
          "             FIRST     LAST                  ALTERNATE";     14374000
     BYTE ARRAY MHEAD2(0:53)=PB:=                                       14376000
          " CYL HEAD   SECTOR    SECTOR      STATUS     CYL  HEAD";     14378000
     BYTE ARRAY STATS(*)=PB := "    SUSPECT     SUSPECT ALT ", <<03537>>14380000
          "    DELETED     REASSIGNED  UNREADABLE ALT";                 14382000
                                                                        14384000
     LDEV:=DEVPARM(1);                                                  14386000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01115>>14388000
     Type    := Ldevtotype(Ldev);                              <<03536>>14390000
     Subtype := 0;                                             <<03536>>14392000
     Subtype := Ldevtosubtype(Ldev);                           <<03536>>14394000
     IF Type >= 0 LAND Type < CS'80'Type THEN                  <<03536>>14396000
     BEGIN                                                     <<03536>>14398000
                                                               <<03536>>14400000
<< Only Types 0,1,2 have a Defective Tracks Table.           >><<03536>>14402000
<< Type 3 has a Defective Sector Table (DSCT).               >><<03536>>14404000
<< We handle it much differently.                            >><<03536>>14406000
<< Note that with the CS'80 family, having a bad volume      >><<03536>>14408000
<< label does not necessarily imply that the DSCT is bad.    >><<03536>>14410000
                                                               <<03536>>14412000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN;              <<00239>>14414000
     DISCIO(LDEV,R,DTT,1D,128);  <<READ IN DTT>>                        14416000
     IF < THEN RETURN;                                                  14418000
     PRINTLDEV(LDEV);                                          <<03536>>14420000
     proc'status:=Get'Disc'Info(ldev,,,,,,,,,,,,,,             <<03510>>14422000
                         sectrk,,lps,trkcyl);                  <<03510>>14424000
     IF not(proc'status) THEN RETURN;                          <<03510>>14426000
     maxlps:=lps * trkcyl -dtt(dtt'next'alt'track); <<in trks>><<03510>>14428000
     MOVE PBUF:=" LOGICAL PACK SIZE = ",2;                              14430000
     TOS:=ASCII(DTT(DTTLPS),10,BPS0);                                   14432000
     ASSEMBLE(ADD);                                                     14434000
     MOVE * :=" CYLINDERS, ",2;                                         14436000
     TOS:=ASCII(MAXLPS,10,BPS0);                                        14438000
     ASSEMBLE(ADD);  <<UPDATE BUFFER POINTER>>                          14440000
     MOVE * :=" ALTERNATE TRACKS AVAILABLE",2;                          14442000
     LEN:=TOS-@PBUF;                                                    14444000
     FWRITE(OUTF,PBUFW,-LEN,0);                                <<RK.08>>14446000
     IF DTT=0 THEN   <<NO ENTRIES IN TABLE>>                            14448000
     BEGIN                                                              14450000
          MOVE PBUF:=" NO DEFECTIVE OR SUSPECT TRACKS FOUND";           14452000
          FWRITE(OUTF,PBUFW,-37,0);                            <<RK.08>>14454000
     END ELSE                                                           14456000
     BEGIN  <<PRINT TABLE>>                                             14458000
          MOVE PBUF:=MHEAD1,(54);                                       14460000
          FWRITE(OUTF,PBUFW,-54,0);                            <<RK.08>>14462000
          MOVE PBUF:=MHEAD2,(54);                                       14464000
          FWRITE(OUTF,PBUFW,-54,0);                            <<RK.08>>14466000
          I:=0;                                                         14468000
          WHILE (I:=I+1)<=DTT DO                                        14470000
          BEGIN  <<LIST EACH ENTRY>>                                    14472000
               PBUF:=" "; MOVE PBUF(1):=PBUF,(57);                      14474000
               track:=dtt(i).dtt'track'number;                 <<03510>>14476000
               cylhead:=cylinderhead(track,ldev);              <<03510>>14478000
               ASCII(CYL,10,PBUF(1));  <<CYLINDER #>>                   14480000
               ASCII(HEAD,10,PBUF(6));  <<HEAD #>>                      14482000
               TOS:=0;                                                  14484000
               TOS:=TRACK;                                              14486000
               TOS:=TOS ** LOGICAL(sectrk);                    <<03510>>14488000
               ASSEMBLE(DDUP,DZRO; DXCH,CAB);                           14490000
               TOS:=sectrk;                                    <<03510>>14492000
               ASSEMBLE(DECA,DADD);  <<LAST SECTOR>>                    14494000
               LEN:=DASCII(*,10,RBUF);      << LAST SECTOR >>  <<01379>>14496000
               MOVE PBUF(21):=RBUF,(LEN);                      <<01379>>14498000
               LEN:=DASCII(*,10,RBUF);     << FIRST SECTOR >>  <<01379>>14500000
               MOVE PBUF(11):=RBUF,(LEN);                      <<01379>>14502000
               DISP:=DTT(I).(14:2);  <<RECORD TYPE>>                    14504000
               IF DISP=0 AND TRACK=DTT(X:=X+1)&LSR(2) THEN              14506000
               DISP:=4;  <<UNREADABLE ALTERNATE>>                       14508000
               MOVE PBUF(29):=STATS(DISP*14),(14);                      14510000
               TOS:=OUTF;  <<FOR FWRITE>>                               14512000
               TOS:=@PBUF & LSR(1);  <<FOR FWRITE>>                     14514000
               IF LOGICAL(DISP) THEN                                    14516000
               BEGIN  <<THERE IS AN ALTERNATE>>                         14518000
                    TOS:=ALTTRACK(LDEV,TRACK);                          14520000
                    IF < THEN RETURN;  <<DISC I/O ERROR>>               14522000
                    IF (ALT:=TOS) = -2 THEN                             14524000
                    BEGIN <<CAN'T READ ALTERNATE>>                      14526000
                         ADDDTTENTRY(TRACK&LSL(2));                     14528000
                         IF = THEN  <<ENTRY ADDED TO TABLE>>            14530000
                         BEGIN                                          14532000
                              MOVE PBUF(30) := STATS(56),(14); <<03537>>14534000
                              DISCIO(LDEV,W,DTT,1D,128);                14536000
                              IF < THEN RETURN;                         14538000
                         END;                                           14540000
                         TOS:=-45;  <<LINE COUNT>>                      14542000
                    END ELSE                                            14544000
                    BEGIN                                               14546000
                         cylhead:=cylinderhead(alt,ldev);      <<03510>>14548000
                         ASCII(CYL,10,PBUF(45)); <<ALTERNATE CYLINDER>> 14550000
                         ASCII(HEAD,10,PBUF(51));  <<ALTERNATE HEAD>>   14552000
                         TOS:=-53;  <<LINE COUNT>>                      14554000
                    END;                                                14556000
               END ELSE                                                 14558000
               TOS:=-45;                                                14560000
               FWRITE(*,*,*,0);                                         14562000
               IF DTT(I+1)=TRACK&LSL(2)+3 THEN I:=I+1; <<SKIP>>         14564000
          END;                                                          14566000
     END;                                                               14568000
     END                                                       <<03536>>14570000
     ELSE  << Not type 0, 1 or 2.                            >><<03536>>14572000
     BEGIN                                                     <<03536>>14574000
        IF Type = CS'80'Type THEN << Don't want other types. >><<03536>>14576000
        BEGIN                                                  <<03536>>14578000
           IF (Subtype = St'9110 LOR Subtype = St'9144) THEN   <<*8114>>14580000
           BEGIN                                               <<03536>>14582000
              Genmsg(Pvmsgset,Viwarn95);                       <<03536>>14584000
              << Linus and Buffalo don't have a DSCT.        >><<*8114>>14586000
              IF Diag'Entry THEN Print'Cartridge'Spares(Ldev); <<*8114>>14588000
              RETURN;                                          <<03536>>14590000
           END                                                 <<03536>>14592000
           ELSE  << A CS'80 Disc.                            >><<03536>>14594000
           BEGIN                                               <<03536>>14596000
              Dtt := 0;                                        <<03536>>14598000
              Move Dtt(1) := Dtt,(dtt'size - 1);               <<03536>>14600000
              Status := 0;                                     <<03536>>14602000
              Discio(Ldev,R,Dtt,Disc'Label'Address,            <<03536>>14604000
                    Sector'Size,Status);                       <<03536>>14606000
              IF < THEN                                        <<03536>>14608000
                 Genmsg(Pvmsgset,Viwarn96);                    <<03536>>14610000
                 << Couldn't read the label.                 >><<03536>>14612000
              Dtt := 0;                                        <<03536>>14614000
              Move Dtt(1) := Dtt,(dtt'size - 1);               <<03536>>14616000
              Status := 0;                                     <<03536>>14618000
              Discio(Ldev,R,Dtt,Dsct'Disc'Address,             <<03536>>14620000
                    Sector'Size,Status);                       <<03536>>14622000
              IF < THEN                                        <<03536>>14624000
              BEGIN                                            <<03536>>14626000
                 Genmsg(Pvmsgset,Vierr97);                     <<03536>>14628000
                 Genmsg(Pvmsgset,Vierr0);                      <<03536>>14630000
                 << Couldn't read the DSCT.                  >><<03536>>14632000
                 GO Check'Diag; << Then returns.             >><<03583>>14634000
              END;                                             <<03536>>14636000
              IF Dtt(Dsct'Number'Of'Entries) = 0 THEN          <<03536>>14638000
              BEGIN                                            <<03536>>14640000
                 Genmsg(Pvmsgset,Viwarn98);                    <<03536>>14642000
                 GO Check'Diag; << Then returns.             >><<03583>>14644000
                 << DSCT was empty. (Great!)                 >><<03536>>14646000
              END;                                             <<03536>>14648000
                                                               <<03536>>14650000
<< Print out a header that says                              >><<03536>>14652000
<< "Num" Defective Sectors Found.                            >><<03536>>14654000
<< Send report to outfile if specified.                      >><<03536>>14656000
                                                               <<03536>>14658000
              Genmsg(Pvmsgset,Viwarn99,%010000,                <<03536>>14660000
                     Dtt(Dsct'Number'Of'Entries),              <<03536>>14662000
                     <<p2>>,<<p3>>,<<p4>>,<<p5>>,-Outf);       <<03536>>14664000
                                                               <<03536>>14666000
<< Print a detail line.                                      >><<03536>>14668000
<< "Sector Num" (decimal) Defective.                         >><<03536>>14670000
                                                               <<03536>>14672000
              FOR I := 0 UNTIL Dtt(Dsct'Number'Of'Entries) - 1 <<03536>>14674000
                                                               <<03536>>14676000
              DO Genmsg(Pvmsgset,Viwarn100,                    <<03536>>14678000
                        %020000,                               <<03536>>14680000
                @Dttd( (Dtt (Dsct'First'Entry'Index) / 2) + I),<<03536>>14682000
                        <<p2>>,<<p3>>,                         <<03536>>14684000
                        <<p4>>,<<p5>>,-Outf);                  <<03536>>14686000
                                                               <<03536>>14688000
<< The above mess picks out Double word entries              >><<03536>>14690000
<< one at a time, starting with the first one,               >><<03536>>14692000
<< which is pointed to by "Dsct'First'Entry'Index".          >><<03536>>14694000
                                                               <<03536>>14696000
    Check'Diag:                                                <<03583>>14698000
                                                               <<03583>>14700000
              IF Diag'Entry THEN Print'CS'80'Spares(Ldev);     <<03583>>14702000
                                                               <<03583>>14704000
<< Always tries to read the hardware spare table,            >><<03583>>14706000
<< even if it couldn't read the disc, then                   >><<03583>>14708000
<< returns.                                                  >><<03583>>14710000
                                                               <<03583>>14712000
            END                                                <<03536>>14714000
         END                                                   <<03536>>14716000
      END                                                      <<03536>>14718000
END << PDTRACK >>;                                                      14720000
PROCEDURE pfspace;                                             <<03510>>14722000
   OPTION privileged,uncallable;                               <<03510>>14724000
                                                               <<03510>>14726000
BEGIN                                                          <<03510>>14728000
                                                               <<03510>>14730000
<< prints out the Disc Free Space Map as a histogram      >>   <<03510>>14732000
<< or a listing of the free space entries. Format of the  >>   <<03510>>14734000
<< command is:                                            >>   <<03510>>14736000
<<             pfspace ldev[;addr]                        >>   <<03510>>14738000
<<                     all                                >>   <<03510>>14740000
<<                                                             <<03510>>14742000
<< LDEV;ADDR will print out a histogram for that specific >>   <<03510>>14744000
<< ldev. If the field "ALL" is included, then it will     >>   <<03510>>14746000
<< print out all the free space entries for that LDEV.    >>   <<03510>>14748000
<< If "ALL" is used, then it will print out a histogram   >>   <<03510>>14750000
<< for all the discs physically mounted - just like free2  >>  <<03510>>14752000
<< does                                                   >>   <<03510>>14754000
                                                               <<03510>>14756000
   INTEGER      ldev                                           <<03510>>14758000
               ;                                               <<03510>>14760000
                                                               <<03510>>14762000
   LOGICAL      call'pfre       << free2 format >>             <<03510>>14764000
               ,checkdisc'status                               <<03510>>14766000
               ,all'ldevs       << free2 and print all ldevs >><<03510>>14768000
               ;                                               <<03510>>14770000
                                                               <<03510>>14772000
                                                               <<03510>>14774000
   all'ldevs:=false;  << initialize >>                         <<03510>>14776000
                                                               <<03510>>14778000
   IF keyword = "ALL" THEN                                     <<03510>>14780000
      BEGIN                                                    <<03510>>14782000
         IF keywdspec(1) THEN   << 2nd field not allowed >>    <<03510>>14784000
            BEGIN                                              <<03510>>14786000
               genmsg(pvmsgset,vierr32);                       <<03510>>14788000
               RETURN;                                         <<03510>>14790000
            END;                                               <<03510>>14792000
         call'pfre:=true;                                      <<03510>>14794000
         all'ldevs:=true;                                      <<03510>>14796000
      END                                                      <<03510>>14798000
   ELSE                                                        <<03510>>14800000
      BEGIN                                                    <<03510>>14802000
         IF keyword <> numeric THEN                            <<03510>>14804000
            BEGIN                                              <<03510>>14806000
               genmsg(pvmsgset,vierr27);                       <<03510>>14808000
               RETURN;                                         <<03510>>14810000
            END;                                               <<03510>>14812000
         ldev:=binary(keyword,keywdlen);                       <<03510>>14814000
         IF ldev <= 0 THEN                                     <<03510>>14816000
            BEGIN                                              <<03510>>14818000
               genmsg(pvmsgset,vierr28);                       <<03510>>14820000
               RETURN;                                         <<03510>>14822000
            END;                                               <<03510>>14824000
         << do some initial checking  >>                       <<03510>>14826000
                                                               <<03510>>14828000
         checkdisc(ldev,checkdisc'status);                     <<03510>>14830000
         IF (checkdisc'status LOR mask(funct)) <>              <<03510>>14832000
            mask(funct) THEN                                   <<03510>>14834000
            BEGIN                                              <<03510>>14836000
               deverror(ldev,checkdisc'status);                <<03510>>14838000
               RETURN;                                         <<03510>>14840000
            END;                                               <<03510>>14842000
         << can you read the disc label ? >>                   <<03510>>14844000
         IF unreadable'label(ldev,false) THEN RETURN;          <<03510>>14846000
         call'pfre:=true;    << assume want free2 printout >>  <<03510>>14848000
         <<  now see if specified a second field >>            <<03510>>14850000
         IF keywdspec(1) THEN    << verify it >>               <<03510>>14852000
            BEGIN                                              <<03510>>14854000
               IF keyword(max'keyword'len) = "ADDR" THEN       <<03510>>14856000
                  call'pfre:=false                             <<03510>>14858000
               ELSE                                            <<03510>>14860000
                  BEGIN                                        <<03510>>14862000
                     genmsg(pvmsgset,vierr3);                  <<03510>>14864000
                     RETURN;                                   <<03510>>14866000
                  END;                                         <<03510>>14868000
            END;                                               <<03510>>14870000
      END;                                                     <<03510>>14872000
                                                               <<03510>>14874000
   << call the appropiate procedure to do the printout    >>   <<03510>>14876000
   << Pfre will call checkdisc to verify that the         >>   <<03510>>14878000
   << LDEVs are ok.                                       >>   <<03510>>14880000
                                                               <<03510>>14882000
   IF call'pfre THEN                                           <<03510>>14884000
      pfre(outf,all'ldevs,ldev)                                <<03510>>14886000
   ELSE                                                        <<03510>>14888000
      pfentries(outf,ldev);                                    <<03510>>14890000
                                                               <<03510>>14892000
END;   << pfspace >>                                           <<03510>>14894000
                                                                        14896000
$PAGE "PVINIT - COMMAND HANDLING FUNCTIONS"                             14898000
                                                                        14900000
$CONTROL SEGMENT=VINITCI                                       <<RK1PV>>14902000
PROCEDURE GETFUNCTION;                                                  14904000
OPTION PRIVILEGED,UNCALLABLE;                                           14906000
BEGIN                                                                   14908000
<< changes to support new DFSM. Before could only have 1  >>   <<03510>>14910000
<< keyword per command. Now can have a max of 4 keywords  >>   <<03510>>14912000
<< per command(max # fields per command is 4)             >>   <<03510>>14914000
<< For this reason, the following parms were changed:     >>   <<03510>>14916000
<<    (dimensioned)keywdlen,keyparmval,keyword,keywordspec>>   <<03510>>14918000
<<    keyparmspec                                         >>   <<03510>>14920000
<< Added new variable number'keywords                     >>   <<03510>>14922000
     INTEGER I:=0,FNCT:=0,DEVLOC:=0;                                    14924000
     INTEGER LEN,LOC,NUM,TYP,PARM,RLEN,DELIM,DEVLEN,ENDLOC,             14926000
             NUMPARMS,COMMPARM;                                         14928000
     LOGICAL OPT,STATUS,OPTMASK,TYPEMASK;                               14930000
     LOGICAL FLAGS;                                                     14932000
     DEFINE                                                             14934000
          ALPHCHAR = FLAGS.(15:1)#,                                     14936000
          NUMCHAR  = FLAGS.(14:1)#,                                     14938000
          SPECHAR  = FLAGS.(13:1)#;                                     14940000
     DOUBLE ARRAY PARMS(0:7);                                           14942000
     INTEGER ARRAY IPARMS(*) = PARMS;                                   14944000
     BYTE POINTER NAME;                                                 14946000
     BYTE ARRAY Nbuf(0:73); <<buffer must be>>                 <<03541>>14948000
                            <<as big as Rbuf>>                 <<03541>>14950000
     ARRAY PROMPT(0:1);                                        <<RK.08>>14952000
     BYTE ARRAY VSID'(0:24);                                            14954000
     BYTE ARRAY DL(0:4);                                                14956000
     BYTE ARRAY DL'(*) = PB :=",.;=",%15;                               14958000
     EQUATE                                                             14960000
          TERMCHR   = %15;                                              14962000
                                                                        14964000
     SUBROUTINE GETNEXTPARM;                                            14966000
     BEGIN                                                              14968000
          COMMPARM:=COMMPARM+1;                                         14970000
          TOS:=PARMS(COMMPARM);                                         14972000
          LEN:=S0.(0:8);                                                14974000
          FLAGS:=S0.(10:3);                                             14976000
          DELIM:=TOS.(11:5);                                            14978000
          @NAME:=TOS;                                                   14980000
     END <<GETNEXTPARM>>;                                               14982000
                                                                        14984000
     LOGICAL SUBROUTINE ILLEGALSTRING;                                  14986000
     BEGIN                                                              14988000
          ILLEGALSTRING:=TRUE;                                          14990000
          IF LEN > 8 THEN                                               14992000
          BEGIN                                                         14994000
               GENMSG(PVMSGSET,(VIERR15+TYP));                          14996000
               RETURN;                                                  14998000
          END;                                                          15000000
          IF NAME <> ALPHA THEN                                         15002000
          BEGIN                                                         15004000
               GENMSG(PVMSGSET,(VIERR18+TYP));                          15006000
               RETURN;                                                  15008000
          END;                                                          15010000
          IF SPECHAR THEN                                               15012000
          BEGIN                                                         15014000
               GENMSG(PVMSGSET,(VIERR21+TYP));                          15016000
               RETURN;                                                  15018000
          END;                                                          15020000
          ILLEGALSTRING:=FALSE;                                         15022000
     END <<ILLEGALSTRING>>;                                             15024000
                                                                        15026000
     LOGICAL SUBROUTINE CHECKPARMS;  <<ANALYZE POSITIONAL PARAMETERS>>  15028000
     BEGIN                                                              15030000
          PARM:=0;                                                      15032000
          COMMPARM:=-1;                                                 15034000
          DEVPARM:=0;                                                   15036000
          KEYWORD:=TERMCHR;  <<FOR POSSIBLE MYCOMMAND CALL>>            15038000
          @KEYWDLOC:=@RBUF(DEVLOC);                                     15040000
          MYCOMMAND(RBUF(DEVLOC),DL,7,NUMPARMS,PARMS);                  15042000
          OPTMASK:=PARMINFO(FNCT).(8:4);                                15044000
          TYPEMASK:=PARMINFO(FNCT).(0:8);                               15046000
          IF (NUM:=PARMINFO(FNCT).(12:4)) = 0 THEN  <<NO PARMS>>        15048000
          BEGIN                                                         15050000
               IF NUMPARMS <> 0 THEN                                    15052000
               BEGIN                                                    15054000
                    GETNEXTPARM;                                        15056000
                    GENMSG(PVMSGSET,VIERR25);                           15058000
                    RETURN;                                             15060000
               END;                                                     15062000
               CHECKPARMS:=TRUE;                                        15064000
               RETURN;                                                  15066000
          END;                                                          15068000
          IF NUMPARMS = 0 THEN                                          15070000
          BEGIN                                                         15072000
               IF NOT OPTMASK THEN                                      15074000
               BEGIN                                                    15076000
                    GENMSG(PVMSGSET,VIERR26);                           15078000
                    RETURN;                                             15080000
               END ELSE                                                 15082000
               PARM:=NUM;  <<FOR PARM LOOP>>                            15084000
          END;                                                          15086000
          WHILE (PARM:=PARM+1) <= NUM DO                                15088000
          BEGIN                                                         15090000
               GETNEXTPARM;                                             15092000
               DEVPARM(PARM):=0;  <<ASSUME ITS NOT A DEV PARAMETER>>    15094000
               TYP:=TYPEMASK.(14:2);                                    15096000
               TYPEMASK:=TYPEMASK & LSR(2);                             15098000
               OPT:=OPTMASK.(15:1);                                     15100000
               OPTMASK:=OPTMASK & LSR(1);                               15102000
               IF LEN = 0 AND NOT OPT THEN                              15104000
               BEGIN                                                    15106000
                    GENMSG(PVMSGSET,VIERR26);                           15108000
                    RETURN;                                             15110000
               END;                                                     15112000
               IF LEN <> 0 THEN  <<NOT AN OMITTED PARM>>                15114000
               CASE * TYP OF                                            15116000
               BEGIN                                                    15118000
                    BEGIN  << INTEGER >>                                15120000
                         IF NAME <> NUMERIC THEN                        15122000
                         BEGIN                                          15124000
                              GENMSG(PVMSGSET,VIERR27);                 15126000
                              RETURN;                                   15128000
                         END;                                           15130000
                         DEVPARM(PARM):=BINARY(NAME,LEN);               15132000
                         IF DEVPARM(PARM) <= 0 THEN                     15134000
                         BEGIN                                          15136000
                              GENMSG(PVMSGSET,VIERR28);                 15138000
                              RETURN;                                   15140000
                         END ELSE                                       15142000
                         DEVPARM:=DEVPARM+1;  <<NUMBER OF DEVS>>        15144000
                    END;                                                15146000
                    BEGIN  << VOLUME NAME >>                            15148000
                         IF ILLEGALSTRING THEN RETURN;                  15150000
                         MOVE VNAME:=NAME,(LEN);                        15152000
                    END;                                                15154000
                    BEGIN  << VOLUME SET DESIGNATOR >>                  15156000
                         I:=0;                                          15158000
                         WHILE DELIM = PERIOD DO                        15160000
                         BEGIN                                          15162000
                              IF I > 1 THEN  <<TOO MANY NAMES>>         15164000
                              BEGIN                                     15166000
                                   GENMSG(PVMSGSET,VIERR29);            15168000
                                   RETURN;                              15170000
                              END;                                      15172000
                              IF NOT(I=0 LAND NAME = "*") THEN          15174000
                              IF ILLEGALSTRING THEN RETURN;             15176000
                              MOVE VSID'(I * 8):=NAME,(LEN);            15178000
                              I:=I+1;                                   15180000
                              GETNEXTPARM;                              15182000
                         END;                                           15184000
                         IF ILLEGALSTRING THEN RETURN;                  15186000
                         MOVE VSID'(I * 8):=NAME,(LEN);                 15188000
                         VSIDSPEC:=TRUE;                                15190000
                    END;                                                15192000
                    BEGIN  << KEYWORD >>                                15194000
                         keywdlen(number'keywords):=len;       <<03510>>15196000
                         MOVE bptr'keyword:=name,(len);        <<03510>>15198000
                         bptr'keyword(len):=termchr; <<mycomm>><<03510>>15200000
                         @KEYWDLOC:=@NAME;                              15202000
                         IF DELIM = EQUALSIGN THEN  <<KEY PARM PRESENT>>15204000
                         BEGIN                                          15206000
                              GETNEXTPARM;                              15208000
                              IF LEN = 0 THEN                           15210000
                              BEGIN                                     15212000
                                   GENMSG(PVMSGSET,VIERR30);            15214000
                                   RETURN;                              15216000
                              END;                                      15218000
                              IF NAME <> NUMERIC THEN                   15220000
                              BEGIN                                     15222000
                                   GENMSG(PVMSGSET,VIERR15);            15224000
                                   RETURN;                              15226000
                              END;                                      15228000
                              keyparmval(number'keywords):=    <<03510>>15230000
                                 binary(name,len);             <<03510>>15232000
                              IF < THEN                                 15234000
                              BEGIN                                     15236000
                                   GENMSG(PVMSGSET,VIERR15);            15238000
                                   RETURN;                              15240000
                              END;                                      15242000
                              IF keyparmval(number'keywords)   <<03510>>15244000
                                 < 0 THEN                      <<03510>>15246000
                              BEGIN                                     15248000
                                   GENMSG(PVMSGSET,VIERR15);            15250000
                                   RETURN;                              15252000
                              END;                                      15254000
                              keyparmspec(number'keywords)     <<03510>>15256000
                                          :=true;              <<03510>>15258000
                         END;                                           15260000
                         keywdspec(number'keywords):=true;     <<03510>>15262000
                         << set-up for next keyword >>         <<03510>>15264000
                         @bptr'keyword:=@bptr'keyword +        <<03510>>15266000
                                        + max'keyword'len;     <<03510>>15268000
                         number'keywords:=number'keywords + 1; <<03510>>15270000
                    END;                                                15272000
               END;                                                     15274000
               WHILE DELIM <> DELIMS((FNCT * 4)+PARM-1) DO              15276000
               BEGIN                                                    15278000
                    IF DELIMS((FNCT * 4)+PARM-1) = CARRETURN THEN       15280000
                    BEGIN                                               15282000
                         GETNEXTPARM;                                   15284000
                         IF LEN = 0 THEN                                15286000
                            GENMSG(PVMSGSET,VIERR31)                    15288000
                         ELSE                                           15290000
                            GENMSG(PVMSGSET,VIERR32);                   15292000
                         RETURN;                                        15294000
                    END;                                                15296000
                    IF NOT OPTMASK THEN                                 15298000
                    BEGIN                                               15300000
                         GENMSG(PVMSGSET,VIERR26);                      15302000
                         RETURN;                                        15304000
                    END;                                                15306000
                    PARM:=PARM+1;                                       15308000
                    OPTMASK:=OPTMASK & LSR(1);                          15310000
                    TYPEMASK:=TYPEMASK & LSR(2);               <<RK.09>>15312000
               END;                                                     15314000
          END;                                                          15316000
          CHECKPARMS:=TRUE;                                             15318000
     END  <<CHECKPARMS>>;                                               15320000
                                                                        15322000
                                                                        15324000
     MOVE DL:=DL',(5);  <<MOVE IN PB-REL DLITERS>>                      15326000
     FNCT:=FUNCT:=0;  <<"ERR" FUNCTION CODE - ERROR>>                   15328000
     MOVE PROMPT:="> ";                                                 15330000
     WHILE FNCT = 0 DO  <<GET VALID FUNCTION NAME>>                     15332000
     BEGIN                                                              15334000
          RLEN:=0;                                                      15336000
          VSIDSPEC:=KEYWDSPEC:=KEYPARMSPEC:=FALSE;                      15338000
          MOVE keyparmspec(1):=keyparmspec,(max'keywords-1);   <<03510>>15340000
          MOVE keywdspec(1):=keywdspec,(max'keywords-1);       <<03510>>15342000
          RBUF:=" "; MOVE RBUF(1):=RBUF,(71);                           15344000
          VSID':=" "; MOVE VSID'(1):=VSID',(23);                        15346000
          VNAME:=" "; MOVE VNAME(1):=VNAME,(7);                         15348000
          keyword:= " "; MOVE keyword(1):=keyword,             <<03510>>15350000
                         (max'keyword'len * max'keywords-1);   <<03510>>15352000
          keywdlen:=0;                                         <<03510>>15354000
          MOVE keywdlen(1):=keywdlen,(max'keywords-1);         <<03510>>15356000
          keyparmval:=0;                                       <<03510>>15358000
          MOVE keyparmval(1):=keyparmval,(max'keywords-1);     <<03510>>15360000
          @bptr'keyword:=@keyword;                             <<03510>>15362000
          number'keywords:=0;                                  <<03510>>15364000
          WHILE RLEN = 0 DO                                             15366000
          BEGIN                                                         15368000
               PRINT(PROMPT,-1,%320);  <<PROMPT - NO CRLF>>             15370000
               RLEN:=READ(RBUFW,-72);                          <<RK.08>>15372000
               IF <> THEN                                      <<RK1PV>>15374000
                  BEGIN                                        <<RK1PV>>15376000
                  MOVE RBUF := "EXIT  ";                       <<RK1PV>>15378000
                  RLEN := 4;                                   <<RK1PV>>15380000
                  END;                                         <<RK1PV>>15382000
          END;                                                          15384000
          RBUF(RLEN):=TERMCHR;                                          15386000
          NBUF:=" "; MOVE NBUF(1):=NBUF,(73);                  <<03541>>15388000
          MOVE NBUF:=RBUF WHILE AS,1;                                   15390000
          DEVLOC:=TOS-@NBUF;                                            15392000
          FOR I:=1 STEP 1 UNTIL FUNCTNUM DO                             15394000
          IF NBUF = FUNCTLIST(I*8),(8) THEN  <<FUNCTION FOUND>>         15396000
          BEGIN                                                         15398000
               FNCT:=I;                                                 15400000
               I:=FUNCTNUM;  <<STOP LOOP>>                              15402000
          END;                                                          15404000
          IF FNCT = 0 THEN                                              15406000
          BEGIN                                                         15408000
               GENMSG(PVMSGSET,VIERR1);                                 15410000
          END ELSE                                                      15412000
          IF CHECKPARMS THEN                                            15414000
          BEGIN                                                         15416000
               I:=0;                                                    15418000
               << because pfspace can have it's first field >> <<03510>>15420000
               << either number or alpha, pfspace will do   >> <<03510>>15422000
               << checkdisc when it finds out that it is an >> <<03510>>15424000
               << ldev. If any of this changes, should also >> <<03510>>15426000
               << change pfspace                            >> <<03510>>15428000
               WHILE DEVPARM <> 0 DO  <<CHECK DEV PARM VALIDITY>>       15430000
               IF DEVPARM(I:=I+1) <> 0 THEN  <<HERE'S ONE>>             15432000
               BEGIN                                                    15434000
                    DEVPARM:=DEVPARM-1;                                 15436000
                    CHECKDISC(DEVPARM(I),STATUS);                       15438000
                    IF (STATUS LOR MASK(FNCT)) <> MASK(FNCT) THEN       15440000
                    BEGIN                                               15442000
                         FNCT:=DEVPARM:=0;  <<CONTINUE FNCT LOOP>>      15444000
                         DEVERROR(DEVPARM(I),STATUS);                   15446000
                    END ELSE                                            15448000
                    DEVSTATUS(I):=STATUS;                               15450000
               END;                                                     15452000
               IF VSIDSPEC AND FNCT <> 0 THEN                           15454000
               BEGIN                                                    15456000
                    VALIDVSID:=TRUE;                                    15458000
                    MOVE VSID:=VSID',(24);                              15460000
               END;                                                     15462000
          END ELSE                                                      15464000
          FNCT:=0;  <<KEEP COMMAND LOOP GOING>>                         15466000
     END;                                                               15468000
     FUNCT:=FNCT;  <<VALID REQUEST: FUNCT <> 0>>                        15470000
END << GETFUNCTION >>;                                                  15472000
$PAGE "PROCEDURE SERVOL"                                       <<03537>>15474000
$CONTROL SEGMENT=NEWPACK                                       <<RK.09>>15476000
PROCEDURE SERVOL;                                                       15478000
OPTION PRIVILEGED,UNCALLABLE;                                           15480000
BEGIN <<SERVOL>>                                                        15482000
EQUATE CYL'DVR=77,  <<#CYLINDERS SUPPORTED BY DRIVER>>         <<06058>>15484000
       CYL'CNTRLR=77, <<#CYLINDERS SUPPORTED BY THE CNTRL>>    <<06058>>15486000
       SECTORS'TRACK=30,                                       <<00075>>15488000
       EOT'EOD'LENGTH=200,<<#SECTORS BETWEEN EOT AND EOD>>     <<00075>>15490000
       REQSTAT=7;                                              <<00075>>15492000
EQUATE WORDSPERSECTR=14, <<LABEL INDEX FOR START OF DESCRIP'N>><<00075>>15494000
       SECTORSPERTRACK = 15,   << Label index for same.     >> <<07098>>15496000
       EOTSECTR=18, <<LABEL INDEX FOR END OF TAPE VALUE>>      <<00075>>15498000
       EODSECTR=20; <<LABEL INDEX FOR END OF DISC VALUE>>      <<00075>>15500000
DEFINE GPTSECT1=4D#,                                           <<00186>>15502000
       GPTSECT2=5D#;                                           <<00186>>15504000
DOUBLE LOG'SECT; <<LOGICAL SECTOR VALUE>>                      <<00075>>15506000
INTEGER LOG'SECTOR=LOG'SECT+1;                                 <<00075>>15508000
DOUBLE ARRAY PHY'ADR(0:0);                                     <<00075>>15510000
INTEGER TYPE,LDEV;                                             <<00075>>15512000
INTEGER    subtype;                                            <<03510>>15514000
LOGICAL STATUS;                                                <<00075>>15516000
INTEGER SDISCTYPE;                                             <<00075>>15518000
EQUATE NUMSDISCTYPES = 7,                                      <<03537>>15520000
       INITARRAYSIZE=7;                                        <<00075>>15522000
INTEGER ARRAY PHY'CYL(*)=PHY'ADR;                              <<00075>>15524000
INTEGER ARRAY STATUS'RTN(*)=PHY'ADR;                           <<00075>>15526000
INTEGER SECTORS'PER'TRACK;                                     <<07098>>15528000
INTEGER TRACKS'CYL;                                            <<00075>>15530000
INTEGER Qmisc := 0;                                            <<03537>>15532000
LOGICAL Dummy;                                                 <<03537>>15534000
INTEGER Counter := 0;                                          <<03537>>15536000
INTEGER Cartridge'Gap'Length := 0; << Defined later on.      >><<*8114>>15538000
EQUATE Disc'Lab'BOT'Word = 16; << In serial disc label       >><<03537>>15540000
DEFINE DOUBLE'SIDED=STATUS'RTN(1).(4:1)=1#;                    <<00075>>15542000
COMMENT:                                                       <<00075>>15544000
   SDISC0TYPES - THIS ARRAY DEFINES WHICH TYPE ZERO DISCS      <<00075>>15546000
                 ARE SUPPORTED AS SERIAL DISCS.  IF THE        <<00075>>15548000
                 NTH ENTRY IN THIS ARRAY IS NON-NEGATIVE,      <<00075>>15550000
                 THEN SUBTYPE N IS SUPPORTED.  THE VALUE       <<00075>>15552000
                 IS THEN USED AS AN INDEX INTO THE ARRAY       <<00075>>15554000
                 SDISCDESC TO LOCATE THE DESCRIPTIVE           <<00075>>15556000
                 PARAMETERS FOR THAT SUBTYPE.                  <<00075>>15558000
   SDISC2TYPES - THIS ARRAY IS LIKE SDISC0TYPES, EXCEPT FOR    <<00075>>15560000
                 TYPE TWO DISCS.                               <<00075>>15562000
   SDISCDESC   - THIS ARRAY CONTAINS THE DESCRIPTIVE PARMS     <<00075>>15564000
                 FOR EACH SUPPORTED SERIAL DISC TYPE.          <<00075>>15566000
                 IT IS LOGICALLY A TWO DIMENSIONAL ARRAY STORED<<00075>>15568000
                 IN ROW-MAJOR FORMAT WITH INITARRAYSIZE        <<00075>>15570000
                 DEFINING THE ROW LENGTH AND ONE ROW FOR       <<00075>>15572000
                 EACH SUPPORTED TYPE AND NUMSDISCTYPES         <<00075>>15574000
                 DEFINING THE NUMBER OF SUPPORTED TYPES.;      <<00075>>15576000
INTEGER ARRAY SDISC0TYPES(0:15)=PB:=                           <<00075>>15578000
4(-1),0<<R7905>>,3(-1),1<<S7920>>,4<<S7925>>,2<<R7906>>,5(-1); <<00239>>15580000
INTEGER ARRAY SDISC2TYPES(0:15)=PB:=                           <<00075>>15582000
3<<S7902>>,15(-1);                                             <<00075>>15584000
INTEGER ARRAY                                                  <<03537>>15586000
  SDISC3TYPES(*) = PB :=                                       <<03537>>15588000
  6,      << LINUS >>                                          <<03537>>15590000
  -1,     << HP7911 - invalid >>                               <<03537>>15592000
  -1,     << HP7912 - invalid >>                               <<03537>>15594000
  6,      << Buffalo >>                                        <<*8114>>15596000
  4(-1),  << HP7914, HP7945 invalid >>                         <<*8835>>15598000
  5,      << HP7935 >>                                         <<03537>>15600000
  7(-1);  << Null >>                                           <<03537>>15602000
INTEGER ARRAY                                                  <<03537>>15604000
  SDISCDESC(-INITARRAYSIZE:NUMSDISCTYPES*INITARRAYSIZE)=PB:=   <<03537>>15606000
<<WORDS>>   <<SECTORS>>  <<LOAD>>   <<END OF>> <<END OF>>      <<00075>>15608000
<<PER>>     <<PER>>      <<POINT>>  <<TAPE>>   <<DISC>>        <<00075>>15610000
<<SECTOR>>  <<TRACK>>                                          <<00075>>15612000
 -1,        -1,          -1,        -1,-1,     -1,-1, <<INVALID>>       15614000
128,        48,          48,        0,38199,   0,38399, <<R7905>>       15616000
128,        48,          48,        2,64327,   2,64527, <<S7920>>       15618000
128,        48,          48,        0,38199,   0,38399, <<R7906>>       15620000
128,        30,          30,        0,0,       0,0,     <<S7902>>       15622000
128,        64,          110,       7,10487,   7,10687,<<7925>><<07098>>15624000
128,        -1,          254,       24,6851,   24,7051,<<7935>><<07098>>15626000
512,        -1,          8,         0,0,       0,0,   <<LINUS>><<03537>>15628000
<< Note: Linus/Buffalo don't get their values from here.     >><<*8114>>15630000
0;                                                             <<00075>>15632000
ARRAY Buff(0:Cartridge'Sector - 1);                            <<*8114>>15634000
BYTE ARRAY BUFFB(*)  = BUFF;                                   <<RK.09>>15636000
ARRAY Buf2(0:Cartridge'Sector - 1);                            <<*8114>>15638000
DOUBLE EOT'SECTOR,EOD'SECTOR;                                  <<DL089>>15640000
INTEGER EOT'SECTOR0=EOT'SECTOR,EOT'SECTOR1=EOT'SECTOR+1,       <<DL089>>15642000
        EOD'SECTOR0=EOD'SECTOR,EOD'SECTOR1=EOD'SECTOR+1;       <<DL089>>15644000
DOUBLE VTABINFO;                                               <<RK.09>>15646000
INTEGER                                                        <<RK.09>>15648000
     A, VTABX, I,                                              <<RK.09>>15650000
     VTABINFO1 = VTABINFO,                                     <<RK.09>>15652000
     VTBAINFO2 = VTABINFO+1;                                   <<RK.09>>15654000
ARRAY LABELDATA(0:127)=PB:=6(0),                                        15656000
                           %20000,                                      15658000
                           3(0),                                        15660000
                           %51505, <<"SE">>                             15662000
                           %51104, <<"RD">>                             15664000
                           %44523, <<"IS">>                             15666000
                           %41460, <<"C0">>                    <<07098>>15668000
                           114(0);                                      15670000
                                                                        15672000
LDEV:=DEVPARM(1);                                                       15674000
     Cartridge := Is'It'Cartridge(Ldev);                       <<*8114>>15676000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN ELSE          <<03739>>15678000
     IF DEVSTATUS(1).DOWNF = 0 THEN                                     15680000
     BEGIN                                                              15682000
          TOS:=SCRATCHVOL(LDEV);                                        15684000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         15686000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>15688000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>15690000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>15692000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>15694000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>15696000
          RETURN;                                              <<01615>>15698000
     END                                                       <<RK.08>>15700000
     ELSE IF NOT OVERWRITE(LDEV,5) THEN RETURN;                <<RK.08>>15702000
     IF Cartridge THEN                                         <<*8114>>15704000
     BEGIN                                                     <<03537>>15706000
          Type    := Ldevtotype(Ldev);                         <<03537>>15708000
          Subtype := Ldevtosubtype(Ldev);                      <<03537>>15710000
     END                                                       <<03537>>15712000
     ELSE                                                      <<03537>>15714000
          Get'Disc'Info(ldev,,,,type,subtype,,,,,,,,,          <<07098>>15716000
                        sectors'per'track);                    <<07098>>15718000
Buff := 0; MOVE Buff(1) := Buff,(Cartridge'Sector - 1);        <<*8114>>15720000
MOVE BUFF:=LABELDATA,(128);                                             15722000
buff(disc'lab'type'word).disc'lab'type:=type;                  <<03510>>15724000
buff(disc'lab'type'word).disc'lab'subtype:=subtype;            <<03510>>15726000
IF NOT Cartridge THEN <<We want to do this junk              >><<*8114>>15728000
BEGIN                                                          <<03537>>15730000
IF type <> mh'disc'type AND                                    <<03510>>15732000
   TYPE <> CS'80'TYPE AND                                      <<03537>>15734000
   type <> floppy'disc'type THEN                               <<03510>>15736000
   BEGIN                                                       <<00075>>15738000
   GENMSG(PVMSGSET,VIERR28,%10000,LDEV);                       <<00075>>15740000
   GENMSG(PVMSGSET,VIERR0);                                    <<00075>>15742000
   RETURN;                                                     <<00075>>15744000
   END;                                                        <<00075>>15746000
sdisctype:=IF type=mh'disc'type THEN                           <<03510>>15748000
   sdisc0types(subtype)                                        <<03510>>15750000
ELSE IF TYPE = CS'80'TYPE THEN                                 <<03537>>15752000
  SDISC3TYPES(SUBTYPE)                                         <<03537>>15754000
ELSE                                                           <<03510>>15756000
   sdisc2types(subtype);                                       <<03510>>15758000
IF SDISCDESC(SDISCTYPE*INITARRAYSIZE)=-1 THEN                  <<00075>>15760000
   BEGIN <<INVALID SUBTYPE>>                                   <<00075>>15762000
   GENMSG(PVMSGSET,VIERR8,%10000,LDEV);                        <<00075>>15764000
   GENMSG(PVMSGSET,VIERR0);                                    <<00075>>15766000
   RETURN;                                                     <<00075>>15768000
   END;  <<INVALID SUBTYPE>>                                   <<00075>>15770000
MOVE BUFF(WORDSPERSECTR):=SDISCDESC(SDISCTYPE*INITARRAYSIZE),  <<00075>>15772000
(INITARRAYSIZE);                                               <<00075>>15774000
IF type = floppy'disc'type THEN                                <<03510>>15776000
   BEGIN <<FIND EOT AND EOD>>                                  <<00075>>15778000
   LOG'SECT:=0D; <<INITIALIZE BOTH WORDS>>                     <<00075>>15780000
   STATUS:=2; <<RETURN ANY ERROR HERE, NOT TO USER>>           <<00075>>15782000
   DISCIO(LDEV,REQSTAT,STATUS'RTN,0D,2,STATUS);                <<00075>>15784000
   IF DOUBLE'SIDED THEN                                        <<00075>>15786000
      TRACKS'CYL:=2                                            <<00075>>15788000
   ELSE                                                        <<00075>>15790000
      TRACKS'CYL:=1;                                           <<00075>>15792000
   LOG'SECTOR:=SECTORS'TRACK*TRACKS'CYL*CYL'DVR-1;             <<00075>>15794000
   DO                                                          <<00075>>15796000
      BEGIN                                                    <<00075>>15798000
      STATUS:=2; <<RETURN ANY ERROR HERE, NOT TO USER>>        <<00075>>15800000
      DISCIO(LDEV,FPA,PHY'ADR,LOG'SECT,2,STATUS);              <<00112>>15802000
      LOG'SECTOR:=LOG'SECTOR-SECTORS'TRACK;                    <<00075>>15804000
      END                                                      <<00075>>15806000
   UNTIL PHY'CYL<CYL'CNTRLR AND STATUS.GSTATUS=1;              <<00092>>15808000
   BUFF(EOTSECTR):=LOG'SECTOR-EOT'EOD'LENGTH+SECTORS'TRACK;    <<00075>>15810000
   BUFF(EODSECTR):=LOG'SECTOR+SECTORS'TRACK;                   <<00075>>15812000
   END;                                                        <<00075>>15814000
IF type = mh'disc'type THEN                                    <<03510>>15816000
   BEGIN <<VERIFY OR ADJUST EOT & EOD FOR THIS DISC>>          <<DL089>>15818000
   EOD'SECTOR0:=BUFF(EODSECTR-1);                              <<DL089>>15820000
   EOD'SECTOR1:=BUFF(EODSECTR);                                <<DL089>>15822000
   STATUS := %(2)010;  << Return error here, no msg >>         <<03537>>15824000
   DISCIO(LDEV,R,BUF2,EOD'SECTOR,128,STATUS);                  <<03537>>15826000
   IF < THEN DO                                                <<DL089>>15828000
      BEGIN <<ADJUST EOT & EOD DOWNWARD>>                      <<DL089>>15830000
      EOD'SECTOR:=EOD'SECTOR-100D;                             <<DL089>>15832000
      BUFF(EODSECTR-1):=EOD'SECTOR0;                           <<DL089>>15834000
      BUFF(EODSECTR):=EOD'SECTOR1;                             <<DL089>>15836000
      EOT'SECTOR:=EOD'SECTOR-DOUBLE(EOT'EOD'LENGTH);           <<DL089>>15838000
      BUFF(EOTSECTR-1):=EOT'SECTOR0;                           <<DL089>>15840000
      BUFF(EOTSECTR):=EOT'SECTOR1;                             <<DL089>>15842000
      STATUS := %(2)010;  << Return error here, no msg >>      <<03537>>15844000
      DISCIO(LDEV,R,BUF2,EOD'SECTOR,128,STATUS);               <<03537>>15846000
      END                                                      <<DL089>>15848000
   UNTIL >=;                                                   <<DL089>>15850000
   END;                                                        <<DL089>>15852000
IF TYPE = CS'80'TYPE THEN                                      <<03537>>15854000
  BEGIN                                                        <<03537>>15856000
  IF (SUBTYPE > ST'9110 LAND SUBTYPE <> ST'9144) THEN          <<*8114>>15858000
    BEGIN     << non-cartridge >>                              <<*8114>>15860000
                                                               <<03537>>15862000
  <<SERIAL function for CS'80 discs - Linus/Buffalo elsewhere>><<*8114>>15864000
                                                               <<03537>>15866000
    IF NOT INITDSCT(LDEV) THEN RETURN; << Verify/Set up DSCT >><<03537>>15868000
                                                               <<03537>>15870000
    DISCIO(LDEV,W,DTT,1D,128); <<WRITE DSCT>>                  <<03638>>15872000
    STATUS := %(2)101;  << Print msg >>                        <<03537>>15874000
    DISCIO(LDEV,REQ'VOL'LIMIT,EOD'SECTOR,0D,2,STATUS);         <<03537>>15876000
    IF <> THEN RETURN;                                         <<03537>>15878000
                                                               <<03537>>15880000
  << Set SDISC pertinent info into disc label >>               <<03537>>15882000
                                                               <<03537>>15884000
    EOT'SECTOR := EOD'SECTOR - DOUBLE(EOT'EOD'LENGTH);         <<03537>>15886000
    BUFF(SECTORSPERTRACK) := SECTORS'PER'TRACK;                <<07098>>15888000
    BUFF(EODSECTR-1) := EOD'SECTOR0;                           <<03537>>15890000
    BUFF(EODSECTR)   := EOD'SECTOR1;                           <<03537>>15892000
    BUFF(EOTSECTR-1) := EOT'SECTOR0;                           <<03537>>15894000
    BUFF(EOTSECTR)   := EOT'SECTOR1;                           <<03537>>15896000
    END                                                        <<03537>>15898000
  END;  << CS'80 SERIAL function >>                            <<03537>>15900000
DISCIO(LDEV,WL,BUFF,0D,128);                                   <<RK1PV>>15902000
END                                                            <<03537>>15904000
ELSE << We are a Linus/Buffalo Drive.                        >><<*8114>>15906000
BEGIN                                                          <<03537>>15908000
   IF NOT Cartridge'Numbers(Ldev, Buff(Wordspersectr)) THEN    <<*8114>>15910000
   BEGIN                                                       <<03537>>15912000
      Genmsg(Pvmsgset,Vierr93); << It's not formatted        >><<03537>>15914000
      RETURN;                                                  <<03537>>15916000
   END;                                                        <<03537>>15918000
   Cartridge'Io(Ldev,Qmisc,Buff,WL,Cartridge'Sector,           <<*8114>>15920000
                Disc'Label'Address,Blocked'IO,                 <<*8114>>15922000
                SKIP'SPARING,Default'Errinfo,Dummy);           <<*8114>>15924000
   IF < THEN RETURN;                                           <<03537>>15926000
END; << Back to Common Code Again.                           >><<03537>>15928000
<<CLEAR GAP TABLE>>                                            <<00186>>15930000
Buf2:=-1;                                                      <<03537>>15932000
                                                               <<03537>>15934000
<< We have two buffers Buff and Buf2 for following reasons.  >><<03537>>15936000
<< 1/ When we are setting the EOT and EOD for Serial disc,   >><<03537>>15938000
<<    we are verifying that we can successfully read the     >><<03537>>15940000
<<    sector indicating End Of Data. If we can't we back     >><<03537>>15942000
<<    up the disc and try again. When we find one we can     >><<03537>>15944000
<<    read, we fill that into the info for the Serial disc   >><<03537>>15946000
<<    label.                                                 >><<03537>>15948000
<< 2/ When Serializing a cartridge we write out a fully     >><<<*8114>>15950000
<<    initialized Gap Table.  We depend on Buff containing   >><<*8114>>15952000
<<    valid label data for BOT so we can calculate how many  >><<*8114>>15954000
<<    sectors we have to initialize.                         >><<*8114>>15956000
                                                               <<03537>>15958000
MOVE Buf2(1) := Buf2,(Cartridge'Sector - 1);                   <<*8114>>15960000
IF Cartridge THEN                                              <<*8114>>15962000
BEGIN                                                          <<03537>>15964000
<< Initialize the whole table at once.                       >><<03537>>15966000
   Cartridge'Gap'Length := INTEGER( Buff(Disc'Lab'BOT'Word))   <<*8114>>15968000
                           - INTEGER( GPTSECT1 );              <<*8114>>15970000
   FOR Counter := 0 UNTIL Cartridge'Gap'Length - 1 DO          <<*8114>>15972000
   BEGIN                                                       <<03537>>15974000
      Cartridge'Io(Ldev,Qmisc,Buf2,W,Cartridge'Sector,         <<*8114>>15976000
                   GPTSECT1 + DOUBLE(Counter),Blocked'IO,      <<*8114>>15978000
                   SKIP'SPARING,Default'Errinfo,Dummy);        <<*8114>>15980000
      IF < THEN RETURN;                                        <<03537>>15982000
   END                                                         <<03537>>15984000
END                                                            <<03537>>15986000
ELSE                                                           <<03537>>15988000
BEGIN << Not a cartridge.                                    >><<*8114>>15990000
DISCIO(Ldev,W,Buf2,GPTSECT1,128);                              <<03537>>15992000
IF < THEN                                                      <<00186>>15994000
   RETURN;                                                     <<03537>>15996000
DISCIO(Ldev,W,Buf2,GPTSECT2,128);                              <<03537>>15998000
IF < THEN                                                      <<00186>>16000000
   RETURN;                                                     <<03537>>16002000
END; << Back to Common Code.                                 >><<03537>>16004000
BUFF:="  "; <<MATCH ON LDEV ONLY>>                             <<RK.09>>16006000
     I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX SEARCH>>          <<RK.09>>16008000
IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,LDEV,I)) = 0D THEN         <<RK.09>>16010000
   BEGIN                                                       <<RK.09>>16012000
   GENMSG(PVMSGSET,VIERR38,%10000,LDEV);                       <<RK.09>>16014000
   RETURN;                                                     <<RK.09>>16016000
   END;                                                        <<RK.09>>16018000
VTABX:=VTABINFO1.(8:8);  <<VTAB INDEX OF SERIAL DEVICE>>       <<RK.09>>16020000
          <<UPDATE VOLUME TABLE>>                              <<RK.09>>16022000
A:=GETSIR(VTABSIR);                                            <<RK.09>>16024000
GETABENTRY(VTABDST,VTABX,BUFF);                                <<RK.09>>16026000
MOVE BUFFB:="SERDISC ",2;   <<VOLUME NAME >>                   <<RK.09>>16028000
ASSEMBLE(DUP,DECA);                                            <<RK.09>>16030000
MOVE * := *,(16);  <<BLANK REST OF VOLUME NAME>>               <<RK.09>>16032000
BUFF(12).(14:2):=2;<<MARK AS NON-SYS DEVICE>>                  <<RK.09>>16034000
BUFF(13):=0;                                                   <<RK.09>>16036000
LPDT'RDY'SER'FRN'DISC := TRUE;                                 <<06276>>16038000
LPDT'SERIAL'OR'FOREIGN := LPDT'SERIAL;                         <<06276>>16040000
PUTABENTRY(VTABDST,VTABX,BUFF);                                <<RK.09>>16042000
RELSIR(VTABSIR,A);                                             <<RK.09>>16044000
END;  <<SERVOL>>                                                        16046000
$PAGE "FOREIGN FUNCTION"                                       <<01115>>16048000
$CONTROL SEGMENT=NEWPACK                                       <<01115>>16050000
PROCEDURE FORNVOL;                                             <<01115>>16052000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01115>>16054000
BEGIN <<FORNVOL>>                                              <<01115>>16056000
DOUBLE LOG'SECT; <<LOGICAL SECTOR VALUE>>                      <<01115>>16058000
INTEGER LOG'SECTOR=LOG'SECT+1;                                 <<01115>>16060000
DOUBLE ARRAY PHY'ADR(0:0);                                     <<01115>>16062000
INTEGER TYPE,LDEV;                                             <<01115>>16064000
INTEGER   subtype;                                             <<03510>>16066000
LOGICAL STATUS;                                                <<01115>>16068000
INTEGER SDISCTYPE;                                             <<01115>>16070000
EQUATE NUMSDISCTYPES=4,                                        <<01115>>16072000
       INITARRAYSIZE=7;                                        <<01115>>16074000
INTEGER ARRAY PHY'CYL(*)=PHY'ADR;                              <<01115>>16076000
INTEGER ARRAY STATUS'RTN(*)=PHY'ADR;                           <<01115>>16078000
INTEGER TRACKS'CYL;                                            <<01115>>16080000
DEFINE DOUBLE'SIDED=STATUS'RTN(1).(4:1)=1#;                    <<01115>>16082000
COMMENT:                                                       <<01115>>16084000
   SDISC0TYPES - THIS ARRAY DEFINES WHICH TYPE ZERO DISCS      <<01115>>16086000
                 ARE SUPPORTED AS FOREIGN DISCS. IF THE        <<01115>>16088000
                 NTH ENTRY IN THIS ARRAY IS NON-NEGATIVE,      <<01115>>16090000
                 THEN SUBTYPE N IS SUPPORTED.                  <<01115>>16092000
   SDISC2TYPES - THIS ARRAY IS LIKE SDISC0TYPES, EXCEPT FOR    <<01115>>16094000
                 TYPE TWO DISCS;                               <<01115>>16096000
<< SDISC3TYPES - This array is like SDISC0TYPES, except for  >><<03537>>16098000
<<               type three (CS'80) discs.                   >><<03537>>16100000
INTEGER ARRAY                                                  <<03537>>16102000
  SDISC0TYPES(*) = PB :=                                       <<03537>>16104000
  -1,     << R7900 - invalid >>                                <<03537>>16106000
  -1,     << F7900 - invalid >>                                <<03537>>16108000
  -1,     << S7900 - invalid >>                                <<03537>>16110000
  -1,     << S2888 - invalid >>                                <<03537>>16112000
  0,      << R7605 >>                                          <<03537>>16114000
  -1,     << F7905 - invalid >>                                <<03537>>16116000
  -1,     << S7905 - invalid >>                                <<03537>>16118000
  -1,     << S7905 FHD replacement - invalid >>                <<03537>>16120000
  1,      << S7920 >>                                          <<03537>>16122000
  4,      << S7925 >>                                          <<03537>>16124000
  2,      << R7906 >>                                          <<03537>>16126000
  -1,     << F7906 - invalid >>                                <<03537>>16128000
  -1,     << S7906 - invalid >>                                <<03537>>16130000
  3(-1);  << Null >>                                           <<03537>>16132000
INTEGER ARRAY SDISC2TYPES(0:15)=PB:=                           <<01115>>16134000
3<<S7902>>,15(-1);                                             <<01115>>16136000
INTEGER ARRAY                                                  <<03537>>16138000
  SDISC3TYPES(*) = PB :=                                       <<03537>>16140000
  -1,     << LINUS - invalid >>                                <<03537>>16142000
  1,      << HP-7911 >>                                        <<06059>>16144000
  2,      << HP-7912 >>                                        <<06059>>16146000
  -1,     << Buffalo - invalid >>                              <<*8114>>16148000
  4,      << HP-7914 >>                                        <<06059>>16150000
  5,      << HP7945 >>                                         <<*8835>>16152000
  2(-1),  << Null   >>                                         <<*8835>>16154000
  8,      << HP7935 >>                                         <<l7674>>16156000
  4(-1);  << Null   >>                                         <<l7674>>16158000
ARRAY BUFF(0:127);                                             <<01115>>16160000
BYTE ARRAY BUFFB(*)  = BUFF;                                   <<01115>>16162000
ARRAY BUF2(0:127);                                             <<01115>>16164000
DOUBLE EOT'SECTOR,EOD'SECTOR;                                  <<01115>>16166000
INTEGER EOT'SECTOR0=EOT'SECTOR,EOT'SECTOR1=EOT'SECTOR+1,       <<01115>>16168000
        EOD'SECTOR0=EOD'SECTOR,EOD'SECTOR1=EOD'SECTOR+1;       <<01115>>16170000
DOUBLE VTABINFO;                                               <<01115>>16172000
INTEGER                                                        <<01115>>16174000
     A, VTABX, I,                                              <<01115>>16176000
     VTABINFO1 = VTABINFO,                                     <<01115>>16178000
     VTBAINFO2 = VTABINFO+1;                                   <<01115>>16180000
                                                               <<01115>>16182000
LDEV:=DEVPARM(1);                                              <<01115>>16184000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN << DO IT >> ELSE     <<01115>>16186000
     IF DEVSTATUS(1).DOWNF = 0 THEN                            <<01115>>16188000
     BEGIN                                                     <<01115>>16190000
          TOS:=SCRATCHVOL(LDEV);                               <<01115>>16192000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                <<01115>>16194000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>16196000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>16198000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>16200000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>16202000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>16204000
          RETURN;                                              <<01615>>16206000
     END                                                       <<01115>>16208000
     ELSE IF NOT OVERWRITE(LDEV,6) THEN RETURN;                <<01115>>16210000
BUFF:=0; MOVE BUFF(1):=BUFF,(128);                             <<01115>>16212000
Get'Disc'Info(ldev,,,,type,subtype);                           <<03510>>16214000
IF type <> mh'disc'type AND                                    <<03510>>16216000
   TYPE <> CS'80'TYPE AND                                      <<03537>>16218000
   type <> floppy'disc'type THEN                               <<03510>>16220000
   BEGIN                                                       <<01115>>16222000
   GENMSG(PVMSGSET,VIERR28,%10000,LDEV);                       <<01115>>16224000
   GENMSG(PVMSGSET,VIERR0);                                    <<01115>>16226000
   RETURN;                                                     <<01115>>16228000
   END;                                                        <<01115>>16230000
SDISCTYPE := IF TYPE = MH'DISC'TYPE THEN SDISC0TYPES(SUBTYPE)  <<03537>>16232000
  ELSE IF TYPE = FLOPPY'DISC'TYPE THEN SDISC2TYPES(SUBTYPE)    <<03537>>16234000
  ELSE SDISC3TYPES(SUBTYPE);                                   <<03537>>16236000
IF SDISCTYPE=-1 THEN                                           <<01115>>16238000
   BEGIN <<INVALID SUBTYPE>>                                   <<01115>>16240000
   GENMSG(PVMSGSET,VIERR8,%10000,LDEV);                        <<01115>>16242000
   GENMSG(PVMSGSET,VIERR0);                                    <<01115>>16244000
   RETURN;                                                     <<01115>>16246000
   END;  <<INVALID SUBTYPE>>                                   <<01115>>16248000
DISCIO(LDEV,WL,BUFF,0D,128);                                   <<01115>>16250000
IF < THEN                                                      <<01115>>16252000
   GENMSG(PVMSGSET,VIERR0);                                    <<01115>>16254000
BUFF:="  "; <<MATCH ON LDEV ONLY>>                             <<01115>>16256000
     I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX SEARCH>>          <<01115>>16258000
IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,LDEV,I)) = 0D THEN         <<01115>>16260000
   BEGIN                                                       <<01115>>16262000
   GENMSG(PVMSGSET,VIERR38,%10000,LDEV);                       <<01115>>16264000
   RETURN;                                                     <<01115>>16266000
   END;                                                        <<01115>>16268000
VTABX:=VTABINFO1.(8:8);  <<VTAB INDEX OF SERIAL DEVICE>>       <<01115>>16270000
          <<UPDATE VOLUME TABLE>>                              <<01115>>16272000
A:=GETSIR(VTABSIR);                                            <<01115>>16274000
GETABENTRY(VTABDST,VTABX,BUFF);                                <<01115>>16276000
MOVE BUFFB:="FORNDISC",2;   <<VOLUME NAME >>                   <<01115>>16278000
ASSEMBLE(DUP,DECA);                                            <<01115>>16280000
MOVE * := *,(16);  <<BLANK REST OF VOLUME NAME>>               <<01115>>16282000
BUFF(12).(14:2):=2;<<MARK AS NON-SYS DEVICE>>                  <<01115>>16284000
BUFF(13):=0;                                                   <<01115>>16286000
LPDT'RDY'SER'FRN'DISC := TRUE;  << Set SER/FOR as mounted >>   <<06276>>16288000
LPDT'SERIAL'OR'FOREIGN := LPDT'FOREIGN;  << Set FOREIGN bit >> <<06276>>16290000
PUTABENTRY(VTABDST,VTABX,BUFF);                                <<01115>>16292000
RELSIR(VTABSIR,A);                                             <<01115>>16294000
END;  <<FORNVOL>>                                              <<01115>>16296000
$PAGE "   VERIFY FUNCTION"                                     <<04670>>16298000
PROCEDURE VERIFY;                                              <<04670>>16300000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>16302000
                                                               <<04670>>16304000
<<Procedure VERIFY checks if there are any bad sector or     >><<04670>>16306000
<<tracks on media. For private volumes and system volumes it >><<04670>>16308000
<<checks each sector or track from the DTT/DSCT against the  >><<04670>>16310000
<<disc free space bit map and if volume is logicaly mounted   ><<04670>>16312000
<<it will check what files have bad data. All bad sectors or >><<04670>>16314000
<<tracks of serial discs are verified with the Gap Table. If >><<04670>>16316000
<<a sector or track lies entire in a "hole" it will be not   >><<04670>>16318000
<<reported. The VERIFY keyword DTT will indicate that        >><<04670>>16320000
<<existing DTT/DSCT is examined (not applicable for LINUS or >><<04670>>16322000
<<foreign discs). Without the DTT keyword the entire media   >><<04670>>16324000
<<is physically verified. All bad sectors/tracks are entered >><<04670>>16326000
<<into the DTT/DSCT which is later used for checking. For    >><<04670>>16328000
<<private volumes, system volumes, serial discs only valid   >><<04670>>16330000
<<logical data are verified. The scratch volumes and foreign >><<04670>>16332000
<<discs are entire checked and all bad sectors/tracks are    >><<04670>>16334000
<<reported.                                                  >><<04670>>16336000
<<The VERIFY command required the device to be downed except >><<04670>>16338000
<<mounted system volume.                                     >><<04670>>16340000
                                                               <<04670>>16342000
BEGIN                                                          <<04670>>16344000
LOGICAL DTT'FLAG := FALSE;                                     <<04670>>16346000
INTEGER TYPE,SUBTYPE,ERR;                                      <<04670>>16348000
DOUBLE ADDR,SIZE,DISC'SIZE;                                    <<04670>>16350000
                                                               <<04670>>16352000
IF KEYWDSPEC THEN                                              <<04670>>16354000
   IF KEYWORD = "DTT" THEN                                     <<04670>>16356000
      DTT'FLAG := TRUE                                         <<04670>>16358000
   ELSE                                                        <<04670>>16360000
      BEGIN                                                    <<04670>>16362000
      GENMSG (PVMSGSET,VIERR3);                                <<04670>>16364000
      RETURN;                                                  <<04670>>16366000
      END;                                                     <<04670>>16368000
                                                               <<04670>>16370000
LDEV := DEVPARM(1);                                            <<04670>>16372000
                                                               <<04670>>16374000
IF NOT GET'DEV'INFO (LDEV,TYPE,SUBTYPE) THEN                   <<04670>>16376000
   RETURN;                                                     <<04670>>16378000
DOWNDEV := DEVSTATUS(1).DOWNF;                                 <<04670>>16380000
IF NOT DOWNDEV AND (NOT SYS OR NOT VOLUME'MOUNTED(LDEV)) THEN  <<04670>>16382000
   BEGIN                                                       <<04670>>16384000
   GENMSG (PVMSGSET,VIWARN138,%10000,LDEV);                             16386000
   END;                                                        <<04670>>16388000
                                                               <<04670>>16390000
IF (SIZE := CALC'DISC'SIZE(LDEV)) = 0D THEN                    <<04670>>16392000
   BEGIN                                                       <<04670>>16394000
   GENMSG (PVMSGSET,VIERR0);                                   <<04670>>16396000
   RETURN;                                                     <<04670>>16398000
   END;                                                        <<04670>>16400000
                                                               <<04670>>16402000
IF CARTRIDGE OR FORVOL THEN                                    <<*8114>>16404000
   IF DTT'FLAG THEN                                            <<04670>>16406000
      BEGIN                                                    <<04670>>16408000
      GENMSG (PVMSGSET,VIERR3);                                <<04670>>16410000
      RETURN;                                                  <<04670>>16412000
      END                                                      <<04670>>16414000
   ELSE                                                        <<04670>>16416000
      BUILD'DSCT                                               <<04670>>16418000
ELSE                                                           <<04670>>16420000
   BEGIN   <<Read DTT/DSCT>>                                   <<04670>>16422000
   DISCIO (LDEV,R,DTT,1D,DTT'SIZE);                            <<04670>>16424000
   IF <> THEN                                                  <<04670>>16426000
   RETURN;                                                     <<04670>>16428000
   END;                                                        <<04670>>16430000
                                                               <<04670>>16432000
ENABLE'BREAK;                                                  <<04670>>16434000
                                                               <<04670>>16436000
IF NOT DTT'FLAG THEN                                           <<04670>>16438000
   BEGIN                                                       <<04670>>16440000
   DTT := 0;                                                            16442000
   IF (PVOL LOR SYS) AND NOT VOLUME'MOUNTED (LDEV) THEN        <<04670>>16444000
      GENMSG (PVMSGSET,VIWARN129,%10000,LDEV);                 <<04670>>16446000
   DISC'SIZE := SIZE;                                                   16448000
   GET'DISC'INFO (LDEV,,,,,,DISC'SIZE);                                 16450000
   GENMSG (PVMSGSET,VIWARN139,%10000,                                   16452000
           INT(SIZE*100D/DISC'SIZE));                                   16454000
   IF NOT VERIFY'MEDIA (LDEV,SIZE) THEN                        <<04670>>16456000
      RETURN;                                                  <<04670>>16458000
   END;                                                        <<04670>>16460000
                                                               <<04670>>16462000
SORT'ENTRIES;   <<SORT DTT/DSCT>>                              <<04670>>16464000
                                                               <<04670>>16466000
DTT'CHANGES := 0;                                              <<04670>>16468000
WHILE GET'ENTRY (ADDR,SIZE) DO                                 <<04670>>16470000
   IF USED'SPACE (LDEV,ADDR,SIZE) THEN                         <<04670>>16472000
      CHECK'SECTOR (LDEV,ADDR,SIZE);                           <<04670>>16474000
                                                               <<04670>>16476000
IF DTT'CHANGES <> 0 AND                                        <<04670>>16478000
   (ERR := CHECK'BAD'FILES (LDEV)) <> 0 THEN                   <<04670>>16480000
      IF ERR = -1 THEN                                         <<04670>>16482000
         GENMSG (PVMSGSET,VIWARN130,%10000,LDEV)               <<04670>>16484000
      ELSE                                                     <<04670>>16486000
         GENMSG (PVMSGSET,ERR);                                <<04670>>16488000
END; <<VERIFY>>                                                <<04670>>16490000
                                                                        16492000
$CONTROL SEGMENT=VINITCI                                       <<RK.09>>16494000
$PAGE "FUNCTION CASE STATEMENT"                                <<00239>>16496000
PROCEDURE FUNCTION;                                                     16498000
OPTION PRIVILEGED,UNCALLABLE;                                           16500000
BEGIN                                                                   16502000
     DEFINE ERR = RETURN#;  <<FUNCTION ERROR>>                          16504000
                                                                        16506000
     GETFUNCTION;                                                       16508000
     FCONTROL(1,14,MORE);                                      <<RK3PV>>16510000
DISABLE'BREAK;                                                 <<04670>>16512000
     CASE * FUNCT OF                                                    16514000
     BEGIN                                                              16516000
          ERR;        << FUNCTION ERROR >>                              16518000
          INIT;                                                         16520000
          FORMAT;     << FORMAT PACK >>                                 16522000
          SCRATCH;                                                      16524000
          COPY;                                                         16526000
          COND;                                                         16528000
          DTRACK;                                                       16530000
          DELVOL;                                                       16532000
          DSTAT;                                                        16534000
          PDEFN;                                                        16536000
          PLABEL;                                                       16538000
          PDTRACK;                                                      16540000
          PFSPACE;                                                      16542000
          SERVOL;                                                       16544000
          EXIT';      << TERMINATE  >>                                  16546000
          DEBUG;      << DEBUG CALL >>                                  16548000
          GENMSG(PVMSGSET,VIHELP);  <<HELP>>                   <<00145>>16550000
          GENMSG(PVMSGSET,VIHELP);  <<XPLAIN>>                 <<00145>>16552000
          GENMSG(PVMSGSET,VIHELP);  <<EXPLAIN>>                <<<<FDF>>16554000
          VERIFY;     << VERIFY SERIAL DISC >>                 <<03638>>16556000
          FORNVOL;                                   << FDF >> <<01115>>16558000
     END <<CASE>>;                                                      16560000
     FCONTROL(1,15,MORE);                                      <<RK3PV>>16562000
END  << FUNCTION >>;                                                    16564000
$PAGE "START UP PROCEDURE"                                     <<01115>>16566000
                                                                        16568000
PROCEDURE SETUPSHOP;                                                    16570000
OPTION PRIVILEGED,UNCALLABLE;                                           16572000
BEGIN                                                                   16574000
     BYTE ARRAY FNAME(0:7);                                             16576000
     DOUBLE ATTRIBUTES;                                        <<RK.08>>16578000
     LOGICAL ATTRIBUTES'0 = ATTRIBUTES;                        <<RK.08>>16580000
                                                                        16582000
     VALIDVSID:=FALSE;                                                  16584000
     MOVE msg:=id;                                             <<03510>>16586000
     MOVE MSG(VUFPOS) := OFFICIAL'VUUFF;                       <<04299>>16588000
     PRINT(MSGW,-43,0);                                        <<03537>>16590000
     WHO(,ATTRIBUTES,,,VGNAME,VANAME);                         <<RK.08>>16592000
     IF (ATTRIBUTES'0 LAND %102000)  = 0 <<SM,OP>> THEN        <<RK.08>>16594000
        BEGIN                                                  <<RK.08>>16596000
        MOVE MSG := "VINIT REQUIRES SM OR OP CAPABILITY";      <<RK.08>>16598000
        PRINT(MSGW,- 34,0);                                    <<RK.08>>16600000
        TERMINATE;                                             <<RK.08>>16602000
        END;                                                   <<RK.08>>16604000
     MOVE FNAME:="VINLIST ";                                            16606000
     OUTF:=FOPEN(FNAME,%414,%1); <<FOPT:CCTL,$STDLIST,ASCII;AOPT:WR>>   16608000
     IF <> THEN                                                         16610000
     BEGIN                                                              16612000
          PRINTFILEINFO(OUTF);                                          16614000
          MOVE MSG:=" ** OUTPUT FILE OPEN ERROR **";                    16616000
          PRINT(MSGW,-29,0);                                   <<RK.08>>16618000
          TERMINATE;                                                    16620000
     END;                                                               16622000
END << SETUPSHOP >>;                                                    16624000
$PAGE "   PROCEDURE TABLESPACE"                                         16626000
$CONTROL SEGMENT=NEWPACK                                                16628000
LOGICAL PROCEDURE tablespace(ldev,dtt,start'adr,nsect);        <<03510>>16630000
   VALUE ldev,start'adr,nsect;                                          16632000
   INTEGER ldev;                                                        16634000
   DOUBLE start'adr,nsect;                                              16636000
   INTEGER ARRAY dtt;                                                   16638000
   OPTION PRIVILEGED,UNCALLABLE;                                        16640000
                                                                        16642000
<<===================================================                   16644000
                                                                        16646000
                                                                        16648000
   Verify that the space is not in the deleted track area               16650000
   Return ccl if space is in the deleted track area                     16652000
   Return ccg if any kind of I/O error                                  16654000
                                                                        16656000
   Parameters:                                                          16658000
        ldev - which logical device                                     16660000
        dtt  - INTEGER array w Defective Tracks Table                   16662000
        start'adr  - DBL wd which contains the sector addr              16664000
        nsect = DBL wd has the number of sectors checking               16666000
                                                                        16668000
   Returns:                                                             16670000
       logical, depends upon CC code                                    16672000
                                                                        16674000
       CCL start'adr is in deleted area                                 16676000
           tablespace = no'error                                        16678000
       CCG I/O error from get'disc'info                                 16680000
           tablespace = error from get'disc'info                        16682000
       CCE start'adr NOT in deleted area                                16684000
           tablespace = no'error                                        16686000
                                                                        16688000
   Assumptions on entry:                                                16690000
        NONE                                                            16692000
                                                                        16694000
   Globals:                                                             16696000
            dtt - dtt'number'of'entries,dtt'track'number,               16698000
                  dtt'track'code,dtt'deleted                            16700000
                                                                        16702000
   Externals:                                                           16704000
        Get'Disc'Info                                                   16706000
                                                                        16708000
   Intrinsics:                                                          16710000
        None.                                                           16712000
                                                                        16714000
   Callers:                                                             16716000
        initdfsm,recover'init                                           16718000
                                                                        16720000
   Fixid:                                                               16722000
        This procedure was added as part of the changes for the         16724000
      new disc free space map.  The fix i.d. on the procedure           16726000
      header applies to the whole procedure.                            16728000
                                                                        16730000
   Changes:                                                             16732000
                                                                        16734000
====================================================>>                  16736000
                                                                        16738000
BEGIN                                                                   16740000
                                                                        16742000
   INTEGER      status=q-1;                                             16744000
   INTEGER      dtt'index                                               16746000
               ,sectors'per'track   << for ldev >>                      16748000
               ,type                                                    16750000
               ;                                                        16752000
   DOUBLE       end'adr    << =start'adr+nsect -1 >>                    16754000
               ,del'start  << deleted trk addr, start >>                16756000
               ,del'end    << deleted trk addr, end >>                  16758000
               ,spare'adr   << addr, in sect, of spare area >>          16760000
               ;                                                        16762000
                                                                        16764000
   LOGICAL      proc'status   << status from called procs >>            16766000
               ;                                                        16768000
                                                                        16770000
   LOGICAL      return'status  =  tablespace;                           16772000
                                                                        16774000
$PAGE                                                                   16776000
                                                                        16778000
   Get'Disc'Info(ldev,,,,type);                                         16780000
                                                                        16782000
   IF type = cs'80'type THEN  << no del trks in a DSCT >>               16784000
      BEGIN                                                             16786000
         condcode:=cce;                                                 16788000
         return'status:=no'error;                                       16790000
         RETURN;                                                        16792000
      END;                                                              16794000
                                                                        16796000
   << any defective tracks in the dtt ? >>                              16798000
   IF dtt(dtt'number'of'entries) = 0 THEN                               16800000
      BEGIN                                                             16802000
         condcode:=cce;                                                 16804000
         return'status:=no'error;                                       16806000
         RETURN;                                                        16808000
      END;                                                              16810000
                                                                        16812000
   return'status:=no'error;   << initialize >>                          16814000
                                                                        16816000
   << get the needed parameters before continuing. Need  >>             16818000
   << logical pack size(in sectors), sectors per track   >>             16820000
   << Call 2 procedures to get them                      >>             16822000
                                                                        16824000
                                                                        16826000
   proc'status:=Get'Disc'Info(ldev,,,,,,spare'adr,,,,,,,,               16828000
                              sectors'per'track);                       16830000
   IF NOT(proc'status) THEN                                             16832000
      BEGIN                                                             16834000
         condcode:=ccg;                                                 16836000
         return'status:=proc'status;                                    16838000
         RETURN;                                                        16840000
      END;                                                              16842000
                                                                        16844000
                                                                        16846000
   dtt'index:=0;                                                        16848000
   end'adr:=start'adr + nsect -1D;  << end of what to check >>          16850000
                                                                        16852000
   << run through the defective tracks table making sure that  >>       16854000
   << none of the space is in any defective track area         >>       16856000
                                                                        16858000
                                                                        16860000
   DO BEGIN                                                             16862000
      dtt'index:=dtt'index+1;   << dtt(0) is # of entries >>            16864000
      IF DBL(dtt(dtt'index).dtt'track'number) *DBL(sectors'per'track)   16866000
         < spare'adr THEN                                               16868000
         BEGIN                                                          16870000
            IF dtt(dtt'index).dtt'track'code = dtt'deleted THEN         16872000
               BEGIN                                                    16874000
                                                                        16876000
                  << calculate sector addr of deleted area >>           16878000
                                                                        16880000
                  del'start:=DBL( dtt(dtt'index).dtt'track'number )     16882000
                             * DBL( sectors'per'track );                16884000
                  del'end:=del'start + DBL( sectors'per'track )         16886000
                           - 1D;                                        16888000
                                                                        16890000
                  IF start'adr >= del'start AND                         16892000
                     end'adr   <= del'end   THEN                        16894000
                     BEGIN                                              16896000
                        condcode:=ccl;                                  16898000
                        RETURN;                                         16900000
                     END;                                               16902000
                  IF del'start >= start'adr AND                         16904000
                     del'end   <= end'adr   THEN                        16906000
                     BEGIN                                              16908000
                        condcode:=ccl;                                  16910000
                        RETURN;                                         16912000
                     END;                                               16914000
                  IF start'adr >= del'start AND                         16916000
                     start'adr <= del'end THEN                          16918000
                     BEGIN                                              16920000
                        condcode:=ccl;                                  16922000
                        RETURN;                                         16924000
                     END;                                               16926000
                  IF end'adr >= del'start AND                           16928000
                     end'adr <= del'start THEN                          16930000
                     BEGIN                                              16932000
                        condcode:=ccl;                                  16934000
                        RETURN;                                         16936000
                     END;                                               16938000
               END;        << deleted track >>                          16940000
            END;           << not in spare area >>                      16942000
                                                                        16944000
         END UNTIL dtt'index = dtt(dtt'number'of'entries);              16946000
                                                                        16948000
      <<  ok, not in deleted area >>                                    16950000
                                                                        16952000
   condcode:=cce;                                                       16954000
   return'status:=no'error;                                             16956000
                                                                        16958000
END;   << tablespace >>                                                 16960000
$PAGE  "PROCEDURE INITDFSM  "                                           16962000
$CONTROL SEGMENT=NEWPACK                                                16964000
LOGICAL PROCEDURE initdfsm(ldev,mv,dirsz,dir'adr,vlab);        <<03510>>16966000
   VALUE ldev,mv,dirsz;                                                 16968000
   LOGICAL mv;                                                          16970000
   INTEGER ldev,dirsz;                                                  16972000
   DOUBLE dir'adr;                                                      16974000
   ARRAY vlab;                                                          16976000
   OPTION PRIVILEGED,UNCALLABLE;                                        16978000
                                                                        16980000
<<===================================================                   16982000
                                                                        16984000
                                                                        16986000
      Procedure to acquire/set-up the bit map and Descriptors           16988000
      on LDEV and to acquire Dirsz number of sectors if this            16990000
      this is the master vol of the volume set(mv=true).                16992000
      Before this procedure is called it is assumed that                16994000
      the defective tracks table(DTT) is set-up                         16996000
      Also that DTT(dtt'logical'pack'size) contains the                 16998000
      logical pack size(in cylinders for MH, in track for FH) of LDEV.  17000000
      Also most of the volume label is filled in.                       17002000
      This procedure will return the diradr. Some of the parameters     17004000
      in the disc label which is returned to the calling                17006000
      procedure will not be up to date, do not depend                   17008000
      on any of them                                                    17010000
      Part of the time this procedure operates in split                 17012000
      stack mode                                                        17014000
      "handle'error" does a "EXIT" - if calling procedure               17016000
       changes, then this must be changed                               17018000
                                                                        17020000
                                                                        17022000
   Parameters:                                                          17024000
        ldev   - logical device number                                  17026000
        mv     - LOGICAL, if true then master vol of                    17028000
                 vol set                                                17030000
        dirsz  - INTEGER, size of Directory                             17032000
        diradr - returned to caller(to set up Directory)                17034000
                 DBL wd contains the address of Dirc                    17036000
        vlab   - LOGICAL array, contains the volume                     17038000
                 label partially filled in by caller.                   17040000
                 NOTE: this procedure will modify this                  17042000
                       array. This procedure will put in                17044000
                       the DFSM variables + Dirc addr and               17046000
                       write out to disc. Caller should                 17048000
                       not depend on its contents                       17050000
                                                                        17052000
   Returns:                                                             17054000
        status word in "DFSM" format                                    17056000
                                                                        17058000
   Assumptions:                                                         17060000
        If any error handle'error is called. It exits                   17062000
        exits and cuts back the stack. IF                               17064000
        calling sequence is changed, MUST change this                   17066000
                                                                        17068000
   Globals:                                                             17070000
        DFSM DST-largest'space,starting'space,ending'space,             17072000
                 dt'entry'size,ds'disc'address,                         17074000
                 ds'number'of'sectors,ds'error'status                   17076000
                 empty'buffer                                           17078000
        disc'label-disc'lab'dirty'dt'flag,                              17080000
                   disc'lab'dt'checksum,disc'lab'dfs'map'ok,            17082000
                   disc'lab'dt'low,disc'lab'dt'high,                    17084000
                   disc'lab'map'low,disc'lab'map'high,                  17086000
                   disc'lab'dirbase,disc'lab'dirsize                    17088000
        dtt-dtt'number'of'entries,dtt'track'code,                       17090000
            dtt'deleted,dtt'track'number                                17092000
                                                                        17094000
   Externals:                                                           17096000
       Get'Disc'Info,tablespace,Read'Disc,Write'Disc,                   17098000
       Create'Dfs'Data'Seg,Lock'Dfs'Data'Seg,Set'Reset'Bit'Map,         17100000
       Unlock'Dfs'Data'Seg,Deallocate'Dfs'Data'Seg                      17102000
                                                                        17104000
   Intrinsics:                                                          17106000
       quit(for debug purposes),debug                                   17108000
                                                                        17110000
   Resources:                                                           17112000
        gets a DFSM DST for work area                                   17114000
                                                                        17116000
   Callers:                                                             17118000
        init                                                            17120000
                                                                        17122000
   Fixid:                                                               17124000
      This procedure was added as part of the disc free space map       17126000
      changes, the fixid aon the procedure header applies to the        17128000
      procedure.                                                        17130000
                                                                        17132000
   Changes:                                                             17134000
                                                                        17136000
====================================================>>                  17138000
                                                                        17140000
BEGIN                                                                   17142000
                                                                        17144000
   LOGICAL  return'status  = initdfsm;                                  17146000
                                                                        17148000
   INTEGER     bit'map'sz      << in sectors >>                         17150000
              ,descr'sz        << sectors    >>                         17152000
              ,num'descr'ent   << # entries in Descr table  >>          17154000
              ,page            << used to calc the #sectors >>          17156000
              ,word            << in the last               >>          17158000
              ,bit             << page                      >>          17160000
              ,temp            << temporary varible         >>          17162000
              ,ldttlps         << log pack sz in TRACKs     >>          17164000
              ,descr'sz'wds    << #wds in descr table >>                17166000
              ,sectors'per'track                                        17168000
              ,type                                                     17170000
              ,subtype                                                  17172000
              ;                                                         17174000
                                                                        17176000
   LOGICAL     rwstat          << status ret from R/W disc  >>          17178000
              ,dfs'status      << status ret from DFS routines >>       17180000
              ,ldfs'locked     << in split stack mode          >>       17182000
              ,lcrit           << returned from setcritical >>          17184000
              ,lcrit'set       << in critical mode             >>       17186000
              ,search          << keep calling tablespace      >>       17188000
              ,proc'status     << status from called procedures >>      17190000
              ;                                                         17192000
                                                                        17194000
   DOUBLE      disc'sz         << in sectors >>                         17196000
              ,wr'adr          << used to r/w the disc      >>          17198000
              ,bit'map'adr     << address of Bit Map        >>          17200000
              ,descr'adr       << address of Descr Table    >>          17202000
              ,good'adr                                                 17204000
              ,ldiradd          << localcopy of Dirc addr  >>           17206000
                                << use in split stack mode >>           17208000
              ;                                                         17210000
                                                                        17212000
   POINTER     descr'table     << Descr table in stack      >>          17214000
              ;                                                         17216000
                                                                        17218000
$IF X3=ON                                                               17220000
   EQUATE mess'len=72;                                                  17222000
   LOGICAL ARRAY mess(0:mess'len/2-1);                                  17224000
   BYTE ARRAY bmess(*)=mess;                                            17226000
   DEFINE blank'mess= mess:="  ";                                       17228000
                      MOVE mess(1):=mess,(mess'len/2-1)#;               17230000
$IF                                                                     17232000
         << a page of bit map >>                                        17234000
   LOGICAL ARRAY      buffer(0:actual'words'per'page-1);                17236000
                                                                        17238000
   INTEGER ARRAY dtt(0:dtt'size-1)=Q;  << used in split stack >>        17240000
                                                                        17242000
   EQUATE nospace =%276; << couldn't find sp for    >>                  17244000
                         << Dir,Bit Map,Descr       >>                  17246000
                                                                        17248000
   << use this to exit from a subroutine >>                             17250000
                                                                        17252000
   DEFINE exit'procedure = ASSEMBLE(exit 5)#;                           17254000
$PAGE "   SUBROUTINE HANDLE'ERROR"                                      17256000
SUBROUTINE handle'error(err);                                  <<03510>>17258000
   VALUE err;                                                           17260000
   LOGICAL err;                                                         17262000
                                                                        17264000
<<===================================================                   17266000
                                                                        17268000
                                                                        17270000
      Any errors in initdfsm, this subroutine is called                 17272000
      It puts the passed error into the return status                   17274000
      word and EXITS by deleting the parameters off the                 17276000
      stack                                                             17278000
      NOTE: if calling sequence changes, this must change               17280000
                                                                        17282000
   Parameters:                                                          17284000
       err - error status in "DFSM" format                              17286000
                                                                        17288000
   Returns:                                                             17290000
       error status to calling procedure to let it                      17292000
       take care of error                                               17294000
                                                                        17296000
   Assumptions on entry:                                                17298000
                                                                        17300000
   Globals:                                                             17302000
      return'status(initdfsm)                                           17304000
                                                                        17306000
   Externals:                                                           17308000
           Unlock'Dfs'Data'Seg,Delete'Dfs'Data'Seg,                     17310000
           resetcritical                                                17312000
                                                                        17314000
   Intrinsics:                                                          17316000
            debug(for debug purposes)                                   17318000
                                                                        17320000
   Fixid:                                                               17322000
      This subroutine header was added as part of the disc free         17324000
      space map chenges.  The fixid on the subroutine header            17326000
      applies to the whole procedure.                                   17328000
                                                                        17330000
   Changes:                                                             17332000
                                                                        17334000
====================================================>>                  17336000
   BEGIN                                                                17338000
                                                                        17340000
$IF X3=ON                                                               17342000
            debug;                                                      17344000
$IF                                                                     17346000
                                                                        17348000
   IF ldfs'locked THEN                                                  17350000
      BEGIN                                                             17352000
         Unlock'Dfs'Data'Seg;                                           17354000
         ldfs'locked:=false;                                            17356000
         <<   don't write out, had some kind of bad r/w status >>       17358000
         Delete'Dfs'Data'Seg(ldev);                                     17360000
      END;                                                              17362000
   IF lcrit'set THEN                                                    17364000
      BEGIN                                                             17366000
         resetcritical(lcrit);                                          17368000
         lcrit'set:=false;                                              17370000
      END;                                                              17372000
                                                                        17374000
   << return status word to calling procedure >>                        17376000
   return'status:=err;                                                  17378000
   exit'procedure;                                                      17380000
END;        << handle'error >>                                          17382000
$PAGE  "    PROCEDURE INITDFSM"                                         17384000
   return'status:=0;       << initialize >>                             17386000
   ldfs'locked:=false;     << initialize >>                             17388000
   lcrit'set:=false;                                                    17390000
$IF X3=ON                                                               17392000
         PUSH(status);                                                  17394000
         TOS.(2:1):=1; << on traps - later turn off traps >>            17396000
         SET(status);                                                   17398000
$IF                                                                     17400000
                                                                        17402000
   << call procedures to get information about the disc       >>        17404000
   << Need dtt, disc size(in sectors),number of descriptor    >>        17406000
   << entries, sectors per track                              >>        17408000
   << (disc'sz-1 is the last good disc address)               >>        17410000
                                                                        17412000
                                                                        17414000
   proc'status:=Get'Disc'Info(ldev,,,,type,subtype);                    17416000
   IF NOT(proc'status) THEN handle'error(proc'status);                  17418000
   << note: sectors per track doesnt mean anything >>                   17420000
   <<       for a BFD                              >>                   17422000
   proc'status:=Get'Disc'Info(ldev,,,dtt,,,disc'sz,,                    17424000
                              num'descr'ent,,descr'sz'wds               17426000
                             ,,,,sectors'per'track);                    17428000
   IF NOT(proc'status) THEN handle'error(proc'status);                  17430000
                                                                        17432000
   <<  number of sectors in the bit map>>                               17434000
   bit'map'sz:=num'descr'ent * page'size;                               17436000
                                                                        17438000
   << number of sectors in the descriptor table >>                      17440000
   descr'sz:=descr'sz'wds/sector'size;                                  17442000
   IF (descr'sz'wds MOD sector'size) <> 0 THEN                          17444000
      descr'sz:=descr'sz +1;                                            17446000
                                                                        17448000
   << find the space for the Bit Map and Descriptors   >>               17450000
   << make sure that the space is not deleted -        >>               17452000
   << it may be reassigned(but prob of it very low)    >>               17454000
                                                                        17456000
                                                                        17458000
   << initialize the addresses >>                                       17460000
   dir'adr:=0D;                                                         17462000
   bit'map'adr:=0D;                                                     17464000
   descr'adr:=0D;                                                       17466000
                                                                        17468000
   good'adr:=beg'good'adr;                                              17470000
   search:=true;                                                        17472000
                                                                        17474000
   << try to find the descriptor+bit map in one hunk,  >>               17476000
   << if can't then try to find separately             >>               17478000
                                                                        17480000
   DO BEGIN                                                             17482000
      proc'status:=tablespace(ldev,dtt,good'adr,                        17484000
                              DBL(bit'map'sz+descr'sz) );               17486000
      IF < THEN good'adr:=good'adr+ DBL(bit'map'sz +descr'sz)           17488000
         ELSE                                                           17490000
            BEGIN                                                       17492000
               IF > THEN handle'error(proc'status)                      17494000
                  ELSE                                                  17496000
                     BEGIN                                              17498000
                        bit'map'adr:=good'adr;                          17500000
                        search:=false;                                  17502000
                     END;                                               17504000
            END;                                                        17506000
   END UNTIL NOT(search) OR (good'adr + DBL(bit'map'sz+descr'sz))       17508000
                            >= disc'sz;                                 17510000
                                                                        17512000
   IF bit'map'adr = 0D THEN   << find separately >>                     17514000
      BEGIN                                                             17516000
         search:=true;                                                  17518000
         good'adr:=beg'good'adr;                                        17520000
         DO BEGIN                                                       17522000
            proc'status:=tablespace(ldev,dtt,good'adr,                  17524000
                                    DBL(bit'map'sz) );                  17526000
            IF < THEN good'adr:=good'adr+ DBL(bit'map'sz)               17528000
               ELSE                                                     17530000
                  BEGIN                                                 17532000
                     IF > THEN handle'error(proc'status)                17534000
                        ELSE                                            17536000
                           BEGIN                                        17538000
                              bit'map'adr:=good'adr;                    17540000
                              search:=false;                            17542000
                           END;                                         17544000
                  END;                                                  17546000
         END UNTIL NOT(search) OR (good'adr + DBL(bit'map'sz))          17548000
                                  >= disc'sz;                           17550000
         IF bit'map'adr = 0D THEN handle'error(nospace);                17552000
                                                                        17554000
         search:=true;                                                  17556000
         good'adr:=bit'map'adr + DBL(bit'map'sz);                       17558000
         DO BEGIN                                                       17560000
            proc'status:=tablespace(ldev,dtt,good'adr,                  17562000
                                    DBL(descr'sz) );                    17564000
            IF < THEN good'adr:=good'adr+ DBL(descr'sz)                 17566000
               ELSE                                                     17568000
                  BEGIN                                                 17570000
                     IF > THEN handle'error(proc'status)                17572000
                        ELSE                                            17574000
                           BEGIN                                        17576000
                              descr'adr:=good'adr;                      17578000
                              search:=false;                            17580000
                           END;                                         17582000
                  END;                                                  17584000
         END UNTIL NOT(search) OR (good'adr + DBL(descr'sz) )           17586000
                                  >= disc'sz;                           17588000
                                                                        17590000
         IF descr'adr = 0D THEN handle'error(nospace);                  17592000
      END                                                               17594000
   ELSE    descr'adr:=bit'map'adr + DBL(bit'map'sz); <<found both tog >>17596000
                                                                        17598000
   IF mv THEN                                                           17600000
      BEGIN                                                             17602000
         good'adr:=descr'adr + DBL(descr'sz);                           17604000
         search:=true;                                                  17606000
         DO BEGIN                                                       17608000
            proc'status:=tablespace(ldev,dtt,good'adr,                  17610000
                          DBL(dirsz) );                                 17612000
            IF < THEN good'adr:=good'adr+ DBL(dirsz)                    17614000
               ELSE                                                     17616000
                  BEGIN                                                 17618000
                     IF > THEN handle'error(proc'status)                17620000
                        ELSE                                            17622000
                           BEGIN                                        17624000
                              dir'adr:=good'adr;                        17626000
                              ldiradd:=good'adr;<< use in split stack >>17628000
                              search:=false;                            17630000
                           END;                                         17632000
                  END;                                                  17634000
         END UNTIL NOT(search) OR (good'adr + DBL(dirsz) )              17636000
                                  >= disc'sz;                           17638000
         IF dir'adr = 0D THEN handle'error(nospace);                    17640000
$IF X3=ON                                                               17642000
         << right now there is a restriction on addr of   >>            17644000
         << Directory - file label only allows 1 wd       >>            17646000
                                                                        17648000
         IF DBL(INT(dir'adr)) <> dir'adr THEN                           17650000
            quit(999);                                                  17652000
$IF                                                                     17654000
      END;    << mv = true >>                                           17656000
                                                                        17658000
   << now allocate space for the Descr table in the stack  >>           17660000
   << allocate #entries * entrysize (in words)             >>           17662000
                                                                        17664000
                                                                        17666000
   PUSH(s);                                                             17668000
   TOS:=TOS+1;                                                          17670000
   @descr'table:=TOS;                                                   17672000
   TOS:=descr'sz'wds;   << #wds needed    >>                            17674000
   ASSEMBLE(adds 0);                                                    17676000
                                                                        17678000
   <<   initialize  >>                                                  17680000
                                                                        17682000
   descr'table:=0;                                                      17684000
   MOVE descr'table(1):=descr'table,(descr'sz'wds-1);                   17686000
                                                                        17688000
   << now create the Descr table for the disc, initialize  >>           17690000
   << the Descr table to all free                          >>           17692000
                                                                        17694000
                                                                        17696000
   descr'table   (largest'space):=0;                                    17698000
   descr'table   (starting'space):=bits'per'page;                       17700000
   descr'table   (ending'space  ):=bits'per'page;                       17702000
                                   << dont do last entry >>             17704000
   MOVE descr'table(dt'entry'size):=descr'table,(num'descr'ent *        17706000
                                     dt'entry'size - dt'entry'size*2);  17708000
                                                                        17710000
   << now figure out the last page size so can fill in the  >>          17712000
   << last Descr entry by calculating page,word,bit        >>           17714000
                                                                        17716000
                                                                        17718000
   TOS:=disc'sz-1D;    << last valid addr for disc           >>         17720000
   TOS:=DBL(bits'per'page);                                             17722000
   ASSEMBLE(ddiv;     << leaves DBL(pg#),DBL(rem)           >>          17724000
            dxch;     <<        DBL(rem),DBL(pg#)           >>          17726000
            delb);    <<        DBL(rem),INT(pg#)           >>          17728000
   page:=TOS;                                                           17730000
                                                                        17732000
   << now word and bit number                               >>          17734000
                                                                        17736000
   ASSEMBLE(delb);    << convert rem to INT                 >>          17738000
   TOS:=bits'per'word;                                                  17740000
   ASSEMBLE(div);     << leaves INT(word#),INT(bit#)        >>          17742000
   bit:=TOS;                                                            17744000
   word:=TOS;                                                           17746000
                                                                        17748000
   << now that have page,word and bit, calculate how many  >>           17750000
   << sectors are actually in the last page of bit map     >>           17752000
                                                                        17754000
                                                                        17756000
   descr'table(page*dt'entry'size + largest'space):=0;                  17758000
   descr'table(page*dt'entry'size + starting'space):=                   17760000
                 word*bits'per'word + bit + 1; << #sect,not adr >>      17762000
                                                                        17764000
   << if the last page of the bit map is a full page, then  >>          17766000
   << ending'space=starting'space. Otherwise if the last    >>          17768000
   << page is a partial page, then ending'space=0           >>          17770000
                                                                        17772000
                                                                        17774000
   IF descr'table(page*dt'entry'size + starting'space) =                17776000
      bits'per'page THEN                                                17778000
      descr'table(page*dt'entry'size + ending'space):=                  17780000
                                              bits'per'page             17782000
   ELSE                                                                 17784000
      descr'table(page*dt'entry'size +ending'space):=0;                 17786000
                                                                        17788000
                                                                        17790000
   rwstat:=Write'Disc(ldev,descr'adr,0<<stack>>,descr'table,            17792000
                      descr'sz'wds);                                    17794000
   IF NOT(rwstat) THEN handle'error(rwstat);                            17796000
                                                                        17798000
   << create and write out the bit map - page by page >>                17800000
                                                                        17802000
   buffer:=empty'buffer;                                                17804000
   MOVE buffer(1):=buffer,(words'per'page-1);                           17806000
   buffer(check'sum'word):=0;  << initialize >>                         17808000
   buffer(check'sum'word):=Make'Check'Sum(buffer,                       17810000
                                          actual'words'per'page);       17812000
                                                                        17814000
   << buffer is now set-up for all the pages except for the   >>        17816000
   << last page, write out all the bit map except for the    >>         17818000
   << last one(last one may be a partial page)                >>        17820000
                                                                        17822000
   wr'adr:=bit'map'adr;                                                 17824000
   temp<<descr'entcntr>>:=1;                                            17826000
   DO BEGIN                                                             17828000
      rwstat:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,                 17830000
                         actual'words'per'page);                        17832000
      IF NOT(rwstat) THEN handle'error(rwstat);                         17834000
      wr'adr:=wr'adr + DBL(page'size);                                  17836000
   END UNTIL (temp<<descr'entcntr>>:=temp +1) >=                        17838000
                             num'descr'ent;                             17840000
                                                                        17842000
   << now use word and bit to figure out how much of the last >>        17844000
   << page is actually part of the bit map page. The rest of  >>        17846000
   << the bit map page is filled with zeroes                  >>        17848000
                                                                        17850000
                                                                        17852000
   IF descr'table(page*dt'entry'size + starting'space) =                17854000
      bits'per'page THEN                                                17856000
      BEGIN                                                             17858000
         rwstat:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,              17860000
                            actual'words'per'page);                     17862000
         IF NOT(rwstat) THEN handle'error(rwstat);                      17864000
      END                                                               17866000
   ELSE                                                                 17868000
      BEGIN                                                             17870000
         buffer:=0;                                                     17872000
         MOVE buffer(1):=buffer,(words'per'page-1);                     17874000
         IF word > 0 THEN                 << mark full wds >>           17876000
            BEGIN                                                       17878000
               buffer:=empty'buffer;                                    17880000
               MOVE buffer(1):=buffer,(word-1); <<wont do if cnt=0 >>   17882000
            END;                                                        17884000
         temp<<bitcnt>>:=0;                                             17886000
         buffer(word).(0:1):=1;                                         17888000
         WHILE (temp<<bitcnt>>:=temp + 1) <= bit DO                     17890000
               buffer(word):=buffer(word) &ASR(1);                      17892000
         buffer(check'sum'word):=0;  << initialize >>                   17894000
         buffer(check'sum'word):=Make'Check'Sum(buffer,                 17896000
                                 actual'words'per'page);                17898000
         rwstat:=Write'disc(ldev,wr'adr,0<<stack>>,buffer,              17900000
                            actual'words'per'page);                     17902000
         IF NOT(rwstat) THEN handle'error(rwstat);                      17904000
      END;          << last page full/not full >>                       17906000
                                                                        17908000
   << everything is in the initial state. Put the address of  >>        17910000
   << the Descr table and bit map in the file label, use      >>        17912000
   << passed array "vlab", this has been partially filled     >>        17914000
   << in by the calling procedure                              >>       17916000
                                                                        17918000
                                                                        17920000
   vlab(disc'lab'dirty'dt'flag):=false;                                 17922000
   vlab(disc'lab'dt'check'sum):=0;  << initialize >>                    17924000
   vlab(disc'lab'dt'check'sum):=                                        17926000
                          Make'Check'Sum(descr'table,                   17928000
                                   descr'sz'wds);                       17930000
   vlab(disc'lab'dfs'map'ok):=true;                                     17932000
   TOS:=descr'adr;                                                      17934000
   vlab(disc'lab'dt'low):=TOS;                                          17936000
   vlab(disc'lab'dt'high):=TOS;                                         17938000
   TOS:=bit'map'adr;                                                    17940000
   vlab(disc'lab'map'low):=TOS;                                         17942000
   vlab(disc'lab'map'high):=TOS;                                        17944000
   IF mv THEN                                                           17946000
      BEGIN                                                             17948000
      << put in Dirc addr(from tablespace) and dirsize(passed) >>       17950000
      vlab(disc'lab'dirbase):=LOG(dir'adr);                             17952000
   IF LOG (dirsz) > 6112 THEN                                  <<07097>>17954000
      vlab (disc'lab'dirbase) := vlab (disc'lab'dirbase) + 29; <<07097>>17956000
      vlab(disc'lab'dirsize):=dirsz;                                    17958000
   END;                                                                 17960000
   <<   write out the disc label Create'Dfs'Data'Seg   >>               17962000
   <<   expects the bit map and descr addr to be in disc label  >>      17964000
                                                                        17966000
                                                                        17968000
   rwstat:=Write'Disc'Label(ldev,0<<stack>>,vlab);                      17970000
   IF NOT(rwstat) THEN handle'error(rwstat);                            17972000
                                                                        17974000
   <<  There is now enough information in the Descr and      >>         17976000
   <<  and Bit map to use the globally defined DFSM          >>         17978000
   <<  routines. Use these routines to allocate space        >>         17980000
                                                                        17982000
   << initialize and get the DST for the DFSM                >>         17984000
   << use the DFSM routines to mark the areas for:           >>         17986000
   <<       1. 0 - 9 reserved                                >><<03527>>17988000
   <<       2. Bit Map                                       >>         17990000
   <<       3. Descriptor table                              >>         17992000
   <<       4. Directory                                     >>         17994000
   <<       5. Deleted tracks                                >>         17996000
                                                                        17998000
                                                                        18000000
   <<  initialize and get the DFSM                         >>           18002000
   <<  it also puts the DST # in the LDT                   >>           18004000
                                                                        18006000
                                                                        18008000
   << setcritical so no interrupts honored while accessing  >>          18010000
   << the DFSM                                              >>          18012000
                                                                        18014000
                                                                        18016000
   lcrit:=setcritical;                                                  18018000
   lcrit'set:=true;                                                     18020000
                                                                        18022000
   dfs'status:=Create'Dfs'Data'Seg(ldev,,                               18024000
                     false<<assume'dt'clean>>,                          18026000
                     true<<flag'dt'as'dirty>> );                        18028000
   IF NOT(dfs'status) THEN handle'error(dfs'status);                    18030000
                                                                        18032000
   <<   not really locking the DST, only really doing the  >>           18034000
   << the EXCHANGEDB to get at the DFSM DST- no one else knows >>       18036000
   << that this pv exists because the VOL Table entry hasn't   >>       18038000
   << been changed yet. This way only one routine has to be    >>       18040000
   << changed if place in LDT where DST# is changed            >>       18042000
                                                                        18044000
   dfs'status:=Lock'Dfs'Data'seg(ldev);                                 18046000
   IF NOT(dfs'status) THEN                                              18048000
      BEGIN                                                             18050000
         Delete'Dfs'Data'Seg(ldev); << get rid of DST >>                18052000
         handle'error(dfs'status);                                      18054000
      END;                                                              18056000
   ldfs'locked:=true;                                                   18058000
                                                                        18060000
   <<======= IN SPLIT STACK MODE ======= >>                             18062000
   <<= DO NOT USE ANY DB REL VARIABLES  =>>                             18064000
                                                                        18066000
   << mark reserved area as allocated >>                                18068000
   ds'disc'address:=start'resv'area;                                    18070000
   Convert'Address'To'Map;                                              18072000
   ds'number'of'sectors:=DBL(resv'area'sz);                             18074000
   Set'Reset'Bit'Map(false);                                            18076000
   IF NOT(ds'error'status)                                              18078000
      THEN handle'error(ds'error'status);                               18080000
                                                                        18082000
   <<         Bit Map                >>                                 18084000
   ds'disc'address:=bit'map'adr;                                        18086000
   Convert'Address'To'Map;                                              18088000
   ds'number'of'sectors:=DBl(bit'map'sz);                               18090000
   Set'Reset'Bit'Map(false);                                            18092000
   IF NOT(ds'error'status)                                              18094000
      THEN handle'error(ds'error'status);                               18096000
                                                                        18098000
   <<    Descriptor table            >>                                 18100000
   ds'disc'address:=descr'adr;                                          18102000
   Convert'Address'To'Map;                                              18104000
   ds'number'of'sectors:=DBL(descr'sz);                                 18106000
   Set'Reset'Bit'Map(false);                                            18108000
   IF NOT(ds'error'status)                                              18110000
      THEN handle'error(ds'error'status);                               18112000
                                                                        18114000
   <<     Directory      >>                                             18116000
   IF mv THEN                                                           18118000
      BEGIN                                                             18120000
         ds'disc'address:=ldiradd;                                      18122000
         Convert'Address'To'Map;                                        18124000
         ds'number'of'sectors:=DBL(dirsz);                              18126000
         Set'Reset'Bit'Map(false);                                      18128000
         If NOT(ds'error'status) THEN                                   18130000
            handle'error(ds'error'status);                              18132000
      END;                  << master volume >>                         18134000
                                                                        18136000
                                                                        18138000
   << run through the Defective Tracks Table looking  >>                18140000
   << for track which are deleted and are within      >>                18142000
   << the logical pack size                           >>                18144000
   << Take these entries out of the DFSM              >>                18146000
                                                                        18148000
                                                                        18150000
   IF type <> cs'80'type THEN << ok dtt may have del trks >>            18152000
   BEGIN                                                                18154000
   temp << dtt'entcntr >> :=1;                                          18156000
                                                                        18158000
   WHILE temp << dtt'entcntr >> <= dtt(dtt'number'of'entries)           18160000
   DO BEGIN                                                             18162000
      IF dtt(temp).dtt'track'code = dtt'deleted AND                     18164000
         DBL( dtt(temp).dtt'track'number ) * DBL(sectors'per'track)     18166000
         < disc'sz THEN                                                 18168000
         BEGIN                                                          18170000
            ds'disc'address:=DBL( dtt(temp).dtt'track'number )          18172000
                             * DBL( sectors'per'track );                18174000
            Convert'Address'To'Map;                                     18176000
            ds'number'of'sectors:=DBL( sectors'per'track );             18178000
            Set'Reset'Bit'Map(false);                                   18180000
            IF NOT(ds'error'status)                                     18182000
               THEN handle'error(ds'error'status);                      18184000
         END;      << deleted out of DFSM >>                            18186000
                                                                        18188000
      temp<<dtt'entcntr>> :=temp +1;                                    18190000
      END; << defective track entries >>                                18192000
                                                                        18194000
   END;   << not a cs'80 disc >>                                        18196000
                                                                        18198000
                                                                        18200000
   <<    release the DFSM Dst     >>                                    18202000
   Unlock'Dfs'Data'Seg;                                                 18204000
   ldfs'locked:=false;                                                  18206000
                                                                        18208000
   <<==== NOT IN SPLIT STACK ======>>                                   18210000
                                                                        18212000
   << all the reserved, bit map and Descriptor table space  >>          18214000
   << (and maybe                                            >>          18216000
   << Directory(if master vol) is marked                          >>    18218000
   << as allocated. THe device LDEV is still "downed". Get rid of >>    18220000
   << the DST so that when user does "up" the DST will be         >>    18222000
   << allocated and initialized. This is to keep the INIT oper-   >>    18224000
   << ation separate from a user access to the LDEV.              >>    18226000
                                                                        18228000
   <<  write out all the buffers in the DFSM DST that   >>              18230000
   <<  are marked as dirty                              >>              18232000
                                                                        18234000
                                                                        18236000
   dfs'status:=Deallocate'Dfs'Data'Seg(ldev);                           18238000
   IF NOT(dfs'status) THEN handle'error(dfs'status);                    18240000
                                                                        18242000
   << get rid of data seg and clear out DST# in LDT        >>           18244000
                                                                        18246000
   Delete'Dfs'Data'Seg(ldev);                                           18248000
                                                                        18250000
   resetcritical(lcrit);                                                18252000
   lcrit'set:=false;                                                    18254000
                                                                        18256000
$IF X3=ON                                                               18258000
   << for debug purposes print out the addresses >>                     18260000
   blank'mess;                                                          18262000
   MOVE bmess:="bit map adr=";                                          18264000
   temp:=dascii(bit'map'adr,8,bmess(12));                               18266000
   MOVE bmess(11+11+5):="size=";                                        18268000
   temp:=11+11+5+6;                                                     18270000
   temp:=ascii(bit'map'sz,8,bmess(temp));                               18272000
   print(mess,-mess'len,%40);                                           18274000
                                                                        18276000
   blank'mess;                                                          18278000
   MOVE bmess:="descr adr=";                                            18280000
   temp:=dascii(descr'adr,8,bmess(10));                                 18282000
   MOVE bmess(9+11+5):="size=";                                         18284000
   temp:=9+11+5+6;                                                      18286000
   temp:=ascii(descr'sz,8,bmess(temp));                                 18288000
   print(mess,-mess'len,%40);                                           18290000
                                                                        18292000
   IF mv THEN                                                           18294000
      BEGIN                                                             18296000
         blank'mess;                                                    18298000
         MOVE bmess:="directory adr=";                                  18300000
         temp:=dascii(dir'adr,8,bmess(14));                             18302000
         MOVE bmess(13+11+5):="size=";                                  18304000
         temp:=13+11+5+6;                                               18306000
         temp:=ascii(dirsz,8,bmess(temp));                              18308000
         print(mess,-mess'len,%40);                                     18310000
      END;                                                              18312000
$IF                                                                     18314000
                                                                        18316000
   return'status:=no'error;                                             18318000
                                                                        18320000
   END;   << initdfsm >>                                                18322000
$PAGE "   PROCEDURE PFENTRIES"                                          18324000
$CONTROL SEGMENT=PVSTATUS                                               18326000
PROCEDURE pfentries(listfn,ldev);                              <<03510>>18328000
   VALUE listfn,ldev;                                                   18330000
   INTEGER listfn,ldev;                                                 18332000
   OPTION PRIVILEGED,UNCALLABLE;                                        18334000
                                                                        18336000
BEGIN                                                                   18338000
                                                                        18340000
<<===================================================                   18342000
                                                                        18344000
   print out a listing of free space entries                            18346000
   This procedure operates part of the time                             18348000
   in split stack mode. Can control-y to                                18350000
   interrupt the printing of entries, but                               18352000
   will continue to process the DFSM so that                            18354000
   can printout the totals at the end.                                  18356000
   Will lock the DFSM DST, collect 15 entries,                          18358000
   (1/4 of a page), save the page,word,bit                              18360000
   number, then print out the entries.                                  18362000
   Note there may be a loss of entries, since                           18364000
   the DFSM DST is locked, unlocked, printed,                           18366000
   then the whole cycle starts over again                               18368000
   NOTE: err'pfentries and relock does an EXIT(2)                       18370000
         IF calling sequence changes then must                          18372000
         change this                                                    18374000
         Also if hit control-y this will do an EXIT(2)                  18376000
                                                                        18378000
   Parameters:                                                          18380000
       listfn - filenumber of the list device                           18382000
       ldev   - logical device # of the device that                     18384000
                is being printed                                        18386000
                                                                        18388000
   Returns:                                                             18390000
       nothing, handles all errors here                                 18392000
                                                                        18394000
   Assumptions:                                                         18396000
          Will honor control-y, but will only quit                      18398000
          printout in 2 subroutines and at the end                      18400000
          of pfentries when printing out totals -                       18402000
          header & print'buffer. ALL 3 places are                       18404000
          not in split stack mode and DFSM DST is                       18406000
          NOT locked. All 3 places will do an EXIT(2)                   18408000
          IF you add any fwrites then must check after                  18410000
          fwrite to see if control-y set. This is so                    18412000
          that printout wont be mangled - there is                      18414000
          an SR on the previous pfspace on mangled                      18416000
          output.                                                       18418000
                                                                        18420000
   Globals:                                                             18422000
       DFSM Dst-ds'page'ptr,ds'error'status,ds'page'number,             18424000
                ds'word'number,ds'bit'number,                           18426000
                ds'last'page'of'map,ds'starting'word'number,            18428000
                ds'starting'bit'number                                  18430000
       ldt-ldt2,ldt'vol'index                                           18432000
       vol'table-vol'ent'size,vol'ldev,scratch,unformatted              18434000
       lpdt-lpdt'entry'size,nsdf,ser'forn                               18436000
       lentry/lentrysize( Q rel) array which contains                   18438000
       15 entries- addr/size which is printed when filled               18440000
       calls procedure controly when someone hits it                    18442000
       DB rel variable req'brk - set to false when                      18444000
       enter                                                            18446000
       bad'page(flagged'bad)                                            18448000
                                                                        18450000
                                                                        18452000
   Externals:                                                           18454000
       Unlock'Dfs'Data'Seg,setcritical,resetcritical,                   18456000
       Lock'Dfs'Data'Seg,Get'Page,Scan'Page                             18458000
                                                                        18460000
   Intrinsics:                                                          18462000
        print'file'info,fwrite,debug,dascii                             18464000
        xcontrap                                                        18466000
                                                                        18468000
   Resources:                                                           18470000
        uses sys global ptr to lpdt                                     18472000
      MVTAB sir (table not actually accessed)                  ((DSF02))18474000
                                                                        18476000
   Callers:                                                             18478000
      pfspace                                                           18480000
                                                                        18482000
   Fixid:                                                               18484000
      This procedure was added as part of the new disc free space       18486000
      map.  The fixid on the procedure header applies to the whole      18488000
      procedure.                                                        18490000
                                                                        18492000
   Changes:                                                             18494000
                                                               ((DSF02))18496000
      Fix to only print free space for private volumes that    ((DSF02))18498000
      are logically mounted.  This is to keep a physical       ((DSF02))18500000
      dismount from happening while free space is being        ((DSF02))18502000
      listed.                                                  ((DSF02))18504000
                                                               ((DSF02))18506000
                                                                        18508000
      Changes to print out the number of DFSM pages on a       ((DFS01))18510000
      volume.                                                  ((DFS01  18512000
                                                               ((DFS01  18514000
====================================================>>                  18516000
                                                                        18518000
$PAGE                                                                   18520000
   INTEGER        lpage         << page # in bit map >>                 18522000
                 ,lword                                                 18524000
                 ,lbit                                                  18526000
                 ,buffcnt       << how many buffers in pg >>            18528000
                 ,charptr                                               18530000
                 ,lentryptr      << index into lentry >>                18532000
                 ,index          << dummy parm        >>                18534000
                 ,dummy                                                 18536000
                 ,sectrk       << sectors per track >>                  18538000
                 ,trkcyl       << tracks per cylinder >>                18540000
                 ,controly'dummy  << for xcontrap >>                    18542000
                 ;                                                      18544000
                                                                        18546000
   LOGICAL        proc'status   << returned from calling procs >>       18548000
                 ,more'pages                                            18550000
                 ,cantfind      << pages marked as bad  >>              18552000
                 ,cont                                                  18554000
                 ,lpg'end       << end of pg?(scan'page) >>             18556000
                 ,ldfs'locked   << dfsm dst locked       >>             18558000
                 ,lcrit'set                                             18560000
                 ,lcrit         << returned from setcritical >>         18562000
                 ,ldone          << finished w DFSM   >>                18564000
                 ,no'start'addr  << need entry addr   >>                18566000
                 ;                                                      18568000
                                                                        18570000
   DOUBLE         lsectcnt                                              18572000
                 ,laddr                                                 18574000
                 ,savsectcnt                                            18576000
                 ,savladdr                                              18578000
                 ,totentries   << total # entries >>                    18580000
                 ,totfs        << total free space >>                   18582000
                 ,max'space    << maximum fs size >>                    18584000
                 ,disc'size    << #sectors for ldev >>                  18586000
                 ;                                                      18588000
                                                                        18590000
   INTEGER bad'page'count;                                     <<03724>>18592000
                                                                        18594000
   <<  used to get the vol table, ldt entry and various >>              18596000
   <<  defs                                             >>              18598000
                                                                        18600000
   INTEGER array temp(0:15);                                            18602000
                                                                        18604000
   LOGICAL ARRAY LDT (*) = TEMP;                               <<06276>>18606000
                                                               <<06276>>18608000
   EQUATE vol'ent'size = %16;                                           18610000
   DEFINE vol'ldev = temp(%14).(0:8)#;                                  18612000
   DEFINE scratch = temp(%14).(15:1)=1#;                                18614000
   DEFINE unformatted = temp(%14).(13:1)=1#;                            18616000
                                                               <<03756>>18618000
   LOGICAL mvtab'sir'flag,                                     <<03756>>18620000
           have'mvtab'sir := FALSE;                            <<03756>>18622000
                                                               <<03756>>18624000
                                                                        18626000
   << used in creating the printout  >>                                 18628000
                                                                        18630000
   EQUATE         max'buff'per'page   = 4;                              18632000
   EQUATE         max'lentry          = 15;                             18634000
   EQUATE         entries'per'line    = 3;                              18636000
   EQUATE         left'just           = 8;                              18638000
   EQUATE         max'field'size      = 9;                              18640000
                                                                        18642000
   DOUBLE ARRAY lentry(0:max'lentry-1) = Q;                             18644000
   DOUBLE ARRAY lentrysize(0:max'lentry-1) = Q;                         18646000
                                                                        18648000
                                                                        18650000
   EQUATE         p'buffer'len = 72;                                    18652000
                                                                        18654000
   LOGICAL ARRAY lp'buffer(0:p'buffer'len/2 -1 );                       18656000
   BYTE ARRAY    p'buffer(*)=lp'buffer;                                 18658000
                                                                        18660000
   DEFINE blank'buffer = p'buffer:=" ";                                 18662000
                         MOVE p'buffer(1):=p'buffer,                    18664000
                                             (p'buffer'len-1)#;         18666000
                                                                        18668000
                                                                        18670000
   << Page descriptor entry flagged as no good page? >>                 18672000
                                                                        18674000
   DEFINE  flagged'bad = ds'descriptor'table( (lpage *                  18676000
                         dt'entry'size)+ largest'space )= bad'page#;    18678000
                                                                        18680000
   << error in creating the print file ? >>                             18682000
                                                                        18684000
   EQUATE write'error = %01;  << for err'pfentries >>                   18686000
                                                                        18688000
   << this is used to exit procedure from subroutine >>                 18690000
                                                                        18692000
   DEFINE exit'procedure = ASSEMBLE(exit 2)#;                           18694000
                                                                        18696000
   << this is for all the exits because control-y    >>                 18698000
   << was hit and must exit the procedure            >>                 18700000
                                                                        18702000
   DEFINE controlygetout = IF req'brk THEN                              18704000
                              BEGIN                                     18706000
                                 space(1);                              18708000
                                 exit'procedure;                        18710000
                              END#;                                     18712000
$PAGE "   SUBROUTINES FOR PFENTRIES"                                    18714000
   SUBROUTINE forget'it;                                       <<03510>>18716000
   BEGIN                                                                18718000
<<===========================                                           18720000
                                                                        18722000
          it's a disc, but not one which has a DFSM                     18724000
                                                                        18726000
   Assumptions:                                                         18728000
         will print out a message and then will EXIT.                   18730000
         IF calling sequence changes, this must change.                 18732000
                                                                        18734000
   Intrinsics:                                                          18736000
        fwrite,ascii                                                    18738000
                                                                        18740000
   Changes:                                                             18742000
                                                                        18744000
===========================>>                                           18746000
                                                                        18748000
      blank'buffer;                                                     18750000
                                                                        18752000
      MOVE p'buffer:="LDEV ";                                           18754000
      dummy:=ascii(ldev,10,p'buffer(5));                                18756000
      dummy:=dummy<<ldev>> + 5<<"LDEV">> + 1<<sp>>;                     18758000
      MOVE p'buffer(dummy):=                                            18760000
        "not mounted or has no DFSM ";                                  18762000
      fwrite(listfn,lp'buffer,-p'buffer'len,%40);                       18764000
                                                                        18766000
      exit'procedure;                                                   18768000
                                                                        18770000
   END;  << forget'it >>                                                18772000
                                                                        18774000
                                                                        18776000
                                                                        18778000
   SUBROUTINE err'pfentries(err);                              <<03510>>18780000
      VALUE err;                                                        18782000
      INTEGER err;                                                      18784000
                                                                        18786000
   BEGIN                                                                18788000
                                                                        18790000
<<===========================                                           18792000
                                                                        18794000
          error routine - exits from whole procedure                    18796000
                                                                        18798000
   Parameters:                                                          18800000
         err - error status in "DFSM" format                            18802000
               NOTE: this procedure takes liberties                     18804000
               w status word. %01 Always means that                     18806000
               ok status, so if comes here w %01                        18808000
               its an I/O error on listfn                               18810000
                                                                        18812000
   Assumptions:                                                         18814000
         NOTE that this routine exits from procedure                    18816000
         with an EXIT. IF  calling sequence changes                     18818000
         this must change.                                              18820000
                                                                        18822000
                                                                        18824000
   Externals:                                                           18826000
        Unlock'Dfs'Data'Seg,resetcritical                               18828000
                                                                        18830000
   Intrinsics:                                                          18832000
         print'file'info,fwrite,ascii,debug                             18834000
                                                                        18836000
   Changes:                                                             18838000
                                                                        18840000
===========================>>                                           18842000
                                                                        18844000
      IF ldfs'locked THEN Unlock'Dfs'Data'Seg;                          18846000
      IF lcrit'set THEN                                                 18848000
         BEGIN                                                          18850000
         resetcritical(lcrit);                                          18852000
         lcrit'set:=false;                                              18854000
      END;                                                              18856000
                                                               <<03756>>18858000
      IF have'mvtab'sir THEN                                   <<03756>>18860000
         BEGIN  << Release MVTAB sir >>                        <<03756>>18862000
            Relsir (mvtabsir, mvtab'sir'flag);                 <<03756>>18864000
            have'mvtab'sir := FALSE;                           <<03756>>18866000
         END;   << Release MVTAB sir >>                        <<03756>>18868000
                                                               <<03756>>18870000
                                                                        18872000
      IF err = write'error THEN print'file'info(listfn)                 18874000
      ELSE                                                              18876000
         BEGIN                                                          18878000
            blank'buffer;                                               18880000
            MOVE p'buffer:="ERROR STATUS=";                             18882000
            dummy:=ascii(err,8,p'buffer(13));                           18884000
            MOVE p'buffer(22):="REL ADR=";                              18886000
            index<<dummy>> :=s0;  << address >>                         18888000
            dummy:=ascii(index,8,p'buffer(30));                         18890000
            fwrite(listfn,lp'buffer,-p'buffer'len,%40);                 18892000
         END;                                                           18894000
                                                                        18896000
$IF X3=ON                                                               18898000
          debug;                                                        18900000
$IF                                                                     18902000
                                                                        18904000
      exit'procedure;                                                   18906000
                                                                        18908000
                                                                        18910000
                                                                        18912000
   END;   << err'pfentries >>                                           18914000
$PAGE                                                                   18916000
                                                                        18918000
   SUBROUTINE unlock;                                          <<03510>>18920000
                                                                        18922000
   BEGIN                                                                18924000
                                                                        18926000
<<===========================                                           18928000
                                                                        18930000
   Assumptions:                                                         18932000
        in split stack mode when enter, DB reset when                   18934000
        leave this subroutine                                           18936000
                                                                        18938000
   Globals:                                                             18940000
       DFSM DST-ds'word'number,ds'bit'number                            18942000
                                                                        18944000
   Externals:                                                           18946000
         Unlock'Dfs'Data'Seg,resetcritical                              18948000
                                                                        18950000
   Changes:                                                             18952000
                                                                        18954000
===========================>>                                           18956000
                                                                        18958000
   lword:=ds'word'number;                                               18960000
   lbit:=ds'bit'number;                                                 18962000
   Unlock'Dfs'Data'Seg;                                                 18964000
   resetcritical(lcrit);                                                18966000
   ldfs'locked:=false;                                                  18968000
   lcrit'set:=false;                                                    18970000
                                                                        18972000
   END;   << unlock >>                                                  18974000
                                                                        18976000
                                                                        18978000
                                                                        18980000
   SUBROUTINE relock;                                          <<03510>>18982000
                                                                        18984000
   BEGIN                                                                18986000
                                                                        18988000
<<===========================                                           18990000
                                                                        18992000
         get back into split stack mode and get DFSM                    18994000
                                                                        18996000
   Assumptions:                                                         18998000
        DB at stack, will reset DB back to DFSM if can                  19000000
        NOTE: if cant get DFSM dst then will do an                      19002000
              EXIT 2 . IF calling sequence changes, the                 19004000
              this must change.                                         19006000
                                                                        19008000
   Globals:                                                             19010000
       DFSM DST-ds'page'ptr,ds'page'number,ds'bit'number                19012000
                                                                        19014000
   Intrinsics:                                                          19016000
        Lock'Dfs'Data'Seg,resetcritical                                 19018000
                                                                        19020000
   Changes:                                                             19022000
                                                                        19024000
===========================>>                                           19026000
                                                                        19028000
                                                                        19030000
   lcrit:=setcritical;                                                  19032000
   lcrit'set:=true;                                                     19034000
                                                                        19036000
   proc'status:=Lock'Dfs'Data'Seg(ldev);                                19038000
   IF NOT(proc'status) THEN                                             19040000
      BEGIN   << when finished printing alloc disab >>                  19042000
         resetcritical(lcrit);                                          19044000
         lcrit'set:=false;                                              19046000
         blank'buffer;                                                  19048000
         MOVE p'buffer:=                                                19050000
         "Allocation has been disabled on LDEV";                        19052000
         dummy:=ascii(ldev,10,p'buffer(37));                            19054000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19056000
         IF <> THEN err'pfentries(write'error);                         19058000
                                                                        19060000
         << now return cuz only looking at one entry >>                 19062000
                                                                        19064000
         exit'procedure;                                                19066000
                                                                        19068000
      END;                                                              19070000
   ldfs'locked:=true;                                                   19072000
                                                                        19074000
   @ds'page'ptr:=Get'Page(lpage);                                       19076000
   IF NOT(ds'error'status) THEN err'pfentries(ds'error'status);         19078000
                                                                        19080000
   ds'page'number:=lpage;                                               19082000
   ds'word'number:=lword;                                               19084000
   ds'bit'number:=lbit;                                                 19086000
                                                                        19088000
   END;   << relock >>                                                  19090000
                                                                        19092000
                                                                        19094000
                                                                        19096000
$PAGE                                                                   19098000
   SUBROUTINE header;                                          <<03510>>19100000
                                                                        19102000
   BEGIN                                                                19104000
                                                                        19106000
<<===========================                                           19108000
                                                                        19110000
   prints out heading at top of page                                    19112000
                                                                        19114000
   Assumptions:                                                         19116000
      DB at stack when called                                           19118000
      will see if user hit control-y and will exit from                 19120000
      procedure                                                         19122000
                                                                        19124000
   Intrinsics:                                                          19126000
     fwrite                                                             19128000
                                                                        19130000
   Changes:                                                             19132000
                                                                        19134000
===========================>>                                           19136000
                                                                        19138000
   << user wants to quit printout ? >>                                  19140000
                                                                        19142000
      controlygetout;                                                   19144000
                                                                        19146000
      blank'buffer;                                                     19148000
      MOVE p'buffer:=" ADDRESS      SIZE  ";                            19150000
      MOVE p'buffer(25):=p'buffer,(p'buffer'len-25);                    19152000
      fwrite(listfn,lp'buffer,-p'buffer'len,%40);                       19154000
      IF <> THEN err'pfentries(write'error);                            19156000
      controlygetout;                                                   19158000
      blank'buffer;                                                     19160000
      MOVE p'buffer:=" _______      ____";                              19162000
      MOVE p'buffer(25):=p'buffer,(p'buffer'len-25);                    19164000
      fwrite(listfn,lp'buffer,-p'buffer'len,%40);                       19166000
      IF <> THEN err'pfentries(write'error);                            19168000
      controlygetout;                                                   19170000
      space(1);                                                         19172000
      controlygetout;                                                   19174000
                                                                        19176000
   END;  << header >>                                                   19178000
                                                                        19180000
                                                                        19182000
                                                                        19184000
   SUBROUTINE print'buffer;                                    <<03510>>19186000
                                                                        19188000
   BEGIN                                                                19190000
                                                                        19192000
<<===========================                                           19194000
                                                                        19196000
      print out the entries which are in lentry/lentrysize              19198000
                                                                        19200000
   Assumptions:                                                         19202000
      DB at stack, may or maynot have a full buffer                     19204000
      to print out                                                      19206000
      will see if user hit control-y and will exit                      19208000
      from procedure                                                    19210000
                                                                        19212000
   Intrinsics:                                                          19214000
      dascii,fwrite                                                     19216000
                                                                        19218000
   Changes:                                                             19220000
                                                                        19222000
===========================>>                                           19224000
                                                                        19226000
   << user wants to quit printout ? >>                                  19228000
                                                                        19230000
   controlygetout;                                                      19232000
                                                                        19234000
   blank'buffer;                                                        19236000
                                                                        19238000
   charptr:=0;    << initialize >>                                      19240000
   index:=0;                                                            19242000
                                                                        19244000
   WHILE index < lentryptr DO                                           19246000
      BEGIN                                                             19248000
         dummy:=dascii(lentry(index),10,p'buffer(charptr));             19250000
         << left justify "addr" and "size" >>                           19252000
         IF dummy < max'field'size THEN                                 19254000
            BEGIN                                                       19256000
               MOVE p'buffer(charptr+left'just):=                       19258000
                       p'buffer(charptr+dummy-1),(-dummy);              19260000
               p'buffer(charptr):=" ";                                  19262000
               MOVE p'buffer(charptr+1):=p'buffer(charptr),             19264000
                                      (max'field'size-dummy-1);         19266000
            END;                                                        19268000
         dummy:=dascii(lentrysize(index),10,p'buffer(charptr+11));      19270000
         IF dummy < max'field'size THEN                                 19272000
            BEGIN                                                       19274000
               MOVE p'buffer(charptr+11+left'just):=                    19276000
                       p'buffer(charptr+11+dummy-1),(-dummy);           19278000
               p'buffer(charptr+11):=" ";                               19280000
               MOVE p'buffer(charptr+11 +1):=                           19282000
                    p'buffer(charptr+11),(max'field'size-dummy-1);      19284000
            END;                                                        19286000
         charptr:=charptr + 25;                                         19288000
         index:=index + 1;                                              19290000
                                                                        19292000
         IF (index MOD entries'per'line) = 0 THEN                       19294000
            BEGIN                                                       19296000
               <<   full line, print it out >>                          19298000
               fwrite(listfn,lp'buffer,-p'buffer'len,%40);              19300000
               IF <> THEN err'pfentries(write'error);                   19302000
               controlygetout;                                          19304000
               blank'buffer;                                            19306000
               charptr:=0;                                              19308000
            END;          << print a line >>                            19310000
      END;  << all done w entries in buffer >>                          19312000
                                                                        19314000
   << printing out a short buffer - may have a partially >>             19316000
   << filled line to print out                           >>             19318000
                                                                        19320000
   IF (lentryptr < max'lentry) AND                                      19322000
      ( (index MOD entries'per'line) <> 0 ) THEN                        19324000
      BEGIN                                                             19326000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19328000
         IF <> THEN err'pfentries(write'error);                         19330000
         controlygetout;                                                19332000
         charptr:=0;    << re-init >>                                   19334000
      END;                                                              19336000
                                                                        19338000
   <<  increment buffcnt( #buffers per page ) >>                        19340000
                                                                        19342000
   buffcnt:=buffcnt + 1;                                                19344000
   IF buffcnt = max'buff'per'page THEN                                  19346000
      BEGIN                                                             19348000
         space(5);                                                      19350000
         controlygetout;                                                19352000
         buffcnt:=0;                                                    19354000
      END;                                                              19356000
                                                                        19358000
   END;   << print'buffer >>                                            19360000
                                                                        19362000
$PAGE                                                                   19364000
   SUBROUTINE put'into'array;                                  <<03510>>19366000
                                                                        19368000
   BEGIN                                                                19370000
                                                                        19372000
<<===========================                                           19374000
                                                                        19376000
      puts lsectcnt/laddr into arrays lentry/lentrysize so that         19378000
      they are ready to printout                                        19380000
                                                                        19382000
   Assumptions:                                                         19384000
          DB at DFSM dst                                                19386000
                                                                        19388000
   Changes:                                                             19390000
                                                                        19392000
===========================>>                                           19394000
                                                                        19396000
      lentry(lentryptr):=laddr;                                         19398000
      lentrysize(lentryptr):=lsectcnt;                                  19400000
                                                                        19402000
   << totals for end of print out >>                                    19404000
                                                                        19406000
      totentries:=totentries +1D;                                       19408000
      totfs:=totfs+lsectcnt;                                            19410000
      IF lsectcnt > max'space THEN max'space:=lsectcnt;                 19412000
                                                                        19414000
      lentryptr:=lentryptr + 1;                                         19416000
                                                                        19418000
                                                                        19420000
      lsectcnt:=0D;    << re-initialize >>                              19422000
      laddr:=0D;                                                        19424000
                                                                        19426000
   END;  << put'into'array >>                                           19428000
                                                                        19430000
                                                                        19432000
                                                                        19434000
   SUBROUTINE output;                                          <<03510>>19436000
                                                                        19438000
   BEGIN                                                                19440000
                                                                        19442000
<<===========================                                           19444000
                                                                        19446000
         print out the full buffer                                      19448000
         when done printing, re-initialize arrays                       19450000
         lentry/lentrysize                                              19452000
                                                                        19454000
   Assumptions:                                                         19456000
       DB at DFSM DST when called                                       19458000
                                                                        19460000
   Globals:                                                             19462000
        lentry/lentrysize is re-initialized                             19464000
                                                                        19466000
   Changes:                                                             19468000
                                                                        19470000
===========================>>                                           19472000
                                                                        19474000
      unlock;                                                           19476000
      IF buffcnt = 0 THEN header;                                       19478000
      print'buffer;                                                     19480000
                                                                        19482000
      <<  zero out lentry/lentrysize  >>                                19484000
                                                                        19486000
      lentry:=0D;                                                       19488000
      MOVE lentry(1):=lentry,(max'lentry-1);                            19490000
      lentrysize:=0D;                                                   19492000
      MOVE lentrysize(1):=lentrysize,(max'lentry-1);                    19494000
      lentryptr:=0;                                                     19496000
                                                                        19498000
      relock;                                                           19500000
                                                                        19502000
   END;   << output >>                                                  19504000
                                                                        19506000
                                                                        19508000
                                                                        19510000
   DOUBLE SUBROUTINE convert'startmap'addr;                    <<03510>>19512000
                                                                        19514000
   BEGIN                                                                19516000
                                                                        19518000
<<===========================                                           19520000
                                                                        19522000
      converts a map address to a sector address                        19524000
      exactly the same as "convert'map'to'address" except               19526000
      this routine uses ds'starting'word'number and                     19528000
      ds'starting'bit'number                                            19530000
      This will return the sector address of where                      19532000
      space was found on ds'page'number                                 19534000
      Operates in split stack mode using parms from                     19536000
      DFSM DST                                                          19538000
                                                                        19540000
   Assumptions:                                                         19542000
       DB at DFSM DST                                                   19544000
                                                                        19546000
   Globals:                                                             19548000
       uses DFSM DST defs - ds'page'number,                             19550000
        ds'starting'word'number,ds'starting'bit'number                  19552000
       bits'per'page,bits'per'word                                      19554000
                                                                        19556000
   Changes:                                                             19558000
                                                                        19560000
===========================>>                                           19562000
                                                                        19564000
                                                                        19566000
   convert'startmap'addr:=( DBL(ds'page'number) * DBL(bits'per'page) )  19568000
                  + DBL( (ds'starting'word'number * bits'per'word)      19570000
                         +ds'starting'bit'number );                     19572000
                                                                        19574000
   END;  << convert'startmap'addr >>                                    19576000
                                                               <<06276>>19578000
   SUBROUTINE DEF'MOVE'FROM'DST;                               <<06276>>19580000
$PAGE  "  PROCEDURE PFENTRIES"                                          19582000
                                                                        19584000
                                                                        19586000
   << verify that ldev really has a DFSM before >>                      19588000
   << beginning                                 >>                      19590000
   << since checkdisc already verified that it  >>                      19592000
   << is a disc go to the LDT to ge the vol     >>                      19594000
   << table index                               >>                      19596000
                                                                        19598000
   MOVE'FROM'DST (@LDT, LDT'DST, LDEV * SIZE'OF'LDT'ENTRY,     <<06276>>19600000
      SIZE'OF'LDT'ENTRY);                                      <<06276>>19602000
                                                               <<06276>>19604000
   MOVE'FROM'DST (@TEMP, VOL'TABLE'DST,                        <<06276>>19606000
      LDT'VOLUME'TBL'INDEX * VOL'ENT'SIZE, VOL'ENT'SIZE);      <<06276>>19608000
                                                                        19610000
   IF vol'ldev <> 0 AND scratch OR unformatted                          19612000
      THEN  forget'it;                                                  19614000
                                                                        19616000
   << a deleted vol ? - wd 0 of vol ent = 0 >>                          19618000
                                                                        19620000
   IF temp = 0 THEN   forget'it;                                        19622000
                                                                        19624000
   << is it foreign or serial ? >>                                      19626000
                                                                        19628000
   IF LPDT'NON'SYS'DOMAIN AND LPDT'RDY'SER'FRN'DISC THEN       <<06276>>19630000
      FORGET'IT;                                               <<06276>>19632000
                                                               <<06276>>19634000
                                                               <<06276>>19636000
                                                                        19638000
                                                                        19640000
   << initialize the DB rel flag before going into >>                   19642000
   << split stack mode                             >>                   19644000
                                                                        19646000
   req'brk:=false;                                                      19648000
                                                                        19650000
   << arm control-y trap >>                                             19652000
                                                                        19654000
   xcontrap(@controly,controly'dummy);                                  19656000
                                                                        19658000
   << initialize some counters >>                                       19660000
                                                                        19662000
   totentries:=0D;                                                      19664000
   totfs:=0D;                                                           19666000
   max'space:=0D;                                                       19668000
      bad'page'count := 0;                                     <<03724>>19670000
                                                                        19672000
   lentry:=0D;                                                          19674000
   MOVE lentry(1):=lentry,(max'lentry-1);                               19676000
   lentrysize:=0D;                                                      19678000
   MOVE lentrysize(1):=lentrysize,(max'lentry-1);                       19680000
                                                                        19682000
   lcrit'set:=false;                                                    19684000
   lcrit:=setcritical;                                                  19686000
   lcrit'set:=true;                                                     19688000
                                                                        19690000
        << print out "LDEV: n"  >>                                      19692000
                                                                        19694000
   blank'buffer;                                                        19696000
   MOVE p'buffer:="LDEV: ";                                             19698000
   dummy:=ascii(ldev,10,p'buffer(5));                                   19700000
   fwrite(listfn,lp'buffer,-20,%40);                                    19702000
   IF <> THEN err'pfentries(write'error);                               19704000
                                                                        19706000
   << If the LDEV is a PV, then it must be logically >>        <<03756>>19708000
   << mounted to list the free space (so it can not  >>        <<03756>>19710000
   << be physically dismounted under us).  If it is  >>        <<03756>>19712000
   << logically mounted we hold the MVTAB sir until  >>        <<03756>>19714000
   << listing of free space is complete to prevent   >>        <<03756>>19716000
   << a dismount.                                    >>        <<03756>>19718000
                                                               <<03756>>19720000
   IF LPDT'NON'SYS'DOMAIN THEN                                 <<06276>>19722000
      BEGIN  << Its a PV >>                                    <<03756>>19724000
                                                               <<03756>>19726000
         mvtab'sir'flag := Getsir (mvtabsir);                  <<03756>>19728000
         have'mvtab'sir := TRUE;                               <<03756>>19730000
         IF NOT LPDT'MOUNTED'PV THEN                           <<06276>>19732000
                                                               <<06276>>19734000
            BEGIN  << Not logically mounted >>                 <<03756>>19736000
                                                               <<03756>>19738000
               Genmsg (pvmsgset, 34);                          <<03756>>19740000
               Relsir (mvtabsir, mvtab'sir'flag);              <<03756>>19742000
               have'mvtab'sir := FALSE;                        <<03756>>19744000
                                                               <<03756>>19746000
               resetcritical (lcrit);                          <<03756>>19748000
               lcrit'set := FALSE;                             <<03756>>19750000
                                                               <<03756>>19752000
               RETURN;                                         <<03756>>19754000
                                                               <<03756>>19756000
            END;   << Not logically mounted >>                 <<03756>>19758000
                                                               <<03756>>19760000
      END;   << Its a PV >>                                    <<03756>>19762000
                                                               <<03756>>19764000
   << lock the DFSM DST and go into split stack mode >>                 19766000
                                                                        19768000
   proc'status:=Lock'Dfs'Data'Seg(ldev);                                19770000
   IF NOT(proc'status) THEN                                             19772000
      BEGIN                                                             19774000
                                                               <<03756>>19776000
         IF have'mvtab'sir THEN                                <<03756>>19778000
            BEGIN  << Release MVTAB sir >>                     <<03756>>19780000
               Relsir (mvtabsir, mvtab'sir'flag);              <<03756>>19782000
               have'mvtab'sir := FALSE;                        <<03756>>19784000
            END;   << Release MVTAB sir >>                     <<03756>>19786000
                                                               <<03756>>19788000
         resetcritical(lcrit);                                          19790000
         lcrit'set:=false;                                              19792000
         MOVE p'buffer:=                                                19794000
         "Allocation has been disabled on LDEV";                        19796000
         dummy:=ascii(ldev,10,p'buffer(37));                            19798000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19800000
         IF <> THEN err'pfentries(write'error);                         19802000
                                                                        19804000
         << now return since there is nothing to print >>               19806000
                                                                        19808000
         RETURN;                                                        19810000
      END;                                                              19812000
   ldfs'locked:=true;                                                   19814000
                                                                        19816000
   << ** in split stack mode  ** >>                                     19818000
                                                                        19820000
   << find the first page which doesnt have the Descriptor >>           19822000
   << entry marked as bad                                   >>          19824000
                                                                        19826000
   lpage:=0;                                                            19828000
   cantfind:=false;                                                     19830000
   cont:=true;                                                          19832000
                                                                        19834000
   WHILE cont DO                                                        19836000
      BEGIN                                                             19838000
         IF flagged'bad THEN                                            19840000
            BEGIN                                                       19842000
               lpage:=lpage+1;                                          19844000
               bad'page'count := bad'page'count + 1;           <<03724>>19846000
               IF lpage > ds'last'page'of'map THEN                      19848000
                  BEGIN                                                 19850000
                     cantfind:=true;                                    19852000
                     cont:=false;                                       19854000
                  END;                                                  19856000
            END                                                         19858000
         ELSE     cont:=false;                                          19860000
      END;                                                              19862000
                                                                        19864000
   IF cantfind THEN                                                     19866000
      BEGIN                                                             19868000
         Unlock'Dfs'Data'Seg;                                           19870000
         ldfs'locked:=false;                                            19872000
         resetcritical(lcrit);                                          19874000
         lcrit'set:=false;                                              19876000
                                                               <<03756>>19878000
         IF have'mvtab'sir THEN                                <<03756>>19880000
            BEGIN  << Release MVTAB sir >>                     <<03756>>19882000
               Relsir (mvtabsir, mvtab'sir'flag);              <<03756>>19884000
               have'mvtab'sir := FALSE;                        <<03756>>19886000
            END;   << Release MVTAB sir >>                     <<03756>>19888000
                                                               <<03756>>19890000
                                                                        19892000
         << print out a message saying bad DFSM >>                      19894000
                                                                        19896000
         blank'buffer;                                                  19898000
         MOVE p'buffer:="LDEV ";                                        19900000
         dummy:=ascii(ldev,10,p'buffer(5));                             19902000
         dummy:=dummy<<ldev>> + 1<<sp>> + 5<<"LDEV">>;                  19904000
         MOVE p'buffer(dummy):="has bad DFSM ";                         19906000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19908000
         IF <> THEN err'pfentries(write'error);                         19910000
                                                                        19912000
         << now return since there is nothing to print >>               19914000
                                                                        19916000
         RETURN;                                                        19918000
      END;                                                              19920000
                                                                        19922000
   @ds'page'ptr:=Get'Page(lpage);                                       19924000
   IF NOT(ds'error'status) THEN err'pfentries(ds'error'status);         19926000
                                                                        19928000
   ds'page'number:=lpage;                                               19930000
   ds'word'number:=0;   << initialize to start a beg of page >>         19932000
   ds'bit'number:=0;                                                    19934000
   lsectcnt:=0D;                                                        19936000
   ldone:=false;                                                        19938000
   laddr:=0D;                                                           19940000
   no'start'addr:=true;                                                 19942000
                                                                        19944000
   << initialize some cntrs for the print out >>                        19946000
                                                                        19948000
   buffcnt:=0;                                                          19950000
   lentryptr:=0;                                                        19952000
                                                                        19954000
      << while looking at the pages have to worry about >>              19956000
      << encountering a bad page, if space really does  >>              19958000
      << span pages                                     >>              19960000
                                                                        19962000
      DO BEGIN                                                          19964000
         lpg'end:=Scan'Page;                                            19966000
         << either found space here & none on prev pg; space >>         19968000
         << on prev pg none here; or both                    >>         19970000
         IF lsectcnt = 0D AND ds'bit'count = 0 THEN                     19972000
            GO TO next'ent;    << didnt find anything >>                19974000
                                                                        19976000
         IF no'start'addr THEN                                          19978000
            BEGIN                                                       19980000
               laddr:=convert'startmap'addr;                            19982000
               no'start'addr:=false;                                    19984000
            END;                                                        19986000
                                                                        19988000
         IF lpg'end THEN       << at end of a page    >>                19990000
            BEGIN                                                       19992000
               IF lpage = ds'last'page'of'map  << last pg & at end >>   19994000
                  THEN BEGIN                                            19996000
                     <<     last pg     >>                              19998000
                     lsectcnt:=lsectcnt + DBL(ds'bit'count);            20000000
                     put'into'array;                                    20002000
                     IF lentryptr = max'lentry THEN output;             20004000
                     no'start'addr:=true;                               20006000
                  END                                                   20008000
               ELSE             << not last pg >>                       20010000
                  BEGIN                                                 20012000
                     IF ds'bit'count = 0 THEN                           20014000
                        BEGIN                                           20016000
                           << space from prev pg & none here >>         20018000
                           put'into'array;                              20020000
                           IF lentryptr = max'lentry THEN output;       20022000
                           no'start'addr:=true;                         20024000
                        END                                             20026000
                     ELSE    << maybe more contg sp on next pg >>       20028000
                        lsectcnt:=lsectcnt + DBL(ds'bit'count);         20030000
               END;           << lpage = ds'last'page'of'map >>         20032000
            END               << lpg'end = true      >>                 20034000
                                                                        20036000
                                                                        20038000
         ELSE                                                           20040000
            BEGIN             << space somewhere in middle of pg >>     20042000
               IF lsectcnt = 0D THEN                                    20044000
                  BEGIN                                                 20046000
                     << found space in middle >>                        20048000
                     lsectcnt:=DBL(ds'bit'count);                       20050000
                     put'into'array;                                    20052000
                     IF lentryptr = max'lentry THEN output;             20054000
                     no'start'addr:=true;                               20056000
                  END                                                   20058000
               ELSE            << lsectcnt <> 0 >>                      20060000
                  BEGIN                                                 20062000
                     IF ds'starting'word'number = 0 AND                 20064000
                        ds'starting'bit'number  = 0                     20066000
                        THEN BEGIN                                      20068000
                           << sp on prev pg and at front current >>     20070000
                           << but havent hit the end of the page >>     20072000
                           lsectcnt:=lsectcnt + DBL(ds'bit'count);      20074000
                           put'into'array;                              20076000
                           IF lentryptr = max'lentry THEN output;       20078000
                           no'start'addr:=true;                         20080000
                        END                                             20082000
                     ELSE                                               20084000
                        BEGIN                                           20086000
                           << had sp on prev pg, none in front >>       20088000
                           << but found some somewhere in pg   >>       20090000
                           << save the addr/size of space found>>       20092000
                           << because may have to unlock the   >>       20094000
                           << DFSM to print                    >>       20096000
                                                                        20098000
                           savsectcnt:=DBL(ds'bit'count);               20100000
                           savladdr:=convert'startmap'addr;             20102000
                           put'into'array;                              20104000
                           IF lentryptr = max'lentry THEN output;       20106000
                           lsectcnt:=savsectcnt;                        20108000
                           laddr:=savladdr;                             20110000
                           put'into'array;                              20112000
                           IF lentryptr = max'lentry THEN output;       20114000
                           no'start'addr:=true;                         20116000
                     END;      << ds'starting'word... >>                20118000
                                                                        20120000
               END;            << lsectcnt = AND <> 0 >>                20122000
            END;               << lpg'end  T AND F    >>                20124000
next'ent:                                                               20126000
                << didnt find anything from "Scan'Page" >>              20128000
                                                                        20130000
         << see if have to swap pages; find the next good page          20132000
            if the next page is marked as bad in the Descriptor         20134000
            table, then any space that is in lsectcnt must be           20136000
            put into space'info since there will be no contiguous       20138000
            space across pages                                          20140000
         >>                                                             20142000
         IF lpg'end THEN                                                20144000
            BEGIN                                                       20146000
               IF lpage = ds'last'page'of'map THEN ldone:=true          20148000
               ELSE                                                     20150000
                  BEGIN                                                 20152000
                     ldone:=false;   << more pages to go >>             20154000
                     lpage:=lpage+1;                                    20156000
                     cantfind:=true;                                    20158000
                     DO BEGIN  << find pg w good Descr entry >>         20160000
                        IF flagged'bad THEN                             20162000
                           BEGIN                                        20164000
                              IF lsectcnt <> 0D THEN                    20166000
                                 BEGIN                                  20168000
                                    put'into'array;                     20170000
                                    IF lentryptr = max'lentry THEN      20172000
                                       output;                          20174000
                                    no'start'addr:=true;                20176000
                                 END;                                   20178000
                              lpage:=lpage+1;                           20180000
                              bad'page'count :=                <<03724>>20182000
                                       bad'page'count + 1;     <<03724>>20184000
                           END                                          20186000
                        ELSE                                            20188000
                           BEGIN                                        20190000
                              @ds'page'ptr:=get'page(lpage);            20192000
                              IF ds'error'status THEN  << good status >>20194000
                                 BEGIN                                  20196000
                                    cantfind:=false;                    20198000
                                    ds'page'number:=lpage;              20200000
                                    ds'word'number:=0; << init  >>      20202000
                                    ds'bit'number:=0;                   20204000
                                 END                                    20206000
                              ELSE   lpage:=lpage+1;                    20208000
                        END;    << flagged'bad  T F >>                  20210000
                     END UNTIL lpage > ds'last'page'of'map              20212000
                            OR NOT(cantfind);                           20214000
                     IF lpage > ds'last'page'of'map THEN ldone:=true;   20216000
                  END;    << lpage = <> last page >>                    20218000
               END;       << lpg'end  T           >>                    20220000
                                                                        20222000
      END UNTIL ldone;         << done with this disc >>                20224000
                                                                        20226000
                                                                        20228000
   Unlock'Dfs'Data'Seg;                                                 20230000
   ldfs'locked := false;                                                20232000
   resetcritical(lcrit);                                                20234000
   lcrit'set:=false;                                                    20236000
                                                               <<03756>>20238000
   IF have'mvtab'sir THEN                                      <<03756>>20240000
      BEGIN  << Release MVTAB sir >>                           <<03756>>20242000
         Relsir (mvtabsir, mvtab'sir'flag);                    <<03756>>20244000
         have'mvtab'sir := FALSE;                              <<03756>>20246000
      END;   << Release MVTAB sir >>                           <<03756>>20248000
                                                               <<03756>>20250000
                                                                        20252000
   << if anything in lentry must print it out >>                        20254000
                                                                        20256000
   IF lentryptr <> 0 THEN                                               20258000
      BEGIN                                                             20260000
         IF buffcnt = 0 THEN header;                                    20262000
         print'buffer;                                                  20264000
      END;                                                              20266000
                                                                        20268000
                                                                        20270000
   << user wants to quit printout ? >>                                  20272000
                                                                        20274000
   controlygetout;                                                      20276000
                                                                        20278000
   << Print out number of bad pages, if any >>                 <<03724>>20280000
                                                               <<03724>>20282000
   IF bad'page'count <> 0 THEN                                 <<03724>>20284000
      BEGIN  << Print bad pages >>                             <<03724>>20286000
                                                               <<03724>>20288000
         blank'buffer;                                         <<03724>>20290000
         MOVE p'buffer := "LDEV ", 2;                          <<03724>>20292000
         TOS := TOS + Ascii (ldev, 10 ,bps0);                  <<03724>>20294000
         MOVE * := " has ", 2;                                 <<03724>>20296000
         TOS := TOS + Ascii (bad'page'count, 10, bps0);        <<03724>>20298000
         MOVE * := " pages of the Disc Free Space Map ", 2;    <<03724>>20300000
         dummy := -(TOS - @p'buffer);                          <<03724>>20302000
         Fwrite (listfn, lp'buffer, dummy, 0);                 <<03724>>20304000
         IF <> THEN err'pfentries (write'error);               <<03724>>20306000
         blank'buffer;                                         <<03724>>20308000
         MOVE p'buffer := "marked as bad.  Up to ", 2;         <<03724>>20310000
         TOS := TOS + Dascii (DOUBLE (bits'per'page) *         <<03724>>20312000
                              DOUBLE (bad'page'count), 10,     <<03724>>20314000
                              bps0);                           <<03724>>20316000
         MOVE * := " sectors of disc space may be lost.", 2;   <<03724>>20318000
         dummy := -(TOS - @p'buffer);                          <<03724>>20320000
         Fwrite (listfn, lp'buffer, dummy, 0);                 <<03724>>20322000
         IF <> THEN err'pfentries (write'error);               <<03724>>20324000
                                                               <<03724>>20326000
      END;   << Print bad pages >>                             <<03724>>20328000
                                                               <<03724>>20330000
   <<  print out the end totals >>                                      20332000
                                                                        20334000
   proc'status:=Get'Disc'info(ldev,,,,,,disc'size);                     20336000
   IF NOT(proc'status) THEN err'pfentries(proc'status);                 20338000
                                                                        20340000
   blank'buffer;                                                        20342000
   MOVE p'buffer:=" NO. ENTRIES: ";                                     20344000
   dummy:=dascii(totentries,10,p'buffer(17));                           20346000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20348000
   IF <> THEN err'pfentries(write'error);                               20350000
   controlygetout;                                                      20352000
                                                                        20354000
   blank'buffer;                                                        20356000
   MOVE p'buffer:=" TOTAL VOLUME CAPACITY: ";                           20358000
   dummy:=dascii(disc'size,10,p'buffer(26));                            20360000
   index<<dummyparm>>:=dummy+27;                                        20362000
   MOVE p'buffer(index):="SECTORS";                                     20364000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20366000
   IF <> THEN err'pfentries(write'error);                               20368000
   controlygetout;                                                      20370000
                                                                        20372000
   blank'buffer;                                                        20374000
   MOVE p'buffer:=" TOTAL FREE SPACE AVAILABLE: ";                      20376000
   dummy:=dascii(totfs,10,p'buffer(29));                                20378000
   index<<dummyparm>>:=dummy+30;                                        20380000
   MOVE p'buffer(index):="SPACE";                                       20382000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20384000
   IF <> THEN err'pfentries(write'error);                               20386000
   controlygetout;                                                      20388000
                                                                        20390000
   blank'buffer;                                                        20392000
   MOVE p'buffer:=" MAXIMUM CONTIGUOUS AREA: ";                         20394000
   dummy:=dascii(max'space,10,p'buffer(26));                            20396000
   index<<dummyparm>>:=dummy+27;                                        20398000
   MOVE p'buffer(index):="SECTORS";                                     20400000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20402000
   IF <> THEN err'pfentries(write'error);                               20404000
   controlygetout;  << just to be consistant >>                         20406000
                                                                        20408000
                                                                        20410000
END;   << pfentries >>                                                  20412000
$PAGE "   PROCEDURE RECOVER'RECEIP"                                     20414000
$CONTROL SEGMENT=CONDENSE                                               20416000
INTEGER PROCEDURE recover'receip(ntry,level,parms,sirs);       <<03510>>20418000
   VALUE level,parms,sirs;                                              20420000
   INTEGER level,parms;                                                 20422000
   DOUBLE sirs;                                                         20424000
   ARRAY ntry;                                                          20426000
   OPTION PRIVILEGED,UNCALLABLE;                                        20428000
                                                                        20430000
BEGIN                                                                   20432000
                                                                        20434000
<<===================================================                   20436000
                                                                        20438000
   this routine is called with DB at Directory DST and                  20440000
   Directory sir locked                                                 20442000
      RETURNS:                                                          20444000
              cond'receip.(15:1)                                        20446000
                                 0 dirc sir not released                20448000
                                 1 dirc sir released                    20450000
              cond'receip.(13:2)                                        20452000
                                 0 continue traversal                   20454000
                                 1 skip subtrees                        20456000
                                 2 stop traversal                       20458000
                                                                        20460000
   Parameters:                                                          20462000
           ntry - pointer to dirc entry in Dirc DST                     20464000
                  (may be file,grp,acct entry)                          20466000
           level - what kind of entry "ntry" is                         20468000
           parms - pointer to DB rel array that                         20470000
                   caller of Dirc is passing here                       20472000
           sirs - sir word for Dirc sir(if you wanted                   20474000
                  to release the Dirc sir)                              20476000
                                                                        20478000
   Returns:                                                             20480000
         status flag , see intro discussion                             20482000
         if terminate scan then                                         20484000
         whattodo = -1    and                                           20486000
         msgmo has private vol msg # for caller to print out            20488000
                                                                        20490000
   Assumptions:                                                         20492000
         Assumes that DB at Dirc DST when enter and will                20494000
         be reset on exit                                               20496000
         Since in split stack mode when enter this routine              20498000
         cannot have any indirect arrays                                20500000
                                                                        20502000
   Globals:                                                             20504000
         file entry in Dirc                                             20506000
         sysdb                                                          20508000
         file label - flchecksum,flmisc,flstatus,flsrlx                 20510000
         pvmsgs - viwarn60,vierr64                                      20512000
         vinit'error                                                    20514000
                                                                        20516000
   Callers:                                                             20518000
          condense'disc(via Dirc)                                       20520000
                                                                        20522000
   Fixid:                                                               20524000
      This procedure was part of the changes for the new disc free      20526000
      space map.  The fixid on the procedure header applies to the      20528000
      whole procedure.                                                  20530000
                                                                        20532000
   Changes:                                                             20534000
                                                                        20536000
====================================================>>                  20538000
                                                                        20540000
   INTEGER         return'status       = recover'receip;                20542000
   DEFINE          sir'status          = (15:1)#;                       20544000
   EQUATE          sir'released        = 0;                             20546000
   EQUATE          sir'not'released    = 1;                             20548000
   DEFINE          dirscanstatus       =(13:2)#;                        20550000
   EQUATE          continue'traversal  = 0;                             20552000
   EQUATE          skip'subtree        = 1;                             20554000
   EQUATE          stop'traversal      = 2;                             20556000
                                                                        20558000
   INTEGER         deltaq              = Q+0;                           20560000
   ARRAY           arrq0(*)            = Q-0;                           20562000
   INTEGER ARRAY   rparms(*);                                           20564000
   ARRAY           vol'set'ldevs(*);     << vol to ldev conv table >>   20566000
   DOUBLE ARRAY    ntryd(*)            = ntry;                          20568000
                                                                        20570000
   INTEGER       numexts                                                20572000
                ,i              << temp,index >>                        20574000
                ,index          << dummy,temp,index >>                  20576000
                ,vtab'of'flab   << vol table index of flab >>           20578000
                ,flab'ldev                                              20580000
                ,mychecksum     << of file label >>                     20582000
                ,dst                                                    20584000
                  ,flaberr  <<flab error flag>>                <<03777>>20586000
                ;                                                       20588000
                                                                        20590000
   LOGICAL       discspace'status                                       20592000
                ,proc'status                                            20594000
                ;                                                       20596000
                                                                        20598000
   DOUBLE        numberofsectors                                        20600000
                ,getaddr                                                20602000
                ,flabaddr                                               20604000
                ,release'sectors                                        20606000
                ,dproc'status   << for purgethefile >>                  20608000
                ;                                                       20610000
                                                                        20612000
   INTEGER POINTER  flab;                                               20614000
   DOUBLE  POINTER  FLABDBL = FLAB;                            <<06468>>20616000
   << rparms definitions >>                                             20618000
                                                                        20620000
   DEFINE          whattodo             = rparms(0)#;                   20622000
   DEFINE          volumesetldevs       = rparms(1)#;                   20624000
   DEFINE          msgno                = rparms(2)#;                   20626000
   DEFINE          condldev             = rparms(3)#;                   20628000
   DEFINE          thisvol              = rparms(4)#;                   20630000
   DEFINE          p'mvtabx             = rparms(5)#;                   20632000
                                                                        20634000
   EQUATE   buffer'len = 36;                                            20636000
   LOGICAL POINTER buffer;                                              20638000
   BYTE POINTER bbuffer;                                                20640000
   BYTE POINTER buf'ptr;                                                20642000
                                                               <<06468>>20644000
   LOGICAL SUBROUTINE DEF'CHECKSUM;                            <<06468>>20646000
                                                               <<06468>>20648000
   SUBROUTINE DEF'PUT'FILE'NAME;                               <<06468>>20650000
                                                                        20652000
                                                                        20654000
$PAGE "SUBROUTINE PURGETHEFILE "                                        20656000
SUBROUTINE purgethefile;                                       <<03510>>20658000
BEGIN                                                                   20660000
                                                                        20662000
<<===================================================                   20664000
                                                                        20666000
   while trying to recover this file found an extent that               20668000
   was already allocated. To prevent errors we are going                20670000
   to purge the file from the Directory. When you purge                 20672000
   the file from the Directory, it decrements the group                 20674000
   and accnt space by the amount of file space, but it                  20676000
   doesn't return the extents. We dont want to return the               20678000
   the space since one extent is already bad. Will recover              20680000
   the space on other LDEVs when do recover on them                     20682000
                                                                        20684000
   Globals:                                                             20686000
        uses flab                                                       20688000
       direcpurgefile                                                   20690000
                                                                        20692000
   Changes:                                                             20694000
                                                                        20696000
====================================================>>                  20698000
                                                                        20700000
   << figure out the amount of space the file has so you  >>            20702000
   << can release the space from the Dirc grp and acct    >>            20704000
   << entry                                               >>            20706000
                                                                        20708000
   release'sectors:=0D;                                                 20710000
   index:=-1;                                                           20712000
   WHILE (index:=index+1) <= numexts DO                                 20714000
      BEGIN                                                             20716000
         IF index = numexts THEN release'sectors:=release'sectors +     20718000
                                 DBL(LOG(FLLASTEXTSIZE))       <<06468>>20720000
         ELSE                                                           20722000
            release'sectors:=release'sectors +                          20724000
                             DBL (LOG (flextsize));            <<06468>>20726000
      END;                                                              20728000
                                                                        20730000
   dproc'status:=direcpurgefile(release'sectors,                        20732000
                                index <<dummy parm >>,                  20734000
                                flacctname,                    <<06468>>20736000
                                flgrpname,                     <<06468>>20738000
                                fllocname,                     <<06468>>20740000
                                p'mvtabx                                20742000
                               );                                       20744000
                                                                        20746000
   << not checking DBL wd Dirc status because already found >>          20748000
   << the flab and no one was using it and none of the other>>          20750000
   << error returns apply to deleting a file entry          >>          20752000
                                                                        20754000
   << now generate a message to tell the user what we did   >>          20756000
                                                                        20758000
   Put'File'Name;                                              <<06468>>20760000
                                                               <<06468>>20762000
   genmsg(pvmsgset,vierr59,%0,@bbuffer);                                20764000
                                                                        20766000
END;  << purgethefile >>                                                20768000
$PAGE "PROCEDURE RECOVER'RECEIP"                                        20770000
   return'status:=0;   << clear it >>                                   20772000
                                                                        20774000
   <<   set sir'status now since never going to release it >>           20776000
                                                                        20778000
   return'status.sir'status:=sir'not'released;                          20780000
                                                                        20782000
   TOS:=ntryd(2);                                                       20784000
   vtab'of'flab:=s1.(0:8);                                              20786000
   s1.(0:8):=0;                                                         20788000
   flaberr := ntry(2).(0:1);                                   <<03777>>20790000
   flabaddr:=TOS;                                                       20792000
                                                                        20794000
   << get out of split stack mode, set back to stack >>                 20796000
                                                                        20798000
   dst:=exchangedb(0);                                                  20800000
                                                                        20802000
   << set ptr to   rparms  >>                                           20804000
                                                                        20806000
   @rparms:=@arrq0(parms-deltaq);                                       20808000
                                                                        20810000
   IF level <> filelevel THEN                                           20812000
      BEGIN                                                             20814000
         IF whattodo = -1 THEN                                          20816000
            return'status.dirscanstatus:=stop'traversal                 20818000
         ELSE                                                           20820000
            return'status.dirscanstatus:=continue'traversal;            20822000
         exchangedb(dst);                                               20824000
         RETURN;                                                        20826000
      END;                                                              20828000
                                                                        20830000
   << pick up the file label address and vol table address  >>          20832000
   << out of the Directory file entry                       >>          20834000
                                                                        20836000
   << check for bad file entries, only 2 cases I know of    >>          20838000
   <<    file label addr = %77777777                        >>          20840000
   <<                      supposedly if restoring a file   >>          20842000
   <<                      and system crashes               >>          20844000
   <<    ntry(2)           word 2 of Dirc file entry has    >>          20846000
   <<                      bit (0:1) set                    >>          20848000
   <<                      Dirc's way of marking a bad file >>          20850000
   <<                      file label (prob I/O error )     >>          20852000
                                                                        20854000
   IF flabaddr = bad'addr OR flaberr = dirc'bad'file THEN      <<03777>>20856000
      BEGIN                                                             20858000
         << file is marked as bad in dirc so dont   >>                  20860000
         << try to recover it. A user cannot access >>                  20862000
         << this file via FOPEN. Just leave in DIRC >>                  20864000
         return'status.dirscanstatus:=continue'traversal;               20866000
         exchangedb(dst);                                               20868000
         RETURN;                                                        20870000
      END;                                                              20872000
                                                                        20874000
   << allocate all the arrays >>                                        20876000
                                                                        20878000
   PUSH(s);                                                             20880000
   TOS:=TOS+1;                                                          20882000
   @flab:=TOS;                                                          20884000
   TOS:=sector'size;                                                    20886000
   ASSEMBLE(adds 0);                                                    20888000
                                                                        20890000
                                                                        20892000
   PUSH(s);                                                             20894000
   TOS:=TOS+1;                                                          20896000
   @buffer:=TOS;                                                        20898000
   TOS:=buffer'len;                                                     20900000
   ASSEMBLE(adds 0);                                                    20902000
                                                                        20904000
   @bbuffer:=(@buffer) &lsl(1);                                         20906000
                                                                        20908000
   << set up ptr to ldevs in vol set >>                                 20910000
                                                                        20912000
   @vol'set'ldevs:=volumesetldevs;                                      20914000
   << ldev of file label isn't in vol set def then          >>          20916000
   << don't look at the rest of this file label             >>          20918000
   IF (flab'ldev:=vol'set'ldevs(vtab'of'flab)) = 0 THEN                 20920000
      BEGIN                                                             20922000
         return'status.dirscanstatus:=continue'traversal;               20924000
         exchangedb(dst);                                               20926000
         RETURN;                                                        20928000
      END;                                                              20930000
                                                                        20932000
   << read in the file label for this file  >>                          20934000
                                                                        20936000
   proc'status:=Read'Disc(flab'ldev,flabaddr,0,flab,sector'size);       20938000
   IF NOT(proc'status) THEN                                             20940000
      BEGIN                                                             20942000
         << Cant read file label so cant recover. To >>                 20944000
         << prevent errors, not going to recover this>>                 20946000
         << file, mark as bad in Dirc and continue   >>                 20948000
         genmsg(pvmsgset,viwarn74,%12000,flab'ldev,                     20950000
                @flabaddr);                                             20952000
         genmsg(pvmsgset,viwarn60);                                     20954000
         return'status.dirscanstatus:=continue'traversal;               20956000
                                                                        20958000
         exchangedb(dst);                                               20960000
         ntry(2).(0:1):=dirc'bad'file;                                  20962000
         dds(dadirty).dirtyf:=1;                                        20964000
         dirwrite(a);                                                   20966000
         RETURN;                                                        20968000
      END;                                                              20970000
                                                                        20972000
   << check the checksum - another test for a good label >>             20974000
                                                                        20976000
   mychecksum := Checksumx;                                    <<06468>>20978000
   IF mychecksum <> flchecksum THEN                            <<06468>>20980000
      BEGIN                                                             20982000
      Put'File'Name;                                           <<06468>>20984000
         << now since file has checksum error dont >>                   20986000
         << recover - mark as bad in Dirc          >>                   20988000
         genmsg(pvmsgset,viwarn75,%0,@bbuffer);                         20990000
         genmsg(pvmsgset,viwarn60);                                     20992000
         return'status.dirscanstatus:=continue'traversal;               20994000
                                                                        20996000
         exchangedb(dst);                                               20998000
         ntry(2).(0:1):=dirc'bad'file;                                  21000000
         dds(dadirty).dirtyf:=1;                                        21002000
         dirwrite(a);                                                   21004000
         RETURN;                                                        21006000
      END;                                                              21008000
                                                                        21010000
   << before you began recovering, it checked to make sure >>           21012000
   << no one else is on - how did this ever happen ?       >>           21014000
   << quit recovering because its too dangerous with files >>           21016000
   << open                                                 >>           21018000
                                                                        21020000
   IF ( flstatus <> 0 OR flsrlx <> 0 ) AND                     <<06468>>21022000
      flclid = sys'cold'loadid THEN                            <<06468>>21024000
                                                               <<06468>>21026000
      BEGIN                                                             21028000
         Put'File'Name;                                        <<06468>>21030000
         genmsg(pvmsgset,vierr64,%0,@bbuffer);                          21032000
         << put in ldt so no one can allocate/deallocate >>             21034000
         Process'Dfs'Error(condldev,vinit'error,3);                     21036000
         whattodo:=-1;                                                  21038000
         msgno:=vierr0;  << abort >>                                    21040000
                                                                        21042000
         return'status.dirscanstatus:=stop'traversal;                   21044000
         exchangedb(dst);                                               21046000
         RETURN;                                                        21048000
      END;                                                              21050000
                                                                        21052000
                                                                        21054000
   << now get back all the space for the file >>                        21056000
                                                                        21058000
   numexts := flnumexts;                                       <<06468>>21060000
                                                                        21062000
   i:=-1;  << initialize >>                                             21064000
   WHILE (i:=i+1) <= numexts DO                                         21066000
      BEGIN                                                             21068000
         IF flab (flextindex + i*2 ).flvolnumf = thisvol THEN  <<06468>>21070000
            BEGIN                                                       21072000
               TOS := flabdbl (dflextindex + i);               <<06468>>21074000
               s1.(0:8):=0;                                             21076000
               getaddr:=TOS;                                            21078000
               IF i = numexts THEN                                      21080000
                  numberofsectors := DBL (LOG (fllastextsize)) <<06468>>21082000
                                                               <<06468>>21084000
               ELSE                                                     21086000
                  numberofsectors := DBL (LOG (flextsize));    <<06468>>21088000
                                                               <<06468>>21090000
                                                                        21092000
               << now go and get the space back >>                      21094000
                                                                        21096000
               discspace'status:=Get'Specific'Disc'Space(               21098000
                                    condldev,getaddr,                   21100000
                                    numberofsectors);                   21102000
               IF discspace'status <> 0 THEN                            21104000
                  BEGIN                                                 21106000
                     << space not available >>                          21108000
                     IF discspace'status = 1 THEN                       21110000
                        BEGIN                                           21112000
                           purgethefile;                                21114000
                           return'status.dirscanstatus:=                21116000
                                    continue'traversal;                 21118000
                           exchangedb(dst);                             21120000
                           RETURN;                                      21122000
                        END                                             21124000
                     ELSE                                               21126000
                        BEGIN                                           21128000
                           << couldnt alloc because of >>               21130000
                           << errors in DFSM           >>               21132000
                           whattodo:=-1;                                21134000
                           msgno:=vierr0;                               21136000
                           genmsg(pvmsgset,vierr61);                    21138000
                           return'status.dirscanstatus:=                21140000
                                       stop'traversal;                  21142000
                           exchangedb(dst);                             21144000
                           RETURN;                                      21146000
                        END;                                            21148000
                                                                        21150000
                  END;                                                  21152000
                                                                        21154000
            END;  << this vol >>                                        21156000
      END;  << run through all extents >>                               21158000
                                                                        21160000
   << now set back to Dirc >>                                           21162000
                                                                        21164000
   return'status.dirscanstatus:=continue'traversal;                     21166000
                                                                        21168000
   exchangedb(dst);                                                     21170000
                                                                        21172000
END;    << recover'receip >>                                            21174000
$PAGE "   PROCEDURE RECOVER'INIT"                                       21176000
$CONTROL SEGMENT=CONDENSE                                               21178000
LOGICAL PROCEDURE recover'init(mv,ldev);                       <<03510>>21180000
   VALUE mv,ldev;                                                       21182000
   INTEGER ldev;                                                        21184000
   LOGICAL mv;                                                          21186000
                                                                        21188000
BEGIN                                                                   21190000
                                                                        21192000
<<===================================================                   21194000
                                                                        21196000
   Before can begin  to recover must initialize the DFSM to             21198000
   all free state.  Before beginning to wipe out the disc               21200000
   make sure that the DFSM(bit map + descriptors) and Dirc              21202000
   is not in a deleted area                                             21204000
   NOTE that cond'disc already checked for any suspect trks             21206000
         in any of the vols of the vol set                              21208000
    THis is the 1st pass of recover - must be very careful              21210000
    about handling errors and letting user know what is                 21212000
    is going on so that they know what to do - we dont want             21214000
    them to reload                                                      21216000
                                                                        21218000
   Parameters:                                                          21220000
          mv - logical, if T then its the master vol                    21222000
               of vol set                                               21224000
          ldev - logical device number                                  21226000
                                                                        21228000
   Returns:                                                             21230000
          t if everything ok                                            21232000
          f if error so that caller will terminate                      21234000
                                                                        21236000
   Globals:                                                             21238000
          pvmsgs - vierr55,vierr56,vierr61,                             21240000
                   vierr62,vierr68,vierr69                              21242000
          disc label - disc'lab'dfs'map'ok,disc'lab'dirty,dt'flag,      21244000
                       disc'lab'dt'checksum                             21246000
          DFSM def - dt'entry'size,bits'per'page,bits'per'word          21248000
                     largest'space,starting'space,ending'space,         21250000
                     empty'buffer,words'per'page,ds'disc'address,       21252000
                     ds'number'of'sectors,ds'error'status               21254000
          DFSM "errors" - dt'write'error,bit'map'write'error,           21256000
                          disc'label'read'error,                        21258000
                          disc'label'write'error                        21260000
          dtt - dtt'number'of'entries,dtt'track'number                  21262000
                                                                        21264000
   Fixid:                                                               21266000
       This procedure was added as part of the disc free space map      21268000
       changes, the fixid on the procedure header applies to the        21270000
       whole procedure.                                                 21272000
                                                                        21274000
   Changes:                                                             21276000
                                                                        21278000
====================================================>>                  21280000
                                                                        21282000
                                                                        21284000
   INTEGER             bit'map'pages   << # pages(mult of sect) >>      21286000
                      ,dt'size            << in words >>                21288000
                      ,page                                             21290000
                      ,word                                             21292000
                      ,bit                                              21294000
                      ,dummy                                            21296000
                      ,sectors'per'track                                21298000
                      ,type                                             21300000
                      ,subtype                                          21302000
                      ;                                                 21304000
                                                                        21306000
   LOGICAL             proc'status                                      21308000
                      ,lcrit                                            21310000
                      ;                                                 21312000
                                                                        21314000
   DOUBLE              bit'map'address                                  21316000
                      ,bit'map'size    << in sectors >>                 21318000
                      ,dt'address                                       21320000
                      ,dt'size'sectors                                  21322000
                      ,dirbase                                          21324000
                      ,dirsize                                          21326000
                      ,disc'size                                        21328000
                      ,wr'adr                                           21330000
                      ;                                                 21332000
                                                                        21334000
   << if everything went ok, then true ELSE false >>                    21336000
   LOGICAL     return'status=recover'init;                              21338000
                                                                        21340000
   LOGICAL ARRAY       temp(0:sector'size-1);                           21342000
   LOGICAL  ARRAY buffer(0:actual'words'per'page-1);                    21344000
                                                                        21346000
   POINTER             descr'table;                                     21348000
                                                                        21350000
   << this is q direct cuz used in split stack mode >>                  21352000
   INTEGER ARRAY       dtt(0:dtt'size-1)=Q;                             21354000
                                                                        21356000
   << initialize >>                                                     21358000
                                                                        21360000
   return'status:=true;                                                 21362000
                                                                        21364000
                                                                        21366000
      << sectors per track doesnt mean anything for BFD >>              21368000
      proc'status:=Get'Disc'Info(ldev,,,dtt,type,subtype,               21370000
                                 disc'size,                             21372000
                bit'map'address,bit'map'pages,dt'address,               21374000
                dt'size,,,,sectors'per'track );                         21376000
   IF NOT(proc'status) THEN                                             21378000
      BEGIN                                                             21380000
         genmsg(pvmsgset,vierr62);                                      21382000
         return'status:=false;                                          21384000
         RETURN;                                                        21386000
      END;                                                              21388000
                                                                        21390000
   bit'map'size:=DBL(bit'map'pages)*DBL(page'size);                     21392000
   dt'size'sectors:=DBL(dt'size/sector'size);                           21394000
   IF (dt'size MOD sector'size) <> 0 THEN dt'size'sectors:=             21396000
                                    dt'size'sectors+1D;                 21398000
                                                                        21400000
   IF mv THEN     << read flab to get Directory address/size >>         21402000
      BEGIN                                                             21404000
         proc'status:=Get'Disc'Info(ldev,temp,true);                    21406000
         IF NOT(proc'status) THEN                                       21408000
            BEGIN                                                       21410000
               genmsg(pvmsgset,vierr62);                                21412000
               return'status:=false;                                    21414000
               RETURN;                                                  21416000
            END;                                                        21418000
         dirbase:=DBL( temp(disc'lab'dirbase) );                        21420000
         dirsize:=DBL( temp(disc'lab'dirsize) );                        21422000
      END;                                                              21424000
                                                                        21426000
   << check to make sure that there are no deleted trks >>              21428000
   << in the reserved area- we must put the dt'table,   >>              21430000
   << bit map, Dirc in the same place                   >>              21432000
   proc'status:=tablespace(ldev,dtt,bit'map'address,                    21434000
                           bit'map'size);                               21436000
   IF < THEN                                                            21438000
      BEGIN                                                             21440000
         genmsg(pvmsgset,vierr68);                                      21442000
         return'status:=false;                                          21444000
         RETURN;                                                        21446000
      END                                                               21448000
   ELSE                                                                 21450000
      IF > THEN                                                         21452000
         BEGIN                                                          21454000
            genmsg(pvmsgset,vierr62);                                   21456000
            return'status:=false;                                       21458000
            RETURN;                                                     21460000
         END;                                                           21462000
                                                                        21464000
   proc'status:=tablespace(ldev,dtt,dt'address,dt'size'sectors);        21466000
   IF < THEN                                                            21468000
      BEGIN                                                             21470000
         genmsg(pvmsgset,vierr68);                                      21472000
         return'status:=false;                                          21474000
         RETURN;                                                        21476000
      END                                                               21478000
   ELSE                                                                 21480000
      IF > THEN                                                         21482000
         BEGIN                                                          21484000
            genmsg(pvmsgset,vierr62);                                   21486000
            return'status:=false;                                       21488000
            RETURN;                                                     21490000
         END;                                                           21492000
                                                                        21494000
   IF mv THEN                                                           21496000
      BEGIN                                                             21498000
         proc'status:=tablespace(ldev,dtt,dirbase,dirsize);             21500000
         IF < THEN                                                      21502000
            BEGIN                                                       21504000
               genmsg(pvmsgset,vierr68);                                21506000
               return'status:=false;                                    21508000
               RETURN;                                                  21510000
            END                                                         21512000
         ELSE IF > THEN                                                 21514000
                 BEGIN                                                  21516000
                    genmsg(pvmsgset,vierr62);                           21518000
                    return'status:=false;                               21520000
                    RETURN;                                             21522000
                 END;                                                   21524000
      END;                                                              21526000
                                                                        21528000
   << now mark the word in the disc label- so that if      >>           21530000
   << anything happens before you can finish recovering -  >>           21532000
   << (system crashes), no one will be able to allocate    >>           21534000
   << on this device and can just start recover again      >>           21536000
   << NOTE if in trying to w/r any of the DFSM or          >>           21538000
   <<      disc label, just mark ldt extension as bad      >>           21540000
   <<      this way no one will be able to to allocate on  >>           21542000
   <<      this device since the state of the bit map,     >>           21544000
   <<      dt'table may be partially initialized           >>           21546000
   <<      if system does crash when system comes up it    >>           21548000
   <<      will try to read these areas and it will mark   >>           21550000
   <<      as bad, dont worry, only worry about NOW -      >>           21552000
   <<      we dont want anyone to use it                   >>           21554000
                                                                        21556000
   << if cant mark the disc label then just return         >>           21558000
   << since havent done anything yet                       >>           21560000
                                                                        21562000
   proc'status:=Read'Disc(ldev,disc'label'address,0,                    21564000
                          temp,sector'size);                            21566000
   IF NOT(proc'status) THEN                                             21568000
      BEGIN                                                             21570000
         genmsg(pvmsgset,vierr62);                                      21572000
         return'status:=false;                                          21574000
         RETURN;                                                        21576000
      END;                                                              21578000
   temp(disc'lab'dfs'map'ok):=false;                                    21580000
   proc'status:=Write'Disc'Label(ldev,0,temp);                          21582000
   IF NOT(proc'status) THEN                                             21584000
      BEGIN                                                             21586000
         genmsg(pvmsgset,vierr62);                                      21588000
         return'status:=false;                                          21590000
         RETURN;                                                        21592000
      END;                                                              21594000
                                                                        21596000
   << now everything is ok so go and mark the descriptors  >>           21598000
   << and bit map to initial state. Already have the file, >>           21600000
   << ldt,dirc sir locked up, also system logging disabled >>           21602000
   << Since disc is mounted, it already has a DFSM DST.    >>           21604000
   << OR if allocation has been disabled, maybe there is no DST. >>     21606000
   << Since you are the only one on- NO ONE should be lined>>           21608000
   << up for the DFSM DST so delete it. IF allocation is   >>           21610000
   << disabled then it will just clear the bits in the     >>           21612000
   << ldt extension. NOTE the Delete''Dfs'Data'Seg gets the>>           21614000
   << ldt sir but you already have it so its ok            >>           21616000
   << From here on, if ther is any I/O errors, leave   >>               21618000
   << the disc'lab'dfs'map'ok as false and mark the ldt    >>           21620000
   << extension as this ldev is bad. The area that     >>               21622000
   << will be reading/writting are needed area and if  >>               21624000
   << something is wrong w them then no one should     >>               21626000
   << be allocating/deallocating                       >>               21628000
                                                                        21630000
   << forget about calling Deallocate cuz going to rebuild >>           21632000
   << the DFSM                                             >>           21634000
   Delete'Dfs'Data'Seg(ldev);                                           21636000
                                                                        21638000
   << now get the descriptor buffer & initialize >>                     21640000
   PUSH(s);                                                             21642000
   TOS:=TOS+1;                                                          21644000
   @descr'table:=TOS;                                                   21646000
   TOS:=dt'size;      << in words >>                                    21648000
   ASSEMBLE(adds 0);                                                    21650000
                                                                        21652000
   << initialize the table >>                                           21654000
                                                                        21656000
   descr'table:=0;                                                      21658000
   MOVE descr'table(1):=descr'table,(dt'size-1);                        21660000
                                                                        21662000
   << now create the Descr table for the disc, initialize  >>           21664000
   << the Descr table to all free                          >>           21666000
                                                                        21668000
                                                                        21670000
   descr'table   (largest'space):=0;                                    21672000
   descr'table   (starting'space):=bits'per'page;                       21674000
   descr'table   (ending'space  ):=bits'per'page;                       21676000
                                   << dont do last entry >>             21678000
   MOVE descr'table(dt'entry'size):=descr'table,(bit'map'pages *        21680000
                                     dt'entry'size - dt'entry'size*2);  21682000
                                                                        21684000
   << now figure out the last page size so can fill in the >>           21686000
   << last Descr entry by calculating page,word,bit        >>           21688000
                                                                        21690000
                                                                        21692000
   TOS:=disc'size-1D;    << last valid addr for disc           >>       21694000
   TOS:=DBL(bits'per'page);                                             21696000
   ASSEMBLE(ddiv;     << leaves DBL(pg#),DBL(rem)           >>          21698000
            dxch;     <<        DBL(rem),DBL(pg#)           >>          21700000
            delb);    <<        DBL(rem),INT(pg#)           >>          21702000
   page:=TOS;                                                           21704000
                                                                        21706000
   << now word and bit number                               >>          21708000
                                                                        21710000
   ASSEMBLE(delb);    << convert rem to INT                 >>          21712000
   TOS:=bits'per'word;                                                  21714000
   ASSEMBLE(div);     << leaves INT(word#),INT(bit#)        >>          21716000
   bit:=TOS;                                                            21718000
   word:=TOS;                                                           21720000
                                                                        21722000
   << now that have page,word and bit, calculate how many  >>           21724000
   << sectors are actually in the last page of bit map     >>           21726000
                                                                        21728000
                                                                        21730000
   descr'table(page*dt'entry'size + largest'space):=0;                  21732000
   descr'table(page*dt'entry'size + starting'space):=                   21734000
                 word*bits'per'word + bit + 1; << #sect,not adr >>      21736000
                                                                        21738000
   << if the last page of the bit map is a full page, then  >>          21740000
   << ending'space=starting'space. Otherwise if the last    >>          21742000
   << page is a partial page, then ending'space=0           >>          21744000
                                                                        21746000
                                                                        21748000
   IF descr'table(page*dt'entry'size + starting'space) =                21750000
      bits'per'page THEN                                                21752000
      descr'table(page*dt'entry'size + ending'space):=                  21754000
                                              bits'per'page             21756000
   ELSE                                                                 21758000
      descr'table(page*dt'entry'size +ending'space):=0;                 21760000
                                                                        21762000
                                                                        21764000
   proc'status:=Write'Disc(ldev,dt'address,0<<stack>>,descr'table,      21766000
                      dt'size);                                         21768000
   IF NOT(proc'status) THEN                                             21770000
      BEGIN                                                             21772000
         genmsg(pvmsgset,vierr61);                                      21774000
         return'status:=false;                                          21776000
         proc'status.error'type:=dt'write'error;                        21778000
         Process'Dfs'Error(ldev,proc'status,[8/50,8/4]);                21780000
         RETURN;                                                        21782000
      END;                                                              21784000
                                                                        21786000
   << create and write out the bit map - page by page >>                21788000
                                                                        21790000
   buffer:=empty'buffer;                                                21792000
   MOVE buffer(1):=buffer,(words'per'page-1);                           21794000
   buffer(check'sum'word):=0;  << initialize >>                         21796000
   buffer(check'sum'word):=Make'Check'Sum(buffer,                       21798000
                                          actual'words'per'page);       21800000
                                                                        21802000
   << buffer is now set-up for all the pages except for the   >>        21804000
   << last page, write out all the bit map except for the     >>        21806000
   << last one(last one may be a partial page)                >>        21808000
                                                                        21810000
   wr'adr:=bit'map'address;                                             21812000
   dummy<<descr'entcntr>>:=1;                                           21814000
   DO BEGIN                                                             21816000
      proc'status:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,            21818000
                         actual'words'per'page);                        21820000
      IF NOT(proc'status) THEN                                          21822000
         BEGIN                                                          21824000
            genmsg(pvmsgset,vierr61);                                   21826000
            return'status:=false;                                       21828000
            proc'status.error'type:=bit'map'write'error;                21830000
            Process'Dfs'Error(ldev,proc'status,[8/51,8/4]);             21832000
         END;                                                           21834000
      wr'adr:=wr'adr + DBL(page'size);                                  21836000
   END UNTIL (dummy<<descr'entcntr>>:=dummy +1) >=                      21838000
                             bit'map'pages;                             21840000
                                                                        21842000
   << now use word and bit to figure out how much of the last  >>       21844000
   << page is actually part of the bit map page. The rest of   >>       21846000
   << the bit map page is filled with zeroes                   >>       21848000
                                                                        21850000
                                                                        21852000
   IF descr'table(page*dt'entry'size + starting'space) =                21854000
      bits'per'page THEN                                                21856000
      BEGIN                                                             21858000
         proc'status:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,         21860000
                            actual'words'per'page);                     21862000
         IF NOT(proc'status) THEN                                       21864000
            BEGIN                                                       21866000
               genmsg(pvmsgset,vierr61);                                21868000
               return'status:=false;                                    21870000
               proc'status.error'type:=bit'map'write'error;             21872000
               Process'Dfs'Error(ldev,proc'status,[8/52,8/4]);          21874000
               RETURN;                                                  21876000
            END;                                                        21878000
      END                                                               21880000
   ELSE                                                                 21882000
      BEGIN                                                             21884000
         buffer:=0;                                                     21886000
         MOVE buffer(1):=buffer,(words'per'page-1);                     21888000
         IF word > 0 THEN                 << mark full wds >>           21890000
            BEGIN                                                       21892000
               buffer:=empty'buffer;                                    21894000
               MOVE buffer(1):=buffer,(word-1); <<wont do if cnt=0 >>   21896000
            END;                                                        21898000
         dummy<<bitcnt>>:=0;                                            21900000
         buffer(word).(0:1):=1;                                         21902000
         WHILE (dummy<<bitcnt>>:=dummy + 1) <= bit DO                   21904000
               buffer(word):=buffer(word) &ASR(1);                      21906000
         buffer(check'sum'word):=0;  << initialize >>                   21908000
         buffer(check'sum'word):=Make'Check'Sum(buffer,                 21910000
                                 actual'words'per'page);                21912000
         proc'status:=Write'disc(ldev,wr'adr,0<<stack>>,buffer,         21914000
                            actual'words'per'page);                     21916000
         IF NOT(proc'status) THEN                                       21918000
            BEGIN                                                       21920000
               genmsg(pvmsgset,vierr61);                                21922000
               return'status:=false;                                    21924000
               proc'status.error'type:=bit'map'write'error;             21926000
               Process'Dfs'Error(ldev,proc'status,[8/53,8/4]);          21928000
               RETURN;                                                  21930000
            END;                                                        21932000
                                                                        21934000
      END;          << last page full/not full >>                       21936000
                                                                        21938000
   << now everything in initial state make the disc label >>            21940000
   << reflect this                                        >>            21942000
                                                                        21944000
   proc'status:=Read'Disc(ldev,disc'label'address,0,                    21946000
                          temp,sector'size);                            21948000
   IF NOT(proc'status) THEN                                             21950000
      BEGIN                                                             21952000
         genmsg(pvmsgset,vierr69);                                      21954000
         return'status:=false;                                          21956000
         proc'status.error'type:=disc'label'read'error;                 21958000
         Process'Dfs'Error(ldev,proc'status,[8/54,8/4]);                21960000
         RETURN;                                                        21962000
      END;                                                              21964000
   temp(disc'lab'dirty'dt'flag):=false;                                 21966000
   temp(disc'lab'dt'checksum):=make'check'sum(descr'table,              21968000
                                       dt'size);                        21970000
   << must set to ok or Create'Dfs'Data'Seg wont create >>              21972000
   << a DFSM DST. Will mark as "bad" later              >>              21974000
   temp(disc'lab'dfs'map'ok):=true;                                     21976000
                                                                        21978000
   proc'status:=Write'Disc'Label(ldev,0,temp);                          21980000
   IF NOT(proc'status) THEN                                             21982000
       BEGIN                                                            21984000
          genmsg(pvmsgset,vierr69);                                     21986000
          return'status:=false;                                         21988000
          proc'status.error'type:=disc'label'write'error;               21990000
          Process'Dfs'Error(ldev,proc'status,[8/55,8/4]);               21992000
          RETURN;                                                       21994000
       END;                                                             21996000
                                                                        21998000
   <<  There is now enough information in the Descr and   >>            22000000
   <<  and Bit map to use the globally defined DFSM       >>            22002000
   <<  routines. Use these routines to allocate space     >>            22004000
                                                                        22006000
   << initialize and get the DST for the DFSM             >>            22008000
   << use the DFSM routines to mark the areas for:        >>            22010000
   <<       1. 0 - 47 reserved                            >>            22012000
   <<       2. Bit Map                                    >>            22014000
   <<       3. Descriptor table                           >>            22016000
   <<       4. Directory                                  >>            22018000
   <<       5. Deleted tracks                             >>            22020000
                                                                        22022000
                                                                        22024000
   <<  initialize and get the DFSM                       >>             22026000
   <<  it also puts the DST # in the LDT                 >>             22028000
                                                                        22030000
                                                                        22032000
   << setcritical so no interrupts honored while accessing  >>          22034000
   << the DFSM                                              >>          22036000
                                                                        22038000
                                                                        22040000
   lcrit:=setcritical;                                                  22042000
   << dont forget to reset critical if error exit >>                    22044000
                                                                        22046000
   proc'status:=Create'Dfs'Data'Seg(ldev,,                              22048000
                     false<<assume'dt'clean>>,                          22050000
                     true<<flag'dt'as'dirty>> );                        22052000
   IF NOT(proc'status) THEN                                             22054000
      BEGIN                                                             22056000
         resetcritical(lcrit);                                          22058000
         IF proc'status = get'dst'error OR                              22060000
            proc'status = get'vm'error THEN                             22062000
            genmsg(pvmsgset,vierr55)                                    22064000
         ELSE genmsg(pvmsgset,vierr69);                                 22066000
         return'status:=false;                                          22068000
         Process'Dfs'Error(ldev,proc'status,[8/56,8/4]);                22070000
         << now mark the disc label disc'lab'dfs'map'ok >>              22072000
         << as false, just in case the system crashes >>                22074000
         proc'status:=Read'Disc(ldev,disc'label'address,                22076000
                                0,temp,sector'size);                    22078000
         temp(disc'lab'dfs'map'ok):=false;                              22080000
         proc'status:=Write'Disc'Label(ldev,0,temp);                    22082000
         RETURN;                                                        22084000
      END;                                                              22086000
                                                                        22088000
   << now read in the disc label again and mark  >>                     22090000
   << disc'lab'dfs'map'ok as false. This way     >>                     22092000
   << if anything happens before all the files   >>                     22094000
   << are recovered, when system comes up alloc  >>                     22096000
   << is disabled - very nice for recovery       >>                     22098000
                                                                        22100000
   proc'status:=Read'Disc(ldev,disc'label'address,                      22102000
                    0,temp,sector'size);                                22104000
   IF NOT(proc'status) THEN                                             22106000
      BEGIN                                                             22108000
         resetcritical(lcrit);                                          22110000
         genmsg(pvmsgset,vierr69);                                      22112000
         return'status:=false;                                          22114000
         Delete'Dfs'Data'Seg(ldev);                                     22116000
         proc'status.error'type:=disc'label'read'error;                 22118000
         Process'Dfs'Error(ldev,proc'status,[8/57,8/4]);                22120000
         RETURN;                                                        22122000
      END;                                                              22124000
   temp(disc'lab'dfs'map'ok):=false;                                    22126000
   proc'status:=Write'Disc'label(ldev,0,temp);                          22128000
   IF NOT(proc'status) THEN                                             22130000
      BEGIN                                                             22132000
         resetcritical(lcrit);                                          22134000
         genmsg(pvmsgset,vierr69);                                      22136000
         return'status:=false;                                          22138000
         Delete'Dfs'Data'Seg(ldev);                                     22140000
         proc'status.error'type:=disc'label'write'error;                22142000
         Process'Dfs'Error(ldev,proc'status,[8/58,8/4]);                22144000
         RETURN;                                                        22146000
      END;                                                              22148000
   <<   not really locking the DST, only really doing the      >>       22150000
   << the EXCHANGEDB to get at the DFSM DST- no one else can   >>       22152000
   << use this pv                                               >>      22154000
   << This way only one routine has to be                       >>      22156000
   << changed if place in LDT where DST# is changed             >>      22158000
                                                                        22160000
   proc'status:=Lock'Dfs'Data'seg(ldev);                                22162000
   IF NOT(proc'status) THEN                                             22164000
      BEGIN                                                             22166000
         << how could this ever happen ? >>                             22168000
         resetcritical(lcrit);                                          22170000
         genmsg(pvmsgset,vierr56);                                      22172000
         return'status:=false;                                          22174000
         Delete'Dfs'Data'Seg(ldev); << get rid of DST >>                22176000
         Process'Dfs'Error(ldev,proc'status,[8/59,8/4]);                22178000
         RETURN;                                                        22180000
      END;                                                              22182000
                                                                        22184000
   <<======= IN SPLIT STACK MODE ======= >>                             22186000
   <<= DO NOT USE ANY DB REL VARIABLES  =>>                             22188000
                                                                        22190000
   << mark reserved area as allocated >>                                22192000
   ds'disc'address:=start'resv'area;                                    22194000
   Convert'Address'To'Map;                                              22196000
   ds'number'of'sectors:=DBL(resv'area'sz);                             22198000
   Set'Reset'Bit'Map(false);                                            22200000
   IF NOT(ds'error'status) THEN                                         22202000
      BEGIN                                                             22204000
         proc'status:=ds'error'status;                                  22206000
         Unlock'Dfs'Data'Seg;                                           22208000
         genmsg(pvmsgset,vierr56);                                      22210000
         Delete'Dfs'Data'Seg(ldev);                                     22212000
         resetcritical(lcrit);                                          22214000
         return'status:=false;                                          22216000
         Process'Dfs'Error(ldev,proc'status,[8/60,8/4]);                22218000
         RETURN;                                                        22220000
      END;                                                              22222000
                                                                        22224000
   <<         Bit Map                >>                                 22226000
   ds'disc'address:=bit'map'address;                                    22228000
   Convert'Address'To'Map;                                              22230000
   ds'number'of'sectors:=bit'map'size;                                  22232000
   Set'Reset'Bit'Map(false);                                            22234000
   IF NOT(ds'error'status) THEN                                         22236000
      BEGIN                                                             22238000
         proc'status:=ds'error'status;                                  22240000
         Unlock'Dfs'Data'Seg;                                           22242000
         genmsg(pvmsgset,vierr56);                                      22244000
         Delete'Dfs'Data'Seg(ldev);                                     22246000
         resetcritical(lcrit);                                          22248000
         return'status:=false;                                          22250000
         Process'Dfs'Error(ldev,proc'status,[8/61,8/4]);                22252000
         RETURN;                                                        22254000
      END;                                                              22256000
                                                                        22258000
   <<    Descriptor table            >>                                 22260000
   ds'disc'address:=dt'address;                                         22262000
   Convert'Address'To'Map;                                              22264000
   ds'number'of'sectors:=dt'size'sectors;                               22266000
   Set'Reset'Bit'Map(false);                                            22268000
   IF NOT(ds'error'status) THEN                                         22270000
      BEGIN                                                             22272000
         proc'status:=ds'error'status;                                  22274000
         Unlock'Dfs'Data'Seg;                                           22276000
         genmsg(pvmsgset,vierr56);                                      22278000
         Delete'Dfs'Data'Seg(ldev);                                     22280000
         resetcritical(lcrit);                                          22282000
         return'status:=false;                                          22284000
         Process'Dfs'Error(ldev,proc'status,[8/62,8/4]);                22286000
         RETURN;                                                        22288000
      END;                                                              22290000
                                                                        22292000
   <<     Directory      >>                                             22294000
   IF mv THEN                                                           22296000
      BEGIN                                                             22298000
         ds'disc'address:=dirbase;                                      22300000
         Convert'Address'To'Map;                                        22302000
         ds'number'of'sectors:=dirsize;                                 22304000
         Set'Reset'Bit'Map(false);                                      22306000
         If NOT(ds'error'status) THEN                                   22308000
            BEGIN                                                       22310000
               proc'status:=ds'error'status;                            22312000
               Unlock'Dfs'Data'Seg;                                     22314000
               genmsg(pvmsgset,vierr56);                                22316000
               Delete'Dfs'Data'Seg(ldev);                               22318000
               resetcritical(lcrit);                                    22320000
               return'status:=false;                                    22322000
               Process'Dfs'Error(ldev,proc'status,[8/63,8/4]);          22324000
               RETURN;                                                  22326000
            END;                                                        22328000
      END;                  << master volume >>                         22330000
                                                                        22332000
                                                                        22334000
   << run through the Defective Tracks Table looking     >>             22336000
   << for track which are deleted and are within         >>             22338000
   << the logical pack size                              >>             22340000
   << Take these entries out of the DFSM                 >>             22342000
                                                                        22344000
                                                                        22346000
   IF type <> cs'80'type THEN  << ok dtt may have del entries >>        22348000
   BEGIN                                                                22350000
   dummy << dtt'entcntr >> :=1;                                         22352000
                                                                        22354000
   WHILE dummy << dtt'entcntr >> <= dtt(dtt'number'of'entries)          22356000
   DO BEGIN                                                             22358000
      IF dtt(dummy).dtt'track'code = dtt'deleted AND                    22360000
         DBL( dtt(dummy).dtt'track'number ) * DBL(sectors'per'track)    22362000
         < disc'size THEN                                               22364000
         BEGIN                                                          22366000
            ds'disc'address:=DBL( dtt(dummy).dtt'track'number )         22368000
                             * DBL( sectors'per'track );                22370000
            Convert'Address'To'Map;                                     22372000
            ds'number'of'sectors:=DBL( sectors'per'track );             22374000
            Set'Reset'Bit'Map(false);                                   22376000
            IF NOT(ds'error'status) THEN                                22378000
               BEGIN                                                    22380000
                  proc'status:=ds'error'status;                         22382000
                  Unlock'Dfs'Data'Seg;                                  22384000
                  genmsg(pvmsgset,vierr56);                             22386000
                  Delete'Dfs'Data'Seg(ldev);                            22388000
                  resetcritical(lcrit);                                 22390000
                  return'status:=false;                                 22392000
                  Process'Dfs'Error(ldev,proc'status,[8/64,8/4]);       22394000
                  RETURN;                                               22396000
               END;                                                     22398000
         END;      << deleted out of DFSM >>                            22400000
                                                                        22402000
      dummy<<dtt'entcntr>> :=dummy +1;                                  22404000
      END; << defective track entries >>                                22406000
                                                                        22408000
   END;   << not cs'80 >>                                               22410000
                                                                        22412000
                                                                        22414000
   <<    release the DFSM Dst     >>                                    22416000
   Unlock'Dfs'Data'Seg;                                                 22418000
                                                                        22420000
                                                                        22422000
   << now resetcritical before exit >>                                  22424000
                                                                        22426000
   resetcritical(lcrit);                                                22428000
   << now in initial state, ready to recover the files >>               22430000
                                                                        22432000
   END;    << recover'init >>                                           22434000
$PAGE "   PROCEDURE CHECKSTATUS"                                        22436000
$CONTROL SEGMENT=CONDENSE                                               22438000
LOGICAL PROCEDURE checkdfsmstatus(ldev);                       <<03510>>22440000
   VALUE ldev;                                                          22442000
   INTEGER ldev;                                                        22444000
   OPTION PRIVILEGED,UNCALLABLE;                                        22446000
                                                                        22448000
<<===================================================                   22450000
                                                                        22452000
       looks at the ldt extension to see if any error                   22454000
       for this DFSM. Return'Disc'Space doesnt return                   22456000
       any error status and we really need to know                      22458000
       must not be in split stack mode                                  22460000
                                                                        22462000
   Parameters:                                                          22464000
          ldev - logical device number                                  22466000
                                                                        22468000
   Returns:                                                             22470000
          DFSM status word which was stored in the                      22472000
          LDT extension                                                 22474000
                                                                        22476000
   Assumptions:                                                         22478000
         MUST NOT be in split stack mode !                              22480000
                                                                        22482000
   Globals:                                                             22484000
        ldt'dst,ldt'entry'size                                          22486000
                                                                        22488000
   Callers:                                                             22490000
       cond'receip                                                      22492000
                                                                        22494000
   Fixid:                                                               22496000
      This procedure was added as part of the disc free space           22498000
      map changes, the fixid on the procedure header applies to the     22500000
      whole procedure.                                                  22502000
                                                                        22504000
   Changes:                                                             22506000
                                                                        22508000
====================================================>>                  22510000
BEGIN                                                                   22512000
                                                                        22514000
                                                                        22516000
   LOGICAL ARRAY LDT (0:SIZE'OF'LDT'ENTRY-1);                  <<06276>>22518000
   LOGICAL ARRAY LDTX (0:SIZE'OF'LDTX'ENTRY-1);                <<06276>>22520000
                                                               <<06276>>22522000
   LOGICAL return'status = checkdfsmstatus;                             22524000
                                                                        22526000
                                                                        22528000
   SUBROUTINE DEF'MOVE'FROM'DST;                               <<06276>>22530000
                                                               <<06276>>22532000
                                                               <<06276>>22534000
   MOVE'FROM'DST (@LDT, LDT'DST, 0, SIZE'OF'LDT'ENTRY);        <<06276>>22536000
                                                               <<06276>>22538000
   MOVE'FROM'DST (@LDTX, LDT'DST, LDTX'BASE +                  <<06276>>22540000
      LDEV * SIZE'OF'LDTX'ENTRY, SIZE'OF'LDTX'ENTRY);          <<06276>>22542000
                                                               <<06276>>22544000
                                                                        22546000
   RETURN'STATUS := LDTX'DFS'ERR;                              <<06276>>22548000
                                                               <<06276>>22550000
                                                                        22552000
END;   << checkstatus >>                                                22554000
$PAGE "  PROCEDURE COND'RECEIP "                                        22556000
$CONTROL SEGMENT=CONDENSE                                               22558000
INTEGER PROCEDURE cond'receip(ntry,level,parms,sirs);          <<03510>>22560000
   VALUE level,parms,sirs;                                              22562000
   INTEGER level,parms;                                                 22564000
   DOUBLE sirs;                                                         22566000
   ARRAY ntry;                                                          22568000
   OPTION PRIVILEGED,UNCALLABLE;                                        22570000
                                                                        22572000
BEGIN                                                                   22574000
                                                                        22576000
<<===================================================                   22578000
                                                                        22580000
   this routine is called with DB at Directory DST and                  22582000
   Directory sir locked                                                 22584000
      RETURNS:                                                          22586000
              cond'receip.(15:1)                                        22588000
                                 0 dirc sir not released                22590000
                                 1 dirc sir released                    22592000
              cond'receip.(13:2)                                        22594000
                                 0 continue traversal                   22596000
                                 1 skip subtrees                        22598000
                                 2 stop traversal                       22600000
   If any errors from DFSM, it terminates scan and                      22602000
   aborts. Tell calling procedure by whattodo =-1                       22604000
                                                                        22606000
   Parameters:                                                          22608000
        ntry - pointer to Dirc entry in Dirc DST                        22610000
               (may be file,grp or acct entry)                          22612000
        level - what kind of Dirc entry ntry is                         22614000
        parms - DB rel ptr to array that caller passed                  22616000
                to Dirc routine                                         22618000
        sirs - if want to release the Dirc sir, use this                22620000
               to pass to relsir                                        22622000
                                                                        22624000
   Returns:                                                             22626000
        see intro for format of return word                             22628000
        If any error and must terminate                                 22630000
              whattodo = -1                                             22632000
              msgno    = private vol msg no. for caller                 22634000
                         to print out                                   22636000
                                                                        22638000
   Assumptions:                                                         22640000
           NOTE: this routine is called in split stack mode             22642000
                 therefore no indirect arrays                           22644000
          DB is set to Dirc on entry and will be reset on               22646000
          exit. Dirc sir will NOT be released.                          22648000
                                                                        22650000
   Globals:                                                             22652000
       flab def - flchecksum,flmisc,flstatus,flsrlx,                    22654000
                  flcoldloadid,flsect'numext,                           22656000
                  flnumexts,flvolnum,flastext,flext,                    22658000
                  dflext                                                22660000
       file entry in Directory                                          22662000
       sysdb                                                            22664000
       pverrmsg - viwarn74,viwarn75,vierr77,                            22666000
                  viwarn78,vierr81,vierr82                              22668000
                                                                        22670000
   Callers:                                                             22672000
       Directory who was called by cond                                 22674000
                                                                        22676000
   Fixid:                                                               22678000
      This procedure was added as part of the new disc free space       22680000
      map, the fixid on the procedure header applies to the             22682000
      whole procedure.                                                  22684000
                                                                        22686000
   Changes:                                                             22688000
                                                                        22690000
====================================================>>                  22692000
                                                                        22694000
   INTEGER         return'status       = cond'receip;                   22696000
   DEFINE          sir'status          = (15:1)#;                       22698000
   EQUATE          sir'released        = 0;                             22700000
   EQUATE          sir'not'released    = 1;                             22702000
   DEFINE          dirscanstatus       =(13:2)#;                        22704000
   EQUATE          continue'traversal  = 0;                             22706000
   EQUATE          skip'subtree        = 1;                             22708000
   EQUATE          stop'traversal      = 2;                             22710000
                                                                        22712000
   INTEGER         deltaq              = Q+0;                           22714000
   ARRAY           arrq0(*)            = Q-0;                           22716000
   INTEGER ARRAY   rparms(*);                                           22718000
   ARRAY           vol'set'ldevs(*);     << vol to ldev conv table >>   22720000
   DOUBLE ARRAY    ntryd(*)            = ntry;                          22722000
   DEFINE          glinkage            = integer(ntry (%30))#; <<03777>>22724000
                                                                        22726000
   INTEGER         vtab'of'flab                                         22728000
                  ,flab'ldev                                            22730000
                  ,mychecksum                                           22732000
                  ,dst                                                  22734000
                  ,i                    << index >>                     22736000
                  ,discspace'status                                     22738000
                  ,numexts           << # exts-1 >>                     22740000
                  ,trans'status      << when r/w exts,what >>           22742000
                                     << to do if error     >>           22744000
                  ,trans'words       << # words writting   >>           22746000
                  ,pv     << pv=0 - system otherwise PV >>     <<03777>>22748000
                  ,flaberr  <<flab error flag>>                <<03777>>22750000
                  ;                                                     22752000
                                                                        22754000
   LOGICAL         proc'status                                          22756000
                  ;                                                     22758000
                                                                        22760000
   DOUBLE          flabaddr                                             22762000
                  ,oldaddr                                              22764000
                  ,newaddr                                              22766000
                  ,numberofsectors                                      22768000
                  ,extent        << cntr # exts wrote  >>               22770000
                  ,write'address                                        22772000
                  ,read'address                                         22774000
                  ,ddummy                                               22776000
                  ;                                                     22778000
                                                                        22780000
   INTEGER POINTER flab;                                                22782000
   DOUBLE POINTER flabdbl = flab;                              <<06468>>22784000
   INTEGER POINTER oldflab;                                    <<06468>>22786000
   INTEGER POINTER newflab;                                             22788000
                                                                        22790000
                                                                        22792000
                                                                        22794000
                                                                        22796000
   EQUATE   buffer'len = 36;                                            22798000
   LOGICAL POINTER buffer;                                              22800000
   BYTE POINTER bbuffer;                                                22802000
   BYTE POINTER buf'ptr;                                                22804000
                                                               <<06468>>22806000
                                                               <<06468>>22808000
                                                               <<06468>>22810000
                                                                        22812000
<< use global array buff for transferring >>                            22814000
                                                                        22816000
   INTEGER POINTER transfer;   << global array buff >>                  22818000
   EQUATE trans'sector'size = buffsize'; << in sect >>                  22820000
                                                                        22822000
                                                                        22824000
   << rparms definitions >>                                             22826000
                                                                        22828000
   DEFINE          whattodo             = rparms(0)#;                   22830000
   DEFINE          volumesetldevs       = rparms(1)#;                   22832000
   DEFINE          msgno                = rparms(2)#;                   22834000
   DEFINE          condldev             = rparms(3)#;                   22836000
   DEFINE          thisvol              = rparms(4)#;                   22838000
   DEFINE          p'mvtabx             = rparms(5)#;                   22840000
                                                               <<06468>>22842000
   LOGICAL SUBROUTINE Def'Checksum;                            <<06468>>22844000
                                                               <<06468>>22846000
   SUBROUTINE Def'Put'File'Name;                               <<06468>>22848000
$PAGE " SUBROUTINE CLEANUP "                                            22850000
SUBROUTINE cleanup;                                            <<03510>>22852000
                                                                        22854000
   BEGIN                                                                22856000
                                                                        22858000
<<===================================================                   22860000
                                                                        22862000
   This subroutine tries to cleanup the mess when you                   22864000
   encounter an I/O error on writting the FLAB                          22866000
   There are 2 cases:                                                   22868000
   1. I/O error on writting flab to new space that just                 22870000
      got                                                               22872000
         keep this space because somethings wrong with it               22874000
         and make new flab have the old ext addr. Dont                  22876000
         have to write the flab cuz already there.                      22878000
         Continue trying to move this file.                             22880000
   2. I/O error on writting flab and extent that got is                 22882000
      NOT the one which contains the file label                         22884000
         mark the Directory as bad so that cant access                  22886000
         it and tell the user. Then return to the Dirc                  22888000
         routine cuz we dont want to look at this file                  22890000
         anymore                                                        22892000
                                                                        22894000
   Assumptions:                                                         22896000
         NOT in split stack mode                                        22898000
                                                                        22900000
   Globals:                                                             22902000
        flab defs - dflext,flcchecksum                                  22904000
        File entry in Dirc                                              22906000
        pvmsgs - viwarn78                                               22908000
                                                                        22910000
        modifies  - newflab, Dirc file entry                            22912000
                                                                        22914000
   Changes:                                                             22916000
                                                                        22918000
====================================================>>                  22920000
                                                                        22922000
      IF i = 0 THEN     << case 1 >>                                    22924000
         BEGIN                                                          22926000
            ddummy := flabdbl (dflextindex);                   <<06468>>22928000
            @flab := @newflab;                                 <<06468>>22930000
            flabdbl (dflextindex) := ddummy;                   <<06468>>22932000
            flchecksum := Checksumx;                           <<06468>>22934000
            << keep this bad space so no one else >>                    22936000
            << can get it                         >>                    22938000
            flabaddr:=oldaddr;  << set back flab addr >>                22940000
         END                                                            22942000
      ELSE                                                              22944000
         BEGIN          << case 2 >>                                    22946000
                                                                        22948000
            exchangedb(dst);   << go to Dirc >>                         22950000
            ntry(2).(0:1):=dirc'bad'file;                               22952000
            dds(dadirty).dirtyf:=1;                                     22954000
            dirwrite(a);                                                22956000
            dst:=exchangedb(0);                                         22958000
                                                                        22960000
            Put'File'Name;                                     <<06468>>22962000
            genmsg(pvmsgset,viwarn83,%0,                                22964000
                   @bbuffer);                                           22966000
                                                                        22968000
                                                                        22970000
            << dont have to do any changes to new flab >>               22972000
            << cuz we arent going to do anything w this>>               22974000
            << file anymore                            >>               22976000
                                                                        22978000
            Return'Disc'Space(condldev,newaddr,                         22980000
                              numberofsectors);                         22982000
            << dont care about status >>                                22984000
         END;                                                           22986000
                                                                        22988000
   END;   << cleanup >>                                                 22990000
$PAGE " PROCEDURE COND'RECEIP "                                         22992000
                                                                        22994000
                                                                        22996000
   << ** in split stack mode when enter this procedure ** >>            22998000
                                                                        23000000
                                                                        23002000
   return'status:=0;   << clear it >>                                   23004000
   << never releasing sir so set status here >>                         23006000
   return'status.sir'status:=sir'not'released;                          23008000
                                                                        23010000
   << pick up the file label address and vol table address  >>          23012000
   << out of the Directory file entry                       >>          23014000
                                                                        23016000
   TOS:=ntryd(2);                                                       23018000
   vtab'of'flab:=s1.(0:8);                                              23020000
   s1.(0:8):=0;                                                         23022000
   flabaddr:=TOS;                                                       23024000
   pv := glinkage.(0:1);      << get type of group >>          <<03777>>23026000
   flaberr := ntry(2).(0:1);                                   <<03777>>23028000
                                                                        23030000
   << ** get out of split stack mode, set back to stack ** >>           23032000
                                                                        23034000
   dst:=exchangedb(0);                                                  23036000
                                                                        23038000
   << set ptr to   rparms  >>                                           23040000
                                                                        23042000
   @rparms:=@arrq0(parms-deltaq);                                       23044000
                                                                        23046000
   IF level <> filelevel THEN                                           23048000
      BEGIN                                                             23050000
         IF whattodo = -1 THEN                                          23052000
            return'status.dirscanstatus:=stop'traversal                 23054000
         ELSE                                                           23056000
            << If COND system volume then skip all groups   >> <<03777>>23058000
            << which belong to private volume.              >> <<03777>>23060000
            IF level = grouplevel AND                          <<03777>>23062000
               p'mvtabx = 0 AND pv = 1 THEN                    <<03777>>23064000
            return'status.dirscanstatus:=skip'subtree          <<03777>>23066000
            ELSE                                               <<03777>>23068000
            return'status.dirscanstatus:=continue'traversal;            23070000
         exchangedb(dst);                                               23072000
         RETURN;                                                        23074000
      END;                                                              23076000
                                                                        23078000
   << check for bad file entries, only 2 cases I know of    >>          23080000
   <<    file label addr = %77777777                        >>          23082000
   <<                      supposedly if restoring a file   >>          23084000
   <<                      and system crashes               >>          23086000
   <<    ntry(2)           word 2 of Dirc file entry has    >>          23088000
   <<                      bit (0:1) set                    >>          23090000
   <<                      Dirc's way of marking a bad file >>          23092000
   <<                      file label (prob I/O error )     >>          23094000
                                                                        23096000
   IF flabaddr = bad'addr OR flaberr = dirc'bad'file THEN      <<03777>>23098000
      BEGIN                                                             23100000
         return'status.dirscanstatus:=continue'traversal;               23102000
         exchangedb(dst);                                               23104000
         RETURN;                                                        23106000
      END;                                                              23108000
                                                                        23110000
   << allocate all the arrays >>                                        23112000
                                                                        23114000
   PUSH(s);                                                             23116000
   TOS:=TOS+1;                                                          23118000
   @flab:=TOS;                                                          23120000
   TOS:=sector'size;                                                    23122000
   ASSEMBLE(adds 0);                                                    23124000
                                                                        23126000
   @oldflab := @flab;                                          <<06468>>23128000
                                                                        23130000
   PUSH(s);                                                             23132000
   TOS:=TOS+1;                                                          23134000
   @newflab:=TOS;                                                       23136000
   TOS:=sector'size;                                                    23138000
   ASSEMBLE(adds 0);                                                    23140000
                                                                        23142000
                                                                        23144000
   PUSH(s);                                                             23146000
   TOS:=TOS+1;                                                          23148000
   @buffer:=TOS;                                                        23150000
   TOS:=buffer'len;                                                     23152000
   ASSEMBLE(adds 0);                                                    23154000
                                                                        23156000
   @bbuffer:=(@buffer) &lsl(1);                                         23158000
                                                                        23160000
   @transfer:=@buff(0);                                                 23162000
                                                                        23164000
   << set up ptr to ldevs in vol set >>                                 23166000
                                                                        23168000
   @vol'set'ldevs:=volumesetldevs;                                      23170000
   << ldev of file label isn't in vol set def then          >>          23172000
   << don't look at the rest of this file label             >>          23174000
   IF (flab'ldev:=vol'set'ldevs(vtab'of'flab)) = 0 THEN                 23176000
      BEGIN                                                             23178000
         return'status.dirscanstatus:=continue'traversal;               23180000
         exchangedb(dst);                                               23182000
         RETURN;                                                        23184000
      END;                                                              23186000
                                                                        23188000
   << read in the file label for this file  >>                          23190000
                                                                        23192000
   proc'status:=Read'Disc(flab'ldev,flabaddr,0,flab,sector'size);       23194000
   IF NOT(proc'status) THEN                                             23196000
      BEGIN                                                             23198000
         genmsg(pvmsgset,viwarn74,%12000,flab'ldev,                     23200000
                @flabaddr);                                             23202000
         return'status.dirscanstatus:=continue'traversal;               23204000
         exchangedb(dst);                                               23206000
         RETURN;                                                        23208000
      END;                                                              23210000
                                                                        23212000
   << check the checksum - another test for a good label >>             23214000
                                                                        23216000
   mychecksum:=TOS;                                                     23218000
   IF LOG (flchecksum) <> Checksumx THEN                       <<06468>>23220000
      BEGIN                                                             23222000
         Put'File'Name;                                        <<06468>>23224000
         genmsg(pvmsgset,viwarn75,%0,@bbuffer);                         23226000
         return'status.dirscanstatus:=continue'traversal;               23228000
         exchangedb(dst);                                               23230000
         RETURN;                                                        23232000
      END;                                                              23234000
                                                                        23236000
   << now make sure that it's ok to move this file   >>                 23238000
   << There are system files which have a ldev/addr in sys >>           23240000
   << global area, such as sl,catalog,confdata. On a       >>           23242000
   << running system these files will be open so they will >>           23244000
   << never be touched, but if a stand-alone did a cond    >>           23246000
   << it would have to make sure it didnt touch these files>>           23248000
                                                                        23250000
   IF ( flstatus <> 0 OR flsrlx <> 0 )  AND                    <<06468>>23252000
                                                               <<06468>>23254000
      flclid = sys'cold'loadid THEN                            <<06468>>23256000
      BEGIN                                                             23258000
         return'status.dirscanstatus:=continue'traversal;               23260000
         exchangedb(dst);                                               23262000
         RETURN;                                                        23264000
      END;                                                              23266000
                                                                        23268000
   << now run through the file label looking for extent on   >>         23270000
   << this ldev                                               >>        23272000
                                                                        23274000
   numexts := flnumexts;                                       <<06468>>23276000
                                                                        23278000
   MOVE newflab:=flab,(sector'size);   << copy flab >>                  23280000
                                                                        23282000
   i:=-1;   << initialize for scan >>                                   23284000
   WHILE (i:=i+1) <= numexts DO                                         23286000
      BEGIN                                                             23288000
         IF flab (flextindex + i*2).flvolnumf = thisvol THEN   <<06468>>23290000
            BEGIN                                                       23292000
               TOS := flabdbl (dflextindex + i);               <<06468>>23294000
               s1.(0:8):=0;                                             23296000
               oldaddr:=TOS;                                            23298000
                                                                        23300000
               IF i = numexts THEN      << what's ext sz >>             23302000
                  numberofsectors := DBL (LOG (fllastextsize)) <<06468>>23304000
               ELSE                                                     23306000
                  numberofsectors := DBL (LOG (flextsize));    <<06468>>23308000
                                                                        23310000
               << call Get'Disc'Space to find space           >>        23312000
               << this is very dependent upon the disc space  >>        23314000
               << routines. It assumes that they do a FIRST   >>        23316000
               << fit. Condense depends upon this!!           >>        23318000
               << Locate'Free'space and Find'Page run through >>        23320000
               << the descriptors to try to find space to     >>        23322000
               << satisfy the request. Set'Reset'Bit'Map is   >>        23324000
               << the one who actually changes the bits.      >>        23326000
               << IF in setting/resetting the bits it finds   >>        23328000
               << that they are not in the correct state, it  >>        23330000
               << will disable'int allocation on this ldev and>>        23332000
               << send a message to the operator              >>        23334000
               << We will abide by disc'space and not continue>>        23336000
               << CONDensing this ldev because the bit map    >>        23338000
               << /descriptors are messed up and to continue  >>        23340000
               << condensing would just mess it up more       >>        23342000
               << pass back a status to main routine to       >>        23344000
               << tell that aborted                           >>        23346000
               << NOTE: Get'Disc'Space assumes that is at     >>        23348000
               <<       the stack                             >>        23350000
                                                                        23352000
another'ext:   << this label is if I got a i/o error on       >>        23354000
               << moving the extent, I want to get another    >>        23356000
               << extent                                      >>        23358000
                                                                        23360000
               newaddr:=0D;                                             23362000
               discspace'status:=Get'Disc'Space(condldev,               23364000
                                  numberofsectors,newaddr );            23366000
               IF discspace'status <> 0 THEN                            23368000
                  BEGIN                                                 23370000
                     IF discspace'status = 1 THEN                       23372000
                                                                        23374000
                        << couldnt get the space for this >>            23376000
                        << extent so quit looking at this >>            23378000
                        << file. IF any previous extents  >>            23380000
                        << got moved the flab already got >>            23382000
                        << updated                        >>            23384000
                                                                        23386000
                        go to exit                                      23388000
                     ELSE                                               23390000
                                                                        23392000
                        BEGIN  << some kind of problem w DFSM >>        23394000
                                                                        23396000
                           whattodo:=-1; << terminate scan >>           23398000
                           msgno:=vierr0;                               23400000
                           genmsg(pvmsgset,vierr77);                    23402000
                           IF discspace'status = 2 THEN                 23404000
                              genmsg(pvmsgset,vierr82)                  23406000
                           ELSE                                         23408000
                              genmsg(pvmsgset,viwarn81);                23410000
                           return'status.dirscanstatus:=                23412000
                                      stop'traversal;                   23414000
                           exchangedb(dst);                             23416000
                           RETURN;                                      23418000
                        END;                                            23420000
                     END;                                               23422000
                                                                        23424000
               << now since we are depending upon the  >>               23426000
               << the disc space  routine to do our    >>               23428000
               << moving for us- check to make sure we >>               23430000
               << are really condensing toward the     >>               23432000
               << low part of the disc                 >>               23434000
                                                                        23436000
               IF newaddr >= oldaddr THEN << forget it, >>              23438000
                  BEGIN                 << dont move  >>                23440000
                     Return'Disc'Space(condldev,newaddr,                23442000
                                       numberofsectors);                23444000
                     GO TO cont'trans;                                  23446000
                  END;                                                  23448000
                                                                        23450000
                                                                        23452000
               << now write out the extent to new address    >>         23454000
                                                                        23456000
               trans'status:=0;  << if i/o error >>                     23458000
               extent:=0D;                                              23460000
               write'address:=newaddr;                                  23462000
               read'address:=oldaddr;                                   23464000
               trans'words:=trans'sector'size * sector'size;            23466000
                                                                        23468000
               WHILE extent < numberofsectors DO                        23470000
                  BEGIN                                                 23472000
                     << not a full transfer ? >>                        23474000
                     IF extent + DBL(trans'sector'size) >               23476000
                        numberofsectors THEN                            23478000
                        trans'words:=INT(numberofsectors-extent)        23480000
                                      * sector'size;                    23482000
                     proc'status:=Read'Disc(condldev,                   23484000
                                  read'address,0,transfer,              23486000
                                  trans'words);                         23488000
                     IF NOT(proc'status) THEN                           23490000
                        BEGIN                                           23492000
                           << this is a hokey way of getting  >>        23494000
                           << out of this loop                >>        23496000
                           extent:=numberofsectors;                     23498000
                           trans'status:=1;                             23500000
                        END                                             23502000
                     ELSE                                               23504000
                        BEGIN                                           23506000
                           proc'status:=Write'Disc(condldev,            23508000
                                        write'address,0,transfer,       23510000
                                        trans'words);                   23512000
                           IF NOT(proc'status) THEN                     23514000
                              BEGIN                                     23516000
                                 << something wrong w this space,  >>   23518000
                                 << keep it                        >>   23520000
                                 GO TO another'ext;                     23522000
                              END;                                      23524000
                           read'address:=read'address+                  23526000
                                       DBL(trans'sector'size);          23528000
                           write'address:=write'address+                23530000
                                          DBL(trans'sector'size);       23532000
                           extent:=extent + DBL(                        23534000
                                   trans'words/sector'size);            23536000
                        END;                                            23538000
                  END; << of moving this extent >>                      23540000
                                                                        23542000
               IF trans'status = 1 THEN                                 23544000
                  BEGIN                                                 23546000
                     << error on read of extent do not move >>          23548000
                     Return'Disc'Space(condldev,newaddr,                23550000
                                       numberofsectors);                23552000
                  END                                                   23554000
               ELSE                                                     23556000
                  IF trans'status = 0 THEN << a ok >>                   23558000
                     BEGIN                                              23560000
                        << combine vol index + new addr into >>         23562000
                        << 1 word                            >>         23564000
                        TOS:=newaddr;                                   23566000
                        s1.(0:8):=thisvol;                              23568000
                        @flab := @newflab;                     <<06468>>23570000
                        flabdbl (dflextindex + i) := TOS;      <<06468>>23572000
                                                                        23574000
                        << did move the file label >>                   23576000
                        IF i=0 THEN                                     23578000
                           flabaddr:=newaddr;                           23580000
                                                                        23582000
                        << now update the file label every- >>          23584000
                        << time you move an extent. This may>>          23586000
                        << be a lot of I/O but it saves the >>          23588000
                        << user a reload/init               >>          23590000
                                                                        23592000
                                                               <<06468>>23594000
                        flchecksum := Checksumx;               <<06468>>23596000
                                                                        23598000
                        proc'status:=Write'Disc(flab'ldev,              23600000
                                   flabaddr,0,newflab,                  23602000
                                   sector'size);                        23604000
                        IF NOT(proc'status) THEN                        23606000
                           BEGIN                                        23608000
                              cleanup;                                  23610000
                              IF i <> 0 THEN                            23612000
                                 << got an I/O error on >>              23614000
                                 << wr flab and not the >>              23616000
                                 << extent that just got>>              23618000
                                 GO TO exit                             23620000
                              ELSE                                      23622000
                                 << got a new flab extent>>             23624000
                                 << but had an I/O error >>             23626000
                                 << on wr to that addr so>>             23628000
                                 << not going to move    >>             23630000
                                 << this extent- will try>>             23632000
                                 << rest of extents      >>             23634000
                                 GO TO cont'trans;                      23636000
                           END;                                         23638000
                                                                        23640000
                        << had good I/O status on write >>              23642000
                        << did the file label move if so>>              23644000
                        << must update the Dirc         >>              23646000
                                                                        23648000
                        IF i = 0 THEN                                   23650000
                           BEGIN                                        23652000
                              ddummy := flabdbl                <<06468>>23654000
                                        (dflextindex + i);     <<06468>>23656000
                              exchangedb(dst);  << sp stack >>          23658000
                              ntryd(2):=ddummy;                         23660000
                              dds(dadirty).dirtyf:=1;                   23662000
                              dirwrite(a);                              23664000
                              dst:=exchangedb(0);                       23666000
                           END;                                         23668000
                                                                        23670000
                        << now release the old space >>                 23672000
                                                                        23674000
                        @flab := @oldflab;                     <<06468>>23676000
                        TOS := flabdbl (dflextindex + i);      <<06468>>23678000
                        s1.(0:8):=0;                                    23680000
                        ddummy:=TOS;                                    23682000
                        Return'Disc'Space(condldev,ddummy,              23684000
                                     numberofsectors);                  23686000
                        proc'status:=checkdfsmstatus(condldev);         23688000
                        IF NOT(proc'status) THEN                        23690000
                           BEGIN  << gen a warn msg >>                  23692000
               Put'File'Name;                                  <<06468>>23694000
                              genmsg(pvmsgset,viwarn78,%0,              23696000
                                     @bbuffer);                         23698000
                           END;                                         23700000
                     END;  << good/bad trans status >>                  23702000
                                                                        23704000
cont'trans:       << come here if we couldn't move the >>               23706000
                  << the extent, Get'Disc'Space gave   >>               23708000
                  << a larger addr or                  >>               23710000
                  << I/O on writting flab continue     >>               23712000
                  << looking                           >>               23714000
            END; << ext vol = thisvol >>                                23716000
         @flab := @oldflab;                                    <<06468>>23718000
      END;     << run through all extent >>                             23720000
                                                                        23722000
                                                                        23724000
exit:     << no space avail for an extent of a file  >>                 23726000
          << so quit looking at this file OR         >>                 23728000
          << I/O error on writting updated flab -    >>                 23730000
          << marked as bad in Dirc so quit looking   >>                 23732000
          << at this file                            >>                 23734000
                                                                        23736000
   << now set back to DIRC >>                                           23738000
                                                                        23740000
   return'status.dirscanstatus:=continue'traversal;                     23742000
                                                                        23744000
   exchangedb(dst);                                                     23746000
                                                                        23748000
END;      << cond'receip >>                                             23750000
$PAGE "   PROCEDURE NO'SUSPECT'TRACKS"                                  23752000
$CONTROL SEGMENT=NEWPACK                                                23754000
   LOGICAL PROCEDURE no'suspect'tracks(ldev);                  <<03510>>23756000
      VALUE ldev;                                                       23758000
      INTEGER ldev;                                                     23760000
      OPTION PRIVILEGED,UNCALLABLE;                                     23762000
                                                                        23764000
   BEGIN                                                                23766000
                                                                        23768000
<<===================================================                   23770000
                                                                        23772000
         returns false if can't read DTT or has                         23774000
         a suspect track                                                23776000
                                                                        23778000
   Parameters:                                                          23780000
           ldev - logical device number                                 23782000
                                                                        23784000
   Returns:                                                             23786000
         T   if ok                                                      23788000
         F   if any suspect tracks or I/O error                         23790000
                                                                        23792000
   Globals:                                                             23794000
         dtt defs - dtt'number'of'entries,dtt'track'code,               23796000
                    dtt'suspect                                         23798000
                                                                        23800000
   Callers:                                                             23802000
        condense'disc                                                   23804000
                                                                        23806000
   Fixid:                                                               23808000
      This procedure was added as part of the changes for the           23810000
      new disc free space map, the fixid on the procedure header        23812000
      applies to the whole procedure.                                   23814000
                                                                        23816000
   Changes:                                                             23818000
                                                                        23820000
====================================================>>                  23822000
                                                                        23824000
                                                                        23826000
      INTEGER                                                           23828000
                   i                                                    23830000
                 ,type                                                  23832000
                  ;                                                     23834000
                                                                        23836000
      LOGICAL        proc'status                                        23838000
                    ;                                                   23840000
                                                                        23842000
      LOGICAL      return'status = no'suspect'tracks                    23844000
                  ;                                                     23846000
                                                                        23848000
                                                                        23850000
      proc'status:=Get'Disc'Info(ldev,,,dtt,type);                      23852000
      IF NOT(proc'status) THEN                                          23854000
         BEGIN                                                          23856000
            return'status:=false;                                       23858000
            RETURN;                                                     23860000
         END;                                                           23862000
                                                                        23864000
      IF type = cs'80'type THEN                                         23866000
         BEGIN                                                          23868000
            IF dtt(dsct'number'of'entries) = 0 THEN                     23870000
               return'status:=true  << no suspect >>                    23872000
            ELSE                                                        23874000
               return'status:=false;  << are suspect >>                 23876000
            RETURN;                                                     23878000
         END;                                                           23880000
                                                                        23882000
      IF dtt(dtt'number'of'entries) = 0 THEN                            23884000
         BEGIN                                                          23886000
            return'status:=true;                                        23888000
            RETURN;                                                     23890000
         END;                                                           23892000
                                                                        23894000
      i:=0;                                                             23896000
      WHILE (i:=i+1) <= dtt(dtt'number'of'entries) DO                   23898000
         BEGIN                                                          23900000
            IF dtt(i).dtt'track'code = dtt'suspect THEN                 23902000
               BEGIN                                                    23904000
                  return'status:=false;                                 23906000
                  RETURN;                                               23908000
               END;                                                     23910000
         END;                                                           23912000
                                                                        23914000
      return'status:=true;                                              23916000
                                                                        23918000
   END;    << no'suspect'tracks >>                                      23920000
$PAGE "   PROCEDURE CONDENSE'DISC "                                     23922000
$CONTROL SEGMENT=CONDENSE                                               23924000
PROCEDURE condense'disc(ldev,recover);                         <<03510>>23926000
   VALUE ldev,recover;                                                  23928000
   INTEGER ldev;                                                        23930000
   LOGICAL recover;                                                     23932000
   OPTION PRIVILEGED,UNCALLABLE;                                        23934000
                                                                        23936000
BEGIN                                                                   23938000
                                                                        23940000
<<===================================================                   23942000
                                                                        23944000
   Verifies the ldev and gets the vol set def for                       23946000
   the vol set that LDEV is a member.                                   23948000
   Once it determines that it is ok, it either                          23950000
   RECOVERs and CONDenses or just CONDenses                             23952000
                                                                        23954000
   Parameters:                                                          23956000
        ldev - logical device number                                    23958000
        recover - logical, if T then want to recover a                  23960000
                  private vol else just condensing ldev                 23962000
                                                                        23964000
   Assumptions:                                                         23966000
        ldev has already been verified as a good ldev                   23968000
        the vol set must be mounted                                     23970000
        turn logging off if was enabled because when                    23972000
        begin to cond/recover it has the file,                          23974000
        dirc,ldt sir locked. The old cond only called                   23976000
         genmsg at most twice but this version calls                    23978000
        genmsg a lot more and there is a possibility                    23980000
        of getting hung up on trying to get an extent                   23982000
        To prevent this, turn logging off.                              23984000
                                                                        23986000
   Globals:                                                             23988000
        sysdb                                                           23990000
        logging flags                                                   23992000
        disc label - disc'lab'type'word,disc'lab'mv,                    23994000
                     disc'lab'set,disc'lab'group'name,                  23996000
                     disc'lab'accnt'name                                23998000
        pvmsgs - vierr0,vierr1,viwarn5,viwarn6,                         24000000
                 vwarn7,vierr67,vierr63,vierr77,                        24002000
                 viwarn80,viwarn81,vierr84                              24004000
                 direcerr                                               24006000
        mvtab entry - mvtablev                                          24008000
        vol table - vol'table'ldev,vol'ent'ldev                         24010000
                                                                        24012000
   Resources:                                                           24014000
         file,ldt,dirc sir                                              24016000
                                                                        24018000
   Callers:                                                             24020000
       cond                                                             24022000
                                                                        24024000
   Fixid:                                                               24026000
      This procedure was added as part of the disc free space map       24028000
      changes, the fixid on the procedure header applies to the         24030000
      whole procedure.                                                  24032000
                                                                        24034000
   Changes:                                                             24036000
                                                                        24038000
====================================================>>                  24040000
                                                                        24042000
   INTEGER            msgnum                                            24044000
                     ,mvtabx                                            24046000
                     ,volume'count                                      24048000
                     ,dirldev                                           24050000
                     ,i           << index,dummy >>                     24052000
                     ,offset      << index,dummy >>                     24054000
                     ,cond'index  << index of ldev in vol'set'ldevs >>  24056000
                     ,savloginfo  << save logging bit >>                24058000
                     ,savflagf   << soft error flag >>                  24060000
                     ;                                                  24062000
    LOGICAL           mv                                                24064000
                     ,proc'status                                       24066000
                     ,dirsirret                                         24068000
                     ,ldtsirret                                         24070000
                     ,filesirret                                        24072000
                     ,logging'off                                       24074000
                     ;                                                  24076000
                                                                        24078000
   DOUBLE             dirbase                                           24080000
                     ,ddummy                                            24082000
                                                                        24084000
                     ;                                                  24086000
                                                                        24088000
   INTEGER ARRAY   rparms(0:9); << 10 wds to receip rout >>             24090000
                                                                        24092000
   DEFINE    whattodo       = rparms(0)#;                               24094000
   DEFINE    volumesetldevs = rparms(1)#;                               24096000
   DEFINE    msgno          = rparms(2)#;                               24098000
   DEFINE    cond'ldev      = rparms(3)#;                               24100000
   DEFINE    thisvolnum     = rparms(4)#;                               24102000
   DEFINE    p'mvtabx       = rparms(5)#;                               24104000
   << 6-9 unused right now >>                                           24106000
                                                                        24108000
   << temp buffer user to get various data structures >>                24110000
                                                                        24112000
   INTEGER ARRAY      temp(0:sector'size-1);                            24114000
   INTEGER ARRAY      vlab(*)    = temp;                                24116000
   INTEGER ARRAY      vsdefn(*)  = temp;                                24118000
   INTEGER ARRAY      mvtabent(*)= temp;                                24120000
   INTEGER ARRAY      vol'ent(*) = temp;                                24122000
                                                                        24124000
   LOGICAL ARRAY      vsid(0:11);  << vol name,grp,accnt >>             24126000
   LOGICAL ARRAY      dummy(*)=vsid;  << used as dummy to DIREC >>      24128000
                                                                        24130000
                                                                        24132000
   INTEGER POINTER    vol'set'ldevs;                                    24134000
                                                                        24136000
                                                               <<06276>>24138000
                                                                        24140000
   << used to define enable/disable logging  >>                         24142000
                                                                        24144000
   DEFINE disable'int= ASSEMBLE(sed 0)#;                                24146000
   DEFINE enable'int = ASSEMBLE(sed 1)#;                                24148000
   EQUATE loginfo= sysdb +%167;                                         24150000
   EQUATE flagf  = sysdb +%176;                                         24152000
   DEFINE loggingflag = (15:1)#;  << = 0 no logging >>                  24154000
   DEFINE softpreemptlog = (11:1)#;  << = 1 keep stats, but dont >>     24156000
                                       <<log-used when know will >>     24158000
                              << eventually recover from "error" >>     24160000
                                                                        24162000
                                                                        24164000
   << use this to exit the procedure from subroutine >>                 24166000
                                                                        24168000
   DEFINE exit'procedure=ASSEMBLE(exit 2)#;                             24170000
                                                                        24172000
                                                                        24174000
   SUBROUTINE leave(msgnum);                                   <<03510>>24176000
      VALUE msgnum;                                                     24178000
      INTEGER msgnum;                                                   24180000
                                                                        24182000
<<===================================================                   24184000
                                                                        24186000
   called if any errors and must exit from procedure                    24188000
   Optionally prints out an pverr msg if msgnum <> 0                    24190000
   Will also turn logging back on if was previously                     24192000
   enabled                                                              24194000
                                                                        24196000
   Parameters:                                                          24198000
          msgnum - pvmsg number to print out, only if                   24200000
                   <> 0                                                 24202000
                                                                        24204000
   Assumptions:                                                         24206000
          Does an EXIT 2 from procedure if calling sequence             24208000
          changes this MUST change                                      24210000
                                                                        24212000
   Globals:                                                             24214000
        logging flags                                                   24216000
        pvmsgs - viwarn80                                               24218000
                                                                        24220000
   Resources:                                                           24222000
        releases the dirc,ldt,file sirs                                 24224000
                                                                        24226000
   Changes:                                                             24228000
                                                                        24230000
====================================================>>                  24232000
   BEGIN                                                                24234000
                                                                        24236000
      IF msgnum <> 0 THEN                                               24238000
         genmsg(pvmsgset,msgnum);                                       24240000
                                                                        24242000
$IF X3=ON                                                               24244000
      debug;                                                            24246000
$IF                                                                     24248000
                                                                        24250000
   << allow logging >>                                                  24252000
                                                                        24254000
   IF logging'off THEN                                                  24256000
      BEGIN                                                             24258000
         disable'int;                                                   24260000
         ABSOLUTE(loginfo).loggingflag:=savloginfo;                     24262000
         ABSOLUTE(flagf).softpreemptlog:=savflagf;                      24264000
         enable'int;                                                    24266000
      END;                                                              24268000
                                                                        24270000
   << now release the sirs >>                                           24272000
                                                                        24274000
   RELSIR (LDT'SIR, LDTSIRRET);                                <<06276>>24276000
   RELSIR (DIRSIR, DIRSIRRET);                                 <<06276>>24278000
   relsir(filesir,filesirret);                                          24280000
                                                                        24282000
  << generate a message saying that turned logging back on >>           24284000
  << if enabled                                            >>           24286000
   IF logging'off THEN                                                  24288000
      BEGIN                                                             24290000
         genmsg(pvmsgset,viwarn80,,,,,,,0);                             24292000
         logging'off:=false;                                            24294000
      END;                                                              24296000
                                                                        24298000
                                                                        24300000
      exit'procedure;                                                   24302000
                                                                        24304000
   END;   << leave >>                                                   24306000
$PAGE                                                                   24308000
   logging'off:=false;   << initialize >>                               24310000
                                                                        24312000
   rparms:=0;                                                           24314000
   MOVE rparms(1):=rparms,(9);                                          24316000
                                                                        24318000
   << now do some initial checking before actually condensing >>        24320000
   << the disc                                                >>        24322000
                                                                        24324000
   << get space for storing the ldevs from the mvtab entry    >>        24326000
   << right now the max amount of discs configurable is 16    >>        24328000
                                                                        24330000
   PUSH(s);                                                             24332000
   TOS:=TOS+1;                                                          24334000
   @vol'set'ldevs:=TOS;                                                 24336000
   TOS:=max'discs+1;       << waste entry 0 >>                          24338000
   ASSEMBLE(adds 0);                                                    24340000
                                                                        24342000
                                                                        24344000
   << initialize  vol'set'ldevs >>                                      24346000
   vol'set'ldevs:=0;                                                    24348000
   MOVE vol'set'ldevs(1):=vol'set'ldevs,(max'discs);                    24350000
                                                                        24352000
   << logging enabled >>                                                24354000
                                                                        24356000
   IF ABSOLUTE(loginfo).loggingflag THEN                                24358000
      BEGIN                                                             24360000
                                                                        24362000
         << going to disable system logging because i dont want >>      24364000
         << to get hung up on file sir if log file needs an extent >>   24366000
         << first generate a message to console/log file        >>      24368000
         genmsg(pvmsgset,viwarn79,,,,,,,0);                             24370000
                                                                        24372000
         disable'int;                                                   24374000
         savloginfo:=ABSOLUTE(loginfo).loggingflag;                     24376000
         ABSOLUTE(loginfo).loggingflag:=0;                              24378000
         savflagf:=ABSOLUTE(flagf).softpreemptlog;                      24380000
         ABSOLUTE(flagf).softpreemptlog:=1;                             24382000
         enable'int;                                                    24384000
         logging'off:=true;                                             24386000
      END;                                                              24388000
                                                                        24390000
   << now get all the sirs before beginning to check >>                 24392000
   << everything                                     >>                 24394000
                                                                        24396000
   filesirret:=getsir(filesir);                                         24398000
   DIRSIRRET := GETSIR (DIRSIR);                               <<06276>>24400000
   LDTSIRRET := GETSIR (LDT'SIR);                              <<06276>>24402000
                                                                        24404000
   << is it a system domain or non-system domain disc ? >>              24406000
   << do some checking for this                         >>              24408000
                                                                        24410000
   IF LPDT'NON'SYS'DOMAIN THEN                                 <<06276>>24412000
      BEGIN                                                             24414000
                                                                        24416000
         << if recovering the disc check to see if      >>              24418000
         << anyone is on or has temp files, $oldpass    >>              24420000
         << if so generate a warning                    >>              24422000
         << must be the only one on because dont want   >>              24424000
         << anyone getting space on the recover disc    >>              24426000
         << plus have dirc sir so no one can access/    >>              24428000
         << modify any file - cuz only have 1 dirc sir, >>              24430000
         << not one for each vol set                    >>              24432000
                                                                        24434000
         IF recover AND NOT(special'entry) THEN                         24436000
            IF NOT(only'one'on) THEN                                    24438000
            BEGIN                                                       24440000
               genmsg(pvmsgset,viwarn6);                                24442000
               recover:=false;  << just cond, dont recover >>           24444000
            END;                                                        24446000
                                                                        24448000
         << read the disc label to get the vol set name >>              24450000
         << group, account                              >>              24452000
                                                                        24454000
         proc'status:=Read'Disc(ldev,0D,0,vlab<<temp>>,sector'size);    24456000
         IF NOT(proc'status) THEN leave(vierr63);                       24458000
                                                                        24460000
         << is it a master volume ? >>                                  24462000
         mv:=vlab(disc'lab'type'word).disc'lab'mv;                      24464000
                                                                        24466000
                                                                        24468000
         MOVE vsid:=vlab(disc'lab'set),(4);                             24470000
         MOVE vsid(4):=vlab(disc'lab'group'name),(4);                   24472000
         MOVE vsid(8):=vlab(disc'lab'accnt'name),(4);                   24474000
                                                                        24476000
         getvsdefn(vsid,vsdefn<<temp>>,,msgnum);                        24478000
         IF <> THEN                                                     24480000
            BEGIN                                                       24482000
               genmsg(pvmsgset,msgnum);                                 24484000
               leave(vierr84);                                          24486000
            END;                                                        24488000
                                                                        24490000
         mvtabx:=vsdefn(vdmisc).mvtabxf;                                24492000
         IF mvtabx = 0 THEN  << a non-sys domain disc must >>           24494000
            BEGIN            << be > 0                     >>           24496000
               genmsg(pvmsgset,viwarn5);                                24498000
               leave(0);                                                24500000
            END;                                                        24502000
                                                                        24504000
         volume'count:=vsdefn(vdinfo).numvol;                           24506000
                                                                        24508000
         getmvtabentry(mvtabx,mvtabent<<temp>>);                        24510000
                                                                        24512000
         << get the ldev & address of the vol set directory >>          24514000
         dirldev:=mvtabent(mvtabldev).ldevf;                            24516000
         TOS:=mvtabent(mvtabldev);                                      24518000
         TOS:=TOS.(8:8);          << strip off "ldev" >>                24520000
         TOS:=mvtabent(mvtabldev+1);                                    24522000
         dirbase:=TOS;                                                  24524000
                                                                        24526000
         << look at the mvtab entry and get the ldevs of  >>            24528000
         << all the vols in the volset and make sure all  >>            24530000
         << of the vols in the vol set are mounted        >>            24532000
                                                                        24534000
         << look at word 2 of 2 word mvtab entry entry >>               24536000
                                                                        24538000
         cond'index:=-1;    << initialize >>                            24540000
         offset:=5;                                                     24542000
         i:=0;    << waste entry 0 >>                                   24544000
         WHILE (i:=i+1) <= volume'count DO                              24546000
           BEGIN                                                        24548000
              vol'set'ldevs(i):=mvtabent( offset+(i-1)*2 ).ldevf;       24550000
              IF vol'set'ldevs(i) = 0 THEN << all vols must >>          24552000
                 BEGIN                     << be mounted    >>          24554000
                    genmsg(pvmsgset,viwarn5);                           24556000
                    leave(0);                                           24558000
                 END                                                    24560000
              ELSE  IF vol'set'ldevs(i)=ldev THEN                       24562000
                       cond'index:=i;                                   24564000
           END;                                                         24566000
                                                                        24568000
        << is ldev a part of this vol set? >>                           24570000
                                                                        24572000
        IF cond'index < 0 THEN                                          24574000
           BEGIN                                                        24576000
              genmsg(pvmsgset,vierr39);                                 24578000
              leave(0);                                                 24580000
           END;                                                         24582000
     END                                                                24584000
  ELSE                                                                  24586000
     BEGIN         << check sys domain ldev >>                          24588000
                                                                        24590000
        << asked for "recover" of sys disc - not allowed >>             24592000
        IF recover THEN                                                 24594000
           BEGIN                                                        24596000
              genmsg(pvmsgset,viwarn7);                                 24598000
              recover:=false;                                           24600000
           END;                                                         24602000
        mvtabx:=0;   << get sys mvtab entry >>                          24604000
        getmvtabentry(mvtabx,mvtabent <<temp>>);                        24606000
                                                                        24608000
        << get the sys ldev and directory address >>                    24610000
                                                                        24612000
        dirldev:=mvtabldev.ldevf;                                       24614000
        TOS:=mvtabent(mvtabldev);                                       24616000
        TOS:=TOS.(8:8);   << strip off ldev >>                          24618000
        TOS:=mvtabent(mvtabldev+1);                                     24620000
        dirbase:=TOS;                                                   24622000
                                                                        24624000
        << now since the mvtab table doesnt have all the  >>            24626000
        << sys ldevs, look at the volume table to find    >>            24628000
        << all the ldevs                                  >>            24630000
                                                                        24632000
        << get the header info >>                                       24634000
                                                                        24636000
        Move'From'Data'Seg(vol'table'dst,0,16,vol'ent);                 24638000
        volume'count:=vol'ent(num'sys'vol);                             24640000
        offset:=vol'ent(0).vol'table'ent'size; <<or sz of ent >>        24642000
                                                                        24644000
                                                                        24646000
        cond'index:=-1;                                                 24648000
        i:=0;      << waste entry 0 >>                                  24650000
        WHILE (i:=i+1) <= volume'count DO                               24652000
           BEGIN                                                        24654000
              Move'From'Data'Seg(vol'table'dst,i*offset,                24656000
                              offset,vol'ent);                          24658000
              << a deleted vol has vol'ent(0) = 0 >>                    24660000
              IF vol'ent(vol'table'ldev).vol'ent'ldev <>                24662000
                 0 AND vol'ent(0) <> 0 THEN                             24664000
                 BEGIN                                                  24666000
                    vol'set'ldevs(i):=vol'ent(vol'table'ldev)           24668000
                                      .vol'ent'ldev;                    24670000
                    IF vol'set'ldevs(i)=ldev THEN                       24672000
                       cond'index:=i;                                   24674000
                 END;                                                   24676000
           END;                                                         24678000
                                                                        24680000
        IF cond'index < 0 THEN                                          24682000
           BEGIN                                                        24684000
              genmsg(pvmsgset,vierr39);                                 24686000
              leave(vierr84);                                           24688000
           END;                                                         24690000
                                                                        24692000
     END;                                                               24694000
                                                                        24696000
   << check all the ldevs for any suspect tracks >>                     24698000
   << NOTE volume'count for sys disc is the max  >>                     24700000
   <<      number of vols, not actual vols-this  >>                     24702000
   <<      is what vol'table(2) has              >>                     24704000
                                                                        24706000
   i:=0;  << waste entry 0 >>                                           24708000
   WHILE (i:=i+1) <= volume'count DO                                    24710000
      BEGIN                                                             24712000
         IF vol'set'ldevs(i) <> 0 THEN                                  24714000
            BEGIN                                                       24716000
               proc'status:=no'suspect'tracks(vol'set'ldevs(i));        24718000
               IF NOT(proc'status) THEN                                 24720000
                  BEGIN                                                 24722000
                     genmsg(pvmsgset,vierr67,%10000,                    24724000
                            vol'set'ldevs(i));                          24726000
                  END;                                                  24728000
            END;                                                        24730000
      END;                                                              24732000
                                                                        24734000
   << you are finally done with all the checking  >>                    24736000
   << now actually cond the disc                  >>                    24738000
                                                                        24740000
                                                                        24742000
   volumesetldevs:=@vol'set'ldevs;                                      24744000
   cond'ldev:=ldev;                                                     24746000
   thisvolnum:=cond'index;                                              24748000
   p'mvtabx:=mvtabx;                                                    24750000
                                                                        24752000
   IF recover THEN                                                      24754000
      BEGIN                                                             24756000
         << tell user that RECOVER is beginning >>                      24758000
         genmsg(pvmsgset,viwarn57);                                     24760000
                                                                        24762000
         proc'status:=recover'init(mv,ldev);                            24764000
         IF NOT(proc'status) THEN leave(vierr0);                        24766000
                                                                        24768000
         << now begin to recover the files >>                           24770000
                                                                        24772000
         ddummy:=direcscan(%120,0D,dummy,dummy,dummy,                   24774000
                           recover'receip,rparms,mvtabx);               24776000
         << an error from the Directory or in receip >>                 24778000
         IF <> THEN   << from Directory >>                              24780000
            BEGIN                                                       24782000
               genmsg(pvmsgset,direcerr);                               24784000
               leave(vierr0);                                           24786000
            END                                                         24788000
         ELSE                                                           24790000
            IF whattodo = -1 THEN                                       24792000
               leave(msgno);                                            24794000
                                                                        24796000
         << finished Recovery, set disc'lab'dfs'map'ok  >>              24798000
         << to true                                     >>              24800000
                                                                        24802000
         proc'status:=Read'Disc(ldev,disc'label'address,                24804000
                                 0,temp,sector'size);                   24806000
         temp(disc'lab'dfs'map'ok):=true;                               24808000
         proc'status:=Write'Disc'Label(ldev,0,temp);                    24810000
                                                                        24812000
         << tell the user so he knows whats going on >>                 24814000
                                                                        24816000
         genmsg(pvmsgset,viwarn58);                                     24818000
                                                                        24820000
         whattodo:=0;    << initialize for 2nd pass through Dirc >>     24822000
         msgno:=0;                                                      24824000
                                                                        24826000
         << now condense it >>                                          24828000
                                                                        24830000
         ddummy:=direcscan(%120,0D,dummy,dummy,dummy,                   24832000
                           cond'receip,rparms,mvtabx);                  24834000
                                                                        24836000
         IF <> THEN     << error from dirc >>                           24838000
            BEGIN                                                       24840000
               genmsg(pvmsgset,direcerr);                               24842000
               leave(vierr0);                                           24844000
            END                                                         24846000
         ELSE                                                           24848000
            IF whattodo = -1 THEN leave(msgno);                         24850000
      END                                                               24852000
   ELSE                                                                 24854000
      BEGIN     << regular cond >>                                      24856000
                                                                        24858000
         << before beginning to COND, make sure that the >>             24860000
         << LDEV has allocation enabled                  >>             24862000
         proc'status:=checkdfsmstatus(ldev);                            24864000
         IF NOT(proc'status) THEN                                       24866000
            BEGIN                                                       24868000
               genmsg(pvmsgset,vierr77);                                24870000
               leave(viwarn81);                                         24872000
            END;                                                        24874000
                                                                        24876000
         << dont care about the 2 word status because >>                24878000
         << i am looking at the whole Directory &     >>                24880000
         << not modifying anything                    >>                24882000
         ddummy:=direcscan(%120,0D,dummy,dummy,dummy,cond'receip,       24884000
                   rparms,mvtabx);                                      24886000
         << an error from the Directory or in receip routine >>         24888000
         IF <> THEN   << from directory >>                              24890000
            BEGIN                                                       24892000
               genmsg(pvmsgset,direcerr);                               24894000
               leave(vierr0);                                           24896000
            END                                                         24898000
         ELSE    << from virecip routine  >>                            24900000
            BEGIN                                                       24902000
               IF whattodo = -1 THEN leave(msgno);                      24904000
            END;                                                        24906000
   END;                                                                 24908000
                                                                        24910000
   IF logging'off THEN                                                  24912000
       BEGIN                                                            24914000
         << now enable logging if it was previously enabled >>          24916000
         disable'int;                                                   24918000
         ABSOLUTE(loginfo).loggingflag:=savloginfo;                     24920000
         ABSOLUTE(flagf).softpreemptlog:=savflagf;                      24922000
         enable'int;                                                    24924000
      END;                                                              24926000
                                                                        24928000
                                                                        24930000
   << release the sirs >>                                               24932000
   RELSIR (LDT'SIR, LDTSIRRET);                                <<06276>>24934000
   RELSIR (DIRSIR, DIRSIRRET);                                 <<06276>>24936000
   relsir(filesir,filesirret);                                          24938000
                                                                        24940000
   << generate a message to say logging enabled if was before>>         24942000
                                                                        24944000
   IF logging'off THEN                                                  24946000
      BEGIN                                                             24948000
         genmsg(pvmsgset,viwarn80,,,,,,,0);                             24950000
         logging'off:=false;                                            24952000
      END;                                                              24954000
                                                                        24956000
   END;   << cond'disc >>                                               24958000
$PAGE "  PROCEDURE PFRE"                                                24960000
$CONTROL SEGMENT=PVSTATUS                                               24962000
$INCLUDE INCLFREE                                                       24964000
$PAGE "PROCEDURE IS'IT'CARTRIDGE"                              <<*8114>>24966000
$CONTROL SEGMENT=LINUS                                         <<03537>>24968000
LOGICAL PROCEDURE Is'It'Cartridge(Ldev);                       <<*8114>>24970000
VALUE   Ldev;                                                  <<03537>>24972000
INTEGER Ldev;                                                  <<03537>>24974000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>24976000
                                                               <<03537>>24978000
<< To decide if a given Ldev is a cartridge tape             >><<*8114>>24980000
<< drive based on type and subtype.                          >><<03537>>24982000
                                                               <<03537>>24984000
BEGIN                                                          <<03537>>24986000
   INTEGER Type;                                               <<03537>>24988000
   INTEGER Subtype;                                            <<03537>>24990000
   Is'It'Cartridge := FALSE;                                   <<*8114>>24992000
   Type := Ldevtotype(Ldev);                                   <<03537>>24994000
   IF < THEN RETURN;                                           <<03537>>24996000
                                                               <<03537>>24998000
   Subtype := Ldevtosubtype(Ldev);                             <<03537>>25000000
   IF < THEN RETURN;                                           <<03537>>25002000
                                                               <<03537>>25004000
   Is'It'Cartridge := Type = cs'80'type LAND                   <<*8114>>25006000
                  (Subtype = St'9110 LOR Subtype = St'9144);   <<*8114>>25008000
END;                                                           <<03537>>25010000
$PAGE "PROCEDURE LOCK"                                         <<03537>>25012000
$CONTROL SEGMENT=LINUS                                         <<03537>>25014000
PROCEDURE Lock(Ldev);                                          <<03537>>25016000
VALUE Ldev;                                                    <<03537>>25018000
INTEGER Ldev;                                                  <<03537>>25020000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25022000
                                                               <<03537>>25024000
<< Intended to Disallow Operator Release request on          >><<03537>>25026000
<< cartridge tape drive. Could be extended for CS'80 discs.  >><<*8114>>25028000
<< Calls driver with function code LOCK, defined             >><<03537>>25030000
<< somewhere in an equate.                                   >><<03537>>25032000
                                                               <<03537>>25034000
BEGIN                                                          <<03537>>25036000
   LOGICAL Other'Locking'Device := FALSE;                      <<03537>>25038000
   ARRAY Junk'Buffer (0:Cartridge'Sector - 1);                 <<*8114>>25040000
   INTEGER Qmisc := 0;                                         <<03537>>25042000
   INTEGER Errors := 0;                                        <<03537>>25044000
   EQUATE Lock = 16;                                           <<03537>>25046000
                                                               <<03537>>25048000
   IF Is'It'Cartridge(Ldev) LOR Other'Locking'Device THEN      <<*8114>>25050000
   BEGIN                                                       <<03537>>25052000
      Cartridge'Io(Ldev,Qmisc,Junk'buffer,Lock,                <<*8114>>25054000
                   Cartridge'Sector,0D,Blocked'IO,             <<*8114>>25056000
                   NO'SPARING,0,Errors);                       <<*8114>>25058000
   END;                                                        <<03537>>25060000
END;                                                           <<03537>>25062000
$PAGE "PROCEDURE UNLOCK"                                       <<03537>>25064000
$CONTROL SEGMENT=LINUS                                         <<03537>>25066000
PROCEDURE Unlock(Ldev);                                        <<03537>>25068000
VALUE Ldev;                                                    <<03537>>25070000
INTEGER Ldev;                                                  <<03537>>25072000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25074000
                                                               <<03537>>25076000
<< Intended to Re-allow Operator Release request on          >><<03537>>25078000
<< cartridge tape drive. Could be extended for CS'80 discs.  >><<*8114>>25080000
<< Calls driver with function code UNLOCK, defined           >><<03537>>25082000
<< somewhere in an equate.                                   >><<03537>>25084000
                                                               <<03537>>25086000
BEGIN                                                          <<03537>>25088000
   LOGICAL Other'Locking'Device := FALSE;                      <<03537>>25090000
   ARRAY Junk'Buffer (0:Cartridge'Sector - 1);                 <<*8114>>25092000
   INTEGER Qmisc := 0;                                         <<03537>>25094000
   INTEGER Errors := 0;                                        <<03537>>25096000
   EQUATE Unlock = 17;                                         <<03537>>25098000
                                                               <<03537>>25100000
   IF Is'It'Cartridge(Ldev) LOR Other'Locking'Device THEN      <<*8114>>25102000
   BEGIN                                                       <<03537>>25104000
      Cartridge'Io(Ldev,Qmisc,Junk'buffer,Unlock,              <<*8114>>25106000
                   Cartridge'Sector,0D,Blocked'IO,NO'SPARING,  <<*8114>>25108000
                   0,Errors);                                  <<*8114>>25110000
   END;                                                        <<03537>>25112000
END;                                                           <<03537>>25114000
$PAGE "PROCEDURE ENABLE'BREAK"                                 <<03537>>25116000
$CONTROL SEGMENT=LINUS                                         <<03537>>25118000
PROCEDURE Enable'Break;                                        <<03537>>25120000
BEGIN                                                          <<03537>>25122000
   LOGICAL Dummy;                                              <<03537>>25124000
   EQUATE File'num = 1;  <<someday this should be fixed      >><<03537>>25126000
                         <<by passing a real File'num.       >><<03537>>25128000
   EQUATE En'Break = 15;                                       <<03537>>25130000
   Fcontrol(File'num,En'break,Dummy);                          <<03537>>25132000
END;                                                           <<03537>>25134000
$PAGE "PROCEDURE DISABLE'BREAK"                                <<03537>>25136000
$CONTROL SEGMENT=LINUS                                         <<03537>>25138000
PROCEDURE Disable'Break;                                       <<03537>>25140000
BEGIN                                                          <<03537>>25142000
   LOGICAL Dummy;                                              <<03537>>25144000
   EQUATE File'num = 1;  <<someday this should be fixed      >><<03537>>25146000
                         <<by passing a real File'num.       >><<03537>>25148000
   EQUATE Dis'Break = 14;                                      <<03537>>25150000
   Fcontrol(File'num,Dis'break,Dummy);                         <<03537>>25152000
END;                                                           <<03537>>25154000
$PAGE "PROCEDURE CARTRIDGE'NUMBERS"                            <<*8114>>25156000
$CONTROL SEGMENT=LINUS                                         <<03537>>25158000
                                                               <<03537>>25160000
LOGICAL PROCEDURE Cartridge'Numbers(Ldev,Buffer);              <<*8114>>25162000
VALUE Ldev;                                                    <<03537>>25164000
INTEGER Ldev;                                                  <<03537>>25166000
ARRAY Buffer;                                                  <<03537>>25168000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25170000
                                                               <<03537>>25172000
<< This innocent procedure goes out to                       >><<03537>>25174000
<< get the device specific numbers for                       >><<03537>>25176000
<< the Serial Label for cartridge tapes.                     >><<*8114>>25178000
<< The only other device dependent                           >><<03537>>25180000
<< information will written to the                           >><<03537>>25182000
<< label is the Type and Subtype of                          >><<03537>>25184000
<< the device which is done earlier.                         >><<03537>>25186000
<< After this procedure executes, the array                  >><<03537>>25188000
<< Buff in Servol has been overlaid with                     >><<03537>>25190000
<< exactly 7 words of useful data starting                   >><<03537>>25192000
<< with element Buff(Wordspersectr).                         >><<03537>>25194000
<< After this we are ready to write a Serial                 >><<03537>>25196000
<< Label.                                                    >><<03537>>25198000
                                                               <<03537>>25200000
BEGIN                                                          <<03537>>25202000
   INTEGER ARRAY Words'Per'Sector(*)  = Buffer(0);             <<03537>>25204000
   INTEGER ARRAY Sectors'Per'Track(*) = Buffer(1);             <<03537>>25206000
   INTEGER ARRAY BOT(*)               = Buffer(2);             <<03537>>25208000
   DOUBLE ARRAY Tape'Mark(*)          = Buffer(3);             <<03537>>25210000
   DOUBLE ARRAY EOT(*)                = Buffer(5);             <<03537>>25212000
                                                               <<03537>>25214000
   DEFINE BYLER'S'NUMBER = 16D#;                               <<03537>>25216000
   EQUATE Cartridge'SPT = 1;  << A System Wide Definition    >><<*8114>>25218000
   EQUATE Unformatted = 0;                                     <<03537>>25220000
                                                               <<03537>>25222000
<< The following two equates are the only places where       >><<03537>>25224000
<< the load point is defined for the Serial label on         >><<03537>>25226000
<< tape cartridges. The size of Gap Table is                 >><<*8114>>25228000
<< calculated in Servol based on the numbers returned        >><<03537>>25230000
<< here. If it becomes necessary to make the Gap Table       >><<03537>>25232000
<< bigger than 4 cartridge sectors, just change the          >><<*8114>>25234000
<< equates here, and the whole system will recognize it.     >><<03537>>25236000
                                                               <<03537>>25238000
   EQUATE Small'Load'Point = 8;  << A System Wide Definition >><<03537>>25240000
   EQUATE Large'Load'Point = 19; << A System Wide Definition >><<04316>>25242000
                                                               <<03537>>25244000
<< Following define is for the last adressable               >><<03537>>25246000
<< sector of data on a small cartridge.                      >><<*8114>>25248000
<< Remember that sectors address from zero.                  >><<03537>>25250000
                                                               <<03537>>25252000
   DEFINE SMALL'CARTRIDGE'LIMIT = 16351D#;                     <<03537>>25254000
   EQUATE Read'Error'Log = %305;                               <<03537>>25256000
   EQUATE Half'Cartridge'Sector = 256; << For Double Array   >><<*8114>>25258000
   EQUATE Certification'Byte = 23;                             <<03537>>25260000
   <<Above is DB+10 turned into byte address plus offset of 3>><<03537>>25262000
                                                               <<03537>>25264000
   INTEGER Qmisc := 0;                                         <<03537>>25266000
   INTEGER Errors := 0;                                        <<03537>>25268000
   DOUBLE Overrun'Area := BYLER'S'NUMBER;                      <<03537>>25270000
   DOUBLE ARRAY Volume'Limit(0:Half'Cartridge'Sector - 1);     <<*8114>>25272000
   ARRAY Numbers(*) = Volume'Limit;                            <<03537>>25274000
   BYTE ARRAY B'Numbers(*) = Numbers;                          <<03537>>25276000
   DOUBLE Address;                                             <<03537>>25278000
   LOGICAL Message'Qualifier = Address;                        <<03537>>25280000
   LOGICAL Utility'Number    = Address + 1;                    <<03537>>25282000
                                                               <<03537>>25284000
<< The first thing to do is to determine whether             >><<03537>>25286000
<< the media that is mounted has been ever                   >><<03537>>25288000
<< initialized. To determine this is non-trivial             >><<03537>>25290000
<< but the following is the most fool proof way              >><<03537>>25292000
<< we could find.                                            >><<03537>>25294000
<< We use driver function 91 - Initiate Utility              >><<03537>>25296000
<< The parameters passed are as follows:                     >><<03537>>25298000
<< The count only needs to be 20 or so but                   >><<03537>>25300000
<< use 1 Sector for simplicity.                              >><<03537>>25302000
<< P1 is 2 to indicate that information will                 >><<03537>>25304000
<< be returned from the device.                              >><<03537>>25306000
<< P2 is the Utility Number - %305 - Read Error Log          >><<03537>>25308000
<< In the buffer we set up the first 2 words to              >><<03537>>25310000
<< pass parameters to the Utility.                           >><<03537>>25312000
<< Word 0 is a 16 bit quantity indicating how many bytes     >><<03583>>25314000
<< follow.                                                   >><<03583>>25316000
<< Bytes passed as parameters are byte aligned starting      >><<03583>>25318000
<< with the second word.                                     >><<03583>>25320000
<< The parameters used this time are:                        >><<03537>>25322000
<< Word 0 - contains 1 indicating 1 byte to follow           >><<03537>>25324000
<< Byte 2 - contains 0 as a passed parameter.                >><<03583>>25326000
<< The Error Log is returned offset in the                   >><<03537>>25328000
<< same buffer by 10 (decimal) words. The                    >><<03537>>25330000
<< only part we want to see is the Log Header                >><<03537>>25332000
<< which is 4 bytes in length. The last byte (3)             >><<03537>>25334000
<< contains the Type of Certification.                       >><<03537>>25336000
<< If this byte is 0 then the Media hasn't been              >><<03537>>25338000
<< initialized.                                              >><<03537>>25340000
<< Simple, wasn't it ?                                       >><<03537>>25342000
<< If we get a 0 back, the fool                              >><<03537>>25344000
<< hasn't formatted the device yet so we return a            >><<03537>>25346000
<< FALSE and quit. Servol will print an error message        >><<03537>>25348000
<< and return.                                               >><<03537>>25350000
                                                               <<03537>>25352000
   Cartridge'Numbers := FALSE;                                 <<*8114>>25354000
   Numbers := 0;                                               <<03537>>25356000
   MOVE Numbers(1) := Numbers,(Cartridge'Sector - 1);          <<*8114>>25358000
                                                               <<03537>>25360000
   Message'Qualifier := Return'Message;                        <<03537>>25362000
   Utility'Number    := Read'Error'Log;                        <<03537>>25364000
   Numbers(0) := 1;                                            <<03537>>25366000
   B'Numbers(2) := 0;                                          <<03583>>25368000
                                                               <<03537>>25370000
   Cartridge'Io(Ldev,Qmisc,Numbers,Initiate'Utility,           <<*8114>>25372000
                Cartridge'Sector,Address,Blocked'IO,           <<*8114>>25374000
                NO'SPARING,Default'Errinfo,Errors);            <<*8114>>25376000
   IF < THEN RETURN;                                           <<03537>>25378000
                                                               <<03537>>25380000
   IF B'Numbers(Certification'Byte) = Unformatted THEN         <<03537>>25382000
   BEGIN                                                       <<03537>>25384000
      Cartridge'Numbers := FALSE;                             <<<*8114>>25386000
      RETURN;                                                  <<03537>>25388000
   END;                                                        <<03537>>25390000
                                                               <<03537>>25392000
<< Otherwise we plod on..                                    >><<03537>>25394000
<< Now we go to the device to see how big                    >><<03537>>25396000
<< it is. We are going to use the Request Volume             >><<03537>>25398000
<< Limit function to get the last sector address             >><<03537>>25400000
<< on the device. RVL is equated somewhere.                  >><<03537>>25402000
<< The RVL function of the driver returns 2 words            >><<03537>>25404000
<< of data in the sector indicating volume limit.            >><<03537>>25406000
<< The driver doesn't set either Count or Tlog so            >><<03537>>25408000
<< we have no idea how many words he is returning.           >><<03537>>25410000
<< We assumed 1 Cartridge'Sector.                            >><<*8114>>25412000
                                                               <<03537>>25414000
   Numbers := 0;                                               <<03537>>25416000
   MOVE Numbers(1) := Numbers,(Cartridge'Sector - 1);          <<*8114>>25418000
                                                               <<03537>>25420000
   Cartridge'Io(Ldev,Qmisc,Numbers,Req'Vol'Limit,              <<*8114>>25422000
                Cartridge'Sector,0D,Blocked'IO,NO'SPARING,     <<*8114>>25424000
                Default'Errinfo,Errors);                       <<*8114>>25426000
   IF < THEN RETURN;                                           <<03537>>25428000
                                                               <<03537>>25430000
<< Must have been good.                                      >><<03537>>25432000
                                                               <<03537>>25434000
   Words'Per'Sector := Cartridge'Sector;                       <<*8114>>25436000
   Sectors'Per'Track := Cartridge'SPT;                         <<*8114>>25438000
                                                               <<03537>>25440000
   IF Volume'Limit <= SMALL'CARTRIDGE'SIZE THEN                <<03537>>25442000
      BOT := Small'Load'Point                                  <<03537>>25444000
   ELSE                                                        <<03537>>25446000
      BOT := Large'Load'Point;                                 <<03537>>25448000
                                                               <<03537>>25450000
<< Subtract the Overrun'Area to place the Tape'Mark.         >><<03537>>25452000
                                                               <<03537>>25454000
   Tape'Mark := Volume'Limit - Overrun'Area;                   <<03537>>25456000
   EOT := Volume'Limit;                                        <<03537>>25458000
   Cartridge'Numbers := TRUE;                                  <<*8114>>25460000
END;                                                           <<03537>>25462000
$PAGE "PROCEDURE CARTRIDGE'IO"                                 <<*8114>>25464000
$CONTROL SEGMENT=LINUS                                         <<03537>>25466000
INTEGER PROCEDURE Cartridge'Io(Ldev,Qmisc,Buf,Funct,Wc,Addr,   <<*8114>>25468000
                  Flags,Spare'Mode,Errinfo,Err'Return);        <<*8114>>25470000
VALUE Ldev,Funct,Wc,Addr,Flags,Spare'Mode,Errinfo;             <<03537>>25472000
INTEGER Ldev,Qmisc,Funct,Wc,Flags;                             <<03537>>25474000
LOGICAL Spare'Mode,Errinfo,Err'return;                         <<03537>>25476000
DOUBLE Addr;                                                   <<03537>>25478000
ARRAY Buf;                                                     <<03537>>25480000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25482000
                                                               <<03537>>25484000
<< General Purpose routine for doing I/O to                  >><<03537>>25486000
<< Cartridge Tape Drive.                                     >><<*8114>>25488000
<< Calling Attackio directly from all over                   >><<03537>>25490000
<< the code is not very tasteful, hence                      >><<03537>>25492000
<< Cartridge'Io                                              >><<*8114>>25494000
<< Has been modeled after Discio routine                     >><<03537>>25496000
<< contained elsewhere in this listing, but                  >><<03537>>25498000
<< has been made more general and flexible                   >><<03537>>25500000
<< than Discio. If Discio had been                           >><<03537>>25502000
<< implemented a bit better, this routine                    >><<03537>>25504000
<< would have been unnecessary.                              >><<03537>>25506000
                                                               <<03537>>25508000
<< Variables of interest:                                    >><<03537>>25510000
<< ---------------------                                     >><<03537>>25512000
<< Ldev       - passed directly to Attachio.                 >><<03537>>25514000
<< Qmisc      - Passed straight to Attackio, apparently      >><<03537>>25516000
<<              Hioctap0 uses this.                          >><<03537>>25518000
<< Buf        - Buffer containing data going to/             >><<03537>>25520000
<<              coming from Linus/Buffalo, this has to be    >><<*8114>>25522000
<<              at least Cartridge'sector in size.           >><<*8114>>25524000
<<              We do some gymnastics here to pass           >><<03537>>25526000
<<              an address to buffer as an integer.          >><<03537>>25528000
<< Funct      - Driver function, passed to Attackio          >><<03537>>25530000
<< Wc         - The length of the data transfer.             >><<03537>>25532000
<< Addr       - The double sector address.                   >><<03537>>25534000
<<              This is split into P1 and P2 and             >><<03537>>25536000
<<              passed to Attackio.                          >><<03537>>25538000
<< Flags      - Depending on the state of the device's       >><<03537>>25540000
<<              LPDT entry, we may                           >><<03537>>25542000
<<              'OR' in bit #10 so that we never             >><<03537>>25544000
<<              allow Attackio to use Sdiscio,               >><<03537>>25546000
<<              then we pass this directly to                >><<03537>>25548000
<<              Attackio. See note later in code.            >><<03537>>25550000
<< Spare'Mode - Indicates whether we want to                 >><<03537>>25552000
<<              use jump or skip sparing.                    >><<03537>>25554000
<<              This flag is 'OR'ed into Top                 >><<03537>>25556000
<<              bit of P1.                                   >><<03537>>25558000
<<              TRUE implies Skip Sparing                    >><<03537>>25560000
<<              FALSE implies Jump Sparing                   >><<03537>>25562000
<<              This flag only valid during W or WL          >><<03537>>25564000
<<              functions.                                   >><<03537>>25566000
<<              The flag is also required for Fill Sector    >><<03537>>25568000
<<              with Blanks or Fill Sector with Zeroes,      >><<03537>>25570000
<<              but those operations are not used            >><<03537>>25572000
<<              in Vinit presently.                          >><<03537>>25574000
<< Errinfo    - Emulates Input Flags of Errinfo of Discio    >><<03537>>25576000
<<              Values Follow.                               >><<03537>>25578000
<<              (15:1) = 0 - Omit Disc Error Message         >><<03537>>25580000
<<                       1 - Print Disc Error Message.       >><<03537>>25582000
<<              (14:1) = 0 - Don't Return Error Status       >><<03537>>25584000
<<                     = 1 - Return Error To Caller.         >><<03537>>25586000
<<              (13:1) = 0 - Omit Function Abort Message     >><<03537>>25588000
<<                       1 - Print Function Abort Message    >><<03537>>25590000
<< Err'Return - Emulates the information that                >><<03537>>25592000
<<              Discio returned in Errinfo.                  >><<03537>>25594000
                                                               <<03537>>25596000
<< This function returns the Attachio Tlog                   >><<03537>>25598000
<< and sets CCL if it had problems doing I/O.                >><<03537>>25600000
                                                               <<03537>>25602000
BEGIN                                                          <<03537>>25604000
   DOUBLE D'Iostat := 0D;                                      <<03537>>25606000
   LOGICAL Iostat = D'Iostat;                                  <<03537>>25608000
   INTEGER Tlog = D'Iostat+1;  << To pick up the Tlog.       >><<03537>>25610000
   INTEGER P1 = Addr;                                          <<03537>>25612000
   INTEGER P2 = Addr+1;                                        <<03537>>25614000
   LOGICAL L'P1 = P1; << will need this to set spare bit.    >><<03537>>25616000
   INTEGER POINTER Bufp = Buf;                                 <<03537>>25618000
   INTEGER Resulting'P1 := 0;                                  <<03537>>25620000
   LOGICAL L'R'P1 = Resulting'P1;                              <<03537>>25622000
   LOGICAL L'Flags = Flags;                                    <<03537>>25624000
   DEFINE P1'FIELD = (1:15)#; <<remainder of P1.             >><<03537>>25626000
   DEFINE  SKP'SPARING = 1#;        <<Get's 'OR'ed into P1   >><<03537>>25628000
   DEFINE  JMP'SPARING = 0#;                                   <<03537>>25630000
   DEFINE EVADE'SDISCIO = 1#;        << We don't want it.    >><<03537>>25632000
   DEFINE SPECIAL'REQUEST = (10:1)#;                           <<03537>>25634000
   DEFINE SPARING'BIT = (0:1)#;                                <<03537>>25636000
   EQUATE Out'Of'Spares = %16; << Attachio Return            >><<03537>>25638000
   EQUATE Uninitialized = %15; << Attachio Return            >><<03537>>25640000
   EQUATE Initialize'Media = 8;                                <<04670>>25642000
                                                               <<03537>>25644000
   CC := CCE;                                                  <<03537>>25646000
   << Now we fiddle around with the parameters.              >><<03537>>25648000
                                                               <<03537>>25650000
<< Ah, sweet mystery of life department:                     >><<03537>>25652000
                                                               <<03537>>25654000
<< There is this bit that is called the special bit          >><<03537>>25656000
<< which is used to get around normal serial disc            >><<03537>>25658000
<< processing and allow the Vinit user to do real I/O        >><<03537>>25660000
<< directly to the device. This is allowed because           >><<03537>>25662000
<< any operation that would affect the integrity of the      >><<03537>>25664000
<< device requires the user to down the device first.        >><<03537>>25666000
<< It seems I underestimated the complexity of               >><<03537>>25668000
<< how this all works. Anyways there is a delicate           >><<03537>>25670000
<< relationship between some code in Attachio and            >><<03537>>25672000
<< what the second word in the LPDT entry for the            >><<03537>>25674000
<< device contains. If you set the special bit               >><<03537>>25676000
<< incorrectly, you will be rewarded with a                  >><<03537>>25678000
<< Suddendeath 613.                                          >><<03537>>25680000
<< In order to prevent this we take a peek at the            >><<03537>>25682000
<< LPDT entry to correctly set the special bit.              >><<03537>>25684000
<< Fields of interest are                                    >><<03537>>25686000
<< 1/LPDT Word 1.DRSTATE (bits 0 for 2)                      >><<03537>>25688000
<<  This field must be 0 when the device is down,            >><<03537>>25690000
<<  but can be 1 when someone is accessing the               >><<03537>>25692000
<<  device. (Like when you do a Plabel when someone          >><<03537>>25694000
<<  else has the device opened.)                             >><<03537>>25696000
<< 2/LPDT Word 1.FORS (bits 11 for 1)                        >><<03537>>25698000
<<  If this bit is 0 then device is Serial,                  >><<03537>>25700000
<<  else Foreign.                                            >><<03537>>25702000
<<  This bit is manipulated by Vinit, Pvproc and             >><<03537>>25704000
<<  set originally by Initial.                               >><<03537>>25706000
<<  I have found it is hard to predict what this             >><<03537>>25708000
<<  bit will be at any given time.                           >><<03537>>25710000
                                                               <<03537>>25712000
<< Anyways, if the device is allocated and                   >><<03537>>25714000
<< a valid serial disc type, then we want to set the         >><<03537>>25716000
<< special bit on.                                           >><<03537>>25718000
<< Otherwise, we leave it off, and the I/O                   >><<03537>>25720000
<< system gives us the same result anyways.                  >><<03537>>25722000
                                                               <<03537>>25724000
   IF LPDT'DEV'OWN'STATE = LPDT'OWNED AND                      <<06276>>25726000
      LPDT'SERIAL'OR'FOREIGN = LPDT'SERIAL THEN                <<06276>>25728000
      L'Flags.SPECIAL'REQUEST := EVADE'SDISCIO;                <<03537>>25730000
                                                               <<03537>>25732000
   IF Funct = W OR Funct = WL THEN                             <<03537>>25734000
                                                               <<03537>>25736000
<< If Cartridge'Io is ever called with Fill Sector with      >><<*8114>>25738000
<< Blanks or Fill Sector with Zeroes, then the above         >><<03537>>25740000
<< check will need to be expanded.                           >><<03537>>25742000
                                                               <<03537>>25744000
   BEGIN                                                       <<03537>>25746000
      L'R'P1 := P1.P1'FIELD; <<Moves lower 15 bits across    >><<03537>>25748000
      IF Spare'Mode THEN                                       <<03537>>25750000
         L'R'P1.SPARING'BIT := SKP'SPARING                     <<03537>>25752000
      ELSE                                                     <<03537>>25754000
         L'R'P1.SPARING'BIT := JMP'SPARING;                    <<03537>>25756000
   END                                                         <<03537>>25758000
   ELSE                                                        <<03537>>25760000
      Resulting'P1 := P1; << Move all 16 bits                >><<03537>>25762000
        << above is a Kludge to take care of a               >><<03537>>25764000
        << HIOCTAP0 problem.                                 >><<03537>>25766000
                                                               <<03537>>25768000
   D'Iostat := Attachio(Ldev,Qmisc,0,@Bufp,Funct,Wc,           <<03537>>25770000
                        Resulting'P1,P2,Flags);                <<03537>>25772000
                                                               <<03537>>25774000
   IF Iostat.GSTATUS <> SUCCESSFUL THEN  <<Unsucessful I/O   >><<03537>>25776000
   BEGIN                                                       <<03537>>25778000
      CC := CCL;                                               <<03537>>25780000
      IF Iostat.QSTATUS = Out'Of'Spares THEN                   <<03537>>25782000
         Genmsg(Pvmsgset,Vierr91)                              <<03537>>25784000
      ELSE IF Iostat.QSTATUS = Uninitialized THEN              <<03537>>25786000
         IF Funct = Initialize'Media THEN                      <<04670>>25788000
            Genmsg(Pvmsgset,Vierr136)                          <<04670>>25790000
         ELSE                                                  <<04670>>25792000
            Genmsg(Pvmsgset,Vierr92)                           <<04670>>25794000
                                                               <<03537>>25796000
  << Above two messages are the only intelligible            >><<03537>>25798000
  << Status returns that the driver gives.                   >><<03537>>25800000
  << All others are like Unit Failure and don't              >><<03537>>25802000
  << really let us give a good message.                      >><<03537>>25804000
                                                               <<03537>>25806000
           ELSE IF Errinfo.(15:1) THEN                         <<03537>>25808000
              Discerror(Ldev,Funct,Iostat,Addr,                <<03537>>25810000
                        Stat.(8:8),Delp);                      <<03537>>25812000
                                                               <<03537>>25814000
      IF Errinfo.(13:1) THEN Genmsg(Pvmsgset,Vierr0);          <<03537>>25816000
   END;                                                        <<03537>>25818000
   IF Errinfo.(14:1) THEN Err'Return := Iostat;                <<03537>>25820000
   Cartridge'Io := Tlog;                                       <<*8114>>25822000
END;                                                           <<03537>>25824000
$PAGE "PROCEDURE FORMAT'A'CARTRIDGE"                           <<*8114>>25826000
$CONTROL SEGMENT=LINUS                                         <<03537>>25828000
PROCEDURE Format'A'Cartridge(Ldev,Spares,Interleave);          <<*8114>>25830000
VALUE Ldev,Spares,Interleave;                                  <<03537>>25832000
INTEGER Ldev,Spares,Interleave;                                <<03537>>25834000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25836000
                                                               <<03537>>25838000
<< This procedure goes out to format the Linus/Buffalo       >><<*8114>>25840000
<< cartridge all by itself. If the diagnostic                >><<03537>>25842000
<< entry point has been used then we allow the               >><<03537>>25844000
<< user to kill field discovered spares.                     >><<03537>>25846000
<< Otherwise all spares are retained and all                 >><<03537>>25848000
<< existing jump spares are converted to skips.              >><<03537>>25850000
<< This routine may take a long long time time,              >><<03537>>25852000
<< depending on how big the cartridge is.                    >><<03537>>25854000
<< Lower down you will see some code to enable               >><<03537>>25856000
<< the break key so that the user can at least               >><<03537>>25858000
<< get some critical commands into the system.               >><<03537>>25860000
<< (If we get it to work.)                                   >><<03537>>25862000
                                                               <<03537>>25864000
BEGIN                                                          <<03537>>25866000
   INTEGER Qmisc := 0;                                         <<03537>>25868000
   INTEGER Errors := 0;                                        <<03537>>25870000
   EQUATE Initialize'Media = 8;                                <<03537>>25872000
   ARRAY Junk'Buffer(0:Cartridge'Sector - 1); << Not used.   >><<*8114>>25874000
   DOUBLE Address := 0D;                                       <<03537>>25876000
   INTEGER P1 = Address;                                       <<03537>>25878000
   INTEGER P2 = Address + 1;                                   <<03537>>25880000
                                                               <<03537>>25882000
   IF Diag'Entry THEN << Must be a CE.                       >><<03537>>25884000
   BEGIN                                                       <<03537>>25886000
      IF Spares = Physical'Format THEN <<Not Allowed.        >><<03537>>25888000
         P1 := Retain'All'Spares                               <<03537>>25890000
      ELSE                                                     <<03537>>25892000
         P1 := Spares;                                         <<03537>>25894000
   END                                                         <<03537>>25896000
   ELSE          << Didn't use the entry point.              >><<03537>>25898000
      P1  := Retain'All'Spares;                                <<03537>>25900000
   P2 := Interleave;                                           <<03537>>25902000
   CC := CCE;                                                  <<03537>>25904000
   Format'Msg(P1);                                             <<03537>>25906000
   Enable'Break;                                               <<03537>>25908000
   Cartridge'Io(Ldev,Qmisc,Junk'Buffer,Initialize'Media,       <<*8114>>25910000
                Cartridge'Sector,Address,Blocked'IO,           <<*8114>>25912000
                NO'SPARING,Default'Errinfo,Errors);            <<*8114>>25914000
   IF < THEN                                                   <<03537>>25916000
      CC := CCL;                                               <<03537>>25918000
   Disable'Break;                                              <<03537>>25920000
END;                                                           <<03537>>25922000
$PAGE "FORMAT'MSG"                                             <<03537>>25924000
$CONTROL SEGMENT=LINUS                                         <<03537>>25926000
PROCEDURE Format'Msg(Spares);                                  <<03537>>25928000
VALUE Spares;                                                  <<03537>>25930000
INTEGER Spares;                                                <<03537>>25932000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03537>>25934000
BEGIN                                                          <<03537>>25936000
                                                               <<03537>>25938000
<< Tell the user what we are doing.                          >><<03537>>25940000
<< The meaning of the Spares variable is                     >><<03537>>25942000
<< equated elsewhere.                                        >><<03537>>25944000
                                                               <<03537>>25946000
    INTEGER Len := 0;                                          <<03537>>25948000
    Msgw := 0;                                                 <<03537>>25950000
    MOVE Msgw(1) := Msgw,(35);                                 <<03537>>25952000
    CASE *Spares OF                                            <<03537>>25954000
    BEGIN                                                      <<03537>>25956000
      <<0>>                                                    <<03537>>25958000
        MOVE Msg := "Format Retaining All Spares.",2;          <<03537>>25960000
      <<1>>                                                    <<03537>>25962000
        MOVE Msg :=                                            <<03537>>25964000
           "Format Retaining Factory Spares Only.",2;          <<03537>>25966000
      <<2>>                                                    <<03537>>25968000
        MOVE Msg := "Physical Format.",2;                      <<03537>>25970000
    END;                                                       <<03537>>25972000
    Len := TOS - @Msg;                                         <<03537>>25974000
    Print(Msgw, -Len, 0);                                      <<03537>>25976000
END;                                                           <<03537>>25978000
$PAGE "PROCEDURE PRINT'CARTRIDGE'SPARES"                       <<*8114>>25980000
$CONTROL SEGMENT=LINUS                                         <<03583>>25982000
PROCEDURE Print'Cartridge'Spares(Ldev);                        <<*8114>>25984000
VALUE Ldev;                                                    <<03583>>25986000
INTEGER Ldev;                                                  <<03583>>25988000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03583>>25990000
                                                               <<03583>>25992000
BEGIN                                                          <<03583>>25994000
   ARRAY Spare'Table(0:Cartridge'Sector - 1);                  <<*8114>>25996000
   BYTE ARRAY B'Spare'Table(*) = Spare'Table;                  <<03583>>25998000
   INTEGER Qmisc := 0;                                         <<03583>>26000000
   INTEGER Err'Info := 0;                                      <<03583>>26002000
   INTEGER Err'result := 0;                                    <<03583>>26004000
   INTEGER I := 0; << Counter Variable - For Loop            >><<03583>>26006000
   DOUBLE Address;                                             <<03583>>26008000
   LOGICAL Message'Qualifier = Address;                        <<03583>>26010000
   LOGICAL Utility'Number = Address + 1;                       <<03583>>26012000
                                                               <<03583>>26014000
   INTEGER Block'Number := 0;                                  <<03583>>26016000
   BYTE ARRAY B'Block'Number(*) = Block'Number;                <<03583>>26018000
   INTEGER Counter := 0; << Used to keep track of where      >><<03583>>26020000
                         << we are in the byte array.        >><<03583>>26022000
                                                               <<03583>>26024000
   EQUATE Spare'Block'Table = 11;                              <<03583>>26026000
   Spare'Table := 0;                                           <<03583>>26028000
   MOVE Spare'Table(1) := Spare'Table,(Cartridge'Sector - 1);  <<*8114>>26030000
                                                               <<03583>>26032000
   Message'Qualifier := Return'Message;                        <<03583>>26034000
   Utility'Number := Read'Drive'Tables;                        <<03583>>26036000
                                                               <<03583>>26038000
   Spare'Table(0) := 1; << 1 Byte to Follow.                 >><<03583>>26040000
                                                               <<03583>>26042000
   << The first word was a 16 bit counter indicating         >><<03583>>26044000
   << how many bytes are going to follow. It gets            >><<03583>>26046000
   << eaten up by the driver. The bytes following            >><<03583>>26048000
   << are byte aligned (not word aligned) starting           >><<03583>>26050000
   << in the left byte of the second word.                   >><<03583>>26052000
                                                               <<03583>>26054000
   << We want to read the Cartridge Spare Block Table.       >><<*8114>>26056000
                                                               <<03583>>26058000
   B'Spare'Table(2) := Spare'Block'Table;                      <<03583>>26060000
                                                               <<03583>>26062000
   Err'Info := 2; << Return error, don't print message.      >><<03583>>26064000
                                                               <<03583>>26066000
   Cartridge'Io(Ldev,Qmisc,Spare'Table,Initiate'Utility,       <<*8114>>26068000
                Cartridge'Sector,Address,Blocked'IO,           <<*8114>>26070000
                NO'SPARING,Err'Info,Err'Result);               <<*8114>>26072000
                                                               <<03583>>26074000
   IF < THEN                                                   <<03583>>26076000
   BEGIN                                                       <<03583>>26078000
      Genmsg(Pvmsgset, Viwarn101);                             <<03583>>26080000
      RETURN;                                                  <<03583>>26082000
   END;                                                        <<03583>>26084000
                                                               <<03583>>26086000
   << Have a bit of a problem here. We are going             >><<03583>>26088000
   << to print out the contents of a table that              >><<03583>>26090000
   << must have been defined at Boise. The                   >><<03583>>26092000
   << addressable unit they used is a byte.                  >><<03583>>26094000
   << Clearly they must have done this so we could           >><<03583>>26096000
   << hook this peripheral to a 6800 or a 41-C               >><<03583>>26098000
   << or something like that.                                >><<03583>>26100000
   << The table format is as follows:                        >><<03583>>26102000
   << The header record is one byte which is a counter       >><<03583>>26104000
   << indexed from 1 (I hope) indicating how many            >><<03583>>26106000
   << 3 byte records following are meaningful.               >><<03583>>26108000
   << I don't know what an empty table looks like, but       >><<03583>>26110000
   << I suspect it has a zero in the header record with      >><<03583>>26112000
   << gibberish following.                                   >><<03583>>26114000
   << Anyways, the 3 byte record contains 2 bytes            >><<03583>>26116000
   << containing the physical block number of spared blocks  >><<03583>>26118000
   << and the next byte contains the track number            >><<03583>>26120000
   << of the spared block. Handling 3 byte records is        >><<03583>>26122000
   << real fun in SPL. For more details on what the          >><<03583>>26124000
   << table contains see a Linus or CS'80 family             >><<03583>>26126000
   << ERS.                                                   >><<03583>>26128000
                                                               <<03583>>26130000
   IF ( B'Spare'Table(First'Byte) = 0 ) THEN                   <<03583>>26132000
                                                               <<03583>>26134000
   << The table has no entries (empty)                       >><<03583>>26136000
                                                               <<03583>>26138000
   BEGIN                                                       <<03583>>26140000
      Genmsg(Pvmsgset, Viwarn102);                             <<03583>>26142000
      RETURN;                                                  <<03583>>26144000
   END;                                                        <<03583>>26146000
                                                               <<03583>>26148000
   << Otherwise print out the table.                         >><<03583>>26150000
                                                               <<03583>>26152000
   << Here goes the Header.                                  >><<03583>>26154000
   << Will say number of entries found and to see            >><<03583>>26156000
   << Linus ERS or Boise TSE for interpretation.             >><<03583>>26158000
                                                               <<03583>>26160000
   Genmsg(Pvmsgset, Viwarn103, %010000,                        <<03583>>26162000
          INTEGER(B'Spare'Table(First'Byte)),                  <<03583>>26164000
          <<p2>>,<<p3>>,<<p4>>,<<p5>>,-Outf);                  <<03583>>26166000
                                                               <<03583>>26168000
   Counter := First'Byte + 1;                                  <<03583>>26170000
                                                               <<03583>>26172000
   << To get to the first record in the buffer.              >><<03583>>26174000
                                                               <<03583>>26176000
   FOR I := 0 UNTIL                                            <<03583>>26178000
      (INTEGER(B'Spare'Table(First'Byte)) - 1)                 <<03583>>26180000
   DO BEGIN                                                    <<03583>>26182000
      MOVE B'Block'Number := B'Spare'Table(Counter + 3*I),(2); <<03583>>26184000
                                                               <<03583>>26186000
      << Picking up 3 word entries and printing them.        >><<03583>>26188000
                                                               <<03583>>26190000
      Genmsg(Pvmsgset,Viwarn104,%011000,                       <<03583>>26192000
             Block'Number,                                     <<03583>>26194000
             INTEGER(B'Spare'Table(Counter + 3 * I + 2)),      <<03583>>26196000
             <<p3>>,<<p4>>,<<p5>>,-Outf);                      <<03583>>26198000
   END;                                                        <<03583>>26200000
END;                                                           <<03583>>26202000
$PAGE "PROCEDURE PRINT'CS'80'SPARES"                           <<03583>>26204000
$CONTROL SEGMENT= PVSTATUS                                     <<03583>>26206000
PROCEDURE Print'CS'80'Spares(Ldev);                            <<03583>>26208000
VALUE Ldev;                                                    <<03583>>26210000
INTEGER Ldev;                                                  <<03583>>26212000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03583>>26214000
                                                               <<03583>>26216000
<< The intention of this procedure is to print               >><<03583>>26218000
<< out the spare track and sector table for                  >><<03583>>26220000
<< any  CS'80 disc device. It is only invoked                >><<03583>>26222000
<< when the Vinit user has run Vinit with the                >><<03583>>26224000
<< Diag entry point. The procedure does direct               >><<03583>>26226000
<< its output to the File VINLIST if a file                  >><<03583>>26228000
<< equation has been provided. This procedure                >><<03583>>26230000
<< is called from the procedure PDTRACK.                     >><<03583>>26232000
                                                               <<03583>>26234000
BEGIN                                                          <<03583>>26236000
   EQUATE Buffer'Size = 159;                                   <<03583>>26238000
                                                               <<03583>>26240000
<< Driver can presently return a maximum of 13 Heads         >><<03583>>26242000
<< worth of data times max. of 23 bytes per head.            >><<03583>>26244000
<< But also need 20 bytes of slop area at the front          >><<03583>>26246000
<< of the buffer for the parameters passed to the            >><<03583>>26248000
<< driver. In total 319 bytes = 160 words, or 159            >><<03583>>26250000
<< when indexing from zero. Might need to increase this      >><<03583>>26252000
<< if we get a bigger CS'80 device.                          >><<03583>>26254000
                                                               <<03583>>26256000
   EQUATE Three'Vector'Address = 1;                            <<03583>>26258000
   EQUATE Head'Byte = 2; << Index into buffer returned       >><<03583>>26260000
                         << from Request Volume Limit.       >><<03583>>26262000
   EQUATE Spare'Track'Table = 1;                               <<03583>>26264000
                                                               <<03583>>26266000
   ARRAY Spare'Table(0:Buffer'Size - 1);                       <<03583>>26268000
   BYTE ARRAY B'Spare'Table(*) = Spare'Table;                  <<03583>>26270000
                                                               <<03583>>26272000
   DOUBLE Address := 0D;                                       <<03583>>26274000
   LOGICAL P1 = Address;                                       <<03583>>26276000
   LOGICAL P2 = Address + 1;                                   <<03583>>26278000
                                                               <<03583>>26280000
   LOGICAL Message'Qualifier = Address;                        <<03583>>26282000
   LOGICAL Utility'Number = Address + 1;                       <<03583>>26284000
                                                               <<03583>>26286000
   INTEGER Num'Spare := 0;                                     <<03583>>26288000
   BYTE ARRAY B'Num'Spare(*) = Num'Spare;                      <<03583>>26290000
                                                               <<03583>>26292000
   INTEGER Heads := 0;                                         <<03583>>26294000
   INTEGER I := 0;                                             <<03583>>26296000
   INTEGER J := 0;                                             <<03583>>26298000
   INTEGER Status := 0; << For Discio.                       >><<03583>>26300000
   INTEGER Counter := 0; << Points to Current Buffer Entry.  >><<03583>>26302000
                                                               <<03583>>26304000
   Spare'Table := 0;                                           <<03583>>26306000
   MOVE Spare'Table(1) := Spare'Table,(Buffer'Size - 1);       <<03583>>26308000
                                                               <<03583>>26310000
<< First we want to get the number of heads on the disc.     >><<03583>>26312000
<< This way the procedure is generalized for CS'80           >><<03583>>26314000
<< discs that haven't even been built yet.                   >><<03583>>26316000
<< We use the Request Volume Limit function of the driver    >><<03583>>26318000
<< with P1 set to one. This returns a three-vector           >><<03583>>26320000
<< address of the max. volume limits as follows.             >><<03583>>26322000
                                                               <<03583>>26324000
<<  Word 0 --> | Max Cylinder #            |                 >><<03583>>26326000
<<  Byte 2 --> | Max Head # | Max Sector # | <-- Byte 3      >><<03583>>26328000
                                                               <<03583>>26330000
   Status := 1;   << Let Discerror handle errors.            >><<03583>>26332000
   P1 := Three'Vector'Address;                                 <<03583>>26334000
   P2 := 0;                                                    <<03583>>26336000
   Discio(Ldev,Req'Vol'Limit,Spare'Table,Address,              <<03583>>26338000
          Sector'Size,Status);                                 <<03583>>26340000
   IF < THEN RETURN;                                           <<03583>>26342000
                                                               <<03583>>26344000
   Heads := INTEGER(B'Spare'Table(Head'Byte)) + 1;             <<03583>>26346000
                                                               <<03583>>26348000
<< Above head number is incremented because driver           >><<03583>>26350000
<< returns a zero relative index.                            >><<03583>>26352000
                                                               <<03583>>26354000
                                                               <<03583>>26356000
   Spare'Table := 0;                                           <<03583>>26358000
   MOVE Spare'Table(1) := Spare'Table,(Buffer'Size - 1);       <<03583>>26360000
                                                               <<03583>>26362000
<< Now read the spare table. We do this by using the         >><<03583>>26364000
<< Initiate'Utility function of the driver. If you want      >><<03583>>26366000
<< the details on how to do it, read documentation           >><<03583>>26368000
<< in procedures Print'Linus'Spares and in Linus'Numbers.    >><<03583>>26370000
                                                               <<03583>>26372000
   Message'Qualifier := Return'Message;                        <<03583>>26374000
   Utility'Number := Read'Drive'Tables;                        <<03583>>26376000
                                                               <<03583>>26378000
   Spare'Table(0) := 1; << 1 byte follows.                   >><<03583>>26380000
   B'Spare'Table(2) := Spare'Track'Table;                      <<03583>>26382000
                                                               <<03583>>26384000
   Status := 0;                                                <<03583>>26386000
                                                               <<03583>>26388000
   Discio(Ldev,Initiate'Utility,Spare'Table,Address,           <<03583>>26390000
          Buffer'Size,Status);                                 <<03583>>26392000
   IF < THEN                                                   <<03583>>26394000
   BEGIN                                                       <<03583>>26396000
                                                               <<03583>>26398000
<< Unable to read the Spare Table. Bye-bye.                  >><<03583>>26400000
                                                               <<03583>>26402000
      Genmsg(PVMSGSET,Vierr109);                               <<03583>>26404000
      RETURN;                                                  <<03583>>26406000
   END;                                                        <<03583>>26408000
                                                               <<03583>>26410000
<< Now we should have the Spare Table. Now print it          >><<03583>>26412000
<< and go home for Thanksgiving.                             >><<03583>>26414000
                                                               <<03583>>26416000
<< Print a Header Line. Tell him how many heads we think     >><<03583>>26418000
<< we have.                                                  >><<03583>>26420000
                                                               <<03583>>26422000
   Genmsg(PVMSGSET,Viwarn110,%011000,Heads,Heads - 1,          <<03583>>26424000
          <<p3>>,<<p4>>,<<p5>>,-Outf);                         <<03583>>26426000
                                                               <<03583>>26428000
<< The format of this table is weird. It has                 >><<03583>>26430000
<< one block for each head. Inside each block there          >><<03583>>26432000
<< is a fixed overhead entry and a variable number           >><<03583>>26434000
<< of detail entries. See the BFD ERS (from Boise)           >><<03583>>26436000
<< for details. The reason we are using Num'Spare            >><<03583>>26438000
<< is that they split 16 bit integers over word              >><<03583>>26440000
<< boundaries half of the time.                              >><<03583>>26442000
                                                               <<03583>>26444000
   Counter := First'Byte; << Data starts at Buffer + 10.     >><<03583>>26446000
   FOR I := 1 UNTIL Heads DO                                   <<03583>>26448000
   BEGIN                                                       <<03583>>26450000
                                                               <<03583>>26452000
<< Print an overhead entry for each head.                    >><<03583>>26454000
                                                               <<03583>>26456000
      Move B'Num'Spare := B'Spare'Table(Counter + 1),(2);      <<03583>>26458000
      Genmsg(PVMSGSET,Viwarn111,%011110,                       <<03583>>26460000
             INTEGER(B'Spare'Table(Counter)),                  <<03583>>26462000
             Num'Spare,                                        <<03583>>26464000
             INTEGER(B'Spare'Table(Counter + 3)),              <<03583>>26466000
             INTEGER(B'Spare'Table(Counter + 4)),              <<03583>>26468000
             <<p5>>,-Outf);                                    <<03583>>26470000
      Counter := Counter + 5;                                  <<03583>>26472000
                                                               <<03583>>26474000
<< Now we have the Header done. We look back in our          >><<03583>>26476000
<< Buffer to see if there are any detail entries to          >><<03583>>26478000
<< list out.                                                 >><<03583>>26480000
                                                               <<03583>>26482000
      IF INTEGER(B'Spare'Table(Counter - 1)) > 0 THEN          <<03583>>26484000
      BEGIN                                                    <<03583>>26486000
         FOR J := 1 UNTIL INTEGER(B'Spare'Table(Counter -1)) DO<<03583>>26488000
         BEGIN                                                 <<03583>>26490000
            MOVE B'Num'Spare := B'Spare'Table(Counter),(2);    <<03583>>26492000
                                                               <<03583>>26494000
<< Now we print one of 2 detail lines, one is for            >><<03583>>26496000
<< factory spares, the other is for field discovered spares. >><<03583>>26498000
<< The top bit tells us that it is a factory spare.          >><<03583>>26500000
                                                               <<03583>>26502000
            Genmsg(PVMSGSET,IF B'Spare'Table(Counter+2).(0:1)  <<03583>>26504000
                            = 1 THEN                           <<03583>>26506000
                                   Viwarn112                   <<03583>>26508000
                                ELSE                           <<03583>>26510000
                                   Viwarn113,                  <<03583>>26512000
                   %011000,Num'Spare,                          <<03583>>26514000
                   INTEGER(B'Spare'Table(Counter+2).(1:7)),    <<03583>>26516000
                   <<p3>>,<<p4>>,<<p5>>,-Outf);                <<03583>>26518000
            Counter := Counter + 3;                            <<03583>>26520000
         END;                                                  <<03583>>26522000
      END;                                                     <<03583>>26524000
   END;                                                        <<03583>>26526000
END;                                                           <<03583>>26528000
$PAGE  "   - OUTER BLOCK "                                              26530000
$CONTROL SEGMENT=VINITCI                                                26532000
                              IF (special'entry:=false) THEN   <<03537>>26534000
                                 BEGIN                         <<03537>>26536000
testentry:                          special'entry:=true;       <<03537>>26538000
                                    genmsg(pvmsgset,viwarn76,  <<03537>>26540000
                                           ,,,,,,0);           <<03537>>26542000
                                 END;                          <<03537>>26544000
$IF X3=OFF     << ALLOW USER TRAPS >>                          <<03537>>26546000
                              TRAPS;                                    26548000
$IF                                                            <<03537>>26550000
IF FALSE THEN  << Skip entry point >>                                   26552000
                                                                        26554000
DIAG:  DIAG'ENTRY := TRUE;  << For SE/CE use in FORMAT >>               26556000
                                                                        26558000
                            SETUPSHOP;                                  26560000
                      WHILE MORE DO FUNCTION;                           26562000
                               END.                                     26564000
