$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
<<************************* VINIT *************************>>           00042000
<< fix for KPR #15570 -bmp                                   >><<03541>>00044000
<< KPR #15570 - stack and prompt were being trashed during   >><<03541>>00046000
<<              entry of command lines longer than 19 bytes. >><<03541>>00048000
<< Enhancement to support Linus (HP 9110)                    >><<03537>>00050000
<< and CS'80 discs. Linus enhancement complete               >><<03537>>00052000
<< as described in Vinit - Linus ERS.                        >><<03537>>00054000
<< CS'80 enhancement partially implemented.                  >><<03537>>00056000
<< bmp - Nov 1981                                            >><<03537>>00058000
<< Allow Pdtrack to list out the Defective sector Table      >><<03536>>00060000
<< on a CS'80 disc. -bmp Nov. 81                             >><<03536>>00062000
<< Implement DIAG entry point enhancements to Pdtrack        >><<03583>>00064000
<< command - HP INTERNAL USE ONLY - bmp Nov 1981             >><<03583>>00066000
<< A slight enhancement.. Allow Pdtrack on Serial devices.   >><<03621>>00068000
<< This was not allowed previously because the Serial Disc   >><<03621>>00070000
<< Interface pretty well ignores the contents of the         >><<03621>>00072000
<< DTT or DSCT anyways. This was mostly done to allow        >><<03621>>00074000
<< printing of the Spared Track Tables when using the        >><<03621>>00076000
<< special entry point.                                      >><<03621>>00078000
                                                                        00080000
$SET X3=OFF    << FOR DFSM DEBUG >>                            <<03510>>00082000
                                                               <<03510>>00084000
ENTRY                                                          <<03537>>00086000
  TESTENTRY,                                                   <<03537>>00088000
  DIAG;                                                        <<03537>>00090000
                                                               <<03510>>00092000
LOGICAL STAT=Q-1;                                                       00094000
LOGICAL DELP=Q-2;                                              <<RK.08>>00096000
INTEGER X=X;                                                            00098000
INTEGER S0=S-0,S1=S-1,S2=S-2,S3=S-3,S4=S-4,S5=S-5;                      00100000
INTEGER QM0=Q-0,QM5=Q-5;                                                00102000
LOGICAL LS0=S-0;                                                        00104000
DOUBLE DS3=S-3,DS6=S-6;                                                 00106000
BYTE POINTER BPS0 = S-0;                                                00108000
DEFINE INT=INTEGER#;                                           <<03510>>00110000
DEFINE LOG=LOGICAL#;                                           <<03510>>00112000
DEFINE DBL=DOUBLE#;                                            <<03510>>00114000
                                                               <<03510>>00116000
EQUATE VUFPOS = 6;                                             <<04299>>00118000
$INCLUDE INCLVUF                                               <<04299>>00120000
DEFINE id =                                                    <<03510>>00122000
   "VINIT         (C) HEWLETT-PACKARD CO., 1978"#;             <<04299>>00124000
                                                               <<03510>>00126000
                                                                        00128000
DEFINE         condcode=status.(6:2)#;                         <<03510>>00130000
                                                                        00132000
INTEGER OUTF;  <<OUTPUT FILE NUMBER>>                                   00134000
INTEGER LDEV;                                                  <<03620>>00136000
INTEGER FUNCT;  <<COMMAND TYPE>>                                        00138000
                                                                        00140000
LOGICAL                                                                 00142000
     req'brk,                                                  <<03510>>00144000
     VSIDSPEC,                                                          00146000
     VNAMESPEC,                                                         00148000
     validvsid;                                                <<03510>>00150000
                                                                        00154000
LOGICAL MORE:=TRUE;  <<FUNCTION LOOP CONTROL VARIABLE>>                 00156000
<< this is a flag to see if VINIT got run from a special >>    <<03510>>00158000
<< entry point. For right now, the only thing it does is >>    <<03510>>00160000
<< it wont check for only'one'on for a cond;recover      >>    <<03510>>00162000
<< for those damn automated test!                        >>    <<03510>>00164000
                                                               <<03510>>00166000
LOGICAL special'entry;                                         <<03510>>00168000
LOGICAL DIAG'ENTRY := FALSE;                                   <<03537>>00170000
INTEGER SECTRK;   << # OF SECTORS PER TRACK >>                 <<03620>>00172000
INTEGER TRKCYL;                                                <<04670>>00174000
INTEGER MAXLPS;                                                <<04670>>00176000
INTEGER SECSIZE;                                               <<04670>>00178000
INTEGER STATUS := 0;  <<DTRACK IO ERROR STATUS>>               <<03620>>00180000
INTEGER POINTER LPDT = 8;                                               00182000
                                                                        00184000
EQUATE dtt'size = 128;                                         <<03510>>00186000
INTEGER ARRAY dtt(0:dtt'size-1);                               <<03510>>00188000
DOUBLE ARRAY                                                   <<03537>>00190000
  DTTD(*) = DTT;  << For DSCT use >>                           <<03537>>00192000
EQUATE MAX'DTT'CHANGES = 255,  <<SECTOR/TRACK ENTRY ONLY>>     <<03620>>00194000
       DTT'DISP'OFFSET = MAX'DTT'CHANGES+1,                    <<03620>>00196000
       DTT'CHANGES'SIZE = MAX'DTT'CHANGES+128;                 <<03620>>00198000
INTEGER ARRAY DTT'CHANGES(0:DTT'CHANGES'SIZE);                 <<03620>>00200000
ARRAY DTT'DISP(*) = DTT'CHANGES(DTT'DISP'OFFSET);              <<03620>>00202000
                                                                        00204000
EQUATE                                                                  00206000
     BUFFSIZE  = 11777,  <<MAX. BUFFER SIZE FOR 7933>>         <<04670>>00208000
     BUFFSIZE' =   64;  <<MAX SECTORS PER TRACK>>              <<RK1PV>>00210000
                                                                        00212000
ARRAY BUFF(-3:BUFFSIZE-1);                                     <<RK1PV>>00214000
                                                                        00216000
DOUBLE ARRAY BUFFD(*) = BUFF;                                           00218000
                                                                        00220000
BYTE ARRAY BUFFB(*) = BUFF;                                             00222000
                                                                        00224000
ARRAY VDIRB(*) = BUFF;                                                  00226000
                                                                        00228000
INTEGER ARRAY DEVPARM(0:3);                                             00230000
                                                                        00232000
LOGICAL ARRAY DEVSTATUS(0:3);                                           00234000
                                                                        00236000
ARRAY Msgw (0:35);  <<Message Buffer>>                         <<03537>>00238000
BYTE ARRAY Msg (*) = Msgw;                                     <<03537>>00240000
                                                                        00242000
ARRAY Rbufw(0:36);                                             <<03541>>00246000
BYTE ARRAY Rbuf(*) = Rbufw;                                    <<03541>>00248000
                                                                        00250000
BYTE ARRAY PBUF(0:71);                                                  00252000
ARRAY PBUFW(*) = PBUF;                                         <<RK.08>>00254000
                                                                        00256000
EQUATE                                                                  00258000
       MAXVOLNUM   =  8;  <<MAX. VOLUMES PER VOLUME SET>>               00260000
EQUATE max'discs = 16; << max amount of discs configurable >>  <<03510>>00262000
                       << in system                        >>  <<03510>>00264000
                                                                        00266000
EQUATE  << DATA SEGMENTS/SIRS >>                                        00268000
     DIRDST    = 20,                                                    00270000
     DIRSIR    =  8,                                                    00272000
     LDTDST    = 14,                                                    00274000
     LDTSIR    = 10,                                                    00276000
     FILESIR   = 37,                                                    00278000
     LPDTDST   = 13,                                                    00280000
     LPDTSIR   =  9,                                                    00282000
     VTABDST   = 29,                                                    00284000
     VTABSIR   = 22,                                                    00286000
     MVTABDST  = 53,                                                    00288000
     MVTABSIR  = 27;                                                    00290000
                                                                        00292000
<<****************** COMMAND PARSER DECLARATIONS *****************>>    00294000
                                                                        00296000
EQUATE  <<DELIMITERS>>                                                  00298000
     COMMA       =  0,                                                  00300000
     PERIOD      =  1,                                                  00302000
     SEMICOLON   =  2,                                                  00304000
     EQUALSIGN   =  3,                                                  00306000
     CARRETURN   =  4;                                                  00308000
                                                                        00310000
EQUATE  max'keyword'len   = 8;                                 <<03510>>00312000
EQUATE  max'keywords  = 4;                                     <<03510>>00314000
INTEGER ARRAY keywdlen(0:max'keywords-1);                      <<03510>>00316000
                                                                        00318000
INTEGER ARRAY keyparmval(0:max'keywords-1);                    <<03510>>00320000
                                                                        00322000
BYTE POINTER KEYWDLOC;                                                  00324000
                                                                        00326000
ARRAY VSIDW(0:12) := "*       ";                               <<00112>>00328000
BYTE ARRAY                                                     <<RK.08>>00330000
     VNAME(0:7),                                               <<RK.08>>00332000
     VSID(*) = VSIDW,                                          <<RK.08>>00334000
     VSNAME(*) = VSID,                                         <<RK.08>>00336000
     VGNAME(*) = VSID(8),                                      <<RK.08>>00338000
     VANAME(*) = VSID(16),                                     <<RK.08>>00340000
     keyword(0:max'keyword'len*max'keywords-1);                <<03510>>00342000
BYTE pointer bptr'keyword;  << for keyword,in getfunction >>   <<03510>>00344000
INTEGER number'keywords;                                       <<03510>>00346000
LOGICAL ARRAY keywdspec(0:max'keywords-1);                     <<03510>>00348000
LOGICAL array keyparmspec(0:max'keywords-1);                   <<03510>>00350000
                                                                        00352000
EQUATE FUNCTNUM = 20;  <<NUMBER OF VINIT FUNCTIONS>>           <<03638>>00354000
                                                                        00356000
BYTE ARRAY FUNCTLIST(0:(FUNCTNUM+1)*8):=                                00358000
     "ERR     ",  << FUNCTION ERROR >>                                  00360000
     "INIT    ",  << USER COMMAND >>                                    00362000
     "FORMAT  ",  << USER COMMAND >>                                    00364000
     "SCRATCH ",  << USER COMMAND >>                                    00366000
     "COPY    ",  << USER COMMAND >>                                    00368000
     "COND    ",                                                        00370000
     "DTRACK  ",  << USER COMMAND >>                                    00372000
     "DELVOL  ",  << USER COMMAND >>                                    00374000
     "DSTAT   ",  << USER COMMAND >>                                    00376000
     "PDEFN   ",  << USER COMMAND >>                                    00378000
     "PLABEL  ",  << USER COMMAND >>                                    00380000
     "PDTRACK ",  << USER COMMAND >>                                    00382000
     "PFSPACE ",  << USER COMMAND >>                                    00384000
     "SERIAL  ",  << USER COMMAND >>                                    00386000
     "EXIT    ",  << TERMINATE    >>                                    00388000
     "DEBUG   ",  << DEBUG CALL   >>                           <<00145>>00390000
     "HELP    ",  << HELP  CALL   >>                           <<00145>>00392000
     "XPLAIN  ",  << HELP  CALL   >>                           <<00145>>00394000
     "EXPLAIN ",  << HELP  CALL   >>                           <<<<FDF>>00396000
     "VERIFY  ",  << USER COMMAND >>                           <<03638>>00398000
     "FOREIGN ";  << USER COMMAND >>                           <<01115>>00400000
                                                                        00402000
<< PARMINFO DESCRIPTION -                                               00404000
                                                                        00406000
   THE PARMINFO ARRAY IS USED TO CONTROL THE PARSING OF VINIT           00408000
   COMMANDS. THERE IS ONE ENTRY FOR EACH COMMAND WHICH A USER           00410000
   CAN ENTER.                                                           00412000
                                                                        00414000
   THE FORMAT OF EACH ENTRY IS -                                        00416000
                                                                        00418000
   PARMINFO(N).(12:4) - NUMBER OF PARAMETERS ALLOWED FOR THIS           00420000
                        COMMAND (MAXIMUM IS FOUR).                      00422000
              .( 8:4) - OPTIONAL PARAMETER MASK INDICATION WHICH        00424000
                        OF THE PARAMETERS FOR THE COMMAND ARE           00426000
                        OPTIONAL. EACH BIT IN THE MASK REPRESENTS       00428000
                        A PARAMETER POSITION; IF THE BIT IS SET,        00430000
                        THE PARAMETER IS OPTIONAL. THE RIGHTMOST BIT    00432000
                        CORRESPONDS TO THE FIRST PARAMETER IN THE       00434000
                        SYNTAX.                                         00436000
              .( 6:2) - TYPE OF THE FIRST PARAMETER:                    00438000
                        0 = INTEGER                                     00440000
                        1 = VOLUME NAME (8 CHARACTERS)                  00442000
                        2 = VOLUME SET SPECIFIER(THREE 8 CHARACTER      00444000
                            STRINGS WITH DELIMITERS)                    00446000
                        3 = KEYWORD STRING (COMMAND DEPENDENT).         00448000
              .( 4:2) - TYPE OF SECOND PARAMETER.                       00450000
              .( 2:2) - TYPE OF THIRD PARAMETER.                        00452000
              .( 0:2) - TYPE OF FOURTH PARAMETER.                       00454000
>>                                                                      00456000
ARRAY PARMINFO(0:FUNCTNUM):=                                            00458000
     %000000,  << ERR - PLACE HOLDER >>                                 00460000
     %160704,  << INIT - TYP:VNAME,INT,VSID,KEYWD;OPT:N,N,Y,Y;          00462000
                         NUM=4                              >>          00464000
     %006042,  << FORMAT - TYP:INT,KEYWD;OPT:N,Y;NUM=2      >> <<03537>>00466000
     %006042,  << SCRATCH - TYP:INT,KEYWD;OPT:N,Y;NUM=2     >>          00468000
     %170304,  << COPY-TYP:INT,INT,KEY,KEY;OPT:N,N,Y,Y;NUM=4>> <<04670>>00470000
     %006042,  << COND- TYP:INT,KEYWD;OPT:N,Y;NUM=2         >>          00472000
     %000001,  << DTRACK - TYP:INT;OPT:N;NUM=1              >>          00474000
     %004442,  << DELVOL - TYP:VNAME,VSID;OPT:N,Y;NUM=2     >>          00476000
     %001421,  << DSTAT - TYP:KEYWD;OPT:Y;NUM=1             >>          00478000
     %001021,  << PDEFN - TYP:VSID;OPT:Y;NUM=1              >>          00480000
     %000001,  << PLABEL - TYP:INT;OPT:N;NUM=1              >>          00482000
     %000001,  << PDTRACK - TYP:INT;OPT:N;NUM=1             >>          00484000
     %007442,  << pfspace - typ:keywd,keywd;opt:n,y;num=2   >> <<03510>>00486000
     %000001,  << SERIAL  - TYP:INT;OPT:N;NUM=1             >>          00488000
     %000000,  << EXIT - TYP:;OPT:;NUM=0                    >>          00490000
     %000000,  << DEBUG - TYP:;OPT:;NUM=0                   >> <<00145>>00492000
     %000000,  << HELP  - TYP:;OPT:;NUM=0                   >> <<00145>>00494000
     %000000,  << XPLAIN- TYP:;OPT:;NUM=0                   >> <<00145>>00496000
     %000000,  << EXPLAIN-TYP:;OPT:;NUM=0                   >> <<<<FDF>>00498000
     %006042,  << VERIFY - TYP:INT,KEYWD;OPT:N,Y;NUM=2      >> <<03638>>00500000
     %000001;  << FOREIGN - TYP:INT;OPT:N;NUM=1             >> <<01115>>00502000
                                                                        00504000
INTEGER ARRAY DELIMS(0:FUNCTNUM*4+3):=                         <<01115>>00506000
     0,0,0,0,                          << ERROR    >>                   00508000
     COMMA,COMMA,SEMICOLON,CARRETURN,  << INIT     >>                   00510000
     SEMICOLON,CARRETURN,0,0,          << FORMAT   >>          <<03537>>00512000
     SEMICOLON,CARRETURN,0,0,          << SCRATCH  >>                   00514000
     COMMA,SEMICOLON,SEMICOLON,CARRETURN,<< COPY   >>          <<04670>>00516000
     SEMICOLON,CARRETURN,0,0,          << COND     >>                   00518000
     CARRETURN,0,0,0,                  << DTRACK   >>                   00520000
     COMMA,CARRETURN,0,0,              << DELVOL   >>                   00522000
     CARRETURN,0,0,0,                  << DSTAT    >>                   00524000
     CARRETURN,0,0,0,                  << PDEFN    >>                   00526000
     CARRETURN,0,0,0,                  << PLABEL   >>                   00528000
     CARRETURN,0,0,0,                  << PDTRACK  >>                   00530000
     semicolon,carreturn,0,0,          << pfspace  >>          <<03510>>00532000
     CARRETURN,0,0,0,                  << SERIAL   >>          <<00145>>00534000
     CARRETURN,0,0,0,                  << EXIT     >>          <<01115>>00536000
     CARRETURN,0,0,0,                  << DEBUG    >>          <<01115>>00538000
     CARRETURN,0,0,0,                  << HELP     >><<FDF.0>> <<01115>>00540000
     CARRETURN,0,0,0,                  << XPLAIN   >>          <<00145>>00542000
     CARRETURN,0,0,0,                  << EXPLAIN  >>          <<<<FDF>>00544000
     SEMICOLON,CARRETURN,0,0,          << VERIFY   >>          <<03638>>00546000
     CARRETURN,0,0,0;                  << FOREIGN  >><<FDF.0>> <<01115>>00548000
                                                                        00550000
COMMENT                                                        <<01445>>00552000
         BITS IN MASK SPECIFY WHICH BITS ARE ALLOWED ON IN     <<01445>>00554000
         THE DISC STATUS RETURNED BY CHECKDISC.  THE BIT       <<01445>>00556000
         MEANINGS ARE:                                         <<01445>>00558000
                                                               <<01445>>00560000
             3 -> FOREIGN AND UP                               <<01445>>00562000
             4 -> MOUNTED                                      <<01445>>00564000
             5 -> DOWNPND                                      <<01445>>00566000
             6 -> DOWN                                         <<01445>>00568000
             7 -> RESERVED                                     <<01445>>00570000
             8 -> SERIAL AND UP                                <<01445>>00572000
             9 -> OFFLINE                                      <<01445>>00574000
            10 -> SYSDOMAIN                                    <<01445>>00576000
            11 -> NOT PVTYPE                                   <<01445>>00578000
            12 -> NOT REMOVABLE                                <<01445>>00580000
            13 -> NOT A DISC                                   <<01445>>00582000
            14 -> DEV NOT CONFIGURED                           <<01445>>00584000
            15 -> LDEV OUT OF RANGE                            <<01445>>00586000
;                                                              <<01445>>00588000
                                                               <<01445>>00590000
ARRAY MASK(0:FUNCTNUM):=                                       <<00145>>00592000
     %000000,  << ERR - PLACE HOLDER >>                                 00594000
     %011200,  << INIT -             >>                        <<01445>>00596000
     %011200,  << FORMAT -           >>                        <<01445>>00598000
     %011200,  << SCRATCH -          >>                        <<01445>>00600000
     %015670,  << COPY -            >>                         <<04670>>00602000
     %007470,  << COND -             >>                                 00604000
     %006000,  << DTRACK -           >>                        <<00239>>00606000
     %001000,  << DELVOL -           >>                                 00608000
     %000000,  << DSTAT -           >>                                  00610000
     %000000,  << PDEFN -            >>                                 00612000
     %007670,  << PLABEL -           >>                        <<RK.03>>00614000
     %007670,  << PDTRACK -          >>                        <<03621>>00616000
     %007470,  << PFSPACE -          >>                                 00618000
     %011200,  <<SERIAL -            >>                        <<01445>>00620000
     %000000,  << EXIT   -           >>                        <<00145>>00622000
     %000000,  << DEBUG  -           >>                        <<00145>>00624000
     %000000,  << HELP   -           >>                        <<00145>>00626000
     %000000,  << XPLAIN -           >>                        <<00145>>00628000
     %000000,  << EXPLAIN-           >>                        <<<<FDF>>00630000
     %017670,  << VERIFY -          >>                         <<04670>>00632000
     %011200;  << FOREIGN -          >>                        <<01445>>00634000
EQUATE MAXSECTTRK = 64;  <<MAX. POSSIBLE SEC/TRK ANY SUBTYPE>> <<00866>>00638000
DEFINE  << FILE LABEL INFORMATION >>                                    00640000
     FLFLIM        = FLABD(15)#,                                        00642000
     FLRECSIZE     = FLAB (37)#,                                        00644000
     FLBLKSIZE     = FLAB (38)#,                                        00646000
     FLSECTOFF     = FLAB (39).(0:8)#,                                  00648000
     FLLASTEXTSIZE = FLAB (40)#,                                        00650000
     FLEXTSIZE     = FLAB (41)#;                                        00652000
EQUATE fllocname = 0;                                          <<03510>>00654000
EQUATE flgrpname = 4;                                          <<03510>>00656000
EQUATE flacctname = 8;                                         <<03510>>00658000
EQUATE flmisc = %34;                                           <<03510>>00660000
DEFINE flsrlx = (0:4)#;                                        <<03510>>00662000
DEFINE flstatus =(14:2)#;                                      <<03510>>00664000
EQUATE flskip1 = %34;    << lock bits, not in checksum >>      <<03510>>00666000
EQUATE flskip2 = %42;    << checksum, not in checksum >>       <<03510>>00668000
EQUATE flchecksum = %42;                                       <<03510>>00670000
EQUATE flcoldloadid = %43; << coldload id >>                   <<03510>>00672000
EQUATE flskip3 = %43;  << coldloadid index >>                  <<03510>>00674000
EQUATE flsect'numext = %47;                                    <<03510>>00676000
DEFINE flnumexts = (11:5)#;                                    <<03510>>00678000
EQUATE flextvol =%54;                                          <<03510>>00680000
DEFINE flvolnum = (0:8)#;                                      <<03510>>00682000
EQUATE dflext = %26;     << dbl wd ist ext index >>            <<03510>>00684000
EQUATE fllastext = %50;                                        <<03510>>00686000
EQUATE flext = %51;                                            <<03510>>00688000
EQUATE flvol = %54;                                            <<03510>>00690000
                                                               <<03510>>00692000
   << this define is taken straight from the file system >>    <<03510>>00694000
                                                               <<03510>>00696000
   DEFINE newchecksum = TOS:=-1;                               <<03510>>00698000
                     x:=127;                                   <<03510>>00700000
                     DO BEGIN                                  <<03510>>00702000
                        IF x <> flskip1 AND x <> flskip2 AND   <<03510>>00704000
                        x <> flskip3 THEN                      <<03510>>00706000
                           TOS:=TOS XOR LOGICAL(newflab(x));   <<03510>>00708000
                        x:=x-1;                                <<03510>>00710000
                     END UNTIL <#;                             <<03510>>00712000
                                                               <<03510>>00714000
   DEFINE oldchecksum = TOS:=-1;                               <<03510>>00716000
                     x:=127;                                   <<03510>>00718000
                     DO BEGIN                                  <<03510>>00720000
                        IF x <> flskip1 AND x <> flskip2 AND   <<03510>>00722000
                        x <> flskip3 THEN                      <<03510>>00724000
                           TOS:=TOS XOR LOGICAL(flab(x));      <<03510>>00726000
                        x:=x-1;                                <<03510>>00728000
                     END UNTIL <#;                             <<03510>>00730000
                                                               <<03510>>00732000
                                                                        00734000
<< MVTAB entry >>                                              <<03510>>00736000
DEFINE mvtabxf =(8:8)#;                                        <<03510>>00738000
EQUATE mvtabldev = 5;                                          <<03510>>00740000
DEFINE ldevf = (0:8)#;                                         <<03510>>00742000
                                                               <<03510>>00744000
<< volume table >>                                             <<03510>>00746000
EQUATE vol'table'dst = %35;                                    <<03510>>00748000
EQUATE num'sys'vol = 2;                                        <<03510>>00750000
EQUATE vol'table'ldev = %14;                                   <<03510>>00752000
DEFINE vol'table'ent'size = (8:8)#;                            <<03510>>00754000
DEFINE vol'ent'ldev =(0:8)#;                                   <<03510>>00756000
                                                               <<03510>>00758000
<< vol set dirc ent >>                                         <<03510>>00760000
DEFINE numvol = (0:4)#;                                        <<03510>>00762000
                                                               <<03510>>00764000
   <<   Directory  >>                                          <<03510>>00766000
                                                               <<03510>>00768000
   EQUATE             a = 0;      << write out entry block >>  <<03510>>00770000
   EQUATE             dadirty=%221;                            <<03510>>00772000
   EQUATE             filelevel= 0;                            <<03510>>00774000
   EQUATE            grouplevel = 1 ;                          <<03777>>00776000
   ARRAY              dds(*) = DB+0;                           <<03510>>00778000
   DEFINE             dirtyf =(15:1)#;                         <<03510>>00780000
   EQUATE             dirc'bad'file = 1;                       <<03510>>00782000
   DEFINE          bad'addr = %77777777D#;                     <<03510>>00784000
                                                               <<03510>>00786000
   << LDT/LDTX definitions >>                                  <<03510>>00788000
                                                               <<03510>>00790000
   EQUATE                                                      <<03510>>00792000
      ldt'dst = 14,        << DST number of LDT/LDTX >>        <<03510>>00794000
                                                               <<03510>>00796000
      ldt'sir = 10,        << SIR number of LDT/LDTX >>        <<03510>>00798000
                                                               <<03510>>00800000
      ldt'entry'size = 5,  << Size of LDT/LDTX entry in words>><<03510>>00802000
                                                               <<03510>>00804000
      ldtx'dfs'dst'word = 2, << Word of LDTX entry containing>><<03510>>00806000
                         << DST number of the disc free space>><<03510>>00808000
                         << data segment for the disc ldev.  >><<03510>>00810000
                                                               <<03510>>00812000
      ldtx'dfs'error'word = 3;<< Word of LDTX entry containin>><<03510>>00814000
                         << standard format error status for >><<03510>>00816000
                         << the disc drive if it has a free  >><<03510>>00818000
                         << space map.  If it does not have a>><<03510>>00820000
                         << value of "no'error", free space  >><<03510>>00822000
                         << allocation is disabled on this   >><<03510>>00824000
                         << disc.                            >><<03510>>00826000
                                                               <<03510>>00828000
EQUATE  << DRIVER FUNCTION CODES >>                                     00830000
     R            =    0,  <<READ I/O REQUEST>>                         00832000
     W            =    1,  <<WRITE I/O REQUEST>>                        00834000
     RS           =    7,  <<REQUEST STATUS I/O REQUEST>>               00836000
     F            =    8,  <<FORMAT TRACK I/O REQUEST>>                 00838000
     IN           =    9,  <<INITIALIZE TRACK I/O REQUEST>>             00840000
     IT           =    9,  <<INITIALIZE TRACK (FLOPPY)>>       <<00239>>00842000
     RFS          =   10,  <<READ FULL SECTOR I/O REQUEST>>             00844000
     WL           =   11,  <<WRITE LABEL (SECTOR 0) REQUEST>>           00846000
     RSPD         =   12,  <<READ WITH SPARING DISABLED>>      <<00112>>00848000
     VM           =   12,  <<VERIFY MEDIA (FLOPPY)>>           <<00239>>00850000
     FPA          =   13,  << FIND PHYSICAL ADDRESS >>         <<03537>>00852000
     REQ'VOL'LIMIT=13,<<CS'80: returns highest logical sector>><<03537>>00854000
     VERIFY'CS'80 =   14,  << CS'80 disc verify >>             <<03537>>00856000
     SET'ADDR'SEC =   82,  << CS'80 SET ADDRESS >>             <<03620>>00858000
     SPARE'BLOCK  =   88,  << CS'80 Spare cmd                >><<03583>>00860000
     Initiate'Utility = 91, << CS'80 General Purpose Command.>><<03620>>00862000
     INIT'UTIL    =   91;  << CS'80 INITIATE UTILITY >>        <<03620>>00864000
                                                               <<03537>>00866000
DEFINE                                                         <<03537>>00868000
     RW'ERT       =   %400310D#, <<R/W ERROR TEST>>            <<03620>>00870000
     RO'ERT       =   %400311D#, <<READ ONLY ERROR TEST>>      <<03620>>00872000
     RETAIN'DATA  = 0D#,                                       <<03620>>00874000
     NO'RETAIN'DATA= 1D#;                                      <<03537>>00876000
                                                               <<03537>>00878000
EQUATE                                                         <<03537>>00880000
     RETAIN'ALL'SPARES = 0,  << CS'80 keep spares parm >>      <<03537>>00882000
     RETAIN'FACTORY'SPARES = 1,  << CS'80 fact. sp. only >>    <<03537>>00884000
     Physical'Format = 2,  << Allowed on Disc only.          >><<03537>>00886000
     DEFAULT'INTERLEAVE = 0;  << No interleave >>              <<03537>>00888000
                                                                        00890000
EQUATE                                                                  00892000
     CCG          =    0,  <<GREATER-THAN CONDITION CODE>>              00894000
     CCL          =    1,  <<LESS-THAN CONDITION CODE>>                 00896000
     CCE          =    2,  <<EQUAL CONDITION CODE>>                     00898000
     SPT          =  %20,  <<I/O ERROR - SPARED TRACK>>                 00900000
     DFT          =  %21,  <<I/O ERROR - DEFECTIVE TRACK>>              00902000
     CDERR        =  %17,  <<I/O ERROR - COREECTABLE DATA ERROR>>       00904000
     SYSDB        =  512,                                               00906000
     FSCNT        =  141,  <<WORD COUNT FOR RFS DISC I/O>>              00908000
     FSERR        =    0,  <<FILE SYSTEM ERROR>>                        00910000
     DTTALT       =  126,  <<NEXT AVAILABLE ALTERNATE - DTT>>           00912000
     DTTLPS       =  127,  <<LOGICAL PACK SIZE (CYLINDERS) - DTT>>      00914000
     LDTENT       =    5,  <<LDT ENTRY SIZE>>                           00916000
     TRKERR       =  %14,  <<DISC I/O ERROR - TRACK ERROR>>             00918000
     TIMEOUT      =  %24,  <<TIME OUT>>                        <<03620>>00920000
     INVADDR      =  %64,  <<INVALID ADDRESS>>                 <<04851>>00922000
     VERERR       = %154,  <<VERIFY ERROR - FLOPPY ONLY>>      <<03712>>00924000
     NO'SPARE     = %164,  <<I/O ERROR NO MORE SPARE TRACK>>   <<03620>>00926000
     SYSLDEV      =    1,  <<SYSTEM DISC>>                              00930000
     PVPMOUNT     =   12,  <<LOG RECORD TYPE>>                          00932000
     SUCCESSFUL   =    1,  <<ATTACHIO GSTATUS VALUE>>                   00938000
     DIRADR2      =   13,  <<WORD IN COLD LOAD INFO SECTOR>>   <<00239>>00940000
     DIRSECT      =   20,  <<WORD IN COLD LOAD INFO SECTOR>>   <<00239>>00942000
     COLDLOADSECT =   28;  <<ADDRESS OF COLD LOAD SECTOR>>     <<00239>>00944000
EQUATE  <<VS DEFINITION ENTRY >>                                        00948000
     VDMISC       =  4,                                                 00950000
     VDINFO       =  5;                                                 00952000
                                                                        00954000
EQUATE  << DIT LOCATIONS >>                                             00956000
     DSTAT1     = 18,  <<REQUEST STATUS WORD 1 (OF 2)>>                 00958000
     DSTAT2     = 19;                                                   00960000
                                                                        00962000
EQUATE VOLDIRENTSIZE = 6;                                               00964000
                                                                        00966000
EQUATE  << VOLUME LABEL INFORMATION >>                                  00968000
     LDEVINFO     =  6,                                                 00970000
     LGENINDEX    =  7,                                                 00972000
     LSYSID       = 16,  << BYTE ADDRESS >>                    <<00112>>00974000
     LSYSID1      =  8,                                                 00976000
     LSYSID2      =  9,                                                 00978000
     LINITDATE    = 14,                                                 00980000
     LDIRBASE     = 15,                                                 00982000
     LDIRSIZE     = 16,                                                 00984000
     LSYSIDLOC    = 16,  <<BYTES>>                                      00986000
     LVNAMELOC    = 20,  <<BYTES>>                                      00988000
     LVNAMELOC'   = 10,  <<WORDS>>                                      00990000
     LVDIRINFO    = 30,                                                 00992000
     LVSACCNTLOC  = 34,  <<BYTES>>                                      00994000
     LVSACCNTLOC' = 17,  <<WORDS>>                                      00996000
     LVSGROUPLOC  = 42,  <<BYTES>>                                      00998000
     LVSGROUPLOC' = 21,  <<WORDS>>                                      01000000
     LVOLDIR      = 25,                                                 01002000
     LVOLDIRLOC   = 50;  <<BYTES>>                                      01004000
                                                                        01006000
EQUATE  << TABLE/ENTRY SIZES >>                                         01008000
     VDCENTSIZE   = 56,  <<CLASS DEFINITION ENTRY>>            <<RK2PV>>01010000
     VDSENTSIZE   = 56,  <<(MAXVOLNUM+1)*VDVENTSIZE>>          <<RK2PV>>01012000
     VDVENTSIZE   =  6,                                                 01014000
     VDVENTSIZEB  = 12,                                                 01016000
     MVTABENTSIZE = 13;                                                 01018000
                                                                        01020000
DEFINE  << SYSTEM DB AREA >>                                            01022000
     PVPROCPINX   = ABSOLUTE(SYSDB+%363)#,                              01024000
     PVRECG'CNT   = ABSOLUTE(SYSDB+%364)#,                              01026000
     VMOUNTINFO   = ABSOLUTE(SYSDB+%365)#;                              01028000
DEFINE     sys'cold'loadid = ABSOLUTE(sysdb +%75)#;            <<03510>>01030000
                                                                        01032000
                                                                        01036000
DEFINE  << PARTIAL FIELDS >>                                            01038000
     MVF        = ( 1:1)#,  <<MASTER VOLUME (VOLUME LABEL)>>            01040000
     NSDF       = ( 4:1)#,  <<NON-SYSTEM DOMAIN (CONT-Y)>>              01042000
     SDLF       = (10:1)#,  <<SER/FORN DISC LOADED (LPDT) >>   <<01115>>01044000
     FORS       = (11:1)#,  << 0=>SERIAL, 1=>FOREIGN >>        <<01115>>01046000
     MNTF       = ( 5:1)#,  <<lpdt - in use as pv>>                     01048000
     RESF       = ( 6:1)#,  <<lpdt - reserved for pv>>                  01050000
     DRSTATE    = ( 0:2)#,  <<DEVICE RECOG STATE>>             <<RK3PV>>01052000
     TRKF       = (0:14)#,  <<TRACK FIELD OF DTT ENTRY>>                01054000
     DTCF       = (14:2)#,  <<DISPOSITION FIELD OF DTT ENTRY>>          01056000
     HEADF      = ( 3:5)#,  <<HEAD FIELD OF SECTOR PREAMBLE>>           01060000
     DOUBLESIDED= (4:1)=1#,  << FLOPPY STATUS2 >>              <<00239>>01062000
     DOWNF      = ( 6:1)#,                                              01064000
     VTABXF     = ( 0:8)#,  <<VTAB INDEX IN EXTENT MAP ENTRY>>          01068000
     QSTATUS    = ( 8:5)#,                                              01072000
     GSTATUS    = (13:3)#,                                              01074000
     TSTATUS    = ( 8:8)#,                                              01076000
     NREADYF    = (14:1)#,  <<NOT-READY BIT OF STATUS (DISMOUNTED)>>    01078000
     SCRATCHF   = ( 0:1)#,                                              01080000
     SINGLESIDED= (4:1)=0#,  << FLOPPY STATUS2 >>              <<00239>>01082000
     VTENTNUMF  = ( 0:8)#,                                              01088000
     VTENTSIZEF = ( 8:8)#;                                              01090000
                                                                        01092000
<< Definitions for init/dttanalysis   >>                       <<03527>>01094000
                                                               <<03527>>01096000
<< The following are for ldev 1, master system disc, only >>   <<03527>>01098000
                                                               <<03527>>01100000
DEFINE  ldev1'start'resv'area = 0D#;                           <<03527>>01102000
DEFINE  ldev1'end'resv'area   = 399D#;                         <<03527>>01104000
DEFINE  ldev1'resv'area'sz    = 400#;                          <<03527>>01106000
DEFINE  ldev1'beg'good'adr    = 400D#;                         <<03527>>01108000
                                                               <<03527>>01110000
<< The following are for all other discs >>                    <<03527>>01112000
                                                               <<03527>>01114000
DEFINE  start'resv'area = 0D#;                                 <<03527>>01116000
DEFINE  end'resv'area   = 9D#;                                 <<03527>>01118000
DEFINE  resv'area'sz    = 10#;                                 <<03527>>01120000
DEFINE  beg'good'adr    = 10D#;                                <<03527>>01122000
                                                               <<03527>>01124000
DEFINE CC=STAT.(6:2)#;                                                  01126000
DEFINE RETURN'CCL = BEGIN CC := CCL; RETURN; END; #;           <<00239>>01128000
DEFINE DUPLICATE = ASSEMBLE(DUP)#;                                      01130000
DEFINE DELETE = ASSEMBLE(DEL)#;                                         01132000
DEFINE ENABLE = ASSEMBLE(SED 0)#;                                       01136000
                                                                        01138000
DEFINE DOWNED = STATUS.(8:1)#;                                          01140000
                                                               <<01115>>01142000
DEFINE LPDT0 = LPDT(LDEV&LSL(1))#,                             <<01115>>01144000
       LPDT1 = LPDT(LDEV&LSL(1)+1)#;                           <<01115>>01146000
                                                               <<01115>>01148000
DEFINE FOREIGN=LPDT1.NSDF=1 AND                                <<01115>>01150000
               LPDT1.SDLF=1 AND                                <<01115>>01152000
               LPDT1.FORS=1 #;                                 <<01115>>01154000
                                                               <<01115>>01156000
LOGICAL DISC'TYPE;                                             <<04670>>01158000
DEFINE                                                         <<04670>>01160000
   SYS     = DISC'TYPE.(15:1)#,                                <<04670>>01162000
   PVOL   = DISC'TYPE.(14:1)#,                                 <<04670>>01164000
   SERIALD = DISC'TYPE.(13:1)#,                                <<04670>>01166000
   SCRVOL  = DISC'TYPE.(12:1)#,                                <<04670>>01168000
   FORVOL  = DISC'TYPE.(11:1)#,                                <<04670>>01170000
   DISC    = DISC'TYPE.(10:1)#,                                <<04670>>01172000
   MH'DISC = DISC'TYPE.( 9:1)#,                                <<04670>>01174000
   FLOPPY  = DISC'TYPE.( 8:1)#,                                <<04670>>01176000
   CS'80   = DISC'TYPE.( 7:1)#,                                <<04670>>01178000
   LINUS   = DISC'TYPE.( 6:1)#,                                <<04670>>01180000
   DOWNDEV = DISC'TYPE.( 0:1)#;                                <<04670>>01182000
                                                               <<04670>>01184000
DEFINE INAPPROPRIATE=                                          <<01115>>01186000
   BEGIN                                                       <<01115>>01188000
      GENMSG(PVMSGSET,DEVERR13);                               <<01115>>01190000
      RETURN;                                                  <<01115>>01192000
   END#;                                                       <<01115>>01194000
                                                                        01196000
DEFINE EXIT' = MORE:=FALSE#;  <<EXIT PROGRAM>>                          01198000
                                                                        01200000
DEFINE                                                                  01202000
     MPYD = ASSEMBLE(LDXA,LMPY;CAB,LDXA;MPY,ZERO;DADD)#,                01204000
     DIVD = ASSEMBLE(ZERO,CAB;LDXA,LDIV;CAB,LDXA;LDIV)#;                01206000
                                                                        01208000
DEFINE TRAPS = PUSH(STATUS);                                            01210000
               TOS.(2:1):=0;  <<RESET USER TRAPS>>                      01212000
               SET(STATUS)#;                                            01214000
                                                               <<03537>>01216000
EQUATE Linus'Sector = 512;  <<sector size for Linus          >><<03537>>01218000
EQUATE Blocked'IO = 1;    << for Attachio Flags              >><<03537>>01220000
EQUATE Diagnostic'And'Block = %21; <<      For Attachio      >><<03583>>01222000
<< A note about setting the Diagnostic Bit in the Flags      >><<03583>>01224000
<< word of an Attachio call. The CS'80 driver people         >><<03583>>01226000
<< have changed the meaning of what this bit means.          >><<03583>>01228000
<< For CS'80 devices, setting this bit means the driver      >><<03583>>01230000
<< no longer handles device release requests, putting        >><<03583>>01232000
<< entries into the DSCT or I/O error logging.               >><<03583>>01234000
<< Also if you use it, be prepared to do your own request    >><<03583>>01236000
<< status after each unsuccessful operation.                 >><<03583>>01238000
DEFINE SKIP'SPARING = TRUE#;                                   <<03537>>01240000
DEFINE JUMP'SPARING = FALSE#;                                  <<03537>>01242000
DEFINE NO'SPARING = FALSE#;                                    <<03537>>01244000
EQUATE Default'Errinfo = 5;                                    <<03537>>01246000
EQUATE Return'Message = 2; << Used to Initiate CS'80 Utility.>><<03583>>01248000
EQUATE Read'Drive'Tables = %304;                               <<03583>>01250000
EQUATE First'Byte = 20;                                        <<03583>>01252000
                                                               <<03583>>01254000
<< When using the Initiate'Utility function of               >><<03583>>01256000
<< the driver, the returned data is offset in                >><<03583>>01258000
<< the buffer.                                               >><<03583>>01260000
                                                               <<03583>>01262000
                                                                        01264000
EQUATE PVMSGSET = 15;                                                   01266000
EQUATE DEVERRMSG = 60;                                                  01268000
                                                                        01270000
EQUATE  << PRIVATE VOLUME ERRORS (INDICES INTO PVERRMSGSET) >>          01272000
     OKEXIT       =   0,                                                01274000
     VMOUNTOFF    =  20,                                                01276000
     OPREJECT     =  21,                                                01278000
     NOTAVAIL     =  22,                                                01280000
     SYSTEMUSE    =  23,                                                01282000
     NODGROUP     =  24,                                                01284000
     NODACCNT     =  25,                                                01286000
     NOTMOUNTED   =  26,                                                01288000
     NODVSET      =  27,                                                01290000
     NOHVSET      =  28,                                                01292000
     NOHGROUP     =  29,                                                01294000
     NOHACCNT     =  30,                                                01296000
     NOVGROUP     =  31,                                                01298000
     NOVACCNT     =  32,                                                01300000
     DUPMOUNT     =  33,                                                01302000
     NOTVALDUSER  =  34,                                                01304000
     DOWNSET      =  35,                                                01306000
     DOWNVOL      =  36,                                                01308000
     DIFFCLASS    =  37,                                                01310000
     USERERR1     =  38,                                                01312000
     USERERR2     =  39,                                                01314000
                                                                        01316000
     MVTABERR     =  50,    << PVERR 50 >>                              01318000
     PVUSERERR    =  51,                                                01320000
     DIRECERR     =  52,                                                01322000
                                                                        01324000
     DEVERR1      =  60,  <<DEVICE OUT OF RANGE>>                       01326000
     DEVERR2      =  61,  <<DEVICE NOT CONFIGURED>>                     01328000
     DEVERR3      =  62,  <<DEVICE IS NOT A DISC>>                      01330000
     DEVERR4      =  63,  <<DEVICE IS NOT REMOVABLE>>                   01332000
     DEVERR5      =  64,  <<DEVICE IS NOT PV TYPE (INVLD SUBTYPE)>>     01334000
     DEVERR6      =  65,  <<DEVICE NOT IN USER DOMAIN>>                 01336000
     DEVERR7      =  66,  <<DEVICE IS NOT ON-LINE>>                     01338000
     DEVERR8      =  67,  <<DEVICE IS A SERIAL DISC>>                   01340000
     DEVERR9      =  68,  <<DEVICE IS RESERVED BY SYSTEM>>              01342000
     DEVERR10     =  69,  <<DEVICE IS DOWNED>>                 <<00.DL>>01344000
     DEVERR11     =  70,  <<DEVICE HAS DOWN PENDING>>          <<00.DL>>01346000
     DEVERR12     =  71,  <<DEVICE IS IN USE BY PV-SYSTEM>>    <<00.DL>>01348000
     DEVERR13     =  72,  <<INAPPROPRIATE FOR FOREIGN DISC>>   <<01115>>01350000
                                                                        01352000
     VIERR0       = 100,  <<function aborted>>                          01354000
     VIERR1       = 101,  <<unrecognized function>>                     01356000
     VIERR2       = 102,  <<inv. track disposition>>                    01358000
     VIERR3       = 103,  <<inv. keyword string>>                       01360000
     VIERR4       = 104,  <<no vol. set currently specified>>           01362000
     VIERR5       = 105,  <<LDEV not downed>>                           01364000
     VIERR6       = 106,  <<LDEV not downed or scratch>>                01366000
     VIERR7       = 107,  <<vol. not member of vol. set>>               01368000
     VIERR8       = 108,  <<subTYPe inconsistency>>                     01370000
     VIERR9       = 109,  <<pack size inconsistency>>                   01372000
     VIERR10      = 110,  <<attempted to copy to bad track>>            01374000
     VIERR11      = 111,  <<no suspect tracks found>>                   01376000
     VIERR12      = 112,  <<no alternate tracks available>>             01378000
     VIERR13      = 113,  <<track not reassigned>>                      01380000
     VIERR14      = 114,  <<def. track in reserved area - reformat>>    01382000
     VIERR15      = 115,  <<inv. keyword parameter>>                    01384000
     VIERR16      = 116,  <<vol. name > 8 char.>>                       01386000
     VIERR17      = 117,  <<vol. set name > 8 char.>>                   01388000
     VIERR18      = 118,  <<keyword > 8 char.>>                         01390000
     VIERR19      = 119,  <<vol. name has non-alpha first char.>>       01392000
     VIERR20      = 120,  <<vol. set has non-alpha first char.>>        01394000
     VIERR21      = 121,  <<keyword has non-alpha first char.>>         01396000
     VIERR22      = 122,  <<vol. name has special char.>>               01398000
     VIERR23      = 123,  <<vol. set has special char.>>                01400000
     VIERR24      = 124,  <<keyword has special char.>>                 01402000
     VIERR25      = 125,  <<no parameters allowed for this function>>   01404000
     VIERR26      = 126,  <<missing non-optional parameter>>            01406000
     VIERR27      = 127,  <<non-numeric in LDEV parameter>>             01408000
     VIERR28      = 128,  <<invalid LDEV value>>                        01410000
     VIERR29      = 129,  <<too many names in vol. set>>                01412000
     VIERR30      = 130,  <<missing keyword paramater>>                 01414000
     VIERR31      = 131,  <<unexpected delimiter>>                      01416000
     VIERR32      = 132,  <<unexpected parameter>>                      01418000
     VIERR33      = 133,  <<format or protect switch problem>> <<RK1PV>>01420000
     VIERR34      = 134,  <<problem with DTT or FST table>>    <<RK1PV>>01422000
     VIERR35      = 135,  <<illegal cylinder address>>         <<RK3PV>>01424000
     VIERR36      = 136,  <<illegal head address>>             <<RK3PV>>01426000
     VIERR37      = 137,  <<DTT table full -- entry not added>><<RK3PV>>01428000
     VIERR38      = 138,  <<LDEV NOT IN VTAB -- ON/OFFLINE >>  <<RK.05>>01430000
     VIERR39      = 139,  <<VOLUME NOT OR PART OF VOLUME SET>> <<00145>>01432000
     VIWARN0      = 140,  <<vol. already scratch/reset>>                01434000
     VIWARN1      = 141,  <<suspect track in alternate area>>           01436000
     VIWARN2      = 142,  <<suspect track in reserved area>>            01438000
     VIWARN3      = 143,  <<suspected tracks detected(format)>><<RK3PV>>01440000
     VIWARN4      = 144,  <<duplicate entry in dtt>>          <<RK3PV>>01442000
     VIWARN5      = 145,  <<COND won't work unless VS mounted>><<00145>>01444000
     VIWARN6      = 146,  <<RECOVER CHANGED TO ALL -- >1 USER>><<00145>>01446000
     VIWARN7      = 147,  <<RECOVER CHANGED TO ALL -- SYSVOL >><<00145>>01448000
     VIWARN8      = 148,  <<FILE ! PURGED>>                    <<00239>>01450000
     VIWARN9      = 149,  <<DTRACK WON'T WITH >1 USER >>       <<00239>>01452000
     VIWARN10     = 150,  <<UNREADABLE LABEL ON LDEV ! >>      <<00239>>01454000
     VIWARN11     = 151,  <<TRACK ! : HEAD ! MADE INVISIBLE>>  <<00239>>01456000
    vierr55      = 155,  << no w.s. for RECOVER >>             <<03510>>01458000
    vierr56      = 156,  << fatal err while try to rec >>      <<03510>>01460000
    viwarn57     = 157,  << beg recover >>                     <<03510>>01462000
    viwarn58     = 158,  << finish recover,beg cond >>         <<03510>>01464000
    vierr59      = 159,  << space already alloc to a file >>   <<03510>>01466000
    viwarn60     = 160,  << file not rec,m bad in dirc >>      <<03510>>01468000
    vierr61      = 161,  << i/o err on DFSM >>                 <<03510>>01470000
    vierr62      = 162,  << i/o err on DTT >>                  <<03510>>01472000
    vierr63      = 163,  << i/o err on r disc lab-cond >>      <<03510>>01474000
    vierr64      = 164,  << open file on REC >>                <<03510>>01476000
     VIERR65      = 165,  <<MORE THAN 4 BAD TRKS ON FLOPPY>>   <<00239>>01478000
     VIERR66      = 166,  <<ILLEGAL OR UNDEFINED SUBTYPE>>     <<00239>>01480000
     VIERR67      = 167,  <<NO SUSPECT TRACKS IN VOLUME SET>>  <<00239>>01482000
    vierr68      = 168,  << deleted trks in DFSM/dirc >>       <<03510>>01484000
    vierr69      = 169,  << i/o err while try to rec >>        <<03510>>01486000
     VIHELP       = 170,  <<LISTING FOR HELP AND XPLAIN>>      <<00239>>01488000
     VIERR71      = 171,  <<DIRPURGE FAILED ON !>>             <<00239>>01490000
     VIERR72      = 172,  <<MUSTOPEN FAILED ON !>>             <<00239>>01492000
     VIERR73      = 173,  <<FCLOSE-DELETE FAILED ON !>>        <<00239>>01494000
    viwarn74    = 174   << couldnt read flab >>                <<03510>>01496000
    ,viwarn75    = 175   << checksum error >>                  <<03510>>01498000
    ,viwarn76    = 176   << special ept >>                     <<03537>>01500000
    ,vierr77     = 177   << problem w DFSM >>                  <<03510>>01502000
    ,viwarn78    = 178  << extent of file already released >>  <<03510>>01504000
    ,viwarn79    = 179   << logging disabled >>                <<03510>>01506000
    ,viwarn80    = 180   << logging enabled  >>                <<03510>>01508000
    ,viwarn81    = 181   << try rec or RLDS >>                 <<03510>>01510000
    ,vierr82     = 182   << i/o err on DFSM >>                 <<03510>>01512000
    ,viwarn83    = 183   << i/o err on wr flab >>              <<03510>>01514000
    ,vierr84     = 184   << could not begin COND >>            <<03510>>01516000
    ,vierr85     = 185   << function ab, but dirc+disc NOT >>  <<03510>>01518000
    ,viwarn86    = 186   << logging disabled, DTRACK >>        <<03510>>01520000
    ,viwarn87    = 187   << logging enabled, DTRACK  >>        <<03510>>01522000
    ,vierr90     = 190  << no vm or dst >>                     <<03510>>01524000
    ,VIWARN88     = 188  << BEGIN VERIFY >>                    <<03537>>01526000
    ,VIWARN89     = 189  << SPARING SECTOR ! >>                <<03537>>01528000
    ,vierr91     = 191 << Linus ran out of spares.           >><<03537>>01530000
    ,vierr92     = 192 << Media is uninitialized.            >><<03537>>01532000
    ,vierr93     = 193 << Media has not been formatted.      >><<03537>>01534000
    ,viwarn94    = 194 << Attempt to reset a scratch.        >><<03537>>01536000
    ,viwarn95    = 195  <<Linus has no DSCT.                 >><<03536>>01538000
    ,viwarn96    = 196  <<Label unreadable but DSCT may be OK>><<03536>>01540000
    ,vierr97     = 197  <<Can't read the DSCT.               >><<03536>>01542000
    ,viwarn98    = 198  <<DSCT is empty.                     >><<03536>>01544000
    ,viwarn99    = 199  << ! Defective Sectors Found.        >><<03536>>01546000
    ,viwarn100   = 200  << Sector ! (decimal) defective.     >><<03536>>01548000
    ,viwarn101   = 201 << Couldn't read Spare Block Table.   >><<03583>>01550000
    ,viwarn102   = 202 << Spare Block Table empty.           >><<03583>>01552000
    ,viwarn103   = 203 << Header Spare Block Printout.       >><<03583>>01554000
    ,viwarn104   = 204 << Detail Line Spare Block Printout.  >><<03583>>01556000
    ,viwarn105  = 205 << Out of spare tracks >>                <<03620>>01558000
    ,vierr106  = 206 << IO error during sparing >>             <<03620>>01560000
    ,viwarn108  = 208 << Do you want purge file xx ? >>        <<03620>>01562000
    ,viwarn107  = 207 << Do you want purge all bad files ? >>  <<03620>>01564000
    ,vierr109    = 209 << Couldn't read the Spare Table.     >><<03583>>01566000
    ,viwarn110   = 210 << Header line for Spare Table.       >><<03583>>01568000
    ,viwarn111   = 211 << Detail line per head.              >><<03583>>01570000
    ,viwarn112   = 212 << Detail line per spare              >><<03583>>01572000
                       << above for factory discovered.      >><<03583>>01574000
    ,viwarn113   = 213 << Detail line for field spare.       >><<03583>>01576000
    ,viwarn114   = 214 <<suspect sector in directory area>>    <<03620>>01578000
    ,viwarn115   = 215 <<suspect sector in bit map area>>      <<03620>>01580000
    ,viwarn116   = 216 <<suspect sector in desc. area>>        <<03620>>01582000
     ,vierr117  = 217 <<non-CS80 device>>                      <<03638>>01584000
     ,vierr118  = 218 <<it is not serial disc>>                <<03638>>01586000
     ,vierr119  = 219 <<unable to read gap table>>             <<03638>>01588000
     ,viwarn120  = 220 <<no data>>                             <<03638>>01590000
     ,viwarn121  = 221 <<unable to read sector>>               <<03638>>01592000
     ,viwarn122  = 222 <<end of data>>                         <<03638>>01594000
     ,vierr123  = 223 <<Inappropriate media-2 sided floppy>>   <<03712>>01596000
     ,viwarn124  = 224 <<Defective ! track>>                   <<03712>>01598000
     ,vierr125 = 225 <<unable to reassign tracks>>             <<04670>>01600000
     ,viwarn127 = 227 <<System logging disable>>               <<04670>>01602000
     ,viwarn128 = 228 <<System logging unable>>                <<04670>>01604000
     ,viwarn129 = 229 <<Volume not mounted>>                   <<04670>>01606000
     ,viwarn130 = 230 <<Unable to report bad files>>           <<04670>>01608000
     ,viwarn131 = 231 <<Unreadable or lost data>>              <<04670>>01610000
     ,viwarn132 = 232 <<Suspect or deleted sector/track >>     <<04670>>01612000
     ,viwarn133 = 233 <<xx% completed>>                        <<04670>>01614000
     ,viwarn134 = 234 <<Beginning Copy>>                       <<04670>>01616000
     ,vierr135 = 235 <<More than one user or temp. files>>     <<04670>>01618000
     ,vierr136 = 236 <<Media error - unable to initilize>>     <<04670>>01620000
     ;                                                         <<03536>>01622000
                                                                        01624000
$PAGE " DISC/DEFECTIVE TRACKS TABLE DEFINITIONS"               <<03510>>01626000
$INCLUDE INCDISC1                                              <<03510>>01628000
$PAGE " DFSM DST DEFINITIONS"                                  <<03510>>01630000
$INCLUDE INCLDFS1                                              <<03510>>01632000
$INCLUDE INCLDFS2                                              <<03510>>01634000
$PAGE " PVINIT - GLOBAL DECLARATIONS"                          <<03510>>01636000
LOGICAL PROCEDURE GETSIR(N);                                            01638000
VALUE N; LOGICAL N;                                                     01640000
OPTION EXTERNAL;                                                        01642000
                                                                        01644000
PROCEDURE RELSIR(N,B);                                                  01646000
VALUE N,B; LOGICAL N,B;                                                 01648000
OPTION EXTERNAL;                                                        01650000
LOGICAL PROCEDURE SETSYSDB;                                             01652000
OPTION EXTERNAL;                                                        01654000
                                                                        01656000
PROCEDURE RESETDB(D);                                                   01658000
VALUE D; LOGICAL D;                                                     01660000
OPTION EXTERNAL;                                                        01662000
                                                                        01664000
INTEGER PROCEDURE EXCHANGEDB(D);                                        01666000
VALUE D; INTEGER D;                                                     01668000
OPTION EXTERNAL;                                                        01670000
                                                                        01672000
PROCEDURE LOG12(MISCINFO,DEVINFO,VNAME,VNAMELEN,RECTYPE);               01674000
VALUE MISCINFO,DEVINFO,VNAMELEN,RECTYPE;                                01676000
LOGICAL MISCINFO,DEVINFO;                                               01678000
INTEGER VNAMELEN,RECTYPE;                                               01680000
ARRAY VNAME;                                                            01682000
OPTION EXTERNAL;                                                        01684000
                                                                        01686000
DOUBLE  PROCEDURE Attachio(Ldev,Qmisc,Dstx,Adr,Fnct,           <<03537>>01688000
                           Cnt,P1,P2,Flags);                   <<03537>>01690000
VALUE   Ldev,Qmisc,Dstx,Adr,Fnct,Cnt,P1,P2,Flags;              <<03537>>01692000
INTEGER Ldev,Qmisc,Dstx,Adr,Fnct,Cnt,P1,P2,Flags;              <<03537>>01694000
OPTION EXTERNAL;                                                        01696000
                                                                        01698000
INTEGER PROCEDURE Ldevtotype(Ldev);                            <<03537>>01700000
VALUE   Ldev;                                                  <<03537>>01702000
INTEGER Ldev;                                                  <<03537>>01704000
OPTION EXTERNAL;                                               <<03537>>01706000
                                                               <<03537>>01708000
INTEGER PROCEDURE Ldevtosubtype(Ldev);                         <<03537>>01710000
VALUE   Ldev;                                                  <<03537>>01712000
INTEGER Ldev;                                                  <<03537>>01714000
OPTION EXTERNAL;                                               <<03537>>01716000
                                                               <<03537>>01718000
DOUBLE PROCEDURE REQSTATUS(LDN);                                        01720000
VALUE LDN; INTEGER LDN;                                                 01722000
OPTION EXTERNAL;                                                        01724000
                                                                        01726000
PROCEDURE GETVSDEFN(VSID,VSDEFN,VSDEF,PVERR);                           01728000
LOGICAL VSDEF;                                                          01730000
INTEGER PVERR;                                                          01732000
ARRAY VSID,VSDEFN;                                                      01734000
OPTION VARIABLE,EXTERNAL;                                               01736000
                                                                        01738000
PROCEDURE GETMVTABENTRY(MVTABX,MVTABENT);                               01740000
VALUE MVTABX; INTEGER MVTABX;                                           01742000
ARRAY MVTABENT;                                                         01744000
OPTION EXTERNAL;                                                        01746000
                                                                        01748000
PROCEDURE GETABENTRY(TABDST,INDEX,TABENT);                              01750000
VALUE TABDST,INDEX;                                                     01752000
INTEGER TABDST,INDEX;                                                   01754000
ARRAY TABENT;                                                           01756000
OPTION EXTERNAL;                                                        01758000
                                                                        01760000
PROCEDURE PUTABENTRY(TABDST,INDEX,TABENT);                              01762000
VALUE TABDST,INDEX;                                                     01764000
INTEGER TABDST,INDEX;                                                   01766000
ARRAY TABENT;                                                           01768000
OPTION EXTERNAL;                                                        01770000
                                                                        01772000
PROCEDURE CHECKDISC(LDN,STAT);                                          01774000
VALUE LDN; INTEGER LDN;                                                 01776000
LOGICAL STAT;                                                           01778000
OPTION EXTERNAL;                                                        01780000
                                                               <<01115>>01782000
INTEGER PROCEDURE DISCTYPE(LDEV, LABL);                        <<01115>>01784000
VALUE LDEV;                                                    <<01115>>01786000
INTEGER LDEV;                                                  <<01115>>01788000
ARRAY LABL;                                                    <<01115>>01790000
OPTION EXTERNAL;                                               <<01115>>01792000
                                                                        01794000
LOGICAL PROCEDURE setcritical;                                 <<03510>>01796000
   OPTION EXTERNAL;                                            <<03510>>01798000
                                                               <<03510>>01800000
PROCEDURE resetcritical(i);                                    <<03510>>01802000
   VALUE i;                                                    <<03510>>01804000
   LOGICAL i;                                                  <<03510>>01806000
   OPTION EXTERNAL;                                            <<03510>>01808000
                                                               <<03510>>01810000
LOGICAL PROCEDURE Lock'Dfs'Data'Seg(ldev);                     <<03510>>01812000
   VALUE ldev;                                                 <<03510>>01814000
   INTEGER ldev;                                               <<03510>>01816000
   OPTION EXTERNAL;                                            <<03510>>01818000
                                                               <<03510>>01820000
PROCEDURE Unlock'Dfs'Data'Seg;                                 <<03510>>01822000
   OPTION EXTERNAL;                                            <<03510>>01824000
                                                               <<03510>>01826000
LOGICAL PROCEDURE Scan'Page;                                   <<03510>>01828000
   OPTION EXTERNAL;                                            <<03510>>01830000
                                                               <<03510>>01832000
PROCEDURE Set'Reset'Bit'Map(set'bits);                         <<03510>>01834000
   VALUE set'bits;                                             <<03510>>01836000
   LOGICAL set'bits;                                           <<03510>>01838000
   OPTION EXTERNAL;                                            <<03510>>01840000
                                                               <<03510>>01842000
PROCEDURE Must'Set'Reset'Bit'Map(set'bits);                    <<03510>>01844000
   VALUE set'bits;                                             <<03510>>01846000
   LOGICAL set'bits;                                           <<03510>>01848000
   OPTION EXTERNAL;                                            <<03510>>01850000
                                                               <<03510>>01852000
PROCEDURE Convert'Address'To'Map;                              <<03510>>01854000
   OPTION EXTERNAL;                                            <<03510>>01856000
                                                               <<03510>>01858000
LOGICAL PROCEDURE Get'Page(page);                              <<03510>>01860000
   VALUE page;                                                 <<03510>>01862000
   INTEGER page;                                               <<03510>>01864000
   OPTION EXTERNAL;                                            <<03510>>01866000
                                                               <<03510>>01868000
LOGICAL PROCEDURE Get'Disc'Info(ldev,disc'label,               <<03510>>01870000
                  read'label,dtt,type,subtype,                 <<03510>>01872000
                  disc'size,bit'map'address,                   <<03510>>01874000
                  bit'map'size'pages,dt'address,               <<03510>>01876000
                  dt'size'words,dt'dirty'flag,                 <<03510>>01878000
                  number'of'buffers,dt'check'sum,              <<03510>>01880000
                  sectors'per'track,                           <<03510>>01882000
                  default'logical'pack'size,                   <<03510>>01884000
                  max'logical'pack'size,                       <<03510>>01886000
                  tracks'per'cylinder,                         <<03510>>01888000
                  starting'head'number,trkmult);               <<03510>>01890000
   VALUE ldev,read'label;                                      <<03510>>01892000
   INTEGER ldev;                                               <<03510>>01894000
   ARRAY disc'label;                                           <<03510>>01896000
   LOGICAL read'label;                                         <<03510>>01898000
   INTEGER ARRAY dtt;                                          <<03510>>01900000
   INTEGER type;                                               <<03510>>01902000
   INTEGER subtype;                                            <<03510>>01904000
   DOUBLE disc'size;                                           <<03510>>01906000
   DOUBLE bit'map'address;                                     <<03510>>01908000
   INTEGER bit'map'size'pages;                                 <<03510>>01910000
   DOUBLE dt'address;                                          <<03510>>01912000
   INTEGER dt'size'words;                                      <<03510>>01914000
   LOGICAL dt'dirty'flag;                                      <<03510>>01916000
   INTEGER number'of'buffers;                                  <<03510>>01918000
   LOGICAL dt'check'sum;                                       <<03510>>01920000
   INTEGER sectors'per'track;                                  <<03510>>01922000
   INTEGER default'logical'pack'size;                          <<03510>>01924000
   INTEGER max'logical'pack'size;                              <<03510>>01926000
   INTEGER tracks'per'cylinder;                                <<03510>>01928000
   INTEGER starting'head'number;                               <<03510>>01930000
   INTEGER trkmult;                                            <<03510>>01932000
   OPTION VARIABLE,EXTERNAL;                                   <<03510>>01934000
                                                               <<03510>>01936000
LOGICAL PROCEDURE Read'Disc(ldev,add,dst,target,count);        <<03510>>01938000
   VALUE ldev,add,dst,count;                                   <<03510>>01940000
   INTEGER ldev,dst,count;                                     <<03510>>01942000
   DOUBLE add;                                                 <<03510>>01944000
   ARRAY target;                                               <<03510>>01946000
   OPTION EXTERNAL;                                            <<03510>>01948000
                                                               <<03510>>01950000
LOGICAL PROCEDURE Write'Disc(ldev,add,dst,source,count);       <<03510>>01952000
   VALUE ldev,add,dst,count;                                   <<03510>>01954000
   INTEGER ldev,dst,count;                                     <<03510>>01956000
   DOUBLE add;                                                 <<03510>>01958000
   ARRAY source;                                               <<03510>>01960000
   OPTION EXTERNAL;                                            <<03510>>01962000
                                                               <<03510>>01964000
PROCEDURE Move'From'Data'Seg(dst,offset,count,target);         <<03510>>01966000
   VALUE dst,offset,count;                                     <<03510>>01968000
   INTEGER dst,offset,count;                                   <<03510>>01970000
   ARRAY target;                                               <<03510>>01972000
   OPTION EXTERNAL;                                            <<03510>>01974000
                                                               <<03510>>01976000
INTEGER PROCEDURE Get'Disc'Space(ldev,number'of'sectors,       <<03510>>01978000
                                 disc'address);                <<03510>>01980000
   VALUE ldev,number'of'sectors;                               <<03510>>01982000
   INTEGER ldev;                                               <<03510>>01984000
   DOUBLE number'of'sectors,disc'address;                      <<03510>>01986000
   OPTION EXTERNAL;                                            <<03510>>01988000
                                                               <<03510>>01990000
PROCEDURE Return'Disc'Space(ldev,disc'address,                 <<03510>>01992000
                             number'of'sectors);               <<03510>>01994000
   VALUE ldev,disc'address,number'of'sectors;                  <<03510>>01996000
   INTEGER ldev;                                               <<03510>>01998000
   DOUBLE disc'address,number'of'sectors;                      <<03510>>02000000
   OPTION EXTERNAL;                                            <<03510>>02002000
                                                               <<03510>>02004000
INTEGER PROCEDURE Get'Specific'Disc'Space(ldev,disc'address,   <<03510>>02006000
                      number'of'sectors);                      <<03510>>02008000
   VALUE ldev,disc'address,number'of'sectors;                  <<03510>>02010000
   INTEGER ldev;                                               <<03510>>02012000
   DOUBLE disc'address,number'of'sectors;                      <<03510>>02014000
   OPTION EXTERNAL;                                            <<03510>>02016000
                                                               <<03510>>02018000
PROCEDURE dirwrite(which);                                     <<03510>>02020000
   VALUE which;                                                <<03510>>02022000
   LOGICAL which;                                              <<03510>>02024000
   OPTION EXTERNAL;                                            <<03510>>02026000
                                                               <<03510>>02028000
LOGICAL PROCEDURE Make'Check'Sum(buffer,count);                <<03510>>02030000
   VALUE count;                                                <<03510>>02032000
   ARRAY buffer;                                               <<03510>>02034000
   INTEGER count;                                              <<03510>>02036000
   OPTION EXTERNAL;                                            <<03510>>02038000
                                                               <<03510>>02040000
LOGICAL PROCEDURE Write'Disc'Label(ldev,dst,source);           <<03510>>02042000
   VALUE ldev,dst;                                             <<03510>>02044000
   INTEGER ldev,dst;                                           <<03510>>02046000
   ARRAY source;                                               <<03510>>02048000
   OPTION EXTERNAL;                                            <<03510>>02050000
                                                               <<03510>>02052000
LOGICAL PROCEDURE Create'Dfs'Data'Seg(ldev,disc'label,         <<03510>>02054000
                       assume'dt'is'dirty,flag'dt'as'dirty);   <<03510>>02056000
   VALUE ldev,assume'dt'is'dirty,flag'dt'as'dirty;             <<03510>>02058000
   INTEGER ldev;                                               <<03510>>02060000
   LOGICAL assume'dt'is'dirty;                                 <<03510>>02062000
   LOGICAL flag'dt'as'dirty;                                   <<03510>>02064000
   array disc'label;                                           <<03510>>02066000
   OPTION VARIABLE,EXTERNAL;                                   <<03510>>02068000
                                                               <<03510>>02070000
LOGICAL PROCEDURE Deallocate'Dfs'Data'Seg(ldev);               <<03510>>02072000
   VALUE ldev;                                                 <<03510>>02074000
   INTEGER ldev;                                               <<03510>>02076000
   OPTION EXTERNAL;                                            <<03510>>02078000
                                                               <<03510>>02080000
PROCEDURE Delete'Dfs'Data'Seg(ldev);                           <<03510>>02082000
   VALUE ldev;                                                 <<03510>>02084000
   INTEGER ldev;                                               <<03510>>02086000
   OPTION EXTERNAL;                                            <<03510>>02088000
                                                               <<03510>>02090000
PROCEDURE Process'Dfs'Error(ldev,error'status,                 <<03510>>02092000
                            type'of'error);                    <<03510>>02094000
   VALUE ldev,error'status,type'of'error;                      <<03510>>02096000
   INTEGER ldev;                                               <<03510>>02098000
   LOGICAL error'status;                                       <<03510>>02100000
   INTEGER type'of'error;                                      <<03510>>02102000
   OPTION EXTERNAL;                                            <<03510>>02104000
                                                               <<03510>>02106000
INTEGER PROCEDURE DSTATCOM(REQTYPE,LDEV);                               02108000
VALUE REQTYPE,LDEV;                                                     02110000
INTEGER REQTYPE,LDEV;                                                   02112000
OPTION EXTERNAL;                                                        02114000
                                                                        02116000
DOUBLE PROCEDURE DIRECFIND (TYPE,LINKAGE'INDEXP,ANAME,GUNAME,  <<RV.PV>>02118000
                            FNAME,PRETURN);                    <<RV.PV>>02120000
VALUE TYPE,LINKAGE'INDEXP;                                     <<RV.PV>>02122000
LOGICAL TYPE;                                                  <<RV.PV>>02124000
DOUBLE LINKAGE'INDEXP;                                         <<RV.PV>>02126000
ARRAY ANAME,GUNAME,FNAME,PRETURN;                                       02128000
OPTION EXTERNAL;                                                        02130000
                                                                        02132000
DOUBLE PROCEDURE DIRECSCAN (TYPE,LINKAGE'INDEXP,ANAME,GUNAME,           02134000
                            FNAME,RECIP,PARMS,MVTABX);                  02136000
VALUE TYPE,LINKAGE'INDEXP,MVTABX;                                       02138000
INTEGER TYPE,MVTABX;                                                    02140000
DOUBLE  LINKAGE'INDEXP;                                                 02142000
ARRAY ANAME,GUNAME,FNAME,PARMS;                                         02144000
INTEGER PROCEDURE RECIP;                                                02146000
OPTION EXTERNAL,VARIABLE;                                               02148000
DOUBLE PROCEDURE direcpurgefile(numsects,dummy,an,gn,          <<03510>>02150000
                                fn,mvtabx);                    <<03510>>02152000
   VALUE numsects,dummy,mvtabx;                                <<03510>>02154000
   DOUBLE numsects;                                            <<03510>>02156000
   INTEGER dummy,mvtabx;                                       <<03510>>02158000
   ARRAY an,gn,fn;                                             <<03510>>02160000
   OPTION EXTERNAL,VARIABLE;                                   <<03510>>02162000
                                                               <<03510>>02164000
                                                                        02166000
DOUBLE PROCEDURE VTABINDEX(VID,VSID,LDN,GEN);                           02168000
VALUE LDN;                                                              02170000
BYTE ARRAY VID,VSID;                                                    02172000
INTEGER LDN,GEN;                                                        02174000
OPTION VARIABLE,EXTERNAL;                                               02176000
                                                                        02178000
PROCEDURE DEBUG;                                                        02180000
OPTION EXTERNAL;                                                        02182000
                                                                        02184000
INTEGER PROCEDURE GENMSG(SETNO,MSGNO,MASK,PARM1,PARM2,                  02186000
   PARM3,PARM4,PARM5,DEST,REPLY,OFFSET,DST,IOTYPE);                     02188000
VALUE SETNO,MSGNO,MASK,PARM1,PARM2,PARM3,PARM4,PARM5,                   02190000
   DEST,REPLY,OFFSET,DST,IOTYPE;                                        02192000
INTEGER SETNO,MSGNO,DEST,DST;                                           02194000
LOGICAL MASK,PARM1,PARM2,PARM3,PARM4,PARM5,REPLY,OFFSET,                02196000
   IOTYPE;                                                              02198000
OPTION VARIABLE,EXTERNAL;                                               02200000
                                                                        02202000
INTEGER PROCEDURE MUSTOPEN (FD,FO,AO,R,D,FM,U,B,N,FS,          <<00239>>02204000
                          NE,I,FC);                            <<00239>>02206000
    VALUE   FO,AO,R,U,B,N,FS,NE,I,FC;                          <<00239>>02208000
    BYTE ARRAY FD,D,FM;                                        <<00239>>02210000
    LOGICAL FO,AO;                                             <<00239>>02212000
    INTEGER R,U,B,N,NE,I,FC;                                   <<00239>>02214000
    DOUBLE  FS;                                                <<00239>>02216000
    OPTION  EXTERNAL,VARIABLE;                                 <<00239>>02218000
                                                               <<00239>>02220000
DOUBLE PROCEDURE DIRECPURGE(TYPE,LINKAGE'INDEXP,ANAME,GUNAME,  <<00239>>02222000
                            FNAME,MVTABX);                     <<00239>>02224000
VALUE TYPE,LINKAGE'INDEXP,MVTABX;                              <<00239>>02226000
LOGICAL TYPE,MVTABX;                                           <<00239>>02228000
DOUBLE LINKAGE'INDEXP;                                         <<00239>>02230000
ARRAY ANAME,GUNAME,FNAME;                                      <<00239>>02232000
OPTION EXTERNAL,VARIABLE;                                      <<00239>>02234000
DOUBLE PROCEDURE WAITFORIO(IOQX);                              <<04670>>02236000
   VALUE IOQX;                                                 <<04670>>02238000
   INTEGER IOQX;                                               <<04670>>02240000
   OPTION EXTERNAL;                                            <<04670>>02242000
                                                               <<04670>>02244000
INTEGER PROCEDURE GETDATASEG(MEMSIZE,VDSIZE);                  <<04670>>02246000
   VALUE MEMSIZE,VDSIZE;                                       <<04670>>02248000
   INTEGER MEMSIZE,VDSIZE;                                     <<04670>>02250000
   OPTION EXTERNAL;                                            <<04670>>02252000
                                                               <<04670>>02254000
PROCEDURE RELDATASEG(IX);                                      <<04670>>02256000
   VALUE IX;                                                   <<04670>>02258000
   INTEGER IX;                                                 <<04670>>02260000
   OPTION EXTERNAL;                                            <<04670>>02262000
                                                               <<04670>>02264000
DOUBLE PROCEDURE CONVERT'MAP'TO'ADDRESS;                       <<04670>>02266000
   OPTION EXTERNAL;                                            <<04670>>02268000
                                                               <<04670>>02270000
INTRINSIC WHO,READ,PRINT,ASCII,BINARY,DASCII,CALENDAR,MYCOMMAND,        02272000
     RESETCONTROL,DBINARY,                                     <<DE>>   02274000
     CTRANSLATE,                                               <<03712>>02276000
     TERMINATE,PRINTFILEINFO,FCLOSE,XCONTRAP;                  <<01599>>02278000
                                                               <<RK.08>>02280000
PROCEDURE EOF;                                                 <<RK.08>>02282000
OPTION FORWARD;                                                <<RK.08>>02284000
                                                               <<03510>>02286000
LOGICAL PROCEDURE initdfsm(ldev,mv,dirsz,diradr,vlab);         <<03510>>02288000
   VALUE ldev,mv,dirsz;                                        <<03510>>02290000
   LOGICAL mv;                                                 <<03510>>02292000
   INTEGER ldev,dirsz;                                         <<03510>>02294000
   DOUBLE diradr;                                              <<03510>>02296000
   ARRAY vlab;                                                 <<03510>>02298000
   OPTION FORWARD;                                             <<03510>>02300000
                                                               <<03510>>02302000
PROCEDURE condense'disc(ldev,recover);                         <<03510>>02304000
   VALUE ldev,recover;                                         <<03510>>02306000
   INTEGER ldev;                                               <<03510>>02308000
   LOGICAL recover;                                            <<03510>>02310000
   OPTION FORWARD;                                             <<03510>>02312000
                                                               <<03510>>02314000
PROCEDURE pfentries(listfn,ldev);                              <<03510>>02316000
   VALUE listfn,ldev;                                          <<03510>>02318000
   INTEGER listfn,ldev;                                        <<03510>>02320000
   OPTION forward;                                             <<03510>>02322000
                                                               <<03510>>02324000
PROCEDURE pfre(fn,all,which'ldev);                             <<03510>>02326000
   VALUE fn,all,which'ldev;                                    <<03510>>02328000
   INTEGER fn,which'ldev;                                      <<03510>>02330000
   LOGICAL all;                                                <<03510>>02332000
   OPTION FORWARD;                                             <<03510>>02334000
                                                               <<03510>>02336000
LOGICAL PROCEDURE Is'It'Linus(Ldev);                           <<03537>>02338000
VALUE   Ldev;                                                  <<03537>>02340000
INTEGER Ldev;                                                  <<03537>>02342000
OPTION FORWARD;                                                <<03537>>02344000
                                                               <<03537>>02346000
INTEGER PROCEDURE Linusio(Ldev,Qmisc,Buf,Funct,Wc,Addr,        <<03537>>02348000
                          Flags,Spare'Mode,Errinfo,            <<03537>>02350000
                          Err'Return);                         <<03537>>02352000
VALUE Ldev,Funct,Wc,Addr,Flags,Spare'Mode,Errinfo;             <<03537>>02354000
INTEGER Ldev,Qmisc,Funct,Wc,Flags;                             <<03537>>02356000
LOGICAL Spare'Mode,Errinfo,Err'return;                         <<03537>>02358000
DOUBLE Addr;                                                   <<03537>>02360000
ARRAY Buf;                                                     <<03537>>02362000
OPTION FORWARD;                                                <<03537>>02364000
                                                               <<03537>>02366000
PROCEDURE Lock(Ldev);                                          <<03537>>02368000
VALUE Ldev;                                                    <<03537>>02370000
INTEGER Ldev;                                                  <<03537>>02372000
OPTION FORWARD;                                                <<03537>>02374000
                                                               <<03537>>02376000
PROCEDURE Unlock(Ldev);                                        <<03537>>02378000
VALUE Ldev;                                                    <<03537>>02380000
INTEGER Ldev;                                                  <<03537>>02382000
OPTION FORWARD;                                                <<03537>>02384000
                                                               <<03537>>02386000
PROCEDURE Disable'Break;                                       <<03537>>02388000
OPTION FORWARD;                                                <<03537>>02390000
                                                               <<03537>>02392000
PROCEDURE Enable'Break;                                        <<03537>>02394000
OPTION FORWARD;                                                <<03537>>02396000
                                                               <<03537>>02398000
LOGICAL PROCEDURE Linus'Numbers(Ldev,Buffer);                  <<03537>>02400000
VALUE Ldev;                                                    <<03537>>02402000
INTEGER Ldev;                                                  <<03537>>02404000
ARRAY Buffer;                                                  <<03537>>02406000
OPTION FORWARD;                                                <<03537>>02408000
                                                               <<03537>>02410000
PROCEDURE Format'A'Linus(Ldev,Spares,Interleave);              <<03537>>02412000
Value Ldev,Spares,Interleave;                                  <<03537>>02414000
Integer Ldev,Spares,Interleave;                                <<03537>>02416000
OPTION FORWARD;                                                <<03537>>02418000
                                                               <<03537>>02420000
PROCEDURE Format'Msg(Spares);                                  <<03537>>02422000
VALUE Spares;                                                  <<03537>>02424000
INTEGER Spares;                                                <<03537>>02426000
OPTION FORWARD;                                                <<03537>>02428000
                                                               <<03537>>02430000
PROCEDURE Print'Linus'Spares(Ldev);                            <<03583>>02432000
VALUE Ldev;                                                    <<03583>>02434000
INTEGER Ldev;                                                  <<03583>>02436000
OPTION FORWARD;                                                <<03583>>02438000
                                                               <<03583>>02440000
PROCEDURE Print'CS'80'Spares(Ldev);                            <<03583>>02442000
VALUE Ldev;                                                    <<03583>>02444000
INTEGER Ldev;                                                  <<03583>>02446000
OPTION FORWARD;                                                <<03583>>02448000
                                                               <<03583>>02450000
                                                                        02452000
INTRINSIC FOPEN,FCHECK,FWRITE,QUIT,FCONTROL;                   <<RK3PV>>02454000
INTRINSIC print'file'info;                                     <<03510>>02456000
                                                                        02458000
$PAGE "PVINIT - UTILITY PROCEDURES"                                     02460000
PROCEDURE controly;                                            <<03510>>02462000
BEGIN                                                                   02464000
                                                                        02466000
<<===================================================                   02468000
                                                                        02470000
     Procedure to handle control - y.                                   02472000
                                                                        02474000
   Parameters:                                                          02476000
      None.                                                             02478000
                                                                        02480000
   Assumptions:                                                         02482000
          this is only called for pfentries                             02484000
          DB may be at the stack or at DFSM DFST                        02486000
                                                                        02488000
   Globals:                                                             02490000
         sets req'brk to true                                           02492000
                                                                        02494000
   Externals:                                                           02496000
         Exchangedb                                                     02498000
                                                                        02500000
   Intrinsics:                                                          02502000
         None.                                                          02504000
                                                                        02506000
   Callers:                                                             02508000
         pfentries                                                      02510000
                                                                        02512000
   Fixid:                                                               02514000
         This fix was add as part of the new disc free space map,       02516000
       the fix i.d. on procedure header applies to the whole            02518000
       procedure.                                                       02520000
                                                                        02522000
   Changes:                                                             02524000
                                                                        02526000
====================================================>>                  02528000
                                                                        02530000
   INTEGER     sdec = Q+1;                                              02532000
   INTEGER     dst = sdec+1;                                            02534000
                                                                        02536000
   << set db back to stack, it may already be at the stack >>           02538000
                                                                        02540000
   dst:=exchangedb(0);                                                  02542000
                                                                        02544000
   req'brk:=true;                                                       02546000
   resetcontrol;                                                        02548000
                                                                        02550000
   exchangedb(dst);                                                     02552000
                                                                        02554000
   << DB set back to wherever it was before >>                          02556000
                                                                        02558000
   TOS:=%31400 + sdec;                                                  02560000
                                                                        02562000
   ASSEMBLE(xeq 0);                                                     02564000
                                                                        02566000
END;   << controly >>                                                   02568000
                                                               <<01599>>02572000
                                                                        02574000
PROCEDURE SPACE(SKIP);                                                  02576000
VALUE SKIP; INTEGER SKIP;                                               02578000
OPTION PRIVILEGED,UNCALLABLE;                                           02580000
BEGIN                                                                   02582000
     INTEGER I;                                                         02584000
     ARRAY BLANK(0:1);                                         <<RK.08>>02586000
                                                                        02588000
     BLANK:="  ";                                              <<RK.08>>02590000
     FOR I:=1 UNTIL SKIP DO FWRITE(OUTF,BLANK,-1,0);                    02592000
END  << SPACE >>;                                                       02594000
                                                               <<00239>>02596000
PROCEDURE PRINTLDEV(LDEV);                                     <<00239>>02598000
VALUE LDEV;                                                    <<00239>>02600000
INTEGER LDEV;                                                  <<00239>>02602000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>02604000
                                                               <<00239>>02606000
BEGIN                                                          <<00239>>02608000
   ARRAY TEMP(0:5);                                            <<00239>>02610000
   BYTE ARRAY BTEMP(*) = TEMP;                                 <<00239>>02612000
   INTEGER L;                                                  <<00239>>02614000
   MOVE BTEMP := "LDEV: ";                                     <<00239>>02616000
   L := ASCII(LDEV,10,BTEMP(6));                               <<00239>>02618000
   FWRITE(OUTF,TEMP,0,0);                                      <<00239>>02620000
   FWRITE(OUTF,TEMP,-(L+6),0);                                 <<00239>>02622000
END;                                                           <<00239>>02624000
                                                                        02626000
PROCEDURE DEVERROR(DEV,STATUS);                                         02628000
VALUE DEV,STATUS;                                                       02630000
INTEGER DEV;                                                            02632000
LOGICAL STATUS;                                                         02634000
OPTION PRIVILEGED,UNCALLABLE;                                           02636000
BEGIN                                                                   02638000
     INTEGER ERRNUM:=0;                                                 02640000
                                                                        02642000
     WHILE NOT STATUS DO  <<LOOK FOR FIRST ERROR BIT>>                  02644000
     BEGIN                                                              02646000
          ERRNUM:=ERRNUM+1;                                             02648000
          STATUS:=STATUS & LSR(1);                                      02650000
     END;                                                               02652000
     IF ERRNUM=12 THEN INAPPROPRIATE                           <<01115>>02654000
       ELSE GENMSG(PVMSGSET,(ERRNUM+DEVERRMSG),%10000,DEV);    <<01115>>02656000
END  << DEVERROR >>;                                                    02658000
                                                                        02660000
PROCEDURE DATECONV(DATE,BUF);                                           02662000
VALUE DATE;                                                             02664000
INTEGER DATE;                                                           02666000
BYTE ARRAY BUF;                                                         02668000
OPTION PRIVILEGED,UNCALLABLE;                                           02670000
BEGIN                                                                   02672000
     INTEGER M,D,Y;                                                     02674000
     INTEGER ARRAY DTAB(0:11)=PB:=                                      02676000
            0,  31,  59,  90, 120, 151, 181,                            02678000
          212, 243, 273, 304, 334;                                      02680000
                                                                        02682000
     MOVE BUF:="  /  /  ";                                              02684000
     Y:=DATE.(0:7);  <<YEAR>>                                           02686000
     D:=DATE.(7:9);  <<DAY >>                                           02688000
     IF Y.(14:2) = 0 AND D >= 60 THEN D:=D-1;  <<LEAP YEAR>>            02690000
     M:=12;  <<ASSUME DECEMBER>>                                        02692000
     DO M:=M-1 UNTIL DTAB(M) < D;  <<FIND CORRECT MONTH>>               02694000
     D:=D-DTAB(M);  <<DAY OF THE MONTH>>                                02696000
     M:=M+1;  <<FIX MONTH FOR OUTPUT PURPOSES>>                         02698000
     ASCII(M,-10,BUF(1));  <<MONTH>>                                    02700000
     ASCII(D,-10,BUF(4));  <<DAY  >>                                    02702000
     ASCII(Y,-10,BUF(7));  <<YEAR >>                                    02704000
END << DATECONV >>;                                                     02706000
                                                                        02712000
$PAGE "PROCEDURE DISCERROR"                                    <<03537>>02714000
PROCEDURE DISCERROR(LDN,FNCT,IOSTAT,ADDR,SEG,OFFSET);          <<RK.08>>02716000
VALUE LDN,FNCT,IOSTAT,ADDR,SEG,OFFSET;                         <<RK.08>>02718000
INTEGER LDN,FNCT,SEG,OFFSET;                                   <<RK.08>>02720000
LOGICAL IOSTAT;                                                         02722000
DOUBLE ADDR;                                                            02724000
OPTION PRIVILEGED,UNCALLABLE;                                           02726000
BEGIN                                                                   02728000
     INTEGER LEN,LOC;                                                   02730000
                                                               <<RK.08>>02732000
     BYTE ARRAY TEMP(0:13);                                             02734000
                                                                        02736000
     Msgw := "  ";                                             <<03537>>02738000
     MOVE Msgw(1) := Msgw,(35);                                <<03537>>02740000
     Len := Loc := 0;                                          <<03537>>02742000
     IF Is'It'Linus(Ldn) THEN                                  <<03537>>02744000
        MOVE Msg := "CARTRIDGE ",2                             <<03537>>02746000
     ELSE                                                      <<03537>>02748000
     MOVE MSG:="DISC ",2;                                               02750000
     CASE FNCT OF                                              <<03537>>02752000
     BEGIN                                                              02754000
          MOVE * :="READ",2;                                            02756000
          MOVE * :="WRITE",2;                                           02758000
          ; <<2>>                                              <<RK1PV>>02760000
          ; <<3>>                                              <<RK1PV>>02762000
          ; <<4>>                                              <<RK1PV>>02764000
          ; <<5>>                                              <<RK1PV>>02766000
          ; <<6>>                                              <<RK1PV>>02768000
          MOVE * :="REQUEST STATUS",2;                         <<03537>>02770000
          MOVE * :="FORMAT",2;                                 <<RK1PV>>02772000
          MOVE * :="INITIALIZE",2;                             <<RK1PV>>02774000
          MOVE * :="READ FULL SECTOR",2;                       <<RK1PV>>02776000
          MOVE * :="WRITE LABEL",2;                            <<RK1PV>>02778000
          MOVE * :="READ SPARE DISABLE",2;                     <<RK1PV>>02780000
          MOVE * :="FIND PHYS. ADDR./REQ. VOL. LIMIT",2;       <<03537>>02782000
          MOVE * :="VERIFY",2;                                 <<03537>>02784000
          ; <<15>>                                             <<03537>>02786000
          MOVE * := "LOCK",2;                                  <<03537>>02788000
          MOVE * := "UNLOCK",2;                                <<03537>>02790000
     END;                                                               02792000
     IF FNCT = SPARE'BLOCK THEN                                <<03537>>02794000
       MOVE * := "SECTOR SPARING",2;                           <<03537>>02796000
     IF FNCT = Initiate'Utility THEN                           <<03583>>02798000
       MOVE * := "INITIATE UTILITY",2;                         <<03537>>02800000
     MOVE * :=" ERROR ON LDEV# ",2;                                     02802000
     LOC:=TOS-@MSG;                                                     02804000
     LOC:=LOC+ASCII(LDN,10,MSG(LOC));                                   02806000
     PRINT(Msgw,-Loc,0);                                       <<03537>>02808000
     Msgw := "  ";                                             <<03537>>02810000
     MOVE Msgw(1) := Msgw,(35);                                <<03537>>02812000
     MOVE Msg := "STATUS=%",2;                                 <<03537>>02814000
     LEN:=ASCII(IOSTAT.TSTATUS,8,TEMP);                                 02816000
     MOVE * :=TEMP(6-LEN),(LEN),2;                                      02818000
     MOVE * :=", ADDRESS=%",2;                                          02820000
     LEN:=DASCII(ADDR,8,TEMP);                                          02822000
     MOVE * :=TEMP(11-LEN),(LEN),2;                                     02824000
     MOVE * := " SEGMENT:%",2;                                 <<00092>>02826000
     LEN:=ASCII(SEG,8,TEMP);                                   <<RK.08>>02828000
     MOVE * := TEMP(6-LEN),(LEN),2;                            <<00092>>02830000
     MOVE * := " OFFSET:%",2;                                  <<00092>>02832000
     LEN:=ASCII(OFFSET,8,TEMP);                                <<00092>>02834000
     MOVE * := TEMP(6-LEN),(LEN),2;                            <<00092>>02836000
     LEN:=TOS-@MSG;                                                     02838000
     PRINT(MSGW,-LEN,0);                                       <<RK.08>>02840000
END << DISCERROR >>;                                                    02842000
$PAGE "PROCEDURE DISCIO"                                       <<04670>>02844000
INTEGER PROCEDURE DISCIO(LDEV,FUNCT,BUF,ADDR,WC,ERRINFO,DSTX); <<04670>>02846000
VALUE LDEV,FUNCT,ADDR,WC,DSTX;                                 <<04670>>02848000
INTEGER LDEV,FUNCT,WC,DSTX;                                    <<04670>>02850000
LOGICAL ERRINFO;                                                        02852000
DOUBLE ADDR;                                                            02854000
ARRAY BUF;                                                              02856000
OPTION VARIABLE;                                                        02858000
OPTION PRIVILEGED,UNCALLABLE;                                           02860000
BEGIN                                                                   02862000
     <<ERRINFO:                                                         02864000
          INPUT - FLAGS FOR ERROR HANDLING                              02866000
                  (15:1) = 0 - OMIT DISC ERROR MESSAGE                  02868000
                           1 - PRINT DISC ERROR MESSAGE.                02870000
                  (14:1) = 0 - DON'T RETURN ERROR STATUS                02872000
                         = 1 - RETURN ERROR TO CALLER.                  02874000
                  (13:1) = 0 - OMIT FUNCTION ABORT MESSAGE              02876000
                           1 - PRINT FUNCTION ABORT MESSAGE             02878000
     >>                                                                 02880000
     LOGICAL PMAP = Q-4;                                                02882000
     LOGICAL IOSTAT,ERRFLAGS;                                           02884000
     INTEGER                                                            02886000
          ADDR1 = ADDR,                                                 02888000
          ADDR2 = ADDR+1;                                               02890000
     INTEGER POINTER BUFP = BUF;                                        02892000
     INTEGER DST,FL;                                           <<04670>>02894000
                                                                        02896000
     CC:=CCE;                                                           02898000
     ERRFLAGS := IF PMAP.(14:1) THEN ERRINFO ELSE 5;           <<04670>>02900000
     DST := IF PMAP THEN DSTX ELSE 0;                          <<04670>>02902000
     FL := IF LPDT1.DRSTATE = 1 AND LPDT1.FORS = 0 THEN %41    <<03620>>02904000
                                                   ELSE 1;     <<03620>>02906000
     IF PMAP.(14:1) AND ERRINFO.(7:1) THEN FL.(15:1) := 0;     <<04670>>02908000
     IF FUNCT = INIT'UTIL AND (ADDR=RW'ERT OR ADDR=RO'ERT) THEN<<03620>>02910000
     << THIS FUNCTION IS ONLY VALID FOR CS'80 DISCS    >>      <<03620>>02912000
     << TO PERFORM INITIATE UTILITY FUNCTION DISC DRIVE>>      <<03620>>02914000
     << MUST HAVE SET SECTOR ADDRESS (BUF-PARAMETER)   >>      <<03620>>02916000
     << CS'80 SPARE SECTORS PROCEDURE USES TWO         >>      <<03620>>02918000
     << FOLLOWING FUNCTIONS :                          >>      <<03620>>02920000
     << READ/WRITE ERROR TEST ON SECTOR (WC=0) OR      >>      <<03620>>02922000
     << TRACK (WC=1) - RW'ERT (P1=2,P2=%310),          >>      <<03620>>02924000
     << READ ONLY ERROR TEST - RO'ERT (P1=2,P2=%311)   >>      <<03620>>02926000
     BEGIN                                                     <<03620>>02928000
     TOS:=ATTACHIO(LDEV,0,0,@BUFP,SET'ADDR'SEC,0,0,0,FL);      <<03620>>02930000
     DELETE;                                                   <<03620>>02932000
     IOSTAT:=TOS;                                              <<03620>>02934000
     IF IOSTAT.GSTATUS <> SUCCESSFUL THEN GOTO ERR;            <<03620>>02936000
     << SET PARAMETERS FOR INITIATE UTILITY FUNCTION   >>      <<03620>>02938000
     IF ADDR=RO'ERT THEN PBUFW := 4 ELSE PBUFW := 5;<<#OF ARG>><<03620>>02940000
     PBUF(2) := 5;   << # OF LOOPS >>                          <<03620>>02942000
     PBUF(3) := 0;   << OFFSET >>                              <<03620>>02944000
     PBUF(4) := 0;   << REPORT - 10 BYTES INFO >>              <<03620>>02946000
     PBUF(5) := WC;  << 0 - SECTOR, 1 - TRACK >>               <<03620>>02948000
     PBUF(6) := 0;   << DATA SOURCE - INTERNAL PATTERN >>      <<03620>>02950000
     WC := -20;      << BUFFER SIZE >>                         <<03620>>02952000
     @BUFP := @PBUFW;                                          <<03620>>02954000
     END;                                                      <<03620>>02956000
                                                               <<03620>>02958000
     TOS:=ATTACHIO(LDEV,0,DST,@BUFP,FUNCT,WC,ADDR1,ADDR2,FL);  <<04670>>02960000
     DISCIO := TOS;                                            <<04670>>02964000
     IOSTAT:=TOS;                                                       02966000
     IF <> THEN                                                <<04670>>02968000
     BEGIN                                                     <<04670>>02970000
     IF IOSTAT.GSTATUS <> SUCCESSFUL THEN  <<UNSUCESSFUL I/O>>          02972000
ERR:                                                           <<03620>>02974000
     BEGIN                                                              02976000
          CC:=CCL;                                                      02978000
          IF ERRFLAGS THEN DISCERROR(LDEV,FUNCT,IOSTAT,ADDR,   <<01115>>02980000
                                     STAT.(8:8),DELP);         <<RK.08>>02982000
          IF ERRFLAGS.(13:1) THEN GENMSG(PVMSGSET,VIERR0);              02984000
     END;                                                               02986000
     END;                                                      <<04670>>02988000
     IF ERRFLAGS.(14:1) THEN ERRINFO:=IOSTAT;                           02990000
END << DISCIO >>;                                                       02992000
                                                                        02994000
LOGICAL PROCEDURE DLIO (LDEV,FUNCT,BUF,ADDR,WC,IOSTAT);        <<04670>>02996000
VALUE LDEV,FUNCT,ADDR,WC;                                      <<04670>>02998000
INTEGER LDEV,FUNCT,WC;                                         <<04670>>03000000
LOGICAL IOSTAT;                                                <<04670>>03002000
DOUBLE ADDR;                                                   <<04670>>03004000
ARRAY BUF;                                                     <<04670>>03006000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>03008000
                                                               <<04670>>03010000
BEGIN                                                          <<04670>>03012000
INTEGER QMISC := 0;                                            <<04670>>03014000
IF LINUS THEN                                                  <<04670>>03016000
   LINUSIO (LDEV,QMISC,BUF,FUNCT,WC,ADDR,BLOCKED'IO,           <<04670>>03018000
            NO'SPARING,IOSTAT,IOSTAT)                          <<04670>>03020000
ELSE                                                           <<04670>>03022000
   DISCIO (LDEV,FUNCT,BUF,ADDR,WC,IOSTAT);                     <<04670>>03024000
DLIO := IF = THEN TRUE ELSE FALSE;                             <<04670>>03026000
END;                                                           <<04670>>03028000
$PAGE "PROCEDURE UNREADABLE'LABEL"                             <<03537>>03030000
LOGICAL PROCEDURE UNREADABLE'LABEL(LDN,OK);                    <<00239>>03032000
VALUE LDN,OK;                                                  <<00239>>03034000
INTEGER LDN;                                                   <<00239>>03036000
LOGICAL OK;                                                    <<00239>>03038000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>03040000
BEGIN                                                          <<00239>>03042000
   ARRAY Temp(0 : Linus'Sector - 1);                           <<03537>>03044000
   INTEGER IOSTATUS;                                           <<03537>>03046000
   LOGICAL L'Iostatus = Iostatus;                              <<03537>>03048000
   INTEGER Qmisc := 0;                                         <<03537>>03050000
                                                               <<00239>>03052000
   IOSTATUS := 2; << RETURN ERROR >>                           <<00239>>03054000
   Unreadable'Label := FALSE;                                  <<03537>>03056000
                                                               <<03537>>03058000
   IF Is'It'Linus(Ldn) THEN                                    <<03537>>03060000
   BEGIN                                                       <<03537>>03062000
      Linusio(Ldn,Qmisc,Temp,R,Linus'Sector,Disc'Label'Address,<<03537>>03064000
              Blocked'IO,NO'SPARING,L'Iostatus,L'Iostatus);    <<03537>>03066000
   END                                                         <<03537>>03068000
   ELSE                                                        <<03537>>03070000
      DISCIO(LDN,R,TEMP,0D,128,IOSTATUS);                      <<03537>>03072000
   IF IOSTATUS.TSTATUS = SUCCESSFUL THEN RETURN;               <<00239>>03074000
   UNREADABLE'LABEL := TRUE;                                   <<00239>>03076000
   GENMSG(PVMSGSET,VIWARN10,%10000,LDN);                       <<00239>>03078000
   IF NOT OK THEN GENMSG(PVMSGSET,VIERR0);                     <<00239>>03080000
END;                                                           <<00239>>03082000
                                                               <<00239>>03084000
$PAGE "PROCEDURE SCRATCHVOL"                                   <<03537>>03086000
LOGICAL PROCEDURE SCRATCHVOL(LDN);                                      03088000
VALUE LDN; INTEGER LDN;                                                 03090000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>03092000
BEGIN                                                                   03094000
     ARRAY VLAB(*) = BUFF;                                              03096000
     BYTE ARRAY VLABB(*) = BUFF;                               <<00145>>03098000
     INTEGER Qmisc := 0;                                       <<03537>>03100000
     LOGICAL Dummy;                                            <<03537>>03102000
                                                                        03104000
     CC := CCE;                                                <<00239>>03106000
     IF Is'It'Linus(Ldn) THEN                                  <<03537>>03108000
     BEGIN                                                     <<03537>>03110000
        Linusio(Ldn,Qmisc,Vlab,R,Linus'Sector,                 <<03537>>03112000
                Disc'Label'Address,Blocked'IO,NO'SPARING,      <<03537>>03114000
                Default'Errinfo,Dummy);                        <<03537>>03116000
     END                                                       <<03537>>03118000
     ELSE                                                      <<03537>>03120000
        DISCIO(LDN,R,VLAB,0D,128);                             <<03537>>03122000
     IF < THEN  <<DISC I/O ERROR>>                                      03124000
     BEGIN                                                              03126000
          CC:=CCL;                                                      03128000
          RETURN;                                                       03130000
     END;                                                               03132000
     SCRATCHVOL := DISCTYPE(LDN,VLAB)=3;                       <<01115>>03134000
END << SCRATCHVOL>>;                                                    03136000
                                                               <<RK.08>>03138000
LOGICAL PROCEDURE OVERWRITE(LDEV,MESSAGE);                     <<RK.08>>03140000
VALUE LDEV,MESSAGE;                                            <<RK.08>>03142000
INTEGER LDEV,MESSAGE;                                          <<RK.08>>03144000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>03146000
BEGIN                                                          <<RK.08>>03148000
                                                               <<01115>>03150000
   COMMENT                                                     <<01115>>03152000
                                                               <<01115>>03154000
       THIS PROCEDURE DETERMINES WHETHER IT IS OK TO OVERWRITE <<01115>>03156000
       A DISC VOLUME.  IF THE VOLUME IS NOT SCRATCH, IT ASKS   <<01115>>03158000
       FOR CONFIRMATION FROM THE USER.                         <<01115>>03160000
                                                               <<01115>>03162000
       ;                                                       <<01115>>03164000
                                                               <<01115>>03166000
   ARRAY VLAB(*) = BUFF;                                       <<RK.08>>03168000
   BYTE ARRAY VLABB(*) = BUFF;                                 <<RK.08>>03170000
   INTEGER SIZE := 0;                                          <<RK.08>>03172000
   BYTE ARRAY BA(0:39);                                        <<RK.08>>03174000
   BYTE ARRAY NAME(*) = BA;                                    <<RK.08>>03176000
   BYTE ARRAY VOLUMESET(*) = BA(10);                           <<RK.08>>03178000
   BYTE ARRAY GROUP(*) = BA(20);                               <<RK.08>>03180000
   BYTE ARRAY ACCOUNT(*) = BA(30);                             <<RK.08>>03182000
   EQUATE IBM'FLOPPY = %10;                                    <<04131>>03184000
                                                               <<RK.08>>03186000
   TOS := SCRATCHVOL(LDEV);                                    <<RK.08>>03188000
   IF < THEN RETURN; <<DISC ERROR - WILL BE FALSE>>            <<RK.08>>03190000
   IF TOS THEN                                                 <<RK.08>>03192000
      BEGIN                                                    <<RK.08>>03194000
      OVERWRITE := TRUE;                                       <<RK.08>>03196000
      RETURN;                                                  <<RK.08>>03198000
      END;                                                     <<RK.08>>03200000
   MOVE BA := 20("  ");                                        <<RK.08>>03202000
   MOVE NAME      := VLABB(LVNAMELOC),(8);                     <<RK.08>>03204000
   MOVE VOLUMESET := VLABB(LVOLDIRLOC),(8);                    <<RK.08>>03206000
   MOVE GROUP     := VLABB(LVSGROUPLOC),(8);                   <<RK.08>>03208000
   MOVE ACCOUNT   := VLABB(LVSACCNTLOC),(8);                   <<RK.08>>03210000
   WHILE SIZE = 0 DO                                           <<RK.08>>03212000
      BEGIN                                                    <<RK.08>>03214000
      TOS := @PBUF;                                            <<RK.08>>03216000
      CASE DISCTYPE(LDEV, VLAB) OF                             <<01115>>03218000
         BEGIN                                                 <<01115>>03220000
           BEGIN  <<CASE 0 -- SYSTEM VOLUME>>                  <<01115>>03222000
             MOVE * := "A FORMER SYSTEM VOLUME ",2;            <<01115>>03224000
             MOVE * := NAME WHILE AN,1;                        <<01115>>03226000
             GO TO GENERATION;                                 <<01115>>03228000
           END;                                                <<01115>>03230000
           BEGIN  <<CASE 1 -- PRIVATE VOLUME>>                 <<01115>>03232000
             MOVE * := NAME WHILE AN,1;                        <<01115>>03234000
             MOVE * := " OF ",2;                               <<01115>>03236000
             MOVE * := VOLUMESET WHILE AN,1;                   <<01115>>03238000
             MOVE * := ".",2;                                  <<01115>>03240000
             MOVE * := GROUP WHILE AN,1;                       <<01115>>03242000
             MOVE * := ".",2;                                  <<01115>>03244000
             MOVE * := ACCOUNT WHILE AN,1;                     <<01115>>03246000
             GO GENERATION;                                    <<01115>>03248000
           END;                                                <<01115>>03250000
           BEGIN <<CASE 2 -- SERIAL>>                          <<01115>>03252000
             MOVE * := "A SERIAL DISC ",2;                     <<01115>>03254000
GENERATION:  MOVE * := " WITH GENERATION = ",2;                <<01115>>03256000
             SIZE := TOS-@PBUF;                                <<01115>>03258000
             SIZE := SIZE+ASCII(VLAB(LGENINDEX),10,PBUF(SIZE));<<01115>>03260000
           END;                                                <<01115>>03262000
                 <<CASE 3 -- SCRATCH>>                         <<01115>>03264000
           ;     <<NOT USED>>                                  <<01115>>03266000
           BEGIN <<CASE 4 -- FOREIGN>>                         <<01115>>03268000
             MOVE * := "A FOREIGN DISC ",2;                    <<01115>>03270000
             TOS := REQSTATUS(LDEV);                           <<04131>>03272000
             ASSEMBLE(DELB);                                   <<04131>>03274000
             IF TOS.(3:4)=IBM'FLOPPY THEN                      <<04131>>03276000
                MOVE * := "(IBM DISKETTE) ",2;                 <<04131>>03278000
             SIZE := TOS-@PBUF;                                <<01115>>03280000
           END;                                                <<01115>>03282000
         END;   <<OF CASE ON DISCTYPE>>                        <<01115>>03284000
      PRINT(PBUFW,-SIZE,0);                                    <<RK.08>>03286000
      TOS := @PBUF;                                            <<RK.08>>03288000
      MOVE * := " TO BE ",2;                                   <<RK.08>>03290000
      CASE MESSAGE OF                                          <<RK.08>>03292000
         BEGIN                                                 <<RK.08>>03294000
         MOVE * := "OVERWRITTEN ?",2;                          <<RK.08>>03296000
         MOVE * := "INITIALIZED ?",2;                          <<RK.08>>03298000
         MOVE * := "FORMATTED ?",2;                            <<RK.08>>03300000
         MOVE * := "MADE SCRATCH ?",2;                         <<RK.08>>03302000
         MOVE * := "COPIED TO ?",2;                            <<RK.08>>03304000
         MOVE * := "MADE SERIAL ?",2;                          <<RK.08>>03306000
         MOVE * := "MADE FOREIGN ?",2;                         <<01115>>03308000
         END; << OF CASE >>                                    <<RK.08>>03310000
      MOVE * := " (Y/N) ",2;                                   <<RK.08>>03312000
      SIZE := TOS - @PBUF;                                     <<RK.08>>03314000
      PRINT(PBUFW,-SIZE,%320);                                 <<RK.08>>03316000
      SIZE := READ(RBUFW,-4);                                  <<RK.08>>03318000
      IF <> THEN EOF;                                          <<RK.08>>03320000
      IF SIZE <> 0 THEN                                        <<RK.08>>03322000
         IF RBUF = "Y" OR RBUF = "y" THEN OVERWRITE := TRUE    <<00092>>03324000
         ELSE IF RBUF = "N" OR RBUF = "n" THEN RETURN          <<00092>>03326000
         ELSE SIZE := 0;                                       <<RK.08>>03328000
      END; << OF SIZE <> 0 >>                                  <<RK.08>>03330000
END; << OF OVERWRITE >>                                        <<RK.08>>03332000
                                                               <<RK.08>>03334000
$PAGE " PROCEDURE VOLUME'MOUNTED"                              <<04670>>03336000
LOGICAL PROCEDURE VOLUME'MOUNTED (LDEV,VOL'INDEX,MVTAB'INDEX,  <<04670>>03338000
                                  VOL'SET'LDEV);               <<04670>>03340000
VALUE LDEV;                                                    <<04670>>03342000
LOGICAL LDEV;                                                  <<04670>>03344000
INTEGER VOL'INDEX,MVTAB'INDEX;                                 <<04670>>03346000
INTEGER ARRAY VOL'SET'LDEV;                                    <<04670>>03348000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<04670>>03350000
                                                               <<04670>>03352000
<<This procedure checks if private or system volume is      >> <<04670>>03354000
<<mounted. Additionaly returns volume index, MVTAB index and>> <<04670>>03356000
<<volume logical device set. The volume logical device table>> <<04670>>03358000
<<has 16 entries. Non zero entry indicates valid LDEV.      >> <<04670>>03360000
                                                               <<04670>>03362000
BEGIN                                                          <<04670>>03364000
INTEGER MSGNUM,MVTABX,I,OFFSET,COND'INDEX,VOLUME'COUNT;        <<04670>>03366000
ARRAY VSID(0:11);                                              <<04670>>03368000
ARRAY VLAB(0:SECSIZE);                                         <<04670>>03370000
ARRAY VSDEFN (*) = VLAB;                                       <<04670>>03372000
ARRAY MVTABENT (*) = VLAB;                                     <<04670>>03374000
ARRAY VOL'ENT (*) = VLAB;                                      <<04670>>03376000
ARRAY VOLSETLDEV (0:MAX'DISCS);                                <<04670>>03378000
LOGICAL A;                                                     <<04670>>03380000
LOGICAL PMAP = Q-4;                                            <<04670>>03382000
DEFINE  VOLIND = PMAP.(0:13)#;                                 <<04670>>03384000
DEFINE  MVTABI = PMAP.(0:14)#;                                 <<04670>>03386000
DEFINE  VSLDEV = PMAP.(0:15)#;                                 <<04670>>03388000
                                                               <<04670>>03390000
VOLUME'MOUNTED := FALSE;                                       <<04670>>03392000
                                                               <<04670>>03394000
VOLSETLDEV := 0;                                               <<04670>>03396000
MOVE VOLSETLDEV(1) := VOLSETLDEV,(MAX'DISCS-1);                <<04670>>03398000
                                                               <<04670>>03400000
<< PRIVATE VOLUME >>                                           <<04670>>03402000
                                                               <<04670>>03404000
IF PVOL THEN                                                   <<04670>>03406000
   BEGIN                                                       <<04670>>03408000
   DISCIO (LDEV,R,VLAB,0D,SECSIZE);                            <<04670>>03410000
   IF <> THEN                                                  <<04670>>03412000
      RETURN;                                                  <<04670>>03414000
                                                               <<04670>>03416000
   MOVE VSID := VLAB (DISC'LAB'SET),(4);                       <<04670>>03418000
   MOVE VSID(4) := VLAB (DISC'LAB'GROUP'NAME),(4);             <<04670>>03420000
   MOVE VSID(8) := VLAB (DISC'LAB'ACCNT'NAME),(4);             <<04670>>03422000
   GETVSDEFN (VSID,VSDEFN,,MSGNUM);                            <<04670>>03424000
   IF <> THEN                                                  <<04670>>03426000
      BEGIN                                                    <<04670>>03428000
      GENMSG (PVMSGSET,MSGNUM);                                <<04670>>03430000
      RETURN;                                                  <<04670>>03432000
      END;                                                     <<04670>>03434000
   MVTABX := VSDEFN (VDMISC).MVTABXF;                          <<04670>>03436000
   IF MVTABX = 0 THEN                                          <<04670>>03438000
      RETURN;                                                  <<04670>>03440000
   VOLUME'COUNT := VSDEFN (VDINFO).NUMVOL;                     <<04670>>03442000
   GETMVTABENTRY (MVTABX,MVTABENT);                            <<04670>>03444000
                                                               <<04670>>03446000
   <<Check if all volumes are mounted>>                        <<04670>>03448000
                                                               <<04670>>03450000
   COND'INDEX := -1;                                           <<04670>>03452000
   OFFSET := 5;                                                <<04670>>03454000
   I := 0;                                                     <<04670>>03456000
   WHILE (I:=I+1) <= VOLUME'COUNT DO                           <<04670>>03458000
      IF (VOLSETLDEV (I) :=                                    <<04670>>03460000
          MVTABENT (OFFSET + (I-1)*2).LDEVF) = 0 THEN          <<04670>>03462000
          RETURN                                               <<04670>>03464000
      ELSE                                                     <<04670>>03466000
         IF VOLSETLDEV (I) = LDEV THEN                         <<04670>>03468000
            COND'INDEX := I;                                   <<04670>>03470000
   END                                                         <<04670>>03472000
                                                               <<04670>>03474000
<< SYSTEM VOLUME >>                                            <<04670>>03476000
                                                               <<04670>>03478000
ELSE                                                           <<04670>>03480000
   BEGIN                                                       <<04670>>03482000
   A := GETSIR(LDTSIR);                                        <<04670>>03484000
   MVTABX := 0;                                                <<04670>>03486000
   GETMVTABENTRY (MVTABX,MVTABENT);                            <<04670>>03488000
   MOVE'FROM'DATA'SEG (VOL'TABLE'DST,0,16,VOL'ENT);            <<04670>>03490000
   VOLUME'COUNT := VOL'ENT (NUM'SYS'VOL);                      <<04670>>03492000
   OFFSET := VOL'ENT.VOL'TABLE'ENT'SIZE;                       <<04670>>03494000
                                                               <<04670>>03496000
   <<Check all system volumes>>                                <<04670>>03498000
                                                               <<04670>>03500000
   COND'INDEX := -1;                                           <<04670>>03502000
   I := 0;                                                     <<04670>>03504000
   WHILE (I:=I+1) <= VOLUME'COUNT DO                           <<04670>>03506000
      BEGIN                                                    <<04670>>03508000
      MOVE'FROM'DATA'SEG (VOL'TABLE'DST,I*OFFSET,OFFSET,       <<04670>>03510000
                          VOL'ENT);                            <<04670>>03512000
      IF VOL'ENT <> 0 AND                                      <<04670>>03514000
         (VOLSETLDEV (I) :=                                    <<04670>>03516000
          VOL'ENT (VOL'TABLE'LDEV).VOL'ENT'LDEV) = LDEV THEN   <<04670>>03518000
         COND'INDEX := I;                                      <<04670>>03520000
      END;                                                     <<04670>>03522000
   RELSIR(LDTSIR,A);                                           <<04670>>03524000
   END;                                                        <<04670>>03526000
                                                               <<04670>>03528000
IF COND'INDEX < 0 THEN                                         <<04670>>03530000
   RETURN;                                                     <<04670>>03532000
                                                               <<04670>>03534000
IF VOLIND THEN                                                 <<04670>>03536000
   VOL'INDEX := COND'INDEX;                                    <<04670>>03538000
IF MVTABI THEN                                                 <<04670>>03540000
   MVTAB'INDEX := MVTABX;                                      <<04670>>03542000
IF VSLDEV THEN                                                 <<04670>>03544000
   MOVE VOL'SET'LDEV := VOLSETLDEV,(MAX'DISCS);                <<04670>>03546000
VOLUME'MOUNTED := TRUE;                                        <<04670>>03548000
                                                               <<04670>>03550000
END;                                                           <<04670>>03552000
$PAGE "PROCEDURE GET'DEV'INFO"                                 <<04670>>03554000
LOGICAL PROCEDURE GET'DEV'INFO (LDEV,TYPE,SUBTYPE);            <<04670>>03556000
VALUE LDEV;                                                    <<04670>>03558000
INTEGER LDEV,TYPE,SUBTYPE;                                     <<04670>>03560000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>03562000
                                                               <<04670>>03564000
<<This procedure sets the DISC'TYPE flag which describes    >> <<04670>>03566000
<<the logical and physical type of volume. It also returns  >> <<04670>>03568000
<<a message - UNREADABLE LABEL.                             >> <<04670>>03570000
                                                               <<04670>>03572000
BEGIN                                                          <<04670>>03574000
ARRAY VLAB (*) = BUFF;                                         <<04670>>03576000
                                                               <<04670>>03578000
GET'DEV'INFO := TRUE;                                          <<04670>>03580000
IF NOT GET'DISC'INFO (LDEV,VLAB,TRUE,,TYPE,SUBTYPE,,,,,,,,,    <<04670>>03582000
                      SECTRK,,,TRKCYL) THEN                    <<04670>>03584000
   BEGIN                                                       <<04670>>03586000
   GET'DEV'INFO := FALSE;                                      <<04670>>03588000
   GENMSG (PVMSGSET,VIWARN10,%10000,LDEV);                     <<04670>>03590000
   GENMSG (PVMSGSET,VIERR0);                                   <<04670>>03592000
   RETURN;                                                     <<04670>>03594000
   END;                                                        <<04670>>03596000
DISC'TYPE.(6:10) := 0;  <<Initialize flags>>                   <<04670>>03598000
CASE DISCTYPE (LDEV,VLAB) OF                                   <<04670>>03600000
   BEGIN                                                       <<04670>>03602000
   SYS    := 1;                                                <<04670>>03604000
   PVOL   := 1;                                                <<04670>>03606000
   SERIALD := 1;                                               <<04670>>03608000
   SCRVOL  := 1;                                               <<04670>>03610000
   FORVOL  := 1;                                               <<04670>>03612000
   END;                                                        <<04670>>03614000
SECSIZE := SECTOR'SIZE;                                        <<04670>>03616000
IF TYPE = MH'DISC'TYPE THEN                                    <<04670>>03618000
   MH'DISC := 1;                                               <<04670>>03620000
IF TYPE = FLOPPY'DISC'TYPE THEN                                <<04670>>03622000
   FLOPPY := 1;                                                <<04670>>03624000
IF TYPE = CS'80'TYPE THEN                                      <<04670>>03626000
   BEGIN                                                       <<04670>>03628000
   CS'80 := 1;                                                 <<04670>>03630000
   IF SUBTYPE = ST'9110 THEN                                   <<04670>>03632000
      BEGIN                                                    <<04670>>03634000
      SECSIZE := 512;                                          <<04670>>03636000
      LINUS := 1;                                              <<04670>>03638000
      END;                                                     <<04670>>03640000
   END;                                                        <<04670>>03642000
                                                               <<04670>>03644000
IF MH'DISC OR FLOPPY OR CS'80 THEN                             <<04670>>03646000
   DISC := 1;                                                  <<04670>>03648000
END;                                                           <<04670>>03650000
$PAGE "PROCEDURE SETSCRATCH"                                   <<03537>>03652000
PROCEDURE SETSCRATCH(LDN,FLAGS);                                        03654000
VALUE LDN,FLAGS;                                                        03656000
INTEGER LDN;                                                            03658000
LOGICAL FLAGS;                                                          03660000
OPTION PRIVILEGED,UNCALLABLE;                                           03662000
BEGIN                                                                   03664000
     ARRAY VLAB(*) = BUFF;                                              03666000
     BYTE ARRAY VLABB(*) = BUFF;                                        03668000
     INTEGER     type                                          <<03510>>03670000
                ,subtype                                       <<03510>>03672000
                ;                                              <<03510>>03674000
     INTEGER Qmisc := 0;                                       <<03537>>03676000
     LOGICAL Dummy;                                            <<03537>>03678000
     DEFINE                                                             03680000
          STATE   = FLAGS.(15:1)#,                                      03682000
          SETVLAB = FLAGS.(14:1)#;                                      03684000
                                                                        03686000
     CC := CCE;                                                <<00239>>03688000
     IF SETVLAB THEN  <<CREATE SCRATCH VOLUME LABEL>>                   03690000
     BEGIN                                                              03692000
          Vlab := 0; MOVE Vlab(1) := Vlab,(Linus'Sector - 1);  <<03537>>03694000
          IF Is'It'Linus(Ldn) THEN                             <<03537>>03696000
          BEGIN                                                <<03537>>03698000
               Type := Ldevtotype(Ldn);                        <<03537>>03700000
               Subtype := Ldevtosubtype(Ldn);                  <<03537>>03702000
          END                                                  <<03537>>03704000
          ELSE                                                 <<03537>>03706000
               Get'Disc'Info(ldn,,,,type,subtype);             <<03537>>03708000
          vlab(disc'lab'type'word).disc'lab'type:=             <<03510>>03710000
                                     type;                     <<03510>>03712000
          vlab(disc'lab'type'word).disc'lab'subtype:=          <<03510>>03714000
                                     subtype;                  <<03510>>03716000
          MOVE VLABB(LVNAMELOC):="SCRATCH ";                            03718000
          MOVE VLABB(LVSACCNTLOC):=" ",2;                               03720000
          ASSEMBLE(DUP,DECA);                                           03722000
          MOVE * := * ,(16);                                            03724000
     END ELSE                                                           03726000
     BEGIN                                                              03728000
          IF Is'It'Linus(Ldn) THEN                             <<03537>>03730000
          BEGIN                                                <<03537>>03732000
               Linusio(Ldn,Qmisc,Vlab,R,Linus'Sector,          <<03537>>03734000
                       Disc'Label'Address,Blocked'IO,          <<03537>>03736000
                       NO'SPARING,Default'Errinfo,Dummy);      <<03537>>03738000
          END                                                  <<03537>>03740000
          ELSE                                                 <<03537>>03742000
               DISCIO(LDN,R,VLAB,0D,128);<<READ IN OLD LABEL >><<03537>>03744000
          IF < THEN  <<DISC I/O ERROR>>                                 03746000
          BEGIN                                                         03748000
               CC:=CCL;                                                 03750000
               RETURN;                                                  03752000
          END;                                                          03754000
          IF VLAB(LDEVINFO).SCRATCHF = STATE  THEN                      03756000
          BEGIN                                                         03758000
               IF STATE THEN                                            03760000
                  MOVE MSG :="SCRATCH"                                  03762000
               ELSE                                                     03764000
                  MOVE MSG :="RESET  ";                                 03766000
               MSG(7):=0;  <<GENMSG STOPPER>>                           03768000
               GENMSG(PVMSGSET,VIWARN0,0,@MSG);                         03770000
               RETURN;                                                  03772000
          END;                                                          03774000
     END;                                                               03776000
     VLAB(LDEVINFO).SCRATCHF:=STATE;                                    03778000
     VLAB(LSYSID2).(15:1):=STATE;  <<SET ID TO "3001" IF SYSVOL>>       03780000
     IF Is'It'Linus(Ldn) THEN                                  <<03537>>03782000
     BEGIN                                                     <<03537>>03784000
          Linusio(Ldn,Qmisc,Vlab,WL,Linus'Sector,              <<03537>>03786000
                  Disc'Label'Address,Blocked'IO,               <<03537>>03788000
                  JUMP'SPARING,Default'Errinfo,Dummy);         <<03537>>03790000
     END                                                       <<03537>>03792000
     ELSE                                                      <<03537>>03794000
          DISCIO(LDN,WL,VLAB,0D,128);                          <<03537>>03796000
     IF < THEN  <<DISC I/O ERROR>>                                      03798000
     BEGIN                                                              03800000
          CC:=CCL;                                                      03802000
          RETURN;                                                       03804000
     END;                                                               03806000
END << SETSCRATCH >>;                                                   03808000
                                                                        03810000
                                                                        03812000
$PAGE "PVINIT - CONDENSE AND DTRACK UTILITIES"                 <<00239>>03814000
                                                                        03816000
DOUBLE PROCEDURE GETMAXADDR(LDN);                                       03818000
VALUE LDN; INTEGER LDN;                                                 03820000
OPTION PRIVILEGED,UNCALLABLE;                                           03822000
BEGIN                                                                   03824000
   LOGICAL       proc'status                                   <<03510>>03826000
                ;                                              <<03510>>03828000
   DOUBLE        max'addr                                      <<03510>>03830000
                ;                                              <<03510>>03832000
                                                                        03834000
     CC:=CCE;  <<ASSUME SUCCESSFUL COMPLETION>>                         03836000
                                                               <<03510>>03838000
   proc'status:=Get'Disc'Info(ldn,,,,,,max'addr);              <<03510>>03840000
   IF NOT(proc'status) THEN                                    <<03510>>03842000
      BEGIN                                                    <<03510>>03844000
         cc:=ccl;                                              <<03510>>03846000
         RETURN;                                               <<03510>>03848000
      END;                                                     <<03510>>03850000
   getmaxaddr:=max'addr;                                       <<03510>>03852000
END << GETMAXADDR >>;                                                   03856000
                                                                        03858000
$CONTROL SEGMENT=CONDENSE                                      <<00239>>03860000
INTEGER PROCEDURE LASTEXTSIZE(FLAB);                                    03862000
INTEGER ARRAY FLAB;                                                     03864000
OPTION PRIVILEGED,UNCALLABLE;                                           03866000
BEGIN                                                                   03868000
     INTEGER RSIZE;                                                     03870000
     DOUBLE ARRAY FLABD(*) = FLAB;                                      03872000
                                                                        03874000
     TOS:=FLRECSIZE;                                                    03876000
     IF < THEN TOS:=-TOS ELSE TOS:=TOS&LSL(1);                          03878000
     RSIZE:=TOS;  <<POS. BYTES>>                                        03880000
     IF FLLASTEXTSIZE = 0 THEN <<COMPUTE LAST EXT SIZE>>                03882000
     BEGIN                                                              03884000
          TOS:=FLFLIM;                                                  03886000
          X:=FLBLKSIZE/(RSIZE&LSR(1));                                  03888000
          DIVD;                                                         03890000
          IF TOS <> 0 THEN TOS:=TOS+1D;                                 03892000
          X:=(FLBLKSIZE+127) & LSR(7);                                  03894000
          MPYD;                                                         03896000
          TOS:=TOS+DOUBLE(LOGICAL(FLSECTOFF));                          03898000
          TOS:=FLEXTSIZE;                                               03900000
          ASSEMBLE(LDIV,DELB;TEST);                                     03902000
          IF = THEN TOS:=TOS+FLEXTSIZE;                                 03904000
     END ELSE                                                           03906000
     TOS:=FLLASTEXTSIZE;                                                03908000
     LASTEXTSIZE:=TOS;                                                  03910000
END << LASTEXTSIZE >>;                                                  03912000
                                                                        03918000
INTEGER PROCEDURE DTRACK'RECIP(NTRY,LEVEL,PARMS,SIRS);         <<00239>>03920000
VALUE LEVEL,PARMS,SIRS;                                        <<00239>>03922000
INTEGER LEVEL,PARMS;                                           <<00239>>03924000
DOUBLE SIRS;                                                   <<00239>>03926000
ARRAY NTRY;                                                    <<00239>>03928000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>03930000
BEGIN                                                          <<00239>>03932000
     <<DB IS AT THE DIRECTORY DATA SEGMENT UPON ENTRY TO       <<00239>>03934000
     <<THIS PROCEDURE.                                         <<00239>>03936000
     INTEGER DELTAQ = Q+0;                                     <<00239>>03938000
     ARRAY ARRQ0(*) = Q-0;                                     <<00239>>03940000
                                                               <<00239>>03942000
     INTEGER LEN;                                              <<03620>>03944000
     INTEGER I,J,EXT,DEV,VTABX,IOSTATUS,                       <<00239>>03946000
          LASTEXT,EXTLENGTH,ERR;                               <<00239>>03948000
     LOGICAL MASK;                                             <<00239>>03950000
     LOGICAL FIRST'TIME := TRUE;                               <<03620>>03952000
     DOUBLE FLABADDR;                                          <<00239>>03954000
     DOUBLE EXTADDREND,                                        <<03620>>03956000
            PHYSICAL'START,                                    <<03620>>03958000
            PHYSICAL'END,                                      <<03620>>03960000
            LOGICAL'START,                                     <<03620>>03962000
            LOGICAL'END,                                       <<03620>>03964000
            TEMP,                                              <<03620>>03966000
            A1,                                                <<03620>>03968000
            A2;                                                <<03620>>03970000
     INTEGER                                                   <<00239>>03972000
          FLABADDR1 = FLABADDR,                                <<00239>>03974000
          FLABADDR2 = FLABADDR+1;                              <<00239>>03976000
     DOUBLE EXTADDR;                                           <<00239>>03978000
     INTEGER                                                   <<00239>>03980000
          EXTADDR1 = EXTADDR,                                  <<00239>>03982000
          EXTADDR2 = EXTADDR+1;                                <<00239>>03984000
     BYTE ARRAY BBUF(0:24) = Q;                                <<03620>>03986000
     DOUBLE ARRAY Q'COPY'D(0:2) = Q;                           <<00239>>03988000
     INTEGER ARRAY RPARMS(*);                                  <<00239>>03990000
     LOGICAL POINTER FLAB;  <<FILE LABEL>>                     <<00239>>03992000
     DOUBLE POINTER FLABD = FLAB;                              <<00239>>03994000
     DOUBLE ARRAY TRACK'START(*);                              <<00239>>03996000
     LOGICAL ARRAY TRK'STARTB(*) = TRACK'START;                <<03620>>03998000
     DOUBLE ARRAY TRACK'END(*);                                <<00239>>04000000
     LOGICAL ARRAY TRK'ENDB(*) = TRACK'END;                    <<03620>>04002000
     ARRAY NAMESW(*);                                          <<00239>>04004000
     DOUBLE ARRAY NAMESD(*) = NAMESW;                          <<00239>>04006000
     INTEGER ARRAY FILE'DISP(*);                               <<00239>>04008000
     ARRAY VDTAB(*);  <<VOLUME TO DEV CONVERSION TABLE>>       <<00239>>04010000
     DOUBLE ARRAY NTRYD(*) = NTRY;                             <<00239>>04012000
     EQUATE                                                    <<00239>>04014000
          FIRSTEXT    = 22,  <<FIRST EXTENT LOCATION (FLAB)>>  <<00239>>04016000
          FLSKIP1     = 28,                                    <<00239>>04018000
          FLSKIP2     = 34,                                    <<00239>>04020000
          FLSKIP3     = 35,                                    <<00239>>04022000
          FL'COLDLOADID = 35,                                  <<00239>>04024000
          FLMISC      =   28,                                  <<00239>>04026000
          FCHECKSUM   = 34;  <<CHECKSUM LOCATION (FLAB)>>      <<00239>>04028000
     EQUATE  <<DIRECTORY INFORMATION>>                         <<00239>>04030000
          DADIRTY     = %221,                                  <<00239>>04032000
          FILELEVEL   =    0,                                  <<00239>>04034000
          GROUPLEVEL  =    1,                                  <<00239>>04036000
          ACCNTLEVEL  =    2;                                  <<00239>>04038000
     DEFINE                                                    <<00239>>04040000
          THISVOL     = RPARMS ( 2)#,                          <<00239>>04044000
          NUMENTRIES  = RPARMS ( 3)#,                          <<00239>>04046000
          HEADER      = RPARMS ( 8)#,                          <<03620>>04048000
          NAMEINDEX   = FILE'DISP(0)#;                         <<00239>>04050000
                                                               <<00239>>04052000
                                                               <<00239>>04054000
     LOGICAL SUBROUTINE CHECKSUM;                              <<00239>>04056000
     BEGIN                                                     <<00239>>04058000
          MASK:=-1;                                            <<00239>>04060000
          X:=127;                                              <<00239>>04062000
          DO BEGIN                                             <<00239>>04064000
               IF X <> FLSKIP1 AND X <> FLSKIP2 AND X <>FLSKIP3<<00239>>04066000
               THEN MASK:=MASK XOR FLAB(X);                    <<00239>>04068000
               X:=X-1;                                         <<00239>>04070000
          END UNTIL <;                                         <<00239>>04072000
          CHECKSUM:=MASK;                                      <<00239>>04074000
     END <<CHECKSUM>>;                                         <<00239>>04076000
                                                               <<00239>>04078000
      LOGICAL SUBROUTINE PRINT'FILENAME;                       <<03620>>04080000
         BEGIN                                                 <<03620>>04082000
         PBUF := " "; MOVE PBUF(1) := PBUF,(72);               <<03620>>04084000
         MOVE PBUFW(15) := NAMESW(NAMEINDEX*12),(4);           <<03620>>04086000
         MOVE PBUF:=PBUF(30) WHILE AN,1; <<ACCOUNT>>           <<03620>>04088000
         MOVE * := ".",2;                                      <<03620>>04090000
         MOVE PBUFW(15) := NAMESW(NAMEINDEX*12+4),(4);         <<03620>>04092000
         MOVE * :=PBUF(30) WHILE AN,1; <<GROUP>>               <<03620>>04094000
         MOVE * := ".",2;                                      <<03620>>04096000
         MOVE PBUFW(15) := NAMESW(NAMEINDEX*12+8),(4);         <<03620>>04098000
         MOVE * := PBUF(30) WHILE AN; <<FILE>>                 <<03620>>04100000
         FWRITE(OUTF,PBUFW,-30,0);                             <<03620>>04102000
         END; <<END OF PRINT'FILENAME>>                        <<03620>>04104000
                                                               <<00239>>04108000
                                                               <<00239>>04110000
     Q'COPY'D(0) := NTRYD(0); << SAVE NAME Q-REL >>            <<00239>>04112000
     Q'COPY'D(1) := NTRYD(1); << SAVE NAME Q-REL >>            <<00239>>04114000
     Q'COPY'D(2) := NTRYD(2); << SAVE FLAB Q-REL >>            <<00239>>04116000
                                                               <<00239>>04118000
     EXCHANGEDB(0);  <<BACK TO VINIT STACK>>                   <<00239>>04120000
                                                               <<00239>>04122000
                                                               <<00239>>04124000
     @RPARMS:=@ARRQ0(PARMS - DELTAQ);                          <<00239>>04126000
     IF RPARMS < 0 THEN                                        <<00239>>04128000
        BEGIN                                                  <<00239>>04130000
        DTRACK'RECIP := 5; <<TERMINATE DIRECTORY SCAN>>        <<00239>>04132000
        EXCHANGEDB(DIRDST);                                    <<00239>>04134000
        RETURN;                                                <<00239>>04136000
        END;                                                   <<00239>>04138000
                                                               <<00239>>04140000
     @VDTAB:=RPARMS(1);                                        <<00239>>04142000
     @TRACK'START:=RPARMS(4);                                  <<00239>>04144000
     @TRACK'END:=RPARMS(5);                                    <<00239>>04146000
     @NAMESW:=RPARMS(6);                                       <<00239>>04148000
     @FILE'DISP:=RPARMS(7);                                    <<00239>>04150000
                                                               <<00239>>04152000
                                                               <<00239>>04154000
     IF  FILELEVEL <= LEVEL <= ACCNTLEVEL THEN                 <<00239>>04156000
        BEGIN                                                  <<00239>>04158000
        NAMESD( (NAMEINDEX+1)*6 + LEVEL*2 ) := Q'COPY'D(0);    <<00239>>04160000
        NAMESD( (NAMEINDEX+1)*6 + LEVEL*2 + 1 ) := Q'COPY'D(1);<<00239>>04162000
        END;                                                   <<00239>>04164000
                                                               <<00239>>04166000
                                                               <<00239>>04168000
     CASE LEVEL OF                                             <<00239>>04170000
     BEGIN                                                     <<00239>>04172000
        BEGIN << FILE LEVEL = 0 >>                             <<00239>>04174000
        FLABADDR:=Q'COPY'D(2);  <<VTAB INDEX/FLAB POINTER>>    <<00239>>04176000
        VTABX:=FLABADDR1.VTABXF;                               <<00239>>04178000
        FLABADDR1.VTABXF:=0;<<MAKE FLABADDR VALID DISC ADDR>>  <<00239>>04180000
        IF FLABADDR=%77777777D THEN                            <<00239>>04182000
           BEGIN<<BAD LABEL-A CRASH OCCURED IN RESTORING>>     <<00239>>04184000
           DTRACK'RECIP := 1;  << CONTINUE SCAN >>             <<00239>>04186000
           EXCHANGEDB(DIRDST);                                 <<00239>>04188000
           RETURN;                                             <<00239>>04190000
           END;                                                <<00239>>04192000
        IF (DEV:=VDTAB(VTABX)) = 0 THEN<<MISSING V-SET MEMBER>><<00239>>04194000
           BEGIN                                               <<00239>>04196000
           DTRACK'RECIP:=1;  <<CONTINUE SCAN>>                 <<00239>>04198000
           EXCHANGEDB(DIRDST);                                 <<00239>>04200000
           RETURN;                                             <<00239>>04202000
           END;                                                <<00239>>04204000
        IOSTATUS := 2;                                         <<00239>>04206000
        @FLAB:=@BUFF;                                          <<00239>>04208000
        DISCIO(DEV,R,FLAB,FLABADDR,128,IOSTATUS);              <<00239>>04210000
        IF IOSTATUS.GSTATUS <> SUCCESSFUL THEN                 <<00239>>04212000
           BEGIN                                               <<00239>>04214000
           NAMEINDEX := NAMEINDEX + 1;                         <<00239>>04216000
           PRINT'FILENAME;                                     <<03620>>04218000
           MOVE PBUF := " ** BAD FILE LABEL";                  <<03620>>04220000
           FWRITE(OUTF,PBUFW,-18,0);                           <<03620>>04222000
           IF NAMEINDEX < MAXSECTTRK THEN                      <<03620>>04224000
           BEGIN                                               <<03620>>04226000
           MOVE NAMESW( (NAMEINDEX+1)*12 ) :=                  <<00239>>04228000
                NAMESW( (NAMEINDEX)*12 ), (12);<<COPY G & A >> <<00239>>04230000
           FILE'DISP(NAMEINDEX) := 1;                          <<00239>>04232000
           END;                                                <<03620>>04234000
           DTRACK'RECIP:=1;  <<CONTINUE>>                      <<00239>>04236000
           EXCHANGEDB(DIRDST);                                 <<00239>>04238000
           RETURN;                                             <<00239>>04240000
           END;                                                <<00239>>04242000
                                                               <<00239>>04244000
        LASTEXT:=FIRSTEXT+(FLAB(39).(11:5));                   <<00239>>04246000
        IF FLAB(FCHECKSUM) = CHECKSUM THEN<<VALID LABEL>>      <<00239>>04248000
           FOR EXT:=FIRSTEXT UNTIL LASTEXT DO  <<CHECK IT>>    <<00239>>04250000
              IF FLABD(EXT) <> 0D THEN  <<EXTENT IN USE>>      <<00239>>04252000
                 BEGIN                                         <<00239>>04254000
                 EXTADDR:=FLABD(EXT);                          <<00239>>04256000
                 EXTLENGTH:=IF EXT=LASTEXT THEN                <<00239>>04258000
                            LASTEXTSIZE(FLAB) ELSE FLAB(41);   <<00239>>04260000
                 IF (EXTADDR1.VTABXF = THISVOL) THEN           <<00239>>04262000
                    BEGIN                                      <<00239>>04264000
                    EXTADDR1.VTABXF:=0;<<ZERO VTAB INDEX>>     <<00239>>04266000
                    EXTADDREND:=EXTADDR+DBL(EXTLENGTH-1);      <<03620>>04268000
                    <<SCAN TRACK TABLES ENTRIES>>              <<03620>>04270000
                    FOR I := 1 UNTIL NUMENTRIES DO             <<03620>>04272000
                     IF (TRACK'END(I) >= EXTADDR) AND          <<03620>>04274000
                     EXTADDREND >= TRACK'START(I)              <<03620>>04276000
                     THEN BEGIN                                <<03620>>04278000
                     IF FIRST'TIME AND NAMEINDEX < MAXSECTTRK  <<03620>>04280000
                      THEN BEGIN                               <<03620>>04282000
                     <<------------------------------------>>  <<03620>>04284000
                     << SAVE FILE NAME FOR PROCESS BAD     >>  <<03620>>04286000
                     << TRACK PROCEDURE                    >>  <<03620>>04288000
                     <<------------------------------------>>  <<03620>>04290000
                      NAMEINDEX := NAMEINDEX +1;               <<03620>>04292000
                      MOVE NAMESW ((NAMEINDEX+1)*12) :=        <<03620>>04294000
                      NAMESW (NAMEINDEX*12),(12); <<G&A>>      <<03620>>04296000
                      FILE'DISP (NAMEINDEX) := 2; <<FILE>>     <<03620>>04298000
                      IF HEADER = 0 THEN                       <<03620>>04300000
                       BEGIN                                   <<03620>>04302000
                       PBUF := "-";                            <<03620>>04304000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04306000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04308000
                       PBUF := " ";                            <<03620>>04310000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04312000
                       MOVE PBUF := "FILE";                    <<03620>>04314000
                       MOVE PBUF(24) := "LOST DATA (SECTORS)"; <<03620>>04316000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04318000
                       PBUF := " ";                            <<03620>>04320000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04322000
                       MOVE PBUF(14) := "PHYSICAL ADDRESS";    <<03620>>04324000
                       MOVE PBUF(38) := "LOGICAL ADDRESS";     <<03620>>04326000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04328000
                       PBUF := "-";                            <<03620>>04330000
                       MOVE PBUF(1) := PBUF,(60);              <<03620>>04332000
                       FWRITE(OUTF,PBUFW,-60,0);               <<03620>>04334000
                       HEADER := 1;                            <<03620>>04336000
                       END;                                    <<03620>>04338000
                      END;                                     <<03620>>04340000
                     <<------------------------------------>>  <<03620>>04342000
                     << PRINT FILENAME                     >>  <<03620>>04344000
                     <<------------------------------------>>  <<03620>>04346000
                     IF FIRST'TIME THEN                        <<03620>>04348000
                      BEGIN                                    <<03620>>04350000
                      PRINT'FILENAME;                          <<03620>>04352000
                      FIRST'TIME := FALSE;                     <<03620>>04354000
                      END;                                     <<03620>>04356000
                     <<------------------------------------>>  <<03620>>04358000
                     << CALCULATE BAD PHYSICAL AND LOGICAL >>  <<03620>>04360000
                     << SECTOR ADDRESS                     >>  <<03620>>04362000
                     <<------------------------------------>>  <<03620>>04364000
                     A1:=TRACK'START(I)-EXTADDR;               <<03620>>04366000
                     A2:=EXTADDREND-TRACK'END(I);              <<03620>>04368000
                     PHYSICAL'START := IF A1 < 0D              <<03620>>04370000
                                    THEN EXTADDR               <<03620>>04372000
                                    ELSE TRACK'START(I);       <<03620>>04374000
                     PHYSICAL'END := IF A2 < 0D                <<03620>>04376000
                                  THEN EXTADDREND              <<03620>>04378000
                                  ELSE TRACK'END(I);           <<03620>>04380000
                     TEMP:=DBL((EXT-FIRSTEXT)*INT(FLAB(41)));  <<03620>>04382000
                     LOGICAL'START := TEMP + (IF A1 > 0D       <<03620>>04384000
                                             THEN A1 ELSE 0D); <<03620>>04386000
                     LOGICAL'END := TEMP + (IF A2 > 0D         <<03620>>04388000
                                   THEN TRACK'END(I)-EXTADDR   <<03620>>04390000
                                   ELSE DBL(EXTLENGTH) );      <<03620>>04392000
                     <<------------------------------------>>  <<03620>>04394000
                     << ELIMINATE ENTRY FORM TRACK TABLES  >>  <<03620>>04396000
                     << IF ENTRY INSIDE EXTENT             >>  <<03620>>04398000
                     <<------------------------------------>>  <<03620>>04400000
                     IF A1 > 0D AND A2 > 0D THEN               <<03620>>04402000
                      BEGIN                                    <<03620>>04404000
                      IF I <> NUMENTRIES THEN                  <<03620>>04406000
                      BEGIN                                    <<03620>>04408000
                      MOVE TRK'STARTB(I*2):=TRK'STARTB((I+1)*2)<<03620>>04410000
                                          ,((NUMENTRIES-I)*2); <<03620>>04412000
                      MOVE TRK'ENDB(I*2):=TRK'ENDB((I+1)*2),   <<03620>>04414000
                                        ((NUMENTRIES-I)*2);    <<03620>>04416000
                      END;                                     <<03620>>04418000
                      I := I - 1;                              <<04290>>04420000
                      NUMENTRIES := NUMENTRIES-1;              <<03620>>04422000
                      END;                                     <<03620>>04424000
                     <<------------------------------------>>  <<03620>>04426000
                     << PRINT PHYSICAL AND LOGICAL SECTOR  >>  <<03620>>04428000
                     << ADDRESS                            >>  <<03620>>04430000
                     <<------------------------------------>>  <<03620>>04432000
                     PBUF := " "; MOVE PBUF(1) := PBUF,(71);   <<03620>>04434000
                     LEN := DASCII(PHYSICAL'START,10,BBUF);    <<03620>>04436000
                     MOVE PBUF(20-LEN) := BBUF,(LEN),2;        <<03620>>04438000
                     IF PHYSICAL'END > PHYSICAL'START THEN     <<03620>>04440000
                      BEGIN                                    <<03620>>04442000
                      LEN := DASCII(PHYSICAL'END,10,BBUF);     <<03620>>04444000
                      MOVE * := " - ",2;                       <<03620>>04446000
                      MOVE * := BBUF,(LEN),2;                  <<03620>>04448000
                      END;                                     <<03620>>04450000
                     DEL;                                      <<03620>>04452000
                     LEN := DASCII(LOGICAL'START,10,BBUF);     <<03620>>04454000
                     MOVE PBUF(44-LEN) := "(",2;               <<03620>>04456000
                     MOVE * := BBUF,(LEN),2;                   <<03620>>04458000
                     IF LOGICAL'END > LOGICAL'START THEN       <<03620>>04460000
                      BEGIN                                    <<03620>>04462000
                      LEN := DASCII(LOGICAL'END,10,BBUF);      <<03620>>04464000
                      MOVE * := " - ",2;                       <<03620>>04466000
                      MOVE * := BBUF,(LEN),2;                  <<03620>>04468000
                      END;                                     <<03620>>04470000
                     MOVE * := ")";                            <<03620>>04472000
                     FWRITE(OUTF,PBUFW,-60,0);                 <<03620>>04474000
                     IF NUMENTRIES = 0 THEN                    <<03620>>04476000
                      BEGIN                                    <<03620>>04478000
                      RPARMS := -1;<<STOP SCAN>>               <<03620>>04480000
                      GOTO XIT;                                <<03620>>04482000
                      END;                                     <<03620>>04484000
                     END;   <<LOOP OF DTT CHANGES>>            <<03620>>04486000
                    END;  << OF ...THISVOL... >>               <<00239>>04490000
                 END;  << OF EXTENT IN USE >>                  <<00239>>04492000
        DTRACK'RECIP:=1;  <<CONTINUE>>                         <<00239>>04494000
        END; << OF FILE LEVEL >>                               <<00239>>04496000
        BEGIN  << GROUP LEVEL >>                               <<00239>>04498000
        DTRACK'RECIP:=1;  <<CONTINUE>>                         <<00239>>04500000
        END; << OF GROUP LEVEL >>                              <<00239>>04502000
        BEGIN << OF ACCOUNT LEVEL >>                           <<00239>>04504000
        DTRACK'RECIP:=1;  <<CONTINUE>>                         <<00239>>04506000
        END;  << OF ACCOUNT LEVEL >>                           <<00239>>04508000
                                                               <<00239>>04510000
     END;  << OF CASE >>                                       <<00239>>04512000
XIT:                                                           <<03620>>04514000
     DTRACK'RECIP := 1;  <<SET CONTINUE SCANN>>                <<00866>>04516000
     EXCHANGEDB(DIRDST);                                       <<00239>>04520000
END << DTRACK'RECIP >>;                                        <<00239>>04522000
                                                               <<00239>>04524000
                                                               <<00239>>04526000
LOGICAL PROCEDURE ONLY'ONE'ON;                                 <<00239>>04528000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>04530000
BEGIN                                                          <<00239>>04532000
   INTEGER DIRLIMIT,JIT'DST,JDT'DST,STACK'DST;                 <<00239>>04534000
   EQUATE  JMAT'DST        = 25,                               <<00239>>04536000
           JDT'DST'LOC     =  5,                               <<00239>>04538000
           JIT'DST'LOC     =  6,                               <<00239>>04540000
           JTFD            =  2,                               <<00239>>04542000
           JFEQ            =  3,                               <<00239>>04544000
           PASSED'FILE'PTR = 18,  <<DOUBLE INDEX>>             <<00239>>04546000
           CPCB'           =  4,                               <<00239>>04548000
           PCB03'          =  3,                               <<00239>>04550000
           NUM'JOBS        = 11,                               <<00239>>04552000
           NUM'SESSIONS    =  9;                               <<00239>>04554000
                                                               <<00239>>04556000
                                                               <<00239>>04558000
   ONLY'ONE'ON := TRUE;                                        <<00239>>04560000
   STACK'DST :=                                                <<00239>>04562000
    ABSOLUTE(ABSOLUTE(CPCB') + PCB03').(1:10);                 <<00239>>04564000
   TOS := @BUFF; TOS := STACK'DST;  TOS := 0;                  <<00239>>04566000
       TOS := JIT'DST'LOC + 1;                                 <<00239>>04568000
   ASSEMBLE(MFDS 4);                                           <<00239>>04570000
   JDT'DST := BUFF(JDT'DST'LOC).(6:10);                        <<00239>>04572000
   JIT'DST := BUFF(JIT'DST'LOC).(6:10);                        <<00239>>04574000
   TOS := @BUFF;  TOS := JMAT'DST;  TOS := 0;                  <<00239>>04576000
       TOS := NUM'JOBS + 1;                                    <<00239>>04578000
   ASSEMBLE(MFDS 4);                                           <<00239>>04580000
   IF ( BUFF(NUM'JOBS) + BUFF(NUM'SESSIONS) ) <> 1             <<00239>>04582000
   THEN ONLY'ONE'ON := FALSE;                                  <<00239>>04584000
   TOS := @BUFF;  TOS := JDT'DST; TOS := 0;                    <<00239>>04586000
      TOS := JFEQ+1;                                           <<00239>>04588000
   ASSEMBLE(MFDS 4);                                           <<00239>>04590000
   IF BUFF(JTFD) <> BUFF(JFEQ) THEN                            <<00239>>04592000
      ONLY'ONE'ON := FALSE;  << SOME TEMP FILES >>             <<00239>>04594000
   TOS := @BUFF;  TOS := JIT'DST;  TOS := 0;                   <<00239>>04596000
      TOS := PASSED'FILE'PTR&LSL(1) + 2;                       <<00239>>04598000
   ASSEMBLE(MFDS 4);                                           <<00239>>04600000
   IF BUFFD(PASSED'FILE'PTR) <> 0D THEN                        <<00239>>04602000
      ONLY'ONE'ON := FALSE;  << $OLDPASS EXISTS >>             <<00239>>04604000
END; << OF ONLY'ONE'ON >>                                      <<00239>>04606000
$PAGE    "PVINIT - CS80 TRACK HANDLING UTILITY PROCEDURES"     <<03620>>04608000
<<=====================================================>>      <<03620>>04610000
<<       PROCEDURE - GET LAST ENTRY FORM DSCT          >>      <<03620>>04612000
<<=====================================================>>      <<03620>>04614000
LOGICAL PROCEDURE GET'DSCT'ENTRY(DISC'ADDR);                   <<03620>>04616000
   COMMENT                                                     <<03620>>04618000
   THIS PROCEDURE RETURNS THE CURRENT LAST ENTRY IN THE DSCT.  <<03620>>04620000
   IT DOES NOT REMOVE THE ENTRY FROM THE DSCT. IF THERE ARE    <<03620>>04622000
   NO ENTRIES IN THE TABLE, IT RETURNS FALSE, OTEHRWISE TRUE.  <<03620>>04624000
   ;                                                           <<03620>>04626000
DOUBLE DISC'ADDR;   <<RETURN DISC ADDRESS - SECTOR>>           <<03620>>04628000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04630000
BEGIN                                                          <<03620>>04632000
IF DTT(DSCT'NUMBER'OF'ENTRIES) > 0 THEN                        <<03620>>04634000
   BEGIN                                                       <<03620>>04636000
   DISC'ADDR := DTTD(DTT(DSCT'FIRST'ENTRY'INDEX)/              <<03620>>04638000
                DTT(DSCT'ENTRY'SIZE)+                          <<03620>>04640000
                DTT(DSCT'NUMBER'OF'ENTRIES)-1);                <<03620>>04642000
   GET'DSCT'ENTRY := TRUE;                                     <<03620>>04644000
   END                                                         <<03620>>04646000
   ELSE GET'DSCT'ENTRY := FALSE;                               <<03620>>04648000
END;   <<GET'DSCT'ENTRY>>                                      <<03620>>04650000
<<====================================================>>       <<03620>>04652000
<<       PROCEDURE - REMOVE LAST ENTRY FROM DSCT      >>       <<03620>>04654000
<<====================================================>>       <<03620>>04656000
LOGICAL PROCEDURE REMOVE'DSCT'ENTRY(TRACK,SPARED);             <<03620>>04658000
   COMMENT                                                     <<03620>>04660000
   THIS PROCEDURE REMOVES THE LAST ENTRY OR ALL ENTRIES        <<03620>>04662000
   (WHICH BELONG TO THE SAME TRACK) IN THE DSCT.               <<03620>>04664000
   UPDATES THE TABLE HEADER.                                   <<03620>>04666000
   IT DOES NOT POST THE DSCT TO DISC.                          <<03620>>04668000
   IF SPARE SECTOR PROCESS FAILED BECAUSE THERE IS NO          <<03620>>04670000
   SPARE TRACKS AVAILABLE THEN SUSPECT SECTOR ENTRY            <<03620>>04672000
   IS NOT PURGED FROM DSCT. HOWEVER THE DSCT NUMBER OF         <<03620>>04674000
   ENTRIES COUNT WILL BE DECREMENTED. BEFORE DTRAK             <<03620>>04676000
   EXITS IT WILL CHECK IF THERE ARE ANY UNPURGED ENTRIES       <<03620>>04678000
   IN DSCT IF SO IT WILL RESET DSCT AND MARKED                 <<03620>>04680000
   UNAVAILABLE SECTORS IN BIT MAP.                             <<03620>>04682000
   ;                                                           <<03620>>04684000
VALUE TRACK,SPARED;                                            <<03620>>04686000
LOGICAL TRACK,  <<0 - SECTOR; 1 - TRACK>>                      <<03620>>04688000
        SPARED;   <<FALSE - NO SPARE TRACK AVAILABLE>>         <<03620>>04690000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04692000
BEGIN                                                          <<03620>>04694000
DOUBLE ADDR;                                                   <<03620>>04696000
INTEGER INDEX;                                                 <<03620>>04698000
IF DTT(DSCT'NUMBER'OF'ENTRIES) > 0 THEN                        <<03620>>04700000
DO                                                             <<03620>>04702000
   BEGIN                                                       <<03620>>04704000
   INDEX := DTT(DSCT'FIRST'ENTRY'INDEX)/                       <<03620>>04706000
            DTT(DSCT'ENTRY'SIZE)+                              <<03620>>04708000
            DTT(DSCT'NUMBER'OF'ENTRIES)-1;                     <<03620>>04710000
   ADDR := DTTD(INDEX);                                        <<03620>>04712000
   IF SPARED THEN DTTD(INDEX) := 0D;   <<PURGE ENTRY>>         <<03620>>04714000
   DTT(DSCT'NUMBER'OF'ENTRIES):=DTT(DSCT'NUMBER'OF'ENTRIES)-1; <<03620>>04716000
   END                                                         <<03620>>04718000
   UNTIL  NOT TRACK OR DTT(DSCT'NUMBER'OF'ENTRIES) <= 0 OR     <<03620>>04720000
         ADDR/DBL(SECTRK) <> DTTD(INDEX-1)/DBL(SECTRK);        <<03620>>04722000
END;   <<REMOVE'DSCT'ENTRY>>                                   <<03620>>04724000
<<====================================================>>       <<03620>>04726000
<<         PROCEDURE - SORT DSCT ENTRIES              >>       <<03620>>04728000
<<====================================================>>       <<03620>>04730000
LOGICAL PROCEDURE SORT'DSCT;                                   <<03620>>04732000
   COMMENT                                                     <<03620>>04734000
   THIS PROCEDURE SORTS ENTRIES IN DEFECTIVE SECTOR TABLE      <<03620>>04736000
   IN DESCENDING OREDER.                                       <<03620>>04738000
   UNUSED PART OF DSCT IS CLEARED. IT IS NECESSARY TO          <<03620>>04740000
   REMOVE ALL GARBAGE.  NON-ZERO ENTRY IN DSCT WILL INDICATE   <<03620>>04742000
   THAT SECTOR WAS UNSPARED.                                   <<03620>>04744000
   ;                                                           <<03620>>04746000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04748000
BEGIN                                                          <<03620>>04750000
INTEGER I,J,SECOND'EL,LAST'EL;                                 <<03620>>04752000
DOUBLE TEMP;                                                   <<03620>>04754000
SECOND'EL := DTT(DSCT'FIRST'ENTRY)/                            <<03620>>04756000
             DTT(DSCT'ENTRY'SIZE)+1;                           <<03620>>04758000
LAST'EL := SECOND'EL+DTT(DSCT'NUMBER'OF'ENTRIES)-2;            <<03620>>04760000
I := (LAST'EL+1)*DTT(DSCT'ENTRY'SIZE);                         <<03620>>04762000
IF I < SECTOR'SIZE THEN                                        <<03620>>04764000
   BEGIN   <<CLEAR REST OF DSCT>>                              <<03620>>04766000
   DTT(I) := 0;                                                <<03620>>04768000
   MOVE DTT(I+1) := DTT(I),(SECTOR'SIZE-I-1);                  <<03620>>04770000
   END;                                                        <<03620>>04772000
IF DTT(DSCT'NUMBER'OF'ENTRIES) <= 1 THEN RETURN;               <<03620>>04774000
FOR I := LAST'EL STEP -1 UNTIL SECOND'EL DO                    <<03620>>04776000
FOR J := SECOND'EL UNTIL I DO                                  <<03620>>04778000
   BEGIN                                                       <<03620>>04780000
   IF DTTD(J) > DTTD(J-1) THEN                                 <<03620>>04782000
      BEGIN                                                    <<03620>>04784000
      TEMP := DTTD(J);                                         <<03620>>04786000
      DTTD(J) := DTTD(J-1);                                    <<03620>>04788000
      DTTD(J-1) := TEMP;                                       <<03620>>04790000
      END;                                                     <<03620>>04792000
   END;                                                        <<03620>>04794000
END;   <<SORT'DSCT>>                                           <<03620>>04796000
<<====================================================>>       <<03620>>04798000
<< PROCEDURE - ENTER CHANGES INTO DTT'CHANGES TABLE   >>       <<03620>>04800000
<<====================================================>>       <<03620>>04802000
LOGICAL PROCEDURE ENT'DTT'CHANGES(ADDR,SIZE);                  <<03620>>04804000
   COMMENT                                                     <<03620>>04806000
   ANY LOST SECTOR ARE ENTERED INTO DTT'CHANGES TABLE.         <<03620>>04808000
   DTT'CHANGES FIRST WORD REPRESENT NUMBER OF ENTRIS.          <<03620>>04810000
   FOR CS80 EACH ENTRY CONSIST WITH TWO ELEMENT : STARTING     <<03620>>04812000
   SECTOR ADDRESS OF DEFECTIVE AREA (LOST DATA) AND SIZE       <<03620>>04814000
   (NUMBER OF SECTORS). THIS TABLE IS USED BY PROCEDURE -      <<03620>>04816000
   PROCESS'BAD'TRKS. IF TABLE IS FULL AFTER ENTRY IS INSERTED  <<03620>>04818000
   IT RETURNS FALSE . PROCESS OF SPARING WILL BE INTERRUPTED.  <<03620>>04820000
   DTRAK PROCEDURE BEFORE EXIT IT WILL EXAMINE FOR CS80        <<03620>>04822000
   DISCS IF THE DSCT IS EMPTY. IF THE DSCT WILL HAVE           <<03620>>04824000
   ANY UNPROCESSED ENTRY THE SPARING PROCESS WILL BE           <<03620>>04826000
   CONTINUED                                                   <<03620>>04828000
   ;                                                           <<03620>>04830000
VALUE SIZE,ADDR;                                               <<03620>>04832000
DOUBLE ADDR;    <<SECTOR ADDRESS>>                             <<03620>>04834000
INTEGER SIZE;    <<NUMBER OF SECTORS>>                         <<03620>>04836000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04838000
BEGIN                                                          <<03620>>04840000
INTEGER TEMP1 = ADDR, TEMP2 = ADDR+1, INDEX;                   <<03620>>04842000
INDEX := DTT'CHANGES*3+1;                                      <<03620>>04844000
ENT'DTT'CHANGES := TRUE;                                       <<03620>>04846000
IF INDEX < MAX'DTT'CHANGES THEN                                <<03620>>04848000
   BEGIN                                                       <<03620>>04850000
   DTT'CHANGES(INDEX) := TEMP1;                                <<03620>>04852000
   DTT'CHANGES(INDEX+1) := TEMP2; <<DEPOSIT DISC ADDRESS>>     <<03620>>04854000
   DTT'CHANGES(INDEX+2) := SIZE;  <<DEPOSIT NUMBER OF SEC>>    <<03620>>04856000
   DTT'CHANGES := DTT'CHANGES+1;                               <<03620>>04858000
   IF INDEX+3 >= MAX'DTT'CHANGES THEN                          <<03620>>04860000
      BEGIN                                                    <<03620>>04862000
      ENT'DTT'CHANGES := FALSE;                                <<03620>>04864000
      END;                                                     <<03620>>04866000
   END                                                         <<03620>>04868000
   ELSE ENT'DTT'CHANGES := FALSE;                              <<03620>>04870000
END;   <<ENT'DTT'CHANGES>>                                     <<03620>>04872000
<<=====================================================>>      <<03620>>04874000
<<         PROCEDURE - NO SPARE TRACK AVAILABLE        >>      <<03620>>04876000
<<=====================================================>>      <<03620>>04878000
LOGICAL PROCEDURE NO'SPARE'TRACK(TRACK,TRACK'LOST);            <<03620>>04880000
   COMMENT                                                     <<03620>>04882000
   THIS PROCEDURE REMOVE ALL ENTRIES FROM DSCT WHICH BELONG    <<03620>>04884000
   TO UNSPARED TRACK. ENTRIES ARE NOT DELETED FORM DSCT BUT    <<03620>>04886000
   ONLY DSCT NUMBER OF ENTRIES COUNT IS ADJUSTED SO WHEN       <<03620>>04888000
   DTRAK IS COMPLETED UNSPARED ENTRIES WILL BE MARKED IN BIT   <<03620>>04890000
   MAP. ALSO DTT'CHANGES TABLE IS UPDATED. IF AFTER LAST       <<03620>>04892000
   UPDATE THE DTT'CHANGES IS FULL IT RETURNS FALSE, OTHERWISE  <<03620>>04894000
   TRUE.                                                       <<03620>>04896000
   ;                                                           <<03620>>04898000
VALUE TRACK,TRACK'LOST;                                        <<03620>>04900000
LOGICAL TRACK,TRACK'LOST;                                      <<03620>>04902000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>04904000
BEGIN                                                          <<03620>>04906000
DOUBLE ADDR1,ADDR2;                                            <<03620>>04908000
EQUATE NO'SPARED = 0;                                          <<03620>>04910000
GET'DSCT'ENTRY(ADDR1);  <<GET LAST ENTRY FROM DSCT>>           <<03620>>04912000
NO'SPARE'TRACK := TRUE;   <<SET INITIAL VALUE>>                <<03620>>04914000
WHILE GET'DSCT'ENTRY(ADDR2) DO                                 <<03620>>04916000
   BEGIN                                                       <<03620>>04918000
   IF ADDR1/DBL(SECTRK) <> ADDR2/DBL(SECTRK) THEN RETURN       <<03620>>04920000
   ELSE                                                        <<03620>>04922000
      BEGIN                                                    <<03620>>04924000
      GENMSG(PVMSGSET,VIWARN105,%20000,@ADDR2);                <<03620>>04926000
      REMOVE'DSCT'ENTRY(TRACK,NO'SPARED);                      <<03620>>04928000
      IF NOT TRACK THEN <<SECTOR - INDICATE IN DTT'CHANGES>>   <<03620>>04930000
      IF NOT ENT'DTT'CHANGES(ADDR2,1) THEN <<FULL>>            <<03620>>04932000
         BEGIN                                                 <<03620>>04934000
         NO'SPARE'TRACK := FALSE;                              <<03620>>04936000
         RETURN;                                               <<03620>>04938000
         END;                                                  <<03620>>04940000
      END;                                                     <<03620>>04942000
    END;                                                       <<03620>>04944000
IF TRACK'LOST THEN  <<ONLY IF RW-ERT TEST FAILED >>            <<03620>>04946000
   NO'SPARE'TRACK :=                                           <<03620>>04948000
   ENT'DTT'CHANGES(ADDR2/DBL(SECTRK)*DBL(SECTRK),SECTOR'SIZE); <<03620>>04950000
END;   <<NO'SPARE'TRACK>>                                      <<03620>>04952000
<<=====================================================>>      <<03620>>04954000
<<          PROCEDURE - CS80'SPARE                     >>      <<03620>>04956000
<<=====================================================>>      <<03620>>04958000
PROCEDURE CS80'SPARE;                                          <<03620>>04960000
   COMMENT                                                     <<03620>>04962000
   THIS PROCEDURE SPARES SUSPECT SECTORS FORM DEFECTIVE        <<03620>>04964000
   SECTORE TABLE (DSCT).                                       <<03620>>04966000
   ON EACH TRACK OF CS80 DISCS THERE IS ONE EXTRA PHYSICAL     <<03620>>04968000
   SECTOR. THIS SECTOR IS USED FOR THE FIRST SPARE OPERATION   <<03620>>04970000
   DONE ON EACH TRACK. WHEN A SECTOR IS SPARED, ALL OFF THE    <<03620>>04972000
   SECTORES ON THE TRACK ARE PHYSICALLY RESHUFFLED TO          <<03620>>04974000
   MINIMIZE THE TIME FOR CONTIGIOUS READS AND WRITES OF MORE   <<03620>>04976000
   THAN ONE SECTOR. IF MORE THAN ONE BAD SECTOR OCCURS ON      <<03620>>04978000
   A TRACK, THE WHOLE TRACK MUST BE SPARED. NUMBER OF SPARED   <<03620>>04980000
   TRACKS ARE FIXED AND CANNOT BE CHANGED BY THE USER.         <<03620>>04982000
                                                               <<03620>>04984000
   THIS PROCEDURE FOR EVERY SUSPECT SECTOR IN DSCT IS          <<03620>>04986000
   PERFORMING THE FOLLOWING SPARE SEQUENCE:                    <<03620>>04988000
   1. A READ WITH MAXIMUM RETRY TIME (800 MS) IS DONE ON THE   <<03620>>04990000
      SUSPECT SECTOR. THE RESULTING DATA IS STORED EVEN        <<03620>>04992000
      AN UNRECOVERABLE DATA ERROR IS RETURNED.                 <<03620>>04994000
   2. A WRITE/READ ERROR TEST IS RUN ON SUSPECT SECTOR. IF IT  <<03620>>04996000
      EXHIBITS ANY READ ABNORMALITIES, THE SECTORE WILL BE     <<03620>>04998000
      SPARED, OTERWISE, GO TO STEP 7.                          <<03620>>05000000
   3. A "SPARE RETAINNING DATA" COMMAND IS ISSUED TO THE       <<03620>>05002000
      SECTOR ADDRESS. IF IT IS SUCCESFUL, ONLY THE SUSPECT     <<03620>>05004000
      SECTOR'S DATA IS LOST, SO GO TO STEP 7. OTHERWISE        <<03620>>05006000
      PROCEED TO NEXT STEP.                                    <<03620>>05008000
   4. A READ WITH MAXIMUM RETRY TIME IS ISSUED TO THE ENTIRE   <<03620>>05010000
      TRACK ON WHICH THE SECTOR LIES, AND THE DATA STORED.     <<03620>>05012000
   5. A "SPARE NOT RETAINING DATA" COMMAND IS ISSUED ON        <<03620>>05014000
      SUSPECT SECTOR.                                          <<03620>>05016000
   6. A WRITE/READ ERROR RATE TEST IS RUN ON THE SPARED AREA.  <<03620>>05018000
      IF ANY OTHER BAD SECTORS ARE DISCOVERD, GO TO STEP 5.    <<03620>>05020000
   7. PREVIOUS SAVED DATA IS WRITTEN BACK TO ITS ORIGINAL      <<03620>>05022000
      ADDRESS.                                                 <<03620>>05024000
   8. THE DSCT ENTRY(IES) IS(ARE) REMOVED. IF SPARE SECTOR     <<03620>>05026000
      FAILED BECAUSE ALL SPARE TRACKS ARE USED, THE ENTRY      <<03620>>05028000
      WILL REMAIN IN DSCT.                                     <<03620>>05030000
                                                               <<03620>>05032000
   THIS PROCEDURE UPDATES THE DTT'CHANGES TABLE WHICH          <<03620>>05034000
   CONTAINS ALL INFORMATION ABOUT BAD SECTORS.                 <<03620>>05036000
   THE DTT'CHANGES TABLE IS USED TO DETERMENT WHICH FILES      <<03620>>05038000
   LOST DATA.                                                  <<03620>>05040000
   ;                                                           <<03620>>05042000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03620>>05044000
BEGIN                                                          <<03620>>05046000
INTEGER IOSTATUS,                                              <<03620>>05048000
        LEN,                                                   <<03620>>05050000
        SEC'INDEX,                                             <<03620>>05052000
        SEC'NUM,                                               <<03620>>05054000
        AREA'SIZE,                                             <<03620>>05056000
        OFFSET;                                                <<03620>>05058000
LOGICAL TRACK'LOST,                                            <<03620>>05060000
        SECTOR'LOST;                                           <<03620>>05062000
DOUBLE  DISC'ADDR,                                             <<03620>>05064000
        START'ADDR;                                            <<03620>>05066000
ARRAY   TRK'BUF(0:SECTOR'SIZE*92); <<BFD SECTRK = 92>>         <<03620>>05068000
EQUATE                                                         <<03620>>05070000
        NO'WARN = 2,                                           <<03620>>05072000
        SPARED = 1,                                            <<03620>>05074000
        NO'SPARED = 0,                                         <<03620>>05076000
        SECTOR = 0,                                            <<03620>>05078000
        TRACK  = 1;                                            <<03620>>05080000
DEFINE                                                         <<03620>>05082000
       EXIT'PROCEDURE = ASSEMBLE( EXIT 0)#;                    <<03620>>05084000
                                                               <<03620>>05086000
LOGICAL SUBROUTINE CHECK'IO'ERROR;                             <<03620>>05088000
        BEGIN                                                  <<03620>>05090000
        IF IOSTATUS.TSTATUS = SUCCESSFUL OR                    <<03620>>05092000
           IOSTATUS.TSTATUS = TRKERR OR                        <<03620>>05094000
           IOSTATUS.TSTATUS = TIMEOUT OR                       <<03620>>05096000
           IOSTATUS.TSTATUS = NO'SPARE THEN RETURN;            <<03620>>05098000
        STATUS := IOSTATUS.TSTATUS;  <<SAVE STATUS>>           <<03620>>05100000
        LEN := ASCII(STATUS,8,PBUF(20));                       <<03620>>05102000
        MOVE PBUF := PBUF(26-LEN),(6-LEN);                     <<03620>>05104000
        PBUF(LEN) := 0;                                        <<03620>>05106000
        GENMSG(PVMSGSET,VIERR106,@PBUF);                       <<03642>>05108000
        EXIT'PROCEDURE;                                        <<03620>>05110000
        END;                                                   <<03620>>05112000
<<------------------------------------------------------>>     <<03620>>05114000
<< SORT DEFECTIVE SECTOR TABLE IN DESCENDING ORDER      >>     <<03620>>05116000
<<------------------------------------------------------>>     <<03620>>05118000
SORT'DSCT;                                                     <<03620>>05120000
<<------------------------------------------------------>>     <<03620>>05122000
<< TRY TO SPARE EVERY SUSPECT SECTOR IN DSCT            >>     <<03620>>05124000
<<------------------------------------------------------>>     <<03620>>05126000
WHILE GET'DSCT'ENTRY(DISC'ADDR) DO                             <<03620>>05128000
   BEGIN                                                       <<03620>>05130000
   SECTOR'LOST := TRACK'LOST := FALSE;                         <<04290>>05132000
   <<--------------------------------------------------->>     <<03620>>05134000
   << READ DATA FROM SUSPECT SECTOR                     >>     <<03620>>05136000
   <<--------------------------------------------------->>     <<03620>>05138000
   IOSTATUS := NO'WARN;                                        <<03620>>05140000
   DISCIO(LDEV,R,TRK'BUF,DISC'ADDR,SECTOR'SIZE,IOSTATUS);      <<03620>>05142000
   IF <> THEN                                                  <<04290>>05144000
      BEGIN                                                    <<04290>>05146000
      CHECK'IO'ERROR;                                          <<04290>>05148000
      SECTOR'LOST := TRUE;                                     <<04290>>05150000
      END;                                                     <<04290>>05152000
   <<--------------------------------------------------->>     <<03620>>05154000
   << RUN W/R ERROR TEST ON DEFECTIVE SECTOR            >>     <<03620>>05156000
   <<--------------------------------------------------->>     <<03620>>05158000
   IOSTATUS := NO'WARN;                                        <<03620>>05160000
   DISCIO(LDEV,INIT'UTIL,DISC'ADDR,RW'ERT,SECTOR,IOSTATUS);    <<03620>>05162000
   IF = THEN    << SUSPECT SECTOR OK >>                        <<03620>>05164000
      BEGIN                                                    <<03620>>05166000
   <<--------------------------------------------------->>     <<03620>>05168000
   << REMOVE SUSPECT SECTOR ENTRY; WRITE DATA BACK      >>     <<03620>>05170000
   <<--------------------------------------------------->>     <<03620>>05172000
      REMOVE'DSCT'ENTRY(SECTOR,SPARED);                        <<03620>>05174000
      IOSTATUS := NO'WARN;                                     <<03620>>05176000
      DISCIO(LDEV,W,TRK'BUF,DISC'ADDR,SECTOR'SIZE,IOSTATUS);   <<03620>>05178000
      IF <> THEN  <<IF DTT'CHANGES TABLE FULL THEN EXIT>>      <<03620>>05180000
         BEGIN                                                 <<03620>>05182000
         CHECK'IO'ERROR;                                       <<03620>>05184000
         IF NOT ENT'DTT'CHANGES(DISC'ADDR,1) THEN GOTO XIT;    <<03620>>05186000
         END                                                   <<04290>>05188000
      ELSE                                                     <<04290>>05190000
         IF SECTOR'LOST THEN                                   <<04290>>05192000
            IF NOT ENT'DTT'CHANGES(DISC'ADDR,1) THEN           <<04290>>05194000
               GOTO XIT;                                       <<04290>>05196000
      GOTO NEXT'DSCT'ENTRY;   <<***>>                          <<04290>>05198000
      END;   <<SUSPECT SECTOR RECOVERED>>                      <<04290>>05200000
                                                               <<03620>>05202000
   <<--------------------------------------------------->>     <<03620>>05204000
   << IF SECTOR IS STILL BAD THEN SPARES SECTOR WITH    >>     <<03620>>05206000
   << RETAINING DATA                                    >>     <<03620>>05208000
   <<--------------------------------------------------->>     <<03620>>05210000
   IOSTATUS := NO'WARN;   << NO EXTRA WARNINGS >>              <<03620>>05212000
   DISCIO(LDEV,SPARE'BLOCK,DISC'ADDR,RETAIN'DATA,0,IOSTATUS);  <<03620>>05214000
   IF = THEN   << SPARE SINGLE SECTOR >>                       <<03620>>05216000
      BEGIN                                                    <<03620>>05218000
      <<------------------------------------------------>>     <<03620>>05220000
      << WRITE SAVED DATA BACK                          >>     <<03620>>05222000
      <<------------------------------------------------>>     <<03620>>05224000
      IOSTATUS := NO'WARN;                                     <<03620>>05226000
      DISCIO(LDEV,W,TRK'BUF,DISC'ADDR,SECTOR'SIZE,IOSTATUS);   <<03620>>05228000
      IF <> THEN                                               <<03620>>05230000
         BEGIN                                                 <<03620>>05232000
         CHECK'IO'ERROR;                                       <<03620>>05234000
         SECTOR'LOST := TRUE;                                  <<03620>>05236000
         END;                                                  <<03620>>05238000
      <<------------------------------------------------>>     <<03620>>05240000
      << RUN READ ONLY ERROR TEST ON SPARED SECTOR      >>     <<03620>>05242000
      <<------------------------------------------------>>     <<03620>>05244000
      IOSTATUS := NO'WARN;                                     <<03620>>05246000
      DISCIO(LDEV,INIT'UTIL,DISC'ADDR,RO'ERT,TRACK,IOSTATUS);  <<03620>>05248000
      IF = THEN                                                <<03620>>05250000
         BEGIN                                                 <<03620>>05252000
         REMOVE'DSCT'ENTRY(TRACK,SPARED);                      <<03620>>05254000
         IF SECTOR'LOST THEN                                   <<03620>>05256000
         IF NOT ENT'DTT'CHANGES(DISC'ADDR,1) THEN GOTO XIT;    <<03620>>05258000
         GOTO NEXT'DSCT'ENTRY;                                 <<03620>>05260000
         END;                                                  <<03620>>05262000
      END;   <<SPARE SINGLE SECTOR>>                           <<03620>>05264000
                                                               <<03620>>05266000
   <<--------------------------------------------------->>     <<03620>>05268000
   << MORE THAN ONE SUSPECT SECTOR ON TRACK             >>     <<03620>>05270000
   << READ ALL DATA FROM BAD TRACK AND SAVE THEM        >>     <<03620>>05272000
   << INDICATE BAD SECTORS IN DTT'CHANGES TABLE         >>     <<03620>>05274000
   <<--------------------------------------------------->>     <<03620>>05276000
   IF <> THEN CHECK'IO'ERROR;                                  <<03620>>05278000
   IF IOSTATUS.TSTATUS = NO'SPARE THEN                         <<03620>>05280000
      IF NOT NO'SPARE'TRACK(TRACK,TRACK'LOST) THEN GOTO XIT;   <<03620>>05282000
   SEC'NUM := AREA'SIZE := OFFSET := 0;                        <<03620>>05284000
   START'ADDR := DISC'ADDR/DBL(SECTRK)*DBL(SECTRK);            <<03620>>05286000
   FOR SEC'NUM := 1 UNTIL SECTRK DO                            <<03620>>05288000
      BEGIN                                                    <<03620>>05290000
      DISCIO(LDEV,R,TRK'BUF(OFFSET),START'ADDR,SECTOR'SIZE,    <<03620>>05292000
                                       IOSTATUS);              <<03620>>05294000
      IF <> THEN   <<BAD SECTOR>>                              <<03620>>05296000
         BEGIN                                                 <<03620>>05298000
         CHECK'IO'ERROR;                                       <<03620>>05300000
         IF AREA'SIZE = 0 THEN   <<FIRST SECTOR IN BAD AREA>>  <<03620>>05302000
            BEGIN                                              <<03620>>05304000
            AREA'SIZE := 1;   <<SET BAD AREA = 1 SECTOR>>      <<03620>>05306000
            SEC'INDEX := SEC'NUM;   <<SET SECTOR INDEX>>       <<03620>>05308000
            DISC'ADDR := START'ADDR;   <<SET START ADDRESS>>   <<03620>>05310000
            END                                                <<03620>>05312000
            ELSE   <<MORE THAN ONE BAD SEC. IN BAD AREA>>      <<03620>>05314000
            IF SEC'INDEX = SEC'NUM-1 THEN                      <<03620>>05316000
               AREA'SIZE := AREA'SIZE+1   <<CONTIGIOUS>>       <<03620>>05318000
               ELSE  <<MARK PREVIOUS BAD AREA>>                <<03620>>05320000
               BEGIN                                           <<03620>>05322000
               IF NOT ENT'DTT'CHANGES(DISC'ADDR,AREA'SIZE) THEN<<03620>>05324000
                  GOTO XIT;                                    <<03620>>05326000
               AREA'SIZE := 1;                                 <<03620>>05328000
               SEC'INDEX := SEC'NUM;                           <<03620>>05330000
               DISC'ADDR := START'ADDR;                        <<03620>>05332000
               END;                                            <<03620>>05334000
         END;                                                  <<03620>>05336000
      START'ADDR := START'ADDR + 1D; <<SET ADDR TO NEXT SEC>>  <<03620>>05338000
      OFFSET := OFFSET +SECTOR'SIZE;                           <<03620>>05340000
   END;   <<LOOP>>                                             <<03620>>05342000
   IF AREA'SIZE <> 0 THEN                                      <<03620>>05344000
      IF NOT ENT'DTT'CHANGES(START'ADDR,AREA'SIZE) THEN        <<03620>>05346000
         GOTO XIT;                                             <<03620>>05348000
   <<--------------------------------------------------->>     <<03620>>05350000
   << SPARE BLOCK WITHOUT RETAINING DATA                >>     <<03620>>05352000
   <<--------------------------------------------------->>     <<03620>>05354000
TRY'AGAIN:                                                     <<03620>>05356000
   IOSTATUS := NO'WARN;   <<NO EXTRA WARNING>>                 <<03620>>05358000
   DISCIO(LDEV,SPARE'BLOCK,DISC'ADDR,NO'RETAIN'DATA,0,         <<03620>>05360000
                                         IOSTATUS);            <<03620>>05362000
   IF <> THEN CHECK'IO'ERROR;                                  <<03620>>05364000
   IF IOSTATUS.TSTATUS = NO'SPARE THEN                         <<03620>>05366000
      IF NOT NO'SPARE'TRACK(TRACK,TRACK'LOST) THEN GOTO XIT;   <<03620>>05368000
   <<--------------------------------------------------->>     <<03620>>05370000
   << RUN WRITE/READ ERROR TEST ON SPARED TRACK         >>     <<03620>>05372000
   <<--------------------------------------------------->>     <<03620>>05374000
   IOSTATUS := NO'WARN;                                        <<03620>>05376000
   DISCIO(LDEV,INIT'UTIL,DISC'ADDR,RW'ERT,TRACK,IOSTATUS);     <<03620>>05378000
   IF <> THEN   <<NEW TRACK ALSO BAD>>                         <<03620>>05380000
      BEGIN                                                    <<03620>>05382000
      CHECK'IO'ERROR;                                          <<03620>>05384000
      TRACK'LOST := TRUE;                                      <<03620>>05386000
      GOTO TRY'AGAIN;                                          <<03620>>05388000
      END;                                                     <<03620>>05390000
   <<--------------------------------------------------->>     <<03620>>05392000
   << REMOVE ALL SUSPECT SECTORS WHICH BELONG TO        >>     <<03620>>05394000
   << THE SAME TRACK AND WRITE ALL DATA BACK            >>     <<03620>>05396000
   <<--------------------------------------------------->>     <<03620>>05398000
   REMOVE'DSCT'ENTRY(TRACK,SPARED);                            <<03620>>05400000
   IOSTATUS := NO'WARN;                                        <<03620>>05402000
   DISCIO(LDEV,W,TRK'BUF,DISC'ADDR,SECTOR'SIZE*SECTRK,IOSTATUS)<<03620>>05404000
   ;                                                           <<03620>>05406000
   IF <> THEN                                                  <<03620>>05408000
      BEGIN                                                    <<03620>>05410000
      CHECK'IO'ERROR;                                          <<03620>>05412000
      IF NOT ENT'DTT'CHANGES(DISC'ADDR,SECTRK) THEN GOTO XIT;  <<03620>>05414000
      END;                                                     <<03620>>05416000
NEXT'DSCT'ENTRY:                                               <<03620>>05418000
   END;   <<END OF DSCT ENTRY LOOP>>                           <<03620>>05420000
XIT:                                                           <<03620>>05422000
END;   <<CS80'SPARE>>                                          <<03620>>05424000
$PAGE "PVINIT - TRACK HANDLING UTILITY PROCEDURES"             <<00239>>05426000
$CONTROL SEGMENT=NEWPACK                                       <<RK3PV>>05428000
INTEGER PROCEDURE ALTTRACK(LDN,TRACK);                                  05430000
VALUE LDN,TRACK;                                                        05432000
INTEGER LDN,TRACK;                                                      05434000
OPTION PRIVILEGED,UNCALLABLE;                                           05436000
BEGIN                                                                   05438000
     INTEGER I,SUBTYPE,TRKCYL,STHEAD;                                   05440000
     INTEGER type;                                             <<03510>>05442000
     LOGICAL L,SECTRK;                                                  05444000
     DOUBLE SECTOR;                                                     05446000
     LOGICAL      proc'status                                  <<03510>>05448000
                 ;                                             <<03510>>05450000
     ARRAY STAT'ADDR(0:3) = Q;                                 <<00239>>05452000
     INTEGER STATUS1 = STAT'ADDR + 2;                          <<00239>>05454000
     INTEGER IOSTATUS;                                         <<00239>>05456000
     INTEGER ARRAY B(0:140) = Q;                                        05458000
        <<THIS PROCEDURE RETURNS LOGICAL (NOT PHYSICAL) TRACK>><<RK.08>>05460000
                                                                        05462000
     CC := CCE;                                                <<00239>>05464000
     L:=0;                                                              05466000
     proc'status:=Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,   <<03510>>05470000
                  sectrk,,,trkcyl,sthead);                     <<03510>>05472000
     IF NOT(proc'status) THEN                                  <<03510>>05474000
        BEGIN                                                  <<03510>>05476000
           cc:=ccl;                                            <<03510>>05478000
           RETURN;                                             <<03510>>05480000
        END;                                                   <<03510>>05482000
     SECTOR:=LOGICAL(TRACK)**SECTRK;                                    05486000
     IF type=mh'disc'type AND                                  <<03510>>05488000
        (rp'7905 <= subtype <= st'7906) THEN                   <<03510>>05490000
     BEGIN                                                     <<00239>>05492000
     WHILE (L:=L+1) < SECTRK DO                                         05494000
     BEGIN                                                              05496000
          DISCIO(LDN,RFS,B,SECTOR+DOUBLE(L-1),FSCNT);                   05498000
          IF < THEN  <<DISC I/O ERROR>>                                 05500000
          BEGIN                                                         05502000
               CC:=CCL;                                                 05504000
               RETURN;                                                  05506000
          END;                                                          05508000
          IF B(1) = B(139) THEN  <<CYLINDER MATCH>>                     05510000
          IF B(2).HEADF = B(140).HEADF THEN  <<HEAD MATCH>>             05512000
          BEGIN  << VALID ALTERNATE ADDRESS >>                          05514000
               ALTTRACK:=IF B(1) = -1 THEN -1 ELSE                      05516000
                         IF B(1) = 0 AND B(2).HEADF = 0 THEN 0          05518000
                         ELSE (B(1)*TRKCYL+B(2).HEADF-STHEAD);          05520000
               RETURN;                                                  05522000
          END;                                                          05524000
     END;                                                               05526000
     END                                                       <<00239>>05528000
  ELSE                                                         <<00239>>05530000
     IF type=floppy'disc'type AND                              <<03510>>05532000
        subtype = floppy'disc'subtype THEN                     <<03510>>05534000
     BEGIN                                                     <<00239>>05536000
     IOSTATUS := 2;                                            <<00239>>05538000
     DISCIO(LDN,VM,STAT'ADDR,SECTOR,SECTRK,IOSTATUS);          <<00239>>05540000
     IF < THEN                                                 <<00239>>05542000
        BEGIN                                                  <<00239>>05544000
        CC := CCL;                                             <<00239>>05546000
        RETURN;                                                <<00239>>05548000
        END;                                                   <<00239>>05550000
     ALTTRACK := IF STATUS1.(8:8) = 0 THEN 0 ELSE              <<00239>>05552000
                    IF STATUS1.(8:8) = %21 THEN -1             <<00239>>05554000
                       ELSE -2;                                <<00239>>05556000
     RETURN;                                                   <<00239>>05558000
     END;                                                      <<00239>>05560000
     ALTTRACK:=-2;  <<NO GOOD ALT TRACK READ>>                          05562000
END  << ALTTRACK >>;                                                    05564000
                                                                        05566000
DOUBLE PROCEDURE ADRCONV(LDN,LOGADR);                                   05568000
VALUE LDN,LOGADR;                                                       05570000
INTEGER LDN;                                                            05572000
DOUBLE LOGADR;  <<LOGICAL ADDRESS>>                                     05574000
OPTION PRIVILEGED,UNCALLABLE;                                           05576000
BEGIN                                                                   05578000
     << THIS PROCEDURE CONVERTS A LOGICAL SECTOR ADDRESS INTO           05580000
        PHYSICAL HEAD,SECTOR, AND CYLINDER. THE RESULTS ARE             05582000
        RETURNED IN ADRCONV AS FOLLOWS:                                 05584000
                                                                        05586000
        ADRCONV   = CYLINDER,                                           05588000
        ADRCONV+1 = HEAD/SECTOR.                                        05590000
     >>                                                                 05592000
     INTEGER SUBTYPE;                                                   05594000
     INTEGER     type                                          <<03510>>05596000
                ,trkcyl                                        <<03510>>05598000
                ,sectrk                                        <<03510>>05600000
                ,headbase                                      <<03510>>05602000
                ;                                              <<03510>>05604000
     INTEGER ARRAY mh'headbase(rp'7905:fp'7906)=PB:=           <<03510>>05606000
         0,%1000,0,0,0,0,0,%1000;                              <<03510>>05608000
                                                                        05610000
     Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,                <<03510>>05612000
                   sectrk,,,trkcyl);                           <<03510>>05614000
     IF type = mh'disc'type AND                                <<03510>>05616000
        rp'7905 <= subtype <= rp'7906 THEN                     <<03510>>05618000
           headbase:=mh'headbase(subtype)                      <<03510>>05620000
     ELSE                                                      <<03510>>05622000
           headbase:=0;                                        <<03510>>05624000
     CC := CCE;                                                <<00239>>05626000
     TOS:=LOGADR;                                                       05630000
     TOS:=trkcyl*sectrk;  << sect/cyl >>                       <<03510>>05632000
     ASSEMBLE(LDIV);                                                    05634000
     IF OVERFLOW THEN  <<INVALID DISC ADDRESS>>                         05636000
     BEGIN                                                              05638000
          CC:=CCL;                                                      05640000
          RETURN;                                                       05642000
     END;                                                               05644000
     TOS:=sectrk;                                              <<03510>>05646000
     ASSEMBLE(DIV,XCH);                                                 05648000
     TOS:=TOS & lsl(8) + headbase + TOS;                       <<03510>>05650000
     ADRCONV:=TOS;                                                      05652000
END << ADRCONV >>;                                                      05654000
                                                                        05656000
PROCEDURE TRACKINIT(LDN,SECT,ADDRECSECT,WC,DISP,OPTN);                  05658000
VALUE LDN,SECT,ADDRECSECT,WC,DISP,OPTN;                                 05660000
DOUBLE SECT,ADDRECSECT;                                                 05662000
INTEGER LDN,WC,DISP;                                                    05664000
LOGICAL OPTN;                                                           05666000
OPTION VARIABLE;                                                        05668000
OPTION PRIVILEGED,UNCALLABLE;                                           05670000
BEGIN                                                                   05672000
     LOGICAL PMAP = Q-4;                                                05674000
     INTEGER BITS;                                                      05676000
     LOGICAL VERIFY;                                                    05678000
                                                               <<RK1PV>>05680000
  << DISP BIT 15 ==> D  (DISP=1) >>                            <<RK1PV>>05682000
  << DISP BIT 14 ==> P  (DISP=2) >>                            <<RK1PV>>05684000
  << DISP BIT 13 ==> S  (DISP=4) >>                            <<RK1PV>>05686000
  << OPTN BIT 15 ==> SEEK TO SPARED TRACK >>                   <<RK1PV>>05688000
  << TRACKINIT TAKES LOGICAL SECTOR ADDRESSES AS INPUT >>      <<RK.08>>05690000
  << THIS PROCEDURE SHOULD ONLY BE CALLED FOR A 7905-7925 >>   <<00239>>05692000
                                                                        05694000
     CC:=CCE;  <<ASSUME NO TRACK ERRORS>>                               05696000
     TOS:=REQSTATUS(LDN);                                      <<RK1PV>>05698000
     ASSEMBLE(DELB);                                           <<RK1PV>>05700000
     IF TOS.(9:2) <> 1 THEN                                    <<RK1PV>>05702000
        BEGIN                                                  <<RK1PV>>05704000
              GENMSG(PVMSGSET,VIERR33);                        <<RK1PV>>05706000
              GENMSG(PVMSGSET,VIERR0);                         <<RK1PV>>05708000
              CC:=CCL;                                         <<RK1PV>>05710000
              RETURN;                                          <<RK1PV>>05712000
        END;                                                   <<RK1PV>>05714000
     VERIFY:=IF PMAP THEN OPTN.(15:1) ELSE 0;                           05716000
     BITS:=IF PMAP.(14:1) THEN DISP ELSE 0;                             05718000
     BUFF(-3):=(BITS & LSL(1)) + INTEGER(VERIFY.(15:1));       <<RK1PV>>05720000
     BUFF(-2):=BUFF(-1):=0;                                    <<RK1PV>>05722000
     IF ADDRECSECT = -1D THEN BUFF(-2):=-1 ELSE                <<RK1PV>>05724000
     IF ADDRECSECT =  0D THEN BUFF(-2):= 0 ELSE                <<RK1PV>>05726000
     BEGIN                                                              05728000
          TOS:=ADRCONV(LDN,ADDRECSECT);  <<LOG. TO PHYS. ADDRESS>>      05730000
          BUFF(-1):=TOS;  <<HEAD/SECTOR>>                      <<RK1PV>>05732000
          BUFF(-2):=TOS;  <<CYLINDER>>                         <<RK1PV>>05734000
     END;                                                               05736000
     DISCIO(LDN,IN,BUFF,SECT,WC);                                       05738000
     IF < THEN CC:=CCL;  <<DISC I/O ERROR>>                             05740000
END  << TRACKINIT >>;                                                   05742000
                                                                        05744000
PROCEDURE FLAGTRACK(LDN,TRACK,ALT);                                     05746000
VALUE LDN,TRACK,ALT;                                                    05748000
INTEGER LDN,TRACK,ALT;                                                  05750000
OPTION PRIVILEGED,UNCALLABLE;                                           05752000
BEGIN                                                                   05754000
     <<  TRACK - LOGICAL (!) TRACK ADDRESS OF BAD TRACK >>     <<RK.08>>05756000
     <<  ALT   - LOGICAL (!) TRACK ADDRESS OF NEW TRACK >>     <<RK.08>>05758000
     <<PROCEDURE ASSUMES DTT ARRAY CONTAINS THE DTT FOR LDN>>           05760000
     << FLAGTRACK WORKS WITH LOGICAL (!) TRACKS INPUT PARMS >> <<RK.08>>05762000
     INTEGER I,SUBTYPE,IOSTATUS;                               <<RK2PV>>05764000
     INTEGER type;                                             <<03510>>05766000
     LOGICAL SECTRK,OLDALT;                                             05768000
     DOUBLE PADR,SECTOR,ALTSECTOR;                                      05770000
     INTEGER PADR1 = PADR;  <<CYLINDER PART OF PHYSICAL ADDRESS>>       05772000
     LOGICAL TRKSIZE;                                          <<RK1PV>>05774000
     EQUATE                                                             05776000
          D      =   1,     <<DEFECTIVE TRACK>>                         05778000
          SP     =   4;     <<SPARE TRACK>>                             05780000
                                                                        05782000
     CC:=CCE;  <<ASSUME NO DISC I/O ERRORS>>                            05784000
     Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,                <<03510>>05786000
                    sectrk);                                   <<03510>>05788000
     trksize:=sectrk * sector'size;                            <<03510>>05792000
     SECTOR:=LOGICAL(TRACK)**SECTRK;                                    05794000
     ALTSECTOR:=LOGICAL(ALT)**SECTRK;                                   05796000
     IF type = mh'disc'type AND                                <<03510>>05798000
        (rp'7905 <= subtype <= st'7906) THEN                   <<03510>>05800000
     BEGIN                                                              05802000
          TOS:=ALTTRACK(LDN,TRACK);                                     05804000
          IF < THEN  <<DISC I/O ERROR>>                                 05806000
          BEGIN                                                         05808000
               CC:=CCL;                                                 05810000
               RETURN;                                                  05812000
          END;                                                          05814000
          IF INTEGER(OLDALT:=TOS) > 0 THEN                     <<RK3PV>>05816000
             <<NOT DELETED OR NORMAL SPARE -- NORMAL OR REA >> <<RK3PV>>05818000
          BEGIN                                                         05820000
     IF OLDALT <> LOGICAL(TRACK) THEN                          <<RK.08>>05822000
               BEGIN                                           <<00239>>05824000
               TRACKINIT(LDN,(OLDALT**SECTRK),-1D,TRKSIZE,SP); <<RK.08>>05826000
               <<DELETE OLD SPARE IF THERE WAS ONE>>           <<RK1PV>>05828000
               IF < THEN  <<DISC I/O ERROR>>                            05830000
               BEGIN                                                    05832000
                    CC:=CCL;                                            05834000
                    RETURN;                                             05836000
               END;                                                     05838000
               END;  << OF OLDALT <> LOGICAL(TRACK) >>         <<00239>>05840000
          END;                                                          05842000
          IF ALT <> 0 THEN <<POINT ALTERNATE AT DEFECTIVE TRK>><<RK1PV>>05844000
          BEGIN                                                <<00239>>05846000
          TRACKINIT(LDN,ALTSECTOR,SECTOR,TRKSIZE,SP);          <<RK1PV>>05848000
          IF < THEN  <<DISC I/O ERROR>>                        <<RK1PV>>05850000
          BEGIN                                                <<RK1PV>>05852000
               CC:=CCL;                                        <<RK1PV>>05854000
               RETURN;                                         <<RK1PV>>05856000
          END;                                                 <<RK1PV>>05858000
          END;  << OF IF ALT<>0 >>                             <<00239>>05860000
          IF ALT = 0 THEN  <<DELETE>>                                   05862000
          BEGIN                                                         05864000
               PADR:=ADRCONV(LDN,SECTOR);  <<LOG. TO PHYS. ADDRESS>>    05866000
               I:=IF PADR1 >= DTT(DTTLPS) THEN SP ELSE D;      <<RK1PV>>05868000
               TRACKINIT(LDN,SECTOR,-1D,TRKSIZE,I);            <<RK1PV>>05870000
               IF < THEN  <<DISC I/O ERROR>>                            05872000
               BEGIN                                                    05874000
                    CC:=CCL;                                            05876000
                    RETURN;                                             05878000
               END;                                                     05880000
          END ELSE         <<REASSIGN>>                                 05882000
          BEGIN                                                         05884000
               TRACKINIT(LDN,SECTOR,ALTSECTOR,TRKSIZE,D);      <<RK1PV>>05886000
               IF < THEN  <<DISC I/O ERROR>>                            05888000
               BEGIN                                                    05890000
                    CC:=CCL;                                            05892000
                    RETURN;                                             05894000
               END;                                                     05896000
          END;                                                          05898000
     END                                                       <<00239>>05900000
     ELSE IF type = floppy'disc'type AND                       <<03510>>05902000
            subtype = floppy'disc'subtype THEN << floppy >>    <<03510>>05904000
     BEGIN   << FLOPPY CAN ONLY BE MARKED DEFECTIVE >>         <<00239>>05906000
          DISCIO(LDN,IT,BUFF,SECTOR,0);                        <<00239>>05908000
          IF < THEN <<DISC I/O ERROR>>                         <<00239>>05910000
             BEGIN                                             <<00239>>05912000
                  CC:=CCL;                                     <<00239>>05914000
                  RETURN;                                      <<00239>>05916000
             END;                                              <<00239>>05918000
     END;                                                      <<00239>>05920000
END  << FLAGTRACK >>;                                                   05922000
                                                                        05924000
                                                                        05926000
DOUBLE PROCEDURE cylinderhead(track,ldev);                     <<03510>>05928000
   VALUE track,ldev;                                           <<03510>>05930000
   INTEGER track,ldev;                                         <<03510>>05932000
OPTION PRIVILEGED,UNCALLABLE;                                           05934000
BEGIN                                                                   05936000
                                                               <<03510>>05938000
     << changed the 2nd parm from subtype to ldev to >>        <<03510>>05940000
     << reference the procedure Get'Disc'Info to get >>        <<03510>>05942000
     << all the pertinent info about disc            >>        <<03510>>05944000
     INTEGER     trkcyl                                        <<03510>>05946000
                ,trkmult                                       <<03510>>05948000
                ,sthead                                        <<03510>>05950000
                ;                                              <<03510>>05952000
     INTEGER                                                            05954000
          HEAD     = CYLINDERHEAD,                                      05956000
          CYLINDER = CYLINDERHEAD+1;                                    05958000
                                                                        05960000
     Get'Disc'Info(ldev,,,,,,,,,,,,,,,,,                       <<03510>>05962000
                   trkcyl,sthead,trkmult);                     <<03510>>05964000
                                                               <<03510>>05966000
     << the hokey trkmult only means anything for    >>        <<03510>>05968000
     << 7900 disc, both platters. There are really   >>        <<03510>>05970000
     << heads 0-3 but hardware only sees 0 & 2       >>        <<03510>>05972000
     CYLINDER := TRACK/TRKCYL*TRKMULT+STHEAD;                  <<03779>>05974000
     HEAD := TRACK MOD TRKCYL;                                 <<03779>>05976000
END << CYLINDERHEAD >>;                                                 05980000
                                                                        05982000
INTEGER PROCEDURE ADDDTTENTRY(TRACK);                                   05984000
VALUE TRACK;                                                            05986000
INTEGER TRACK;                                                          05988000
OPTION PRIVILEGED,UNCALLABLE;                                           05990000
BEGIN                                                                   05992000
     INTEGER I:=0;                                                      05994000
                                                                        05996000
     CC:=CCE;  <<ASSUME DTT NOT FULL>>                                  05998000
     IF DTT = 120 THEN  <<TABLE FULL>>                                  06000000
     BEGIN                                                              06002000
          CC:=CCL;                                                      06004000
          ADDDTTENTRY:=2;                                               06006000
          RETURN;                                                       06008000
     END;                                                               06010000
     WHILE (I:=I+1) <= DTT DO                                           06012000
     BEGIN  <<FIND WHERE IT GOES>>                                      06014000
          IF (DTT(I)&LSR(2)) = (TRACK&LSR(2)) THEN RETURN;  <<DUP ENT>> 06016000
          IF > THEN                                                     06018000
          BEGIN  <<MAKE ROOM FOR IT>>                                   06020000
               MOVE DTT(DTT+1):=DTT(DTT),(I-DTT-1);                     06022000
               GO TO ADD;                                               06024000
          END;                                                          06026000
     END;                                                               06028000
ADD: DTT(I):=TRACK;                                                     06030000
     DTT:=DTT+1;                                                        06032000
     ADDDTTENTRY:=1;                                                    06034000
END << ADDDTTENTRY >>;                                                  06036000
                                                               <<RK3PV>>06038000
PROCEDURE EOF;                                                 <<RK3PV>>06040000
   BEGIN                                                       <<RK3PV>>06042000
      MOVE MSG:="EOF DETECTED";                                <<RK3PV>>06044000
      PRINT(MSGW,6,0);                                         <<RK.08>>06046000
      QUIT(0);                                                 <<RK3PV>>06048000
      RETURN;                                                  <<RK3PV>>06050000
   END;                                                        <<RK3PV>>06052000
                                                               <<RK3PV>>06054000
PROCEDURE ADDENTRY(MAXHEAD,MAXCYL);                            <<RK3PV>>06056000
VALUE MAXHEAD,MAXCYL;                                          <<RK3PV>>06058000
INTEGER MAXHEAD,MAXCYL;                                        <<RK3PV>>06060000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>06062000
BEGIN                                                          <<RK3PV>>06064000
   LOGICAL INTERACTIVE,TRACK;                                  <<RK3PV>>06066000
   INTEGER LEN,CYL,HEAD;                                       <<RK3PV>>06068000
                                                               <<RK3PV>>06070000
   WHO(INTERACTIVE);                                           <<RK3PV>>06072000
   IF NOT INTERACTIVE THEN RETURN;                             <<RK3PV>>06074000
   MOVE MSG:=("ARE THERE ANY KNOWN BAD TRACKS",%15,%12,        <<RK.05>>06076000
   "THAT YOU WANT TO REASSIGN? ");                             <<RK.05>>06078000
L1:PRINT(MSGW,-59,%320);                                       <<RK.08>>06080000
   LEN:=READ(RBUFW,-10);                                       <<RK.08>>06082000
   IF <> THEN EOF;                                             <<RK3PV>>06084000
   IF LEN=0 OR RBUF="N" OR RBUF = "n" THEN RETURN ELSE         <<00092>>06086000
      IF RBUF<>"Y" AND RBUF<>"y" THEN GOTO L1;                 <<00092>>06088000
   MOVE MSG:="CYL?  HEAD?   ";                                 <<RK3PV>>06090000
L2:PRINT(MSGW,-5,%320);                                        <<RK.08>>06092000
   LEN:=READ(RBUFW,-10);                                       <<RK.08>>06094000
   IF <> THEN EOF;                                             <<RK3PV>>06096000
   IF LEN=0 THEN RETURN;                                       <<RK3PV>>06098000
   CYL:=BINARY(RBUF,LEN);                                      <<RK3PV>>06100000
   IF <> THEN GOTO L2;                                         <<RK3PV>>06102000
   IF CYL<0 OR CYL>MAXCYL THEN                                 <<RK3PV>>06104000
      BEGIN                                                    <<RK3PV>>06106000
      GENMSG(PVMSGSET,VIERR35);                                <<RK3PV>>06108000
      GOTO L2;                                                 <<RK3PV>>06110000
      END;                                                     <<RK3PV>>06112000
L3:PRINT(MSGW(3),-6,%320);                                     <<RK.08>>06114000
   LEN:=READ(RBUFW,-10);                                       <<RK.08>>06116000
   IF <> THEN EOF;                                             <<RK3PV>>06118000
   IF LEN=0 THEN RETURN;                                       <<RK3PV>>06120000
   HEAD:=BINARY(RBUF,LEN);                                     <<RK3PV>>06122000
   IF HEAD<0 OR HEAD>MAXHEAD THEN                              <<RK3PV>>06124000
      BEGIN                                                    <<RK3PV>>06126000
      GENMSG(PVMSGSET,VIERR36);                                <<RK3PV>>06128000
      GOTO L3;                                                 <<RK3PV>>06130000
      END;                                                     <<RK3PV>>06132000
   TRACK:=(LOGICAL(CYL)*LOGICAL(MAXHEAD+1)+LOGICAL(HEAD))*4;   <<RK3PV>>06134000
   TOS:=ADDDTTENTRY(TRACK);                                    <<RK3PV>>06136000
   IF < THEN GENMSG(PVMSGSET,VIERR37);                         <<RK3PV>>06138000
   IF TOS=0 THEN GENMSG(PVMSGSET,VIWARN4);                     <<RK3PV>>06140000
   GOTO L2;                                                    <<RK3PV>>06142000
   END; <<OF ADDENTRY>>                                        <<RK3PV>>06144000
                                                               <<RK3PV>>06146000
                                                                        06148000
INTEGER PROCEDURE DELDTTENTRY(TRACK);                                   06150000
VALUE TRACK;                                                            06152000
INTEGER TRACK;                                                          06154000
OPTION PRIVILEGED,UNCALLABLE;                                           06156000
BEGIN                                                                   06158000
     INTEGER I:=0;                                                      06160000
                                                                        06162000
     WHILE (I:=I+1) <= DTT DO                                           06164000
     IF DTT(I) = TRACK THEN                                             06166000
     BEGIN  <<FOUND IT>>                                                06168000
          DELDTTENTRY:=-1;                                              06170000
          MOVE DTT(I):=DTT(I+1),(DTT-I);                                06172000
          DTT:=DTT-1;                                                   06174000
          I:=DTT;  <<STOP LOOP>>                                        06176000
     END;                                                               06178000
END << DELDTTENTRY >>;                                                  06180000
                                                                        06182000
$CONTROL SEGMENT=NEWPACK                                       <<RK1PV>>06184000
PROCEDURE SORT'DTT(DTT);                                       <<00239>>06186000
INTEGER ARRAY DTT;                                             <<00239>>06188000
BEGIN                                                          <<00239>>06190000
   INTEGER I,J,K,T;                                            <<00239>>06192000
                                                               <<00239>>06194000
   IF DTT <= 1 THEN RETURN;                                    <<00239>>06196000
   FOR I := DTT STEP -1 UNTIL 2 DO                             <<00239>>06198000
   FOR J := 2 UNTIL I DO                                       <<00239>>06200000
      BEGIN                                                    <<00239>>06202000
      IF DTT(J) < DTT(J-1) THEN                                <<00239>>06204000
         BEGIN                                                 <<00239>>06206000
         T := DTT(J);                                          <<00239>>06208000
         DTT(J) := DTT(J-1);                                   <<00239>>06210000
         DTT(J-1) := T;                                        <<00239>>06212000
         END;                                                  <<00239>>06214000
      END;                                                     <<00239>>06216000
   FOR I := 1 UNTIL (DTT-1) DO                                 <<00239>>06218000
      IF DTT(I) = DTT(I+1) THEN                                <<00239>>06220000
         BEGIN                                                 <<00239>>06222000
         MOVE DTT(I) := DTT(I+1),(DTT-I);                      <<00239>>06224000
         DTT := DTT - 1;                                       <<00239>>06226000
         END;                                                  <<00239>>06228000
END;  << END OF SORT'DTT >>                                    <<00239>>06230000
                                                               <<00239>>06232000
                                                               <<00239>>06236000
PROCEDURE dttanalysis(ldn,diradr,dirsz,bitmapadr,descradr);    <<03510>>06238000
   VALUE ldn,diradr,dirsz,bitmapadr,descradr;                  <<03510>>06240000
   INTEGER ldn,dirsz;                                          <<03510>>06242000
   DOUBLE diradr,bitmapadr,descradr;                           <<03510>>06244000
   OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                      <<03510>>06246000
BEGIN                                                                   06250000
<<   >>                                                        <<01353>>06252000
   << make calling procedure variable, only check the Dirc   >><<03510>>06254000
   << bitmap, and Descriptor addr if these are present. Both >><<03510>>06256000
   << format and init do not send these 4 args because format>><<03510>>06258000
   << a disc doesnt create any of these structures and init  >><<03510>>06260000
   << can place these anywhere. Before the FST(old DFSM) and >><<03510>>06262000
   << Directory                                              >><<03510>>06264000
   << were always next to each other and the FST ALWAYS start>><<03510>>06266000
   << at sector 30. Dtrack passes these 4 args because a user>><<03510>>06268000
   << needs to know if any suspect/deleted tracks are in     >><<03510>>06270000
   << these areas                                            >><<03510>>06272000
   << if pass Diradr then ASSUMES also passed dirsz          >><<03510>>06274000
<<  >>                                                         <<01353>>06278000
     INTEGER ENT:=0;                                                    06280000
     INTEGER I,J,K,ALT,CNT,LOC,LEN,TRK,RLEN,SIZE,ALTTRK,                06282000
             TRKCYL,MAXLPS,SUBTYPE,TRKSIZE;                             06284000
     LOGICAL NODISP,SECTRK,IOSTATUS,DISPMASK,ALTNEEDED=NODISP;          06286000
     DOUBLE ADDR,DTEMP,FSECT,LSECT;                                     06288000
     INTEGER                                                            06290000
          ADDR1  = ADDR,                                                06292000
          ADDR2  = ADDR+1,                                              06294000
          DTEMP1 = DTEMP,                                               06296000
          DTEMP2 = DTEMP+1;                                             06298000
   INTEGER     bit'map'sz        << in sectors >>              <<03510>>06300000
              ,descr'sz          << in sectors >>              <<03510>>06302000
              ,type                                            <<03510>>06304000
              ,def'log'pack'sz  << in cylinders >>             <<03510>>06306000
              ,bit'map'size'pages                              <<03510>>06308000
              ,dt'size'words                                   <<03510>>06310000
              ;                                                <<03510>>06312000
   LOGICAL     only'rec                                        <<03510>>06314000
              ,proc'status  << status from procedures >>       <<03510>>06316000
              ;                                                <<03510>>06318000
   DOUBLE      enddiradr                                       <<03510>>06320000
              ,endbitmapadr                                    <<03510>>06322000
              ,enddescradr                                     <<03510>>06324000
              ;                                                <<03510>>06326000
                                                               <<03510>>06328000
     << use this define to exit proc from subr >>              <<03510>>06330000
                                                               <<03510>>06332000
     DEFINE exit'procedure = ASSEMBLE(exit 8)#;                <<03510>>06334000
                                                               <<03510>>06336000
     DEFINE VALIDISP = NOT NODISP#;                                     06338000
     LOGICAL FLAGGED;                                          <<00239>>06340000
     BYTE ARRAY ANS(0:8)=PB:="REC","DEL","REA";                         06342000
      BYTE array disp(0:23)=pb:="RECOVER ","DELETE  ",         <<03510>>06344000
                               "REASSIGN";                              06346000
     INTEGER ARRAY DISPSIZE(0:2)=PB:=7,6,8;                    <<RK1PV>>06348000
     BYTE ARRAY BBUF(0:10);    <<WORK AREA >>                           06350000
     EQUATE BLANK = %6440;                                              06354000
     LOGICAL REA'OR'DEL;                                       <<00239>>06356000
     EQUATE REA = 8,                                           <<00239>>06358000
            DEL' = 4,                                          <<00239>>06360000
            REC = 2;                                           <<00239>>06362000
      LOGICAL    pmap=q-4;                                     <<03510>>06364000
      DEFINE     check'dirc=    pmap.(12:1)=1#;                <<03510>>06366000
      DEFINE     check'bitmap=  pmap.(14:1)#;                  <<03510>>06368000
      DEFINE     check'descr=   pmap.(15:1)#;                  <<03510>>06370000
                                                               <<03510>>06372000
                                                                        06374000
     SUBROUTINE leave(err);                                    <<03510>>06376000
        VALUE err;                                             <<03510>>06378000
        LOGICAL err;                                           <<03510>>06380000
                                                               <<03510>>06382000
     BEGIN                                                     <<03510>>06384000
                                                               <<03510>>06386000
$IF X3=ON                                                      <<03510>>06388000
         debug;                                                <<03510>>06390000
$IF                                                            <<03510>>06392000
        genmsg(pvmsgset,vierr34);                              <<03510>>06394000
        exit'procedure;                                        <<03510>>06396000
                                                               <<03510>>06398000
     END;                                                      <<03510>>06400000
     SUBROUTINE PRINTRACKINFO;                                          06402000
     BEGIN                                                              06404000
          TOS:=@PBUF;  <<INITIAL BUFFER PTR>>                           06406000
          IF K<2 THEN MOVE *:=" SUSPECT",2                              06408000
          ELSE MOVE *:="UNREADABLE",2;                                  06410000
          IF K>0 THEN MOVE *:=" ALT",2;                                 06412000
          MOVE *:=" TRK  LDEV #",2;                                     06414000
          TOS:=ASCII(LDN,10,BPS0);                                      06416000
          ASSEMBLE(ADD);  <<UPDATE BUFFER PTR>>                         06418000
          MOVE *:=" CYL=",2;                                            06420000
          dtemp:=cylinderhead(trk,ldn);                        <<03510>>06422000
          TOS:=ASCII(DTEMP2,10,BPS0);                                   06424000
          ASSEMBLE(ADD);                                                06426000
          MOVE *:=" HEAD=",2;                                           06428000
          TOS:=ASCII(DTEMP1,10,BPS0);                                   06430000
          ASSEMBLE(ADD); <<UPDATE BUFFER PTR>>                          06432000
          MOVE *:=" (SECTORS %",2;                                      06434000
          LEN:=DASCII(FSECT,8,BBUF);                                    06436000
          MOVE *:=BBUF(11-LEN),(LEN),2;                                 06438000
          MOVE *:="-%",2;                                               06440000
          LEN:=DASCII(LSECT,8,BBUF);                                    06442000
          MOVE *:=BBUF(11-LEN),(LEN),2;                                 06444000
          MOVE * :=")",2;                                               06446000
          LEN:=TOS-@PBUF;                                               06448000
          PRINT(PBUFW,-LEN,0);                                 <<RK.08>>06450000
     END <<PRINTRACKINFO>>;                                             06452000
                                                                        06454000
     INTEGER SUBROUTINE DELDTTENTRIES(TRACK);                           06456000
     VALUE TRACK;                                                       06458000
     INTEGER TRACK;                                                     06460000
     BEGIN                                                              06462000
          I:=J:=0;                                                      06464000
          WHILE (I:=I+1) <= DTT DO                                      06466000
          IF (DTT(I)&LSR(2)) = TRACK THEN                               06468000
          BEGIN                                                         06470000
               WHILE (DTT(I) & LSR(2)) = TRACK DO                       06472000
               BEGIN                                                    06474000
                    I:=I+1;                                             06476000
                    J:=J+1;                                             06478000
               END;                                                     06480000
               MOVE DTT(I-J):=DTT(I),(DTT-I+1);                         06482000
               DTT:=DTT-J;                                              06484000
               DELDTTENTRIES:=-J;                                       06486000
               I:=DTT;  <<STOP LOOP>>                                   06488000
          END;                                                          06490000
     END <<DELDTTENTRIES>> ;                                            06492000
                                                                        06494000
     INTEGER SUBROUTINE GETDISP(LEGAL);                                 06496000
     VALUE LEGAL;                                                       06498000
     LOGICAL LEGAL;                                                     06500000
     BEGIN                                                              06502000
          I:=CNT:=LOC:=0;   K:=-1;                             <<RK1PV>>06504000
          DISPMASK:=LEGAL & LSR(1);  <<SKIP IGNORE BIT>>                06506000
          WHILE DISPMASK <> 0 DO                                        06508000
          BEGIN                                                         06510000
               IF I = 0 THEN K:=K+1;     <<BIT LOC>>                    06512000
               IF DISPMASK THEN I:=I+1;  <<BIT COUNT>>                  06514000
               DISPMASK:=DISPMASK & LSR(1);                             06516000
          END;                                                          06518000
          CNT:=I+INTEGER(LEGAL.(15:1));  <<NUMBER OF CHOICES ALLOWED>>  06520000
          DISPMASK:=LEGAL & LSR(1);                                     06522000
          TOS:=@PBUF+1;                                                 06524000
          WHILE DISPMASK <> 0 DO                                        06526000
          BEGIN                                                         06528000
               IF DISPMASK THEN                                         06530000
               BEGIN                                           <<RV.PV>>06532000
               MOVE * :=DISP(LOC*8),(DISPSIZE(LOC)),2;         <<RK1PV>>06534000
               I:=I-1;                                                  06536000
               CASE *I OF                                               06538000
               BEGIN                                                    06540000
                    ;                                                   06542000
                    MOVE * :=" OR ",2;                                  06544000
                    MOVE * :=",",2;                                     06546000
               END;                                                     06548000
               END;                                            <<RK1PV>>06550000
               LOC:=LOC+1;                                     <<RK1PV>>06552000
               DISPMASK:=DISPMASK & LSR(1);                    <<RV.PV>>06554000
          END;                                                          06556000
          IF CNT=1 THEN <<NO CHOICE ANYWAY>>                   <<RK4PV>>06558000
             BEGIN                                             <<RK4PV>>06560000
             IF K=1 THEN MOVE *:="D",2                         <<RK4PV>>06562000
                ELSE MOVE *:="ED",2;                           <<RK4PV>>06564000
             LEN:=TOS-@PBUF;                                   <<RK4PV>>06566000
             PRINT(PBUFW,-LEN,0);                              <<RK.08>>06568000
             GETDISP:=K+1;                                     <<RK4PV>>06570000
             RETURN;                                           <<RK4PV>>06572000
             END;                                              <<RK4PV>>06574000
          MOVE * :="? ",2;                                              06576000
          LEN:=TOS-@PBUF;                                               06578000
          NODISP:=TRUE;                                                 06580000
          WHILE NODISP DO                                               06582000
          BEGIN                                                         06584000
               PRINT(PBUFW,-LEN,%320);                         <<RK.08>>06586000
               RLEN:=READ(RBUFW,-10);                          <<RK.08>>06588000
               IF <> THEN EOF;                                 <<RK3PV>>06590000
               RBUF(RLEN):=0;                                  <<00092>>06592000
               MOVE RBUF:=RBUF WHILE ANS;                      <<00092>>06594000
               IF RLEN=0 THEN                                  <<RK1PV>>06596000
               BEGIN  <<ASSUME "IGNORE" OR "NO">>                       06598000
                    I:=-1;  <<FOR X CHECK BELOW>>                       06600000
                    NODISP:=FALSE;                                      06602000
               END ELSE                                                 06604000
               BEGIN                                                    06606000
                    IF CNT = 1 THEN  <<"YES" OR "NO" EXPECTED>>         06608000
                    BEGIN                                               06610000
                         NODISP:=FALSE;  <<ASSUME VALID RESP>>          06612000
                         IF RBUF="Y" THEN I:=K ELSE                     06614000
                         IF RBUF="N" THEN I:=-1 ELSE                    06616000
                         IF RLEN>=3 AND RBUF=ANS(K*3),(3)      <<RK1PV>>06618000
                            THEN I:=K ELSE                     <<RK1PV>>06620000
                         NODISP:=TRUE;  <<RESPONSE WAS INVALID>>        06622000
                    END ELSE                                            06624000
                    BEGIN                                               06626000
                         J:=0;                                          06628000
                         DO  <<LOOK FOR DISP MATCH>>                    06630000
                           IF RBUF = ANS(J*3),(3) THEN                  06632000
                           BEGIN                                        06634000
                                NODISP:=FALSE;                          06636000
                                I:=J;  <<SAVE MATCH>>                   06638000
                                J:=2;  <<STOP LOOP>>                    06640000
                           END                                          06642000
                         UNTIL (J:=J+1) = 3;                            06644000
                    END;                                                06646000
               END;                                                     06648000
               IF VALIDISP THEN                                         06650000
               BEGIN                                                    06652000
                    X:=14-I;                                            06654000
                    BEGIN                                               06656000
                         TOS:=LEGAL;                                    06658000
                         ASSEMBLE(TBC 0,X);                             06660000
                         IF = THEN NODISP:=TRUE;                        06662000
                         DELETE;                                        06664000
                    END;                                                06666000
                    GETDISP:=15-X;                                      06668000
               END ELSE                                                 06670000
               BEGIN                                                    06672000
                    GENMSG(PVMSGSET,VIERR2);                            06674000
               END;                                                     06676000
          END;                                                          06678000
     END <<GETDISP>>;                                                   06680000
                                                                        06682000
     SUBROUTINE SETDISP(TRACK,DISP);                                    06684000
     VALUE TRACK,DISP; INTEGER TRACK,DISP;                              06686000
     BEGIN                                                              06688000
          CASE *DISP OF                                                 06690000
          BEGIN                                                         06692000
               RETURN;  <<DISP = 0 - IGNORE>>                           06694000
                                                                        06696000
               BEGIN    <<DISP = 1 - RECOVER>>                          06698000
                    DELDTTENTRY(DTT(ENT));                     <<RK4PV>>06700000
                    RETURN;                                             06702000
               END;                                                     06704000
                                                                        06706000
               ALT:=0;  <<DISP = 2 - DELETE>>                           06708000
                                                                        06710000
               BEGIN    <<DISP = 3 - REASSIGN>>                         06712000
                    ALTNEEDED:=TRUE;                                    06714000
                    WHILE ALTNEEDED DO                                  06716000
                    BEGIN                                               06718000
                         IF DTT(DTTALT)=(MAXLPS*TRKCYL) THEN            06720000
                         BEGIN  <<NO ALTERNATES AVAILABLE>>             06722000
                              GENMSG(PVMSGSET,VIERR10);                 06724000
                              GENMSG(PVMSGSET,VIERR12);        <<RK1PV>>06726000
                              RETURN;                                   06728000
                         END;                                           06730000
                         I:=0;                                          06732000
                         ALTNEEDED:=FALSE;                              06734000
                         WHILE (I:=I+1) <= DTT DO                       06736000
                         IF DTT(I)&LSR(2)=DTT(DTTALT) THEN              06738000
                         BEGIN  <<AVAILABLE ALTERNATE IS BAD>>          06740000
                              DTT(X):=DTT(DTTALT)+1;                    06742000
                              ALTNEEDED:=TRUE;                          06744000
                              I:=DTT;  <<STOP LOOP>>                    06746000
                         END;                                           06748000
                    END;                                                06750000
                    ALT:=DTT(DTTALT);                                   06752000
                    DTT(X):=DTT(X)+1;                                   06754000
               END;                                                     06756000
                                                                        06758000
          END <<CASE>>;                                                 06760000
          DELDTTENTRIES(TRACK);                                <<RK4PV>>06762000
          ADDDTTENTRY(TRACK&LSL(2)+DISP);                      <<RK4PV>>06764000
                                                               <<00239>>06766000
          X := DTT'CHANGES := DTT'CHANGES + 1;                 <<00239>>06768000
          DTT'CHANGES(X) := (TRACK & LSL(2)) + DISP;           <<00239>>06770000
          DTT'DISP(X) := ALT;                                  <<00239>>06772000
                                                               <<00239>>06774000
                                                               <<00239>>06776000
     END <<SETDISP>>;                                                   06778000
                                                                        06780000
     CC:=CCE;  <<ASSUME NO DTT ENTRIES>>                                06782000
     DTT'CHANGES := 0;                                         <<00239>>06784000
     MOVE DTT'CHANGES(1) := DTT'CHANGES,(DTT'CHANGES'SIZE);    <<03620>>06786000
     proc'status:=Get'Disc'Info(ldn,,,,type,subtype,,,,,,,,,   <<03510>>06790000
                      sectrk,def'log'pack'sz,,trkcyl);         <<03510>>06792000
     IF NOT(proc'status) THEN leave(proc'status);              <<03510>>06794000
     size:=def'log'pack'sz * trkcyl; << in tracks, of disc >>  <<03510>>06796000
     IF type = floppy'disc'type AND                            <<03510>>06800000
        subtype = floppy'disc'subtype THEN                     <<03510>>06802000
           rea'or'del:=del'                                    <<03510>>06804000
        ELSE                                                   <<03510>>06806000
           rea'or'del:=rea;                                    <<03510>>06808000
     << compute the ending addresses(in sectors) of any of   >><<03510>>06810000
     << the arguments which are present. This is so that the >><<03510>>06812000
     << addr can be checked to see if they lie in susp areas >><<03510>>06814000
                                                               <<03510>>06816000
     IF check'dirc THEN enddiradr:=diradr + DBL(dirsz) -1D;    <<03510>>06818000
     IF check'bitmap THEN                                      <<03510>>06820000
        BEGIN                                                  <<03510>>06822000
           proc'status:=Get'Disc'Info(ldn,,,,,,,,              <<03510>>06824000
                                  bit'map'size'pages);         <<03510>>06826000
           IF NOT(proc'status) THEN leave(proc'status);        <<03510>>06828000
           bit'map'sz:=bit'map'size'pages * page'size;         <<03510>>06830000
           endbitmapadr:=bitmapadr + DBL(bit'map'sz) -1D;      <<03510>>06832000
        END;                                                   <<03510>>06834000
     IF check'descr THEN                                       <<03510>>06836000
        BEGIN                                                  <<03510>>06838000
           proc'status:=Get'Disc'info(ldn,,,,,,,,,,            <<03510>>06840000
                                 dt'size'words);               <<03510>>06842000
           IF NOT(proc'status) THEN leave(proc'status);        <<03510>>06844000
           descr'sz:=dt'size'words / sector'size;              <<03510>>06846000
           IF (dt'size'words MOD sector'size) <> 0 THEN        <<03510>>06848000
                  descr'sz:=descr'sz+1;                        <<03510>>06850000
           enddescradr:=descradr + DBL(descr'sz) -1D;          <<03510>>06852000
        END;                                                   <<03510>>06854000
                                                               <<03510>>06856000
   IF NOT CS'80 THEN                                           <<03620>>06858000
     BEGIN                                                     <<03620>>06860000
     SORT'DTT(DTT);                                            <<00239>>06862000
     ENT:=DTT+1;                                               <<RK3PV>>06864000
     WHILE (ENT:=ENT-1) > 0 DO                                 <<RK3PV>>06866000
     IF (K:=DTT(ENT).(14:2)) <= 1 THEN  <<SUSPECT TRACK>>               06868000
     BEGIN                                                              06870000
          CC:=CCG;  <<SUSPECT TRACKS FOUND>>                            06872000
          TRK:=DTT(ENT)&LSR(2);  <<TRACK #>>                            06874000
          IF K=0 AND ENT<>DTT AND DTT(ENT+1)&LSR(2)=TRK THEN K:=2;      06876000
          FSECT:=LOGICAL(TRK)**SECTRK;  <<FIRST SECTOR>>                06878000
          LSECT:=FSECT+DOUBLE(SECTRK-1);  <<LAST SECTOR>>               06880000
          PRINTRACKINFO;                                                06882000
          IOSTATUS:=%2;  <<RETURN ERROR, NO ERROR MESSAGES>>            06886000
          FLAGGED:=( ALTTRACK(LDN,TRK) < 0 );                  <<RK4PV>>06888000
          IF LSECT >= (SECTRK**LOGICAL(SIZE)) THEN                      06890000
          BEGIN                                                         06892000
               GENMSG(PVMSGSET,VIWARN1);                                06894000
               IF FLAGGED THEN                                          06896000
               BEGIN                                                    06898000
                    WHILE GETDISP(DEL') = 0 DO  <<DEL>>        <<00239>>06900000
                    BEGIN                                               06902000
                         GENMSG(PVMSGSET,VIERR2);                       06904000
                    END;                                                06906000
                    SETDISP(TRK,2);  <<DEL>>                   <<RK1PV>>06908000
               END ELSE                                                 06910000
               SETDISP(TRK,GETDISP(DEL'+REC));      <<DEL,REC>><<00239>>06912000
          END ELSE                                                      06914000
          IF FLAGGED THEN                                               06916000
             SETDISP(TRK,GETDISP(REA'OR'DEL))                  <<00239>>06918000
          ELSE                                                          06920000
             BEGIN                                             <<03510>>06922000
                only'rec<< recover opt only>>:=false; <<init>> <<03510>>06924000
                IF check'dirc THEN                             <<03510>>06926000
                   BEGIN                                       <<03510>>06928000
                      IF diradr >= fsect AND                   <<03510>>06930000
                         diradr <= lsect THEN only'rec:=true   <<03510>>06932000
                      ELSE                                     <<03510>>06934000
                         IF enddiradr >= fsect AND             <<03510>>06936000
                            enddiradr <= lsect THEN            <<03510>>06938000
                                               only'rec:=true  <<03510>>06940000
                      ELSE                                     <<03510>>06942000
                         IF diradr >= fsect AND                <<03510>>06944000
                            enddiradr <= lsect THEN            <<03510>>06946000
                                     only'rec:=true            <<03510>>06948000
                      ELSE                                     <<03510>>06950000
                         IF fsect >= diradr AND                <<03510>>06952000
                            lsect <= enddiradr THEN            <<03510>>06954000
                                     only'rec:=true;           <<03510>>06956000
                   END;                                        <<03510>>06958000
                IF check'bitmap THEN                           <<03510>>06960000
                   BEGIN                                       <<03510>>06962000
                      IF bitmapadr >= fsect AND                <<03510>>06964000
                         bitmapadr <= lsect THEN only'rec:=true<<03510>>06966000
                      ELSE                                     <<03510>>06968000
                         IF endbitmapadr >=fsect AND           <<03510>>06970000
                            endbitmapadr <=lsect THEN          <<03510>>06972000
                                                only'rec:=true <<03510>>06974000
                      ELSE                                     <<03510>>06976000
                         IF bitmapadr >= fsect AND             <<03510>>06978000
                            endbitmapadr <= lsect THEN         <<03510>>06980000
                                      only'rec:=true           <<03510>>06982000
                      ELSE                                     <<03510>>06984000
                         IF fsect >= bitmapadr AND             <<03510>>06986000
                            lsect <= endbitmapadr THEN         <<03510>>06988000
                                      only'rec:=true;          <<03510>>06990000
                   END;                                        <<03510>>06992000
                IF check'descr THEN                            <<03510>>06994000
                   BEGIN                                       <<03510>>06996000
                      IF descradr >= fsect AND                 <<03510>>06998000
                         descradr <= lsect THEN only'rec:=true <<03510>>07000000
                      ELSE                                     <<03510>>07002000
                         IF enddescradr >=fsect AND            <<03510>>07004000
                            enddescradr <=lsect THEN           <<03510>>07006000
                                                only'rec:=true <<03510>>07008000
                      ELSE                                     <<03510>>07010000
                         IF descradr >= fsect AND              <<03510>>07012000
                            enddescradr <= lsect THEN          <<03510>>07014000
                                  only'rec:=true               <<03510>>07016000
                      ELSE                                     <<03510>>07018000
                         IF fsect >= descradr AND              <<03510>>07020000
                            lsect <= enddescradr THEN          <<03510>>07022000
                                  only'rec:=true               <<03510>>07024000
                   END;                                        <<03510>>07026000
                << In reserved area ??? >>                     <<03527>>07028000
                IF ldn = 1 THEN                                <<03527>>07030000
                   BEGIN  << LDEV 1 >>                         <<03527>>07032000
                      IF ldev1'start'resv'area >= fsect AND    <<03527>>07034000
                      ldev1'start'resv'area <= lsect THEN      <<03527>>07036000
                         only'rec := TRUE;                     <<03527>>07038000
                      IF ldev1'end'resv'area >= fsect AND      <<03527>>07040000
                      ldev1'end'resv'area <= lsect THEN        <<03527>>07042000
                         only'rec := TRUE;                     <<03527>>07044000
                      IF ldev1'start'resv'area >= fsect AND    <<03527>>07046000
                      ldev1'end'resv'area <= lsect THEN        <<03527>>07048000
                         only'rec := TRUE;                     <<03527>>07050000
                      IF fsect >= ldev1'start'resv'area AND    <<03527>>07052000
                      lsect <= ldev1'end'resv'area THEN        <<03527>>07054000
                         only'rec := TRUE;                     <<03527>>07056000
                   END    << LDEV 1 >>                         <<03527>>07058000
                ELSE                                           <<03527>>07060000
                   BEGIN  << Other disc >>                     <<03527>>07062000
                      IF start'resv'area >= fsect AND          <<03527>>07064000
                      start'resv'area <= lsect THEN            <<03527>>07066000
                         only'rec := TRUE;                     <<03527>>07068000
                      IF end'resv'area >= fsect AND            <<03527>>07070000
                      end'resv'area <= lsect THEN              <<03527>>07072000
                         only'rec := TRUE;                     <<03527>>07074000
                      IF start'resv'area >= fsect AND          <<03527>>07076000
                      end'resv'area <= lsect THEN              <<03527>>07078000
                         only'rec := TRUE;                     <<03527>>07080000
                      IF fsect >= start'resv'area AND          <<03527>>07082000
                      lsect <= end'resv'area THEN              <<03527>>07084000
                         only'rec := TRUE;                     <<03527>>07086000
                   END;   << Other disc >>                     <<03527>>07088000
                IF only'rec THEN                               <<03510>>07092000
                   BEGIN                                       <<03510>>07094000
                      genmsg(pvmsgset,viwarn2);                <<03510>>07096000
                      setdisp(trk,getdisp(rec));               <<03510>>07098000
                   END                                         <<03510>>07100000
                ELSE  setdisp(trk,getdisp(rea'or'del + rec) ); <<03510>>07102000
             END;                                              <<03510>>07104000
         END;                                                  <<03620>>07106000
     END                                                       <<03620>>07108000
     ELSE   << CS'80 DISC >>                                   <<03620>>07110000
        BEGIN                                                  <<03620>>07112000
        <<-------------------------------------------->>       <<03620>>07114000
        << SPARE ALL DEFECTIVE SECTORS                >>       <<03620>>07116000
        <<-------------------------------------------->>       <<03620>>07118000
        CS80'SPARE;                                            <<03620>>07120000
        <<-------------------------------------------->>       <<03620>>07122000
        << CHECK IF ANY LOST DATA IN DIRECTORY, BIT   >>       <<03620>>07124000
        << MAP OR BIT MAP DESCRIPTOR                  >>       <<03620>>07126000
        <<-------------------------------------------->>       <<03620>>07128000
        J := 0;                                                <<03620>>07130000
        IF DTT'CHANGES > 0 THEN                                <<03620>>07132000
           BEGIN                                               <<03620>>07134000
           CC := CCG;   <<SUSPECT SECTOR FOUND>>               <<03620>>07136000
           FOR I := 1 UNTIL DTT'CHANGES DO                     <<03620>>07138000
              BEGIN                                            <<03620>>07140000
              ADDR1 := DTT'CHANGES(J:=J+1);                    <<03620>>07142000
              ADDR2 := DTT'CHANGES(J:=J+1);                    <<03620>>07144000
              FSECT := ADDR;                                   <<03620>>07146000
              LSECT := FSECT + DBL(DTT'CHANGES(J:=J+1)-1);     <<03620>>07148000
              IF CHECK'DIRC THEN                               <<03620>>07150000
                 IF DIRADR <= LSECT AND                        <<03620>>07152000
                 ENDDIRADR >= FSECT THEN                       <<03620>>07154000
                 GENMSG(PVMSGSET,VIWARN114);                   <<03620>>07156000
              IF CHECK'BITMAP THEN                             <<03620>>07158000
                 IF BITMAPADR <= LSECT AND                     <<03620>>07160000
                 ENDBITMAPADR >= FSECT THEN                    <<03620>>07162000
                 GENMSG(PVMSGSET,VIWARN115);                   <<03620>>07164000
              IF CHECK'DESCR THEN                              <<03620>>07166000
                 IF DESCRADR <= LSECT AND                      <<03620>>07168000
                 ENDDESCRADR >= FSECT THEN                     <<03620>>07170000
                 GENMSG(PVMSGSET,VIWARN116);                   <<03620>>07172000
              <<CHECK IF IN RESERVED AREA>>                    <<03620>>07174000
              IF START'RESV'AREA <= LSECT AND                  <<03620>>07176000
              END'RESV'AREA >= FSECT THEN                      <<03620>>07178000
              GENMSG(PVMSGSET,VIWARN2);                        <<03620>>07180000
              END;                                             <<03620>>07182000
           END;                                                <<03620>>07184000
     END;                                                               07186000
END << DTTANALYSIS >>;                                                  07188000
                                                               <<00239>>07190000
PROCEDURE ADD'DTT'CHANGES(LDN);                                <<00239>>07192000
VALUE LDN;                                                     <<00239>>07194000
INTEGER LDN;                                                   <<00239>>07196000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>07198000
BEGIN                                                          <<00239>>07200000
INTEGER I;                                                     <<00239>>07202000
                                                               <<00239>>07204000
   CC := CCE;                                                  <<00239>>07206000
   IF DTT'CHANGES = 0 THEN RETURN;                             <<00239>>07208000
   FOR I := 1 UNTIL DTT'CHANGES DO                             <<00239>>07210000
      BEGIN                                                    <<00239>>07212000
      TOS := LDN;                                              <<00239>>07214000
      TOS := DTT'CHANGES(I).(0:14);                            <<00239>>07216000
      TOS := DTT'DISP(I);                                      <<00239>>07218000
      FLAGTRACK(*,*,*);                                        <<00239>>07220000
      IF < THEN                                                <<00239>>07222000
         BEGIN                                                 <<00239>>07224000
         CC := CCL;                                            <<00239>>07226000
         RETURN;                                               <<00239>>07228000
         END;                                                  <<00239>>07230000
      END;                                                     <<00239>>07232000
END;                                                           <<00239>>07234000
$PAGE   "PVINIT - FORMAT FLOPPY PROCEDURES"                    <<04669>>07236000
$PAGE   "PVINIT - FORMAT FLOPPY PROCEDURES"                             07238000
PROCEDURE FORMAT'IBM'FLOPPY(LDN);                                       07240000
   COMMENT                                                              07242000
   THIS PROCEDURE FORMAT AND INITIALIZE A 3740 IBM DISKETTE.            07244000
                                                                        07246000
   THE 3740 IBM DISKETTES ARE SINGLESIDED WITH 77 TRACKS                07248000
   NUMBERED FROM 0 TO 76. EACH TRACK IS DIVIDED INTO 26 SECTORS         07250000
   WITH A STORAGE CAPACITY OF 128 SECTOR BYTES PER SECTOR.              07252000
   TRACK 0, CALLED THE INDEX TRACK, IS RESERVED FOR                     07254000
   INFORMATION DESCRIBING THE DISKETTE'S CONTENTS. THE TRACKS          07256000
   NUMBERED 01 THROUGH 73 ARE USED FOR DATA. EACH SECTOR CAN            07258000
   CONTAIN ONE RECORD. TRACK 74 IS RESERVED AND SHOULD NOT BE           07260000
   USED FOR DATA ENTRY. THE LAST TWO TRACKS (75 AND 76) ARE             07262000
   RESERVED FOR USE AS REPLACEMENT FOR DEFECTIVE TRACKS.                07264000
   EACH RECORD ON THE INDEX TRACK HAS A RECORD LENGTH OF 80             07266000
   BYTES. THE FIRST SEVEN SECTORS OF THE INDEX TRACK MAY                07268000
   CONTAIN SYSTEM INFORMATION OR INFORMATION ABOUT THE DISKETTE         07270000
   E.G. THE 5-TH SECTOR KEEPS DEFECTIVE TRACK TABLE (UP TO              07272000
   TWO TRACKS). THESE SEVEN SECTORS ARE NOT USUALLY USED OR             07274000
   MODIFIED BY THE OPERATOR. THE REMAINING SECTORS (08-26)              07276000
   MAY CONTAIN DATA SET LABELS, WHICH ARE USED TO DEFINE THE            07278000
   DATA SETS RESIDENT ON THE DISC AND ARE INVISIBLE. ALL DATA           07280000
   ARE RECORDED IN EBCIDC.                                              07282000
                                                                        07284000
   THIS PROCEDURE IS FORMATING ENTIRE DISKETTE WITHOUT                  07286000
   INVISIBLE TRACKS. THE INTERLEAVE VALUE IS 1 (IT IS REQUIRED          07288000
   FOR TRACK 0). THE DATA SET LABEL IS INTIALIZED WITH RECORD           07290000
   LENGTH VALUE OF 80 BYTES.                                            07292000
   ;                                                                    07294000
VALUE LDN;                                                              07296000
INTEGER LDN;   <<LOGICAL DEVICE NUMBER>>                                07298000
OPTION PRIVILEGED,UNCALLABLE;                                           07300000
                                                                        07302000
BEGIN                                                                   07304000
ARRAY DUMMY(0:3)=Q;   <<VERIFY RETURNS 4 WORDS>>                        07306000
DOUBLE ADDR=DUMMY;                                                      07308000
BYTE ARRAY VOLNAME(0:5);  <<Volume name>>                               07310000
INTEGER ADDR1=ADDR,ADDR2=ADDR+1;                                        07312000
INTEGER STATUS1=DUMMY+2,STATUS2=DUMMY+3;                                07314000
DOUBLE STATUS=STATUS1;                                                  07316000
INTEGER IOSTATUS,                                                       07318000
        I,                                                              07320000
        OFFSET,                                                         07322000
        SECTRK:=26,     <<26 SECTORS PER TRACK>>                        07324000
        TRKERRCNT:=0,   <<NUMBER OF DEFECTIVE TRACKS>>                  07326000
        TRACK,          <<TRACK NUMBER>>                                07328000
        TRKERR1 := 0,   <<DEFECTIVE TRACK #1>>                          07330000
        TRKERR2 := 0;   <<DEFECTIVE TRACK #2>>                          07332000
EQUATE  IBM'FLOPPY = %10,                                               07334000
        BLANK'DISKETTE = 1;                                             07336000
                                                                        07338000
IF KEYWDLEN = 3 THEN                                                    07340000
   MOVE VOLNAME := "IBMIRD"                                             07342000
ELSE                                                                    07344000
   BEGIN                                                                07346000
   MOVE VOLNAME := "      ";                                            07348000
   KEYWORD(10) := 0;                                                    07350000
   MOVE VOLNAME := KEYWORD(4) WHILE ANS;                                07352000
   IF 4 < KEYWDLEN AND KEYWDLEN <= 10 AND                               07354000
      KEYWORD = "IBM:" AND                                              07356000
      VOLNAME = KEYWORD(4),(KEYWDLEN-4) THEN                            07358000
   ELSE                                                                 07360000
      BEGIN                                                             07362000
      GENMSG(PVMSGSET,VIERR3);                                          07364000
      CC := CCL;                                                        07366000
      RETURN;                                                           07368000
      END;                                                              07370000
   END;                                                                 07372000
                                                                        07374000
CC := CCE;   <<ASSUME SUCCESFUL>>                                       07376000
STATUS := REQSTATUS(LDN);                                               07378000
IF STATUS2.DOUBLESIDED THEN   <<ONLY SINGLESIDED>>                      07380000
   BEGIN                                                                07382000
   GENMSG(PVMSGSET,VIERR123);                                           07384000
   GENMSG(PVMSGSET,VIERR0);                                             07386000
   GOTO XIT;                                                            07388000
   END;                                                                 07390000
                                                                        07392000
<<--------------------------------------------------------->>           07394000
<< FORMAT DISKETTE WITH OVERRIDE OLD FORMAT                >>           07396000
<< THE ENTIRE DISKETTE WILL BE FORMATED WITHOUT INVISIBLE  >>           07398000
<< TRACKS. THE INTERLEAVE VALUE IS SET TO 1.               >>           07400000
<<--------------------------------------------------------->>           07402000
                                                                        07404000
ADDR1 := BLANK'DISKETTE;   <<ALL TRACKS MAKE VISIBLE>>                  07406000
ADDR2 := IBM'FLOPPY;                                                    07408000
DISCIO(LDN,F,BUFF,ADDR,0);                                              07410000
IF < THEN GOTO XIT;                                                     07412000
                                                                        07414000
<<--------------------------------------------------------->>           07416000
<< VERIFY DISKETTE                                         >>           07418000
<< THE BAD TRACK ADDRESS IS SAVED IN THE 5-TH SECTOR.      >>           07420000
<< THE MAX. PERMISSIBLE NUMBER OF BAD TRACKS IS TWO.       >>           07422000
<< ALL BAD TRACKS ARE VISIBLE.                             >>           07424000
<<--------------------------------------------------------->>           07426000
                                                                        07428000
ADDR := 0D;                                                             07430000
LOOP:                                                                   07432000
IOSTATUS := 2;                                                          07434000
DISCIO(LDN,VM,ADDR,ADDR,0,IOSTATUS);   <<VERIFY>>                       07436000
IF IOSTATUS.TSTATUS <> SUCCESSFUL THEN                                  07438000
   IF IOSTATUS.TSTATUS = TRKERR OR                                      07440000
      IOSTATUS.TSTATUS = VERERR THEN   <<MARK BAD TRACK>>               07442000
      BEGIN                                                             07444000
      TRACK := ADDR2/SECTRK;   <<TRACK ADDR>>                           07446000
      TRKERRCNT := TRKERRCNT + 1;                                       07448000
      IF TRKERRCNT > 2 THEN   <<MAX 2 BAD TRACKS>>                      07450000
         BEGIN                                                          07452000
         GENMSG(PVMSGSET,VIWARN124,%10000,TRACK);                       07454000
         GENMSG(PVMSGSET,VIERR65,%10000,(TRKERRCNT-1));                 07456000
         GENMSG(PVMSGSET,VIERR0);                                       07458000
         GOTO XIT;                                                      07460000
         END;                                                           07462000
      <<SAVE BAD TRACK ADDRESS>>                                        07464000
      IF TRKERRCNT = 1 THEN TRKERR1 := TRACK                            07466000
                       ELSE TRKERR2 := TRACK;                           07468000
      <<MARK TRACK AS DEFECTIVE - SET BIT D ON>>                        07470000
      DISCIO(LDN,IT,BUFF,DOUBLE(TRACK),0);  <<D. SIZE = 1664W>>         07472000
      IF < THEN GOTO XIT;                                               07474000
      GENMSG(PVMSGSET,VIWARN124,%10000,TRACK);                          07476000
      ADDR2 := (TRACK+1)*SECTRK;   <<SET TO NEXT TRACK>>                07478000
      IF TRACK < 74 THEN GOTO LOOP;                                     07480000
      END                                                               07482000
   ELSE                                                                 07484000
      BEGIN                                                             07486000
      DISCERROR(LDN,VM,IOSTATUS,ADDR,STAT.(8:8),DELP);                  07488000
      GENMSG(PVMSGSET,VIERR0);                                          07490000
      GOTO XIT;                                                         07492000
      END;                                                              07494000
                                                                        07496000
<<--------------------------------------------------------->>           07498000
<< INITIALIZE INDEX TRACK                                  >>           07500000
<<--------------------------------------------------------->>           07502000
                                                                        07504000
<<INITIALIZE EACH SECTOR OF INDEX TRACK>>                               07506000
<<BYTES 1-80 - BLANKS, BYTES 81-128 - NULL>>                            07508000
                                                                        07510000
BUFF := "  ";MOVE BUFF(1) := BUFF,(1663);   <<INIT. TRACK>>             07512000
FOR I := 0 UNTIL 25 DO                                                  07514000
   BEGIN                                                                07516000
   OFFSET := I*64+40;                                                   07518000
   BUFF(OFFSET) := 0;                                                   07520000
   MOVE BUFF(OFFSET+1) := BUFF(OFFSET),(23);                            07522000
   END;                                                                 07524000
                                                                        07526000
<<--------------------------------------------------------->>           07528000
<< INITIALIZE SECTORS 1-7 OF INDEX TRACK                   >>           07530000
<<--------------------------------------------------------->>           07532000
                                                                        07534000
<< SECTOR 5  -  ERROR MAP >>                                            07536000
                                                                        07538000
OFFSET := 512;   << (5-1)*128 >>                                        07540000
MOVE BUFFB(OFFSET) := "ERMAP";                                          07542000
IF TRKERR1 <> 0 THEN   <<MARK BAD TRACK IN POS. 7 AND 8>>               07544000
   BEGIN                                                                07546000
   MOVE BUFFB(OFFSET+6) := "000";                                       07548000
   ASCII(TRKERR1,-10,BUFFB(OFFSET+7));                                  07550000
   END;                                                                 07552000
IF TRKERR2 <> 0 THEN   <<MARK SEC. BAD TRACK IN POS 11-12>>             07554000
   BEGIN                                                                07556000
   MOVE BUFFB(OFFSET+10) := "000";                                      07558000
   ASCII(TRKERR1,-10,BUFFB(OFFSET+11));                                 07560000
   END;                                                                 07562000
                                                                        07564000
<< SECTOR 7 >>                                                          07566000
                                                                        07568000
OFFSET := 768;   << (7-1)*128 >>                                        07570000
MOVE BUFFB(OFFSET) := "VOL1",2;                                         07572000
MOVE * := VOLNAME,(6);                                                  07574000
BUFFB(OFFSET+79) := "W";                                                07576000
                                                                        07578000
<<--------------------------------------------------------->>           07580000
<< INITIALIZE SECTORS 8 - 26 OF INDEX TRACK                >>           07582000
<<--------------------------------------------------------->>           07584000
                                                                        07586000
FOR I := 7 UNTIL 25 DO                                                  07588000
   BEGIN                                                                07590000
   OFFSET := I*128;                                                     07592000
   IF I=7 THEN                                                          07594000
      BEGIN   << SECTOR 8 >>                                            07596000
      MOVE BUFFB(OFFSET) := "HDR1 DATA";                                07598000
      MOVE BUFFB(OFFSET+24) := "080 01001";                             07600000
      MOVE BUFFB(OFFSET+74) := "01001";                                 07602000
      END                                                               07604000
   ELSE                                                                 07606000
      BEGIN   << SETORS 9-26 >>                                         07608000
      MOVE BUFFB(OFFSET) := "DDR1 DATA00";                              07610000
      ASCII(I+1,-10,BUFFB(OFFSET+10));                                  07612000
      MOVE BUFFB(OFFSET+22) := "080 74001";                             07614000
      MOVE BUFFB(OFFSET+74) := "74001";                                 07616000
      END;                                                              07618000
   MOVE BUFFB(OFFSET+34) := "73026";                                    07620000
   END;                                                                 07622000
                                                                        07624000
   << CONVERT FROM ASCII TO EBCDIC >>                                   07626000
                                                                        07628000
   CTRANSLATE(2,BUFFB,BUFFB,3328);                                      07630000
                                                                        07632000
   << MARK SETORS 8-26 AS INVISIBLE >>                                  07634000
                                                                        07636000
   <<DEACTIVATE (MAKE INVISIBLE) ENTIRE TRACK>>                         07638000
   <<DRIVER FEATURE - IT ALWAYS ASSUMES ENTIRE TRACK>>                  07640000
   DISCIO(LDN,IT,BUFF,0D,0);                                            07642000
   IF < THEN GOTO XIT;                                                  07644000
   <<ACTIVATE SECTOR 1>>                                                07646000
   DISCIO(LDN,WL,BUFF,0D,64);                                           07648000
   IF < THEN GOTO XIT;                                                  07650000
   <<ACTIVATE SECTORS 2-8>>                                             07652000
   DISCIO(LDN,W,BUFF(64),1D,448);                                       07654000
   IF < THEN                                                            07656000
XIT:                                                                    07658000
      BEGIN                                                             07660000
      CC := CCL;                                                        07662000
      RETURN;                                                           07664000
      END;                                                              07666000
END;   <<FORMAT'IBM'FLOPPY>>                                            07668000
PROCEDURE FORMAT'A'FLOPPY(LDN);                                <<00239>>07670000
VALUE LDN;                                                     <<00239>>07672000
INTEGER LDN;                                                   <<00239>>07674000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>07676000
BEGIN                                                          <<00239>>07678000
ARRAY DUMMY(0:3) = Q;  << VM RETURNS 4 WDS>>                   <<00239>>07680000
DOUBLE ADDR = DUMMY + 0;                                       <<00239>>07682000
INTEGER ADDR1=ADDR,ADDR2=ADDR+1;                               <<00239>>07684000
INTEGER STATUS1 = DUMMY + 2,STATUS2 = DUMMY + 3;               <<00239>>07686000
DOUBLE STATUS = STATUS1;                                       <<00239>>07688000
INTEGER IOSTATUS,SECPERCYL,CYL,SECTRK:=30,TRKERRCNT:=0;        <<00239>>07690000
EQUATE      HP'FLOPPY = 2,                                     <<00239>>07692000
       MAKE'INVISIBLE = 8,                                     <<00239>>07694000
       BLANK'DISKETTE = 1;                                     <<00239>>07696000
                                                               <<00239>>07698000
                                                               <<00239>>07700000
   CC := CCE;  <<ASSUME SUCCESSFUL>>                           <<00239>>07702000
   STATUS := REQSTATUS(LDN);                                   <<00239>>07704000
   ADDR1 := BLANK'DISKETTE;                                    <<00239>>07706000
   ADDR2 := HP'FLOPPY;                                         <<00239>>07708000
   SECPERCYL := IF STATUS2.DOUBLESIDED THEN 60 ELSE 30;        <<00239>>07710000
   DISCIO(LDN,F,BUFF,ADDR,0);  << FORMAT >>                    <<00239>>07712000
   IF < THEN                                                   <<00239>>07714000
      BEGIN                                                    <<00239>>07716000
      CC := CCL;                                               <<00239>>07718000
      RETURN;                                                  <<00239>>07720000
      END;                                                     <<00239>>07722000
   ADDR := 0D;                                                 <<04131>>07724000
LOOP:                                                          <<00239>>07726000
   IOSTATUS := 2;                                              <<00239>>07728000
   DISCIO(LDN,VM,ADDR,ADDR,0,IOSTATUS);<<VERIFY WHOLE FLOPPY>> <<00239>>07732000
   IF IOSTATUS.TSTATUS <> SUCCESSFUL THEN << GOT AN ERROR >>   <<00239>>07734000
      BEGIN                                                    <<00239>>07736000
      CYL := ADDR2/SECPERCYL;                                  <<00239>>07738000
      TRKERRCNT := TRKERRCNT + 1;                              <<00239>>07742000
      DTT(DTTALT) := DTT(DTTALT) + 1;                          <<00239>>07744000
      IF STATUS2.DOUBLESIDED AND TRKERRCNT > 4 OR              <<00239>>07746000
         STATUS2.SINGLESIDED AND TRKERRCNT > 2 THEN            <<00239>>07748000
            BEGIN                                              <<00239>>07750000
            GENMSG(PVMSGSET,VIERR65,%10000,(TRKERRCNT-1));     <<00239>>07752000
            GENMSG(PVMSGSET,VIERR0);                           <<00239>>07754000
            CC := CCL;                                         <<00239>>07756000
            RETURN;                                            <<00239>>07758000
            END;                                               <<00239>>07760000
      TOS := ADDR2;                                            <<00239>>07762000
      TOS := S0 MOD SECTRK;                                    <<00239>>07764000
      ASSEMBLE(LSUB);                                          <<00239>>07766000
      ADDR2 := TOS;                                            <<00239>>07768000
      DISCIO(LDN,IT,BUFF,ADDR,0); <<MARK TRK DEFECTIVE>>       <<00239>>07770000
      IF < THEN                                                <<00239>>07772000
         BEGIN                                                 <<00239>>07774000
         CC := CCL;                                            <<00239>>07776000
         RETURN;                                               <<00239>>07778000
         END;                                                  <<00239>>07780000
      GENMSG(PVMSGSET,VIWARN11,%11000,CYL,                     <<00239>>07782000
              ( (ADDR2/SECTRK) MOD (SECPERCYL/SECTRK) ) );     <<00239>>07784000
      ADDR2 := ADDR2 + SECTRK;                                 <<00239>>07786000
     IF CYL < 77 THEN GOTO LOOP;                               <<04131>>07788000
      END;                                                     <<00239>>07790000
                                                               <<00239>>07794000
   IF TRKERRCNT <> 0 THEN                                      <<00239>>07796000
      BEGIN                                                    <<00239>>07798000
      GENMSG(PVMSGSET,VIWARN3,%10000,TRKERRCNT);               <<00239>>07800000
      END;                                                     <<00239>>07802000
                                                               <<00239>>07804000
   ADDR1 := MAKE'INVISIBLE;                                    <<00239>>07806000
   ADDR2 := HP'FLOPPY;                                         <<00239>>07808000
   DISCIO(LDN,F,BUFF,ADDR,0);                                  <<00239>>07810000
   IF < THEN                                                   <<00239>>07812000
      BEGIN                                                    <<00239>>07814000
      CC := CCL;                                               <<00239>>07816000
      RETURN;                                                  <<00239>>07818000
      END;                                                     <<00239>>07820000
END;  << OF FORMAT'A'FLOPPY >>                                 <<00239>>07822000
$PAGE "INITDSCT PROCEDURE FOR CS'80 DISCS."                    <<03537>>07824000
LOGICAL PROCEDURE INITDSCT(LDEV);                              <<03537>>07826000
                                                               <<03537>>07828000
VALUE                                                          <<03537>>07830000
  LDEV;                                                        <<03537>>07832000
                                                               <<03537>>07834000
INTEGER                                                        <<03537>>07836000
  LDEV;                                                        <<03537>>07838000
                                                               <<03537>>07840000
BEGIN                                                          <<03537>>07842000
<<  Initializes the Defective Sectors Table for a CS'80 disc >><<03537>>07844000
<<                                                           >><<03537>>07846000
<<  This is as follows:                                      >><<03537>>07848000
<<                                                           >><<03537>>07850000
<<   1.  Zero the table in a buffer and initialize the       >><<03537>>07852000
<<       overhead words.                                     >><<03537>>07854000
<<                                                           >><<03537>>07856000
<<   2.  Invoke the driver (disc) VERIFY function.  This     >><<03537>>07858000
<<       proceeds until it gets an error.                    >><<03537>>07860000
<<                                                           >><<03537>>07862000
<<   3.  If the error is a TRACK/SECTOR error, save the      >><<03537>>07864000
<<       sector number in the DSCT and restart the verify    >><<03537>>07866000
<<       with the NEXT sector.  Continue this until          >><<03537>>07868000
<<       END-OF-VOLUME.                                      >><<03537>>07870000
<<                                                           >><<03537>>07872000
<<   4.  Then, spare each sector found without retaining     >><<03537>>07874000
<<       data and clear the DSCT.  Write the (clear) DSCT    >><<03537>>07876000
<<       out to the disc.                                    >><<03537>>07878000
<<                                                           >><<03537>>07880000
<<       Unusual errors (unit failure, DSCT full, etc)       >><<03537>>07882000
<<       are fatal and cause an error message and return     >><<03537>>07884000
                                                               <<03537>>07886000
  DOUBLE                                                       <<03537>>07888000
    VOL'LIMIT,                                                 <<03537>>07890000
    ADDR,                                                      <<03537>>07892000
    DTEMP;                                                     <<03537>>07894000
                                                               <<03537>>07896000
  INTEGER                                                      <<03537>>07898000
    I;                                                         <<03537>>07900000
                                                               <<03537>>07902000
  LOGICAL                                                      <<03537>>07904000
    DSCTFULL,                                                  <<03642>>07906000
    IOSTATUS;                                                  <<03537>>07908000
                                                               <<03642>>07910000
LOGICAL SUBROUTINE CHECK'IO'ERROR;                             <<03642>>07912000
        BEGIN                                                  <<03642>>07914000
        IF IOSTATUS.TSTATUS = SUCCESSFUL OR                    <<03642>>07916000
           IOSTATUS.TSTATUS = TRKERR OR                        <<03642>>07918000
           IOSTATUS.TSTATUS = NO'SPARE THEN RETURN;            <<03642>>07920000
        I := ASCII(IOSTATUS.TSTATUS,8,BUFFB);                  <<03642>>07922000
        BUFFB(6) := 0;                                         <<03642>>07924000
        GENMSG(PVMSGSET,VIERR106,0,@BUFFB(6-I));               <<03642>>07926000
        GENMSG(PVMSGSET,0);                                    <<03642>>07928000
        ASSEMBLE(EXIT 0);                                      <<03642>>07930000
        END;                                                   <<03642>>07932000
                                                               <<03642>>07934000
INITDSCT := FALSE;  <<ASSUME FAILURE>>                         <<03642>>07936000
                                                               <<03642>>07938000
<<INITIALIZE THE DSCT>>                                        <<03642>>07940000
                                                               <<03537>>07942000
  DTT := 0;                                                    <<03537>>07944000
  MOVE DTT(1) := DTT, (DTT'SIZE - 1);                          <<03537>>07946000
  DTT(DSCT'FIRST'ENTRY'INDEX) := DSCT'OFFSET'TO'FIRST'ENTRY;   <<03537>>07948000
  DTT(DSCT'ENTRY'SIZE) := DSCT'SIZE'OF'ENTRY;                  <<03537>>07950000
  DTT(DSCT'MAX'NUMBER'OF'ENTRIES) := DSCT'MAX'ENTRIES;         <<03537>>07952000
                                                               <<03642>>07954000
  DISCIO(LDEV,W,DTT,1D,128); <<WRITE OUT DTT FOR VERIFY>>      <<03642>>07956000
                                                               <<03537>>07958000
  ADDR := 0D;  << Where to start verify >>                     <<03537>>07960000
                                                               <<03537>>07962000
  GENMSG(PVMSGSET,VIWARN88);  << "BEGIN VERIFY" >>             <<03537>>07964000
                                                               <<03537>>07966000
  << Get maximum sector address >>                             <<03537>>07968000
  IOSTATUS := %(2)111;  << Print messages, return status >>    <<03537>>07970000
  DISCIO(LDEV,REQ'VOL'LIMIT,VOL'LIMIT,0D,2,IOSTATUS);          <<03537>>07972000
  IF (IOSTATUS LAND %377) <> SUCCESSFUL THEN RETURN;           <<03537>>07974000
VER:                                                           <<03642>>07976000
  DSCTFULL := FALSE;                                           <<03642>>07978000
  DO                                                           <<03537>>07980000
    BEGIN  << Basic verify loop >>                             <<03537>>07982000
    IOSTATUS := %(2)010;  << No messages, return status >>     <<03537>>07984000
    DTEMP := VOL'LIMIT;                                        <<04670>>07986000
    DISCIO(LDEV,VERIFY'CS'80,DTEMP,ADDR,2,IOSTATUS);           <<04670>>07988000
    IOSTATUS := IOSTATUS LAND %377;<< Clear junk in hi byte >> <<03537>>07990000
    IF IOSTATUS.GSTATUS <> SUCCESSFUL THEN                     <<03537>>07992000
      BEGIN  << Here's an error >>                             <<03537>>07994000
      IF IOSTATUS = TRKERR THEN                                <<03537>>07996000
        BEGIN  << Track/Sector error >>                        <<03537>>07998000
        IF DTT(DSCT'NUMBER'OF'ENTRIES) <                       <<03537>>08000000
           DTT(DSCT'MAX'NUMBER'OF'ENTRIES) THEN                <<03537>>08002000
          BEGIN  << Room in table, add sector address >>       <<03537>>08004000
          DTTD(DTT(DSCT'FIRST'ENTRY'INDEX) / 2 +               <<03642>>08006000
               DTT(DSCT'NUMBER'OF'ENTRIES)) := DTEMP;          <<03642>>08008000
          DTT(DSCT'NUMBER'OF'ENTRIES) :=                       <<03537>>08012000
            DTT(DSCT'NUMBER'OF'ENTRIES) + 1;  << Inc count >>  <<03537>>08014000
          ADDR := DTEMP + 1D;  << Restart verify at next sec >><<03537>>08018000
          IF DTT(DSCT'NUMBER'OF'ENTRIES) =                     <<03642>>08020000
             DTT(DSCT'MAX'NUMBER'OF'ENTRIES) THEN              <<03642>>08022000
             BEGIN                                             <<03642>>08024000
             DSCTFULL := TRUE;                                 <<03642>>08026000
             IOSTATUS := SUCCESSFUL;  <<LEAVE LOOP>>           <<03642>>08028000
             END;                                              <<03642>>08030000
          END  << Room in table >>                             <<03537>>08032000
        ELSE                                                   <<03537>>08034000
          BEGIN  << DSCT is full! >>                           <<03537>>08036000
          GENMSG(PVMSGSET,VIERR37);  << DTT (!) full >>        <<03537>>08038000
          GENMSG(PVMSGSET,VIWARN0);  << Function aborted >>    <<03537>>08040000
          RETURN;  << Leave procedure >>                       <<03537>>08042000
          END;  << DSCT full case >>                           <<03537>>08044000
        END  << Track/Sector error >>                          <<03537>>08046000
      ELSE                                                     <<03537>>08048000
        BEGIN  << NOT Track/Sector error >>                    <<03537>>08050000
        DISCERROR(LDEV,VERIFY'CS'80,IOSTATUS,ADDR,             <<03537>>08052000
                  STAT.(8:8),DELP);  << Print I/O err msg >>   <<03537>>08054000
        GENMSG(PVMSGSET,VIWARN0);  << Function aborted >>      <<03537>>08056000
        RETURN;  << Leave procedure >>                         <<03537>>08058000
        END;  << NOT Track/Sector error >>                     <<03537>>08060000
      END;  << Got an error >>                                 <<03537>>08062000
    END                                                        <<03537>>08064000
                                                               <<03537>>08066000
<< Keep verifying until done >>                                <<03537>>08068000
                                                               <<03537>>08070000
  UNTIL IOSTATUS = SUCCESSFUL OR ADDR > VOL'LIMIT;             <<03537>>08072000
                                                               <<03537>>08074000
<<All defective sectors from DSCT are being processed.>>       <<03642>>08076000
<<On each entry form DSCT write/read error test is performed>> <<03642>>08078000
<<If it successful then entry is removed, otherwise wiil be>>  <<03642>>08080000
<<spared. Proccess is continued even media is out of spare>>   <<03642>>08082000
<<tracks. Spare is done without retaining data.>>              <<03642>>08084000
                                                               <<03642>>08086000
  SORT'DSCT;                                                   <<03642>>08088000
  WHILE GET'DSCT'ENTRY(ADDR) DO                                <<03642>>08090000
     BEGIN                                                     <<03642>>08092000
     IOSTATUS := 2;  <<NO WARNING>>                            <<03642>>08094000
     DISCIO(LDEV,INIT'UTIL,ADDR,RW'ERT,0,IOSTATUS);            <<03642>>08096000
     IF <> THEN                                                <<03642>>08098000
       BEGIN                                                   <<03642>>08100000
       CHECK'IO'ERROR;                                         <<03642>>08102000
       IOSTATUS := 2;                                          <<03642>>08104000
       DISCIO(LDEV,SPARE'BLOCK,ADDR,NO'RETAIN'DATA,0,IOSTATUS);<<03642>>08106000
       IF <> THEN                                              <<03642>>08108000
         BEGIN                                                 <<03642>>08110000
         CHECK'IO'ERROR;                                       <<03642>>08112000
         IF IOSTATUS.TSTATUS = NO'SPARE THEN                   <<03642>>08114000
         GENMSG(PVMSGSET,VIWARN105,%20000,@ADDR) ELSE;         <<03642>>08116000
         END                                                   <<03642>>08118000
         ELSE GENMSG(PVMSGSET,VIWARN89,%20000,@ADDR);          <<03642>>08120000
       END;                                                    <<03642>>08122000
     REMOVE'DSCT'ENTRY(0,1);                                   <<03642>>08124000
     END;                                                      <<03642>>08126000
                                                               <<03642>>08128000
  IF DSCTFULL THEN GOTO VER;  <<TRY AGAIN IF DSCT WAS FULL>>   <<03642>>08130000
                                                               <<03537>>08134000
  << Caller will write it out >>                               <<03537>>08136000
                                                               <<03537>>08138000
  INITDSCT := TRUE;  << All OK >>                              <<03537>>08140000
                                                               <<03537>>08142000
  END  << INITDSCT proc >>;                                    <<03537>>08144000
                                                                        08146000
$PAGE "PVINIT - USER COMMANDS: INITIALIZE "                    <<RK.08>>08148000
                                                                        08150000
PROCEDURE INIT;                                                         08152000
OPTION PRIVILEGED,UNCALLABLE;                                           08154000
BEGIN                                                                   08156000
                                                               <<03510>>08158000
     << initializes the private volume by             >>       <<03510>>08160000
     << creating a defective tracks table-assumes     >>       <<03510>>08162000
     << the disc has already been formatted           >>       <<03510>>08164000
     << creates a DFSM & alloc space for bit map,     >>       <<03510>>08166000
     << descr + Dirc if mv                            >>       <<03510>>08168000
     << updates the vol label and vol entry           >>       <<03510>>08170000
     << (also generate a log entry)                   >>       <<03510>>08172000
     << create directory if this is the master volume >>       <<03510>>08174000
     << of the volume set                             >>       <<03510>>08176000
     INTEGER ENT:=0,GEN:=0;                                    <<DE>>   08178000
     LOGICAL D,VSDIRSIZE:=0,DIRCSIZE:=0;                       <<DE>>   08180000
     DOUBLE  VSDDIRSIZE;                                       <<DE>>   08182000
     INTEGER I,J,K,ALT,CNT,ERR,LOC,LEN,LPS,TRK,HEAD,LDEV,RLEN,SIZE,     08184000
             INDEX,TRACK,ALTTRK,TRKCYL,MAXLPS,SUBTYPE,TRKSIZE,          08186000
             LPSTRK,NEXT;                                      <<RK1PV>>08188000
     INTEGER     type                                          <<03510>>08190000
                ;                                              <<03510>>08192000
     LOGICAL     initd                                         <<03510>>08194000
                ,proc'status                                   <<03510>>08196000
                ;                                              <<03510>>08198000
     INTEGER PVERR = I;  <<ERROR NUMBER FOR GENMSG>>                    08200000
     DOUBLE DIRADR; <<Dirc start addr>>                        <<01353>>08204000
     LOGICAL A,SECTRK,IOSTATUS,MASTERVOL,                               08206000
             NOHIGHER'ADDR;                                             08208000
     DOUBLE DTEMP,FSECT,LSECT,SECTRKD;                                  08210000
     DOUBLE VTABINFO;                                                   08212000
     INTEGER                                                            08214000
          VTABINFO1 = VTABINFO,                                         08216000
          VTBAINFO2 = VTABINFO+1;                                       08218000
     DOUBLE ADDR;                                                       08220000
     INTEGER                                                            08222000
          ADDR1 = ADDR,                                                 08224000
          ADDR2 = ADDR+1;                                               08226000
     DOUBLE RSTATUS;                                                    08228000
     INTEGER                                                            08230000
          RSTATUS1 = RSTATUS,                                           08232000
          RSTATUS2 = RSTATUS+1;                                         08234000
     ARRAY VSDIR(*) = BUFF;                                             08238000
     BYTE ARRAY VSDIRB(*) = BUFF;                                       08240000
     LOGICAL ARRAY VLAB(0:127);  <<VOLUME LABEL>>              <<DE>>   08242000
     BYTE ARRAY VLABB(*) = VLAB;                                        08244000
     ARRAY VSDEFN(0:VDSENTSIZE);                                        08246000
     BYTE ARRAY VSDEFNB(*) = VSDEFN;                                    08248000
     BYTE POINTER NAME;                                                 08250000
     EQUATE MVNAME = VDVENTSIZEB;                                       08252000
     EQUATE STOPPER = %077776;                                 <<RK1PV>>08254000
                                                               <<03510>>08256000
     << use this to exit procedure from subr >>                <<03510>>08258000
                                                               <<03510>>08260000
     DEFINE exit'procedure = ASSEMBLE(exit 0)#;                <<03510>>08262000
                                                               <<03510>>08264000
                                                                        08266000
     SUBROUTINE check'error(err);                              <<03510>>08268000
        VALUE err;                                             <<03510>>08270000
        LOGICAL err;                                           <<03510>>08272000
                                                               <<03510>>08274000
     BEGIN                                                     <<03510>>08276000
$IF X3=ON                                                      <<03510>>08278000
          debug;                                               <<03510>>08280000
$IF                                                            <<03510>>08282000
        IF err = get'dst'error OR err = get'vm'error           <<03510>>08284000
           THEN                                                <<03510>>08286000
              genmsg(pvmsgset,vierr90)                         <<03510>>08288000
        ELSE                                                   <<03510>>08290000
              genmsg(pvmsgset,vierr34);                        <<03510>>08292000
        exit'procedure;                                        <<03510>>08294000
                                                               <<03510>>08296000
     END;                                                      <<03510>>08298000
     LOGICAL SUBROUTINE INVALIDVOL;                                     08300000
     BEGIN                                                              08302000
          INVALIDVOL:=TRUE;  <<ASSUME VOL IS NOT PART OF VSET>>         08304000
          I:=0;                                                         08306000
          WHILE (I:=I+1) <= MAXVOLNUM DO                                08308000
          BEGIN                                                         08310000
               @NAME:=@VSDEFNB((I*VDVENTSIZE) & LSL(1));                08312000
               IF VNAME = NAME,(8) THEN                                 08314000
               BEGIN                                                    08316000
                    INVALIDVOL:=FALSE;                                  08318000
                    IF VNAME = VSDEFNB(MVNAME),(8) THEN  <<MASTER>>     08320000
                    BEGIN                                               08322000
                         MASTERVOL:=TRUE;                               08324000
                         MOVE MSG:=" ENTER DIRECTORY SIZE",2;  <<RK4PV>>08326000
                         MOVE *:=" (SECTORS - 384 TO 65000): ";<<DE>>   08328000
                         WHILE VSDIRSIZE = 0 DO  <<ASK FOR SIZE>>       08330000
                         BEGIN                                          08332000
                              PRINT (MSGW,-48,%320);           <<DE>>   08334000
                              MOVE rbuf:=10(" ");              <<03510>>08336000
                              read(rbufw,-10);                 <<03510>>08338000
                              IF <> THEN EOF;                  <<RK3PV>>08340000
                              len:=10;                         <<03510>>08342000
                              WHILE len >=0 AND                <<03510>>08344000
                                 rbuf(len-1) =  " " DO         <<03510>>08346000
                                 len:=len-1;                   <<03510>>08348000
                              VSDDIRSIZE := DBINARY(RBUF,LEN); <<DE>>   08350000
                              IF <> THEN                                08352000
                              BEGIN                                     08354000
                                   VSDIRSIZE:=0;                        08356000
                                   MOVE PBUF:=" ** INVALID INTEGER",2;  08358000
                                   MOVE   * :=" VALUE **";              08360000
                                   PRINT(PBUFW,-28,0);         <<RK.08>>08362000
                              END ELSE                                  08364000
                              IF (VSDDIRSIZE < 384D <<MIN>> OR <<DE>>   08366000
                                  VSDDIRSIZE > 65000D <<MAX>>) <<DE>>   08368000
                              THEN BEGIN                       <<DE>>   08370000
                                   VSDIRSIZE:=0;                        08372000
                                   MOVE PBUF:=" ** ILLEGAL DIRECTORY",2;08374000
                                   MOVE   * :=" SIZE **";               08376000
                                   PRINT(PBUFW,-29,0);         <<RK.08>>08378000
                                   END                         <<DE>>   08380000
                              ELSE                             <<DE>>   08382000
                                VSDIRSIZE:=INTEGER(VSDDIRSIZE);<<DE>>   08384000
                         END;                                           08386000
                    END;                                                08388000
                    I:=MAXVOLNUM;  <<STOP LOOP>>                        08390000
               END;                                                     08392000
          END;                                                          08394000
     END  <<INVALIDVOL>>;                                               08396000
                                                                        08398000
$PAGE "INIT COMMAND-INITDTT SUBROUTINE FOR FLOPPIES/MAC DISCS."<<03537>>08400000
     SUBROUTINE INITDTT;                                                08402000
     BEGIN                                                              08404000
          dtt:=0;                                              <<03510>>08406000
          MOVE dtt(1):=dtt,(dtt'size-1);                       <<03510>>08408000
          IF TYPE = CS'80'TYPE THEN                            <<03537>>08410000
            BEGIN                                              <<03537>>08412000
            IF NOT INITDSCT(LDEV) THEN                         <<03537>>08414000
              EXIT'PROCEDURE  << INIDSCT failed >>             <<03537>>08416000
            END                                                <<03537>>08418000
          ELSE                                                 <<03510>>08422000
             BEGIN                                             <<03510>>08424000
          proc'status:=Get'Disc'Info(ldev,,,,,,,,,,,,,,        <<03510>>08426000
                                sectrk,lps,                    <<03510>>08428000
                                maxlps,trkcyl);                <<03510>>08430000
          IF NOT(proc'status) THEN check'error(proc'status);   <<03510>>08432000
          trksize:=sectrk * sector'size;  << in wds >>         <<03510>>08434000
          dtt(dtt'logical'pack'size):=lps;                     <<03510>>08436000
          dtt(dtt'next'alt'track):=size:=lps * trkcyl;         <<03510>>08438000
          IF type=floppy'disc'type AND                         <<03510>>08442000
             subtype=floppy'disc'subtype THEN                  <<03510>>08444000
             BEGIN                                             <<00239>>08446000
             FORMAT'A'FLOPPY(LDEV);                            <<00239>>08448000
             IF < THEN ASSEMBLE(EXIT 0);                       <<00239>>08450000
             END                                               <<00239>>08452000
          ELSE                                                 <<00239>>08454000
             BEGIN  << 7920 FAMILY >>                          <<00239>>08456000
               TRACK:=-1;                                      <<RK2PV>>08458000
               WHILE (TRACK:=TRACK+1) < MAXLPS*TRKCYL DO       <<RK2PV>>08460000
               BEGIN  <<CHECK EACH TRACK FOR DEFECTIVE>>                08462000
                    ADDR:=LOGICAL(TRACK)**SECTRK;                       08464000
                    IOSTATUS:=%2;  <<RETURN ERROR, NO ERROR MESSAGES>>  08466000
                    DISCIO(LDEV,RSPD,BUFF,ADDR,128,IOSTATUS);           08468000
                    IF IOSTATUS.GSTATUS <> SUCCESSFUL THEN              08470000
                    BEGIN                                               08472000
                         ERR:=IOSTATUS.QSTATUS;  <<ACTUAL ERROR>>       08474000
                         IF NOT (%7<=ERR<=%11 LOR %17<=ERR<=%21) THEN   08476000
                         BEGIN                                          08478000
                              DISCERROR(LDEV,R,IOSTATUS,ADDR,  <<RK.08>>08480000
                                        STAT.(8:8),DELP);      <<RK.08>>08482000
                              GENMSG(PVMSGSET,VIERR0);                  08484000
                              ASSEMBLE(EXIT 0);                         08486000
                         END;                                           08488000
                         IF ERR = SPT THEN  <<SPARE TRACK>>             08490000
                         BEGIN                                          08492000
                              TOS:=ALTTRACK(LDEV,TRACK);                08494000
                              IF < THEN ASSEMBLE(EXIT 0);  <<I/O ERROR>>08496000
                              IF TOS >= 0 THEN  <<A FORMER SPARE TRACK>>08498000
                              BEGIN                                     08500000
                                   IF TRACK >= LPS*TRKCYL THEN <<RK2PV>>08502000
                                   TRACKINIT(LDEV,ADDR,0D,TRKSIZE,%4)   08504000
                                 ELSE                                   08506000
                                   TRACKINIT(LDEV,ADDR,ADDR,TRKSIZE,0); 08508000
                                   IF < THEN ASSEMBLE(EXIT 0);          08510000
                              END ELSE ERR:=DFT;                        08512000
                         END;                                           08514000
                         IF ERR = DFT THEN                              08516000
                         BEGIN                                          08518000
                              IF TRACK >= LPS*TRKCYL THEN      <<RK2PV>>08520000
                              TRACKINIT(LDEV,ADDR,-1D,TRKSIZE,%4) <<RH>>08522000
                            ELSE                                        08524000
                              TRACKINIT(LDEV,ADDR,-1D,TRKSIZE,%1);<<RH>>08526000
                              IF < THEN ASSEMBLE(EXIT 0);               08528000
                         END;                                           08530000
                         IF ERR <> SPT THEN  <<SUSPECT/DEFECT>><<RH.PV>>08532000
                         ADDDTTENTRY(TRACK & LSL(2));  <<SUSPECT ENTRY>>08534000
                    END ELSE                                            08536000
                    IF TRACK >= LPS*TRKCYL THEN <<ITS A SPARE>><<RK2PV>>08538000
                    BEGIN                                               08540000
                         TRACKINIT(LDEV,ADDR,0D,TRKSIZE,%4);            08542000
                         IF < THEN ASSEMBLE(EXIT 0); <<DISC I/O ERROR>> 08544000
                    END;                                                08546000
               END;                                                     08548000
          ADDENTRY((TRKCYL-1),(MAXLPS-1));                     <<RK3PV>>08550000
          dttanalysis(ldev);                                   <<03510>>08552000
          IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>               08556000
               IF DTT'CHANGES <> 0 THEN ADD'DTT'CHANGES(LDEV); <<00239>>08558000
               IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>> <<00239>>08560000
             END; << OF 7920 >>                                <<00239>>08562000
          END;  << not a cs'80 >>                              <<03510>>08564000
                                                               <<03510>>08566000
          DISCIO(LDEV,W,DTT,1D,128);  <<WRITE OUT DTT>>                 08568000
          IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>               08570000
     END <<INITDTT>>;                                                   08572000
                                                                        08576000
$PAGE "INIT COMMAND-INITDIR - SETS UP DIRECTORY ON MASTER VOL."<<03537>>08578000
     SUBROUTINE INITDIR;                                                08580000
     BEGIN                                                              08582000
          VSDIR:=0; MOVE VSDIR(1):=VSDIR,(BUFFSIZE-1);         <<RK1PV>>08584000
                                                                        08586000
      << 0 (3)  DIRECTORY BASE >>                                       08588000
                                                                        08590000
          VSDIR(1):=%2;  <<FIRSTAVAIL POINTER>>                         08592000
          TOS := 0;                                            <<DE>>   08596000
          TOS := VSDIRSIZE & DCSR(4);                          <<DE>>   08598000
          DIRCSIZE := TOS;                                     <<DE>>   08600000
          IF TOS <> 0 THEN DIRCSIZE:=DIRCSIZE+1;               <<DE>>   08602000
          D := 1;                                              <<DE>>   08604000
          WHILE (D:=D+1) < (DIRCSIZE+1) DO VSDIR(D):=%177777;  <<DE>>   08606000
          I := 0;                                              <<DE>>   08608000
          IF VSDIRSIZE.(12:4)<>0 THEN                          <<DE>>   08610000
             BEGIN                                             <<DE>>   08612000
             WHILE (I:=I+1) <= INTEGER(VSDIRSIZE.(12:4)) DO    <<DE>>   08614000
                BEGIN                                          <<DE>>   08616000
                VSDIR (D) := VSDIR (D) & LSR(1);               <<DE>>   08618000
                VSDIR (D).(0:1) := 1;                          <<DE>>   08620000
                END;                                           <<DE>>   08622000
             END                                               <<DE>>   08624000
             ELSE VSDIR(D) := %177777;                         <<DE>>   08626000
          VSDIR := DIRCSIZE + 1;                               <<DE>>   08628000
          <<REST OF THE FIRST THREE SECTORS IS ZERO>>                   08630000
                                                                        08632000
       << CALCULATE SYSACCTINDEX START >>                      <<DE>>   08634000
          TOS := 0;                                            <<DE>>   08636000
          TOS := VSDIRSIZE & DCSR(11);                         <<DE>>   08638000
          I := TOS;                                            <<DE>>   08640000
          IF TOS<>0 THEN I := I+1;                             <<DE>>   08642000
          IF I<3 THEN I:=3;   << Minimum 3 sector BITMAP >>    <<DE>>   08644000
          J := I+4; << NUMBER OF SECTORS TO ALLOC. >>          <<DE>>   08646000
          I := I & LSL(7);                                     <<DE>>   08648000
                                                               <<DE>>   08650000
       << CALCULATE FIRSTAVAIL & ALLOC. BITMAP >>              <<DE>>   08652000
          K := 2;                                              <<DE>>   08654000
          WHILE J>=16 DO                                       <<DE>>   08656000
             BEGIN                                             <<DE>>   08658000
                J := J-16;                                     <<DE>>   08660000
                VSDIR(1) := VSDIR(1)+1;                        <<DE>>   08662000
                VSDIR(K) := 0;                                 <<DE>>   08664000
                K := K + 1;                                    <<DE>>   08666000
             END;                                              <<DE>>   08668000
          WHILE J>0 DO                                         <<DE>>   08670000
             BEGIN                                             <<DE>>   08672000
                J := J - 1;                                    <<DE>>   08674000
                VSDIR(K) := VSDIR(K) & LSR(1)                  <<DE>>   08676000
             END;                                              <<DE>>   08678000
                                                               <<DE>>   08680000
          << INDEX BLOCK PREFIX >>                                      08682000
                                                                        08684000
          VSDIR(I     ):=%110143;  <<PREFIX(0) - ACCOUNT>>              08686000
          VSDIR(I:=I+1):=%000000;  <<PREFIX(1) -        >>              08688000
          VSDIR(I:=I+1):=%000000;  <<PREFIX(2) -        >>              08690000
          VSDIR(I:=I+1):=%000000;  <<PREFIX(3) -        >>              08692000
          VSDIR(I:=I+1):=%010743;  <<PREFIX(4) -        >>              08694000
          VSDIR(I:=I+1):=%000000;  <<PREFIX(5) -        >>              08696000
          K:=(I:=I+1) & LSL(1);                                         08698000
          VSDIRB(K):=" "; MOVE VSDIRB(K+1):=VSDIRB(K),(7);              08700000
          DISCIO(LDEV,W,VSDIR,DIRADR,BUFFSIZE);                <<01353>>08702000
          IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>               08704000
          VSDIR:=0; MOVE VSDIR(1):=VSDIR,(511);  <<4 SECTORS>>          08706000
          I:=VSDIRSIZE;                                                 08708000
          ADDR:=DIRADR;                                        <<01353>>08710000
          WHILE I > 0 DO                                                08712000
          BEGIN                                                         08714000
               ADDR:=ADDR+DOUBLE(BUFFSIZE');                   <<RK1PV>>08716000
               J:=IF (I:=I-BUFFSIZE') > BUFFSIZE'              <<RK1PV>>08718000
                  THEN BUFFSIZE ELSE (I & LSL(7));             <<RK1PV>>08720000
               DISCIO(LDEV,W,VSDIR,ADDR,J);                             08722000
               IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>          08724000
          END;                                                          08726000
     END <<INITDIR>>;                                                   08728000
                                                                        08730000
$PAGE "INIT COMMAND - UPDATEVTAB SUBROUTINE."                  <<03537>>08732000
     SUBROUTINE UPDATEVTAB;                                             08734000
     BEGIN                                                              08736000
          GETABENTRY(VTABDST,VTABINFO1.(8:8),BUFF);                     08738000
          MOVE BUFFB:=VNAME,(8),2;                                      08740000
          MOVE * := VSID(8),(16);  <<GROUP/ACCOUNT>>                    08742000
          BUFF(12).(14:2):=2;  <<MARK AS NON-SYSTEM DOMAIN>>   <<RK.09>>08744000
          BUFF(13):=0;                                                  08746000
           LPDT(LDEV&LSL(1)+1).SDLF:=0;<<CLEAR SERIAL BIT>>    <<RK.09>>08748000
     lpdt( ldev &lsl(1) + 1 ).fors:=0; << clear foreign >>     <<03510>>08750000
          PUTABENTRY(VTABDST,VTABINFO1.(8:8),BUFF);                     08752000
     END <<UPDATEVTAB>>;                                                08754000
                                                                        08756000
                                                                        08758000
$PAGE "INIT COMMAND - CHGVTAB SUBROUTINE."                     <<03537>>08760000
     SUBROUTINE chgvtab;                                       <<03510>>08762000
     BEGIN                                                              08764000
          A:=GETSIR(VTABSIR);                                           08766000
          I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX>>                     08768000
          IF (VTABINFO:=VTABINDEX(VNAME,VSID,LDEV,I)) = 0D THEN         08770000
          BEGIN                                                         08772000
               GENMSG(PVMSGSET,VIERR38,%10000,LDEV);           <<RK.05>>08774000
               RELSIR(VTABSIR,A);                                       08776000
               RETURN;                                                  08778000
          END;                                                          08780000
                                                               <<DE>>   08784000
          UPDATEVTAB;  <<PUT NEW LABEL INTO VTAB>>                      08786000
          RELSIR(VTABSIR,A);                                            08788000
          <<ADD LOG ENTRY TO INDICATE PRESENCE OF NEW VOLUME>>          08790000
          I:=2 CAT VTABINFO1(0:8:8);                                    08792000
          J:=SUBTYPE CAT LDEV(0:8:8);                                   08794000
          MOVE BUFF:=VLAB(LVNAMELOC'),(4),2;                            08796000
          MOVE *:=VLAB(LVSACCNTLOC'),(12);                              08798000
          LOG12(I,J,BUFF,16,PVPMOUNT);                                  08800000
   END;   << chgvtab >>                                        <<03510>>08802000
$PAGE "INIT COMMAND - MAIN PROCEDURE."                         <<03537>>08804000
     diradr:=0D;   << initialize  >>                           <<03510>>08806000
     IF KEYWDSPEC THEN  <<CHECK FOR VALID KEYWORD>>                     08808000
     IF KEYWORD <> "GEN" THEN                                           08810000
     BEGIN                                                              08812000
          GENMSG(PVMSGSET,VIERR3);                                      08814000
          RETURN;                                                       08816000
     END ELSE                                                           08818000
     IF KEYPARMSPEC THEN GEN:=KEYPARMVAL;                               08820000
     IF NOT VALIDVSID THEN                                              08822000
     BEGIN                                                              08824000
          GENMSG(PVMSGSET,VIERR4);                                      08826000
          RETURN;                                                       08828000
     END;                                                               08830000
     LDEV:=DEVPARM(2);                                                  08832000
          Get'Disc'Info(ldev,,,,type,subtype);                 <<03510>>08834000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN << DO IT >> ELSE     <<00239>>08836000
     << device must be "downed" to init a pv    >>             <<03510>>08838000
                                                               <<03510>>08840000
     IF DEVSTATUS(2).DOWNF = 0 THEN                                     08842000
     BEGIN                                                              08844000
          TOS:=SCRATCHVOL(LDEV);                                        08846000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         08848000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>08850000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>08852000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>08854000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>08856000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>08858000
          RETURN;                                              <<01615>>08860000
     END                                                       <<RK.08>>08862000
     ELSE IF NOT OVERWRITE(LDEV,1) THEN RETURN;                <<RK.08>>08864000
     GETVSDEFN(VSIDW,VSDEFN,,PVERR);                           <<RK.08>>08866000
     IF <> THEN                                                         08868000
     BEGIN                                                              08870000
          GENMSG(PVMSGSET,PVERR);                                       08872000
          RETURN;                                                       08874000
     END;                                                               08876000
     IF INVALIDVOL THEN                                                 08878000
     BEGIN                                                              08880000
          GENMSG(PVMSGSET,VIERR7);                             <<RK.08>>08882000
          RETURN;                                                       08884000
     END;                                                               08886000
     INITDTT;                                                           08888000
                                                               <<03510>>08890000
     << create a partial vol label- initdfsm will >>           <<03510>>08892000
     << complete it and write it out              >>           <<03510>>08894000
                                                               <<03510>>08896000
     VLAB:=0; MOVE VLAB(1):=VLAB,(127);                        <<03510>>08898000
     VLAB(disc'lab'gen'index):=GEN;  <<GENERATION INDEX>>      <<03510>>08900000
     VLAB(disc'lab'type'word).disc'lab'type:=type;             <<03510>>08902000
     VLAB(disc'lab'type'word).disc'lab'subtype:=subtype;       <<03510>>08904000
     MOVE VLABB(disc'lab'volume'name*2):=VNAME,(8);            <<03510>>08906000
     VLAB(disc'lab'init'date):=CALENDAR;                       <<03510>>08908000
     MOVE VLABB(disc'lab'accnt'name*2):=VSID(16),(8),2;        <<03510>>08910000
     MOVE * :=VSID(8),(8),2;  <<GROUP>>                        <<03510>>08912000
     MOVE * :=VSID,(8);  <<SET NAME>>                          <<03510>>08914000
     IF MASTERVOL THEN  <<ADD MASTER VOLUME INFO>>             <<03510>>08916000
     BEGIN                                                     <<03510>>08918000
        VLAB(disc'lab'type'word).disc'lab'mv:=1;               <<03510>>08920000
        MOVE VLAB(disc'lab'set):=VSDEFN,(VDSENTSIZE);          <<03510>>08922000
     END;                                                      <<03510>>08924000
     initd:=initdfsm(ldev,mastervol,                           <<03510>>08926000
                     vsdirsize,diradr,vlab);                   <<03510>>08928000
     IF NOT(initd) THEN check'error(initd);                    <<03510>>08930000
     chgvtab;                                                  <<03510>>08932000
     IF mastervol THEN initdir;                                <<03510>>08934000
END << INIT >>;                                                         08936000
$PAGE "PROCEDURE FORMAT"                                       <<03537>>08938000
                                                                        08940000
PROCEDURE FORMAT;                                                       08942000
OPTION PRIVILEGED,UNCALLABLE;                                           08944000
BEGIN                                                                   08946000
     INTEGER I,TRK,LDEV,VTABX,MAXLPS,TRKCYL,SUBTYPE,TRKSIZE,            08948000
             LPS,                                              <<RK1PV>>08950000
             TRKERRCNT:=0;                                              08952000
     INTEGER type;                                             <<03510>>08954000
     LOGICAL A,SECTRK,IOSTATUS;                                         08956000
     DOUBLE ADDR;                                                       08958000
     INTEGER                                                            08960000
          ADDR1 = ADDR,                                                 08962000
          ADDR2 = ADDR+1;                                               08964000
     DOUBLE VTABINFO;                                                   08966000
     INTEGER                                                            08968000
          VTABINFO1 = VTABINFO,                                         08970000
          VTBAINFO2 = VTABINFO+1;                                       08972000
     INTEGER Spares := 0;<< Indicates type of sparing wanted.>><<03537>>08974000
                      << 0 - Retain All, 1 - Retain Factory, >><<03537>>08976000
                      << 2 - Physical Format - HP7935 only.  >><<03537>>08978000
     LOGICAL         proc'status  << returned from procedures ><<03510>>08980000
                    ;                                          <<03510>>08982000
     << use this define to exit proc from subr >>              <<03510>>08984000
                                                               <<03510>>08986000
     DEFINE exit'procedure = ASSEMBLE(exit 0)#;                <<03510>>08988000
                                                               <<03510>>08990000
     LOGICAL HP := TRUE;   <<HP MEDIA>>                        <<04669>>08994000
                                                                        08996000
     SUBROUTINE leave(err);                                    <<03510>>08998000
        VALUE err;                                             <<03510>>09000000
        LOGICAL err;                                           <<03510>>09002000
                                                               <<03510>>09004000
     BEGIN                                                     <<03510>>09006000
$IF X3=ON                                                      <<03510>>09008000
          debug;                                               <<03510>>09010000
$IF                                                            <<03510>>09012000
          genmsg(pvmsgset,vierr34);                            <<03510>>09014000
          exit'procedure;                                      <<03510>>09016000
     END;                                                      <<03510>>09018000
     SUBROUTINE MAKESCRATCH;                                            09020000
     BEGIN                                                              09022000
          <<UPDATE VOLUME TABLE>>                                       09024000
          A:=GETSIR(VTABSIR);                                           09026000
          GETABENTRY(VTABDST,VTABX,BUFF);                               09028000
          MOVE BUFFB:="SCRATCH ",2;   <<VOLUME NAME >>                  09030000
          ASSEMBLE(DUP,DECA);                                           09032000
          MOVE * := *,(16);  <<BLANK REST OF VOLUME NAME>>              09034000
          BUFF(12).(14:2):=3;<<MARK AS NON-SYS DEVICE,SCRATCH>><<RK0PV>>09036000
          BUFF(13):=0;                                                  09038000
           LPDT(LDEV&LSL(1)+1).SDLF:=0;<<CLEAR SERIAL BIT>>    <<RK.09>>09040000
          PUTABENTRY(VTABDST,VTABX,BUFF);                               09042000
          RELSIR(VTABSIR,A);                                            09044000
          <<UPDATE VOLUME LABEL>>                                       09046000
          SETSCRATCH(LDEV,%3);                                          09048000
     IF < THEN exit'procedure;                                 <<03510>>09050000
     END <<MAKESCRATCH>>;                                               09052000
                                                                        09054000
     LDEV:=DEVPARM(1);                                                  09056000
     IF KEYWDSPEC THEN  <<Check for undocumented keywords    >><<03537>>09058000
     BEGIN                                                     <<03537>>09060000
        IF KEYWORD="PHYSICAL" THEN                             <<03537>>09062000
           Spares := Physical'Format                           <<03537>>09064000
                                                               <<03537>>09066000
        ELSE IF KEYWORD="PHYS" THEN                            <<03537>>09068000
           Spares := Physical'Format                           <<03537>>09070000
                                                               <<03537>>09072000
        ELSE IF KEYWORD="PRIMARY" THEN                         <<03537>>09074000
           Spares := Retain'Factory'Spares                     <<03537>>09076000
                                                               <<03537>>09078000
        <<Check if format IBM floppy>>                         <<04669>>09080000
        ELSE IF KEYWORD = "IBM" THEN                           <<04669>>09082000
           HP := FALSE  <<IBM FLOPPY>>                         <<04669>>09084000
                                                               <<04669>>09086000
        ELSE  <<WRONG KEYWORD>>                                <<04669>>09088000
INVKEY:                                                        <<04669>>09090000
           BEGIN                                               <<04669>>09092000
              GENMSG(PVMSGSET,VIERR3);                         <<04669>>09094000
              RETURN;                                          <<04669>>09096000
           END;                                                <<04669>>09098000
     END;                                                      <<04669>>09100000
                                                               <<04669>>09102000
     LINUS := IS'IT'LINUS(LDEV);                               <<04669>>09104000
     IF UNREADABLE'LABEL(LDEV,TRUE) THEN << DO IT >> ELSE      <<00239>>09108000
     IF DEVSTATUS(1).DOWNF = 0 THEN                                     09110000
     BEGIN                                                              09112000
          TOS:=SCRATCHVOL(LDEV);                                        09114000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         09116000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>09118000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>09120000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>09122000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>09124000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>09126000
          RETURN;                                              <<01615>>09128000
     END                                                       <<RK.08>>09130000
     ELSE IF NOT OVERWRITE(LDEV,2) THEN RETURN;                <<RK.08>>09132000
     IF NOT Linus THEN <<Linus doesn't have user accessable  >><<03537>>09134000
                       <<Spare Track Tables.                 >><<03537>>09136000
     BEGIN <<This jumps all DTT and Formatting code if Linus.>><<03537>>09138000
     Get'Disc'Info(ldev,,,,type,subtype);                      <<03537>>09140000
     proc'status:=Get'Disc'Info(ldev,,,,,,,,,,,,,,sectrk,lps,  <<03510>>09142000
                        maxlps,trkcyl);                        <<03510>>09144000
     IF NOT(proc'status) THEN leave(proc'status);              <<03510>>09146000
     trksize:=sectrk * sector'size; << in words >>             <<03510>>09148000
     DTT:=0; MOVE DTT(1):=DTT,(127); <<ZERO BUFFER>>           <<RK1PV>>09150000
     dtt(dtt'logical'pack'size):=lps;                          <<03510>>09154000
     dtt(dtt'next'alt'track):=lps * trkcyl;                    <<03510>>09156000
IF type=floppy'disc'type AND                                   <<03510>>09158000
   subtype=floppy'disc'subtype THEN                            <<03510>>09160000
   IF NOT HP THEN   <<IBM>>                                    <<04669>>09162000
      BEGIN                                                    <<04669>>09164000
      FORMAT'IBM'FLOPPY(LDEV);                                 <<04669>>09166000
      RETURN;                                                  <<04669>>09168000
      END                                                      <<04669>>09170000
   ELSE   <<HP DISKETTE>>                                      <<04669>>09172000
   BEGIN                                                       <<00239>>09174000
   FORMAT'A'FLOPPY(LDEV);                                      <<00239>>09176000
   IF < THEN RETURN;                                           <<00239>>09178000
   END                                                         <<00239>>09180000
ELSE IF NOT HP THEN GOTO INVKEY  <<FLOPPY ONLY>>               <<04669>>09182000
ELSE IF TYPE = MH'DISC'TYPE THEN                               <<03537>>09184000
   BEGIN  << HP7920 FAMILY >>                                  <<00239>>09186000
     FOR I:=(TRKSIZE-1) STEP -3 UNTIL -1 DO                    <<RK1PV>>09188000
     BEGIN                                                     <<RK1PV>>09190000
           BUFF(I-2)  :=%066666;                               <<RK1PV>>09192000
           BUFF(I-1):=%155555;                                 <<RK1PV>>09194000
           BUFF(I):=%133333;                                   <<RK1PV>>09196000
     END;                                                      <<RK1PV>>09198000
     BUFF(-3):=%10;<<SET SPARE>>                               <<RK2PV>>09200000
     BUFF(-2):=0;  <<CYL=0>>                                   <<RK2PV>>09202000
     BUFF(-1):=0;  <<HEAD/SECTOR=0>>                           <<RK2PV>>09204000
     TOS:=REQSTATUS(LDEV);                                     <<RK1PV>>09206000
     ASSEMBLE(DELB);                                           <<RK1PV>>09208000
     IF TOS.(9:2) <> 1 THEN                                    <<RK1PV>>09210000
        BEGIN                                                  <<RK1PV>>09212000
              GENMSG(PVMSGSET,VIERR33);                        <<RK1PV>>09214000
              GENMSG(PVMSGSET,VIERR0);                         <<RK1PV>>09216000
              RETURN;                                          <<RK1PV>>09218000
        END;                                                   <<RK1PV>>09220000
     FOR TRK:= 0 UNTIL ((MAXLPS*TRKCYL)-1) DO                           09222000
     BEGIN                                                              09224000
          ADDR:=LOGICAL(TRK)**SECTRK;                                   09226000
          IOSTATUS:=%2;  <<RETURN ERROR, NO ERROR MESSAGES>>            09228000
          DISCIO(LDEV,F,BUFF,ADDR,TRKSIZE,IOSTATUS);           <<RK1PV>>09230000
          IF IOSTATUS.QSTATUS <> 0 THEN                        <<RK1PV>>09232000
          BEGIN                                                <<RK1PV>>09234000
                TRKERRCNT:=TRKERRCNT+1;                        <<RK1PV>>09236000
                IF DTT<120 THEN DTT:=DTT+1;                    <<RK1PV>>09238000
                DTT(DTT):=TRK&LSL(2);                          <<RK1PV>>09240000
                IF TRK>=DTT(DTTALT) THEN DTT(DTT):=DTT(DTT)+1; <<RK1PV>>09242000
          END;                                                 <<RK1PV>>09244000
          IF TRK >= LPS*TRKCYL THEN                            <<RK2PV>>09246000
             BEGIN                                             <<00112>>09248000
             DISCIO(LDEV,IN,BUFF,ADDR,TRKSIZE);<<ABORT IF CCL>><<RK2PV>>09250000
             IF < THEN RETURN;                                 <<00112>>09252000
             END;                                              <<00112>>09254000
     END;                                                               09256000
   END  << MH disc formatting >>                               <<03537>>09258000
ELSE IF TYPE = CS'80'TYPE AND SUBTYPE > ST'9110 THEN           <<03537>>09260000
  BEGIN  << Request to format a 7935 >>                        <<03537>>09262000
  IOSTATUS := %(2)111;  << Print msg, return status >>         <<03537>>09264000
  IF DIAG'ENTRY THEN                                           <<03537>>09266000
    BEGIN  << Test for special keywords >>                     <<03537>>09268000
      Addr1 := Spares;                                         <<03537>>09270000
    END  << DIAG entry used >>                                 <<03537>>09272000
  ELSE                                                         <<03537>>09274000
    BEGIN  << Set sparing options >>                           <<03537>>09276000
      ADDR1 := RETAIN'ALL'SPARES;                              <<03537>>09278000
    END;                                                       <<03537>>09280000
  ADDR2 := DEFAULT'INTERLEAVE;                                 <<03537>>09282000
  Format'Msg(Addr1); << Tell user what we're doing           >><<03537>>09284000
  DISCIO(LDEV,F,BUFF,ADDR,0,IOSTATUS);                         <<03537>>09286000
  IOSTATUS := IOSTATUS LAND %377;  << Clear hi byte >>         <<03537>>09288000
  IF IOSTATUS <> SUCCESSFUL THEN RETURN;                       <<03537>>09290000
                                                               <<03537>>09292000
<< Disc is formatted at this point.  INIT handles DSCT >>      <<03537>>09294000
                                                               <<03537>>09296000
  END;  << 7935 formatting >>                                  <<03537>>09298000
                                                               <<03537>>09300000
     END                                                       <<03537>>09302000
     ELSE  <<We are(is?) a Linus.                            >><<03537>>09304000
     BEGIN                                                     <<03537>>09306000
        Format'A'Linus(Ldev,Spares,Default'Interleave);        <<03537>>09308000
                << The above function really Initializes It. >><<03537>>09310000
        IF < THEN RETURN;                                      <<03537>>09312000
     END;                                                      <<03537>>09314000
     I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX SEARCH>>                   09316000
     MOVE BUFFB:="  "; <<FORCE MISMATCH ON NAME>>              <<PV.BV>>09318000
     IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,LDEV,I)) = 0D THEN             09320000
     BEGIN                                                              09322000
          GENMSG(PVMSGSET,VIERR38,%10000,LDEV);                <<RK.05>>09324000
          RETURN;                                                       09326000
     END;                                                               09328000
     VTABX:=VTABINFO1.(8:8);  <<VTAB INDEX OF "TO" DEVICE>>             09330000
     MAKESCRATCH;  <<UPDATE VTAB AND VOLUME LABEL>>                     09332000
     IF Linus THEN RETURN; <<We're done !                    >><<03537>>09334000
     IF TRKERRCNT <> 0 THEN                                             09336000
     BEGIN                                                              09338000
          GENMSG(PVMSGSET,VIWARN3,%10000,TRKERRCNT);                    09340000
     END;                                                               09342000
IF type <> floppy'disc'type THEN                               <<03510>>09344000
   BEGIN                                                       <<00239>>09346000
     ADDENTRY((TRKCYL-1),(MAXLPS-1));                          <<RK3PV>>09348000
     dttanalysis(ldev);                                        <<03510>>09350000
     IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>           <<RK1PV>>09354000
     IF DTT'CHANGES <> 0 THEN ADD'DTT'CHANGES(LDEV);           <<00239>>09356000
     IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>           <<00239>>09358000
   END;                                                        <<00239>>09360000
     DISCIO(LDEV,W,DTT,1D,128);  <<WRITE OUT DTT>>             <<RK1PV>>09362000
     IF < THEN ASSEMBLE(EXIT 0);  <<DISC I/O ERROR>>           <<RK1PV>>09364000
END << FORMAT >>;                                                       09366000
                                                                        09368000
$PAGE "PROCEDURE SCRATCH"                                      <<03537>>09370000
$CONTROL SEGMENT=VINITCI                                       <<RK1PV>>09372000
PROCEDURE SCRATCH;                                                      09374000
OPTION PRIVILEGED,UNCALLABLE;                                           09376000
BEGIN                                                                   09378000
     INTEGER LDEV;                                                      09380000
     LOGICAL STATE:=1;  <<ASSUME SCRATCH>>                              09382000
     INTEGER     vtabrelsir                                    <<03510>>09384000
                ,vtabx                                         <<03510>>09386000
                ;                                              <<03510>>09388000
     ARRAY Vlab(*) = Buff;                                     <<03537>>09390000
     INTEGER Qmisc := 0;                                       <<03537>>09392000
     LOGICAL Dummy;                                            <<03537>>09394000
     INTEGER Dtype := 0;                                       <<03537>>09396000
                                                                        09398000
     IF KEYWDSPEC THEN  <<CHECK FOR VALID KEYWORD>>                     09400000
     IF KEYWORD="RESET" THEN STATE:=0 ELSE                              09402000
     BEGIN                                                              09404000
          GENMSG(PVMSGSET,VIERR3);                                      09406000
          RETURN;                                                       09408000
     END;                                                               09410000
     LDEV:=DEVPARM(1);                                                  09412000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01115>>09414000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN ELSE          <<00239>>09416000
     IF DEVSTATUS(1).DOWNF = 0 THEN                                     09418000
     BEGIN                                                              09420000
          TOS:=SCRATCHVOL(LDEV);                                        09422000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         09424000
          IF NOT TOS THEN                                               09426000
          BEGIN                                                         09428000
               GENMSG(PVMSGSET,VIERR5,%10000,LDEV);                     09430000
               GENMSG(PVMSGSET,VIERR0);                                 09432000
               RETURN;                                                  09434000
          END;                                                          09436000
     END                                                       <<RK.08>>09438000
     ELSE IF NOT OVERWRITE(LDEV,3) THEN RETURN;                <<RK.08>>09440000
     << set the vol table entry to scratch/reset >>            <<03510>>09442000
     vtabrelsir:=getsir(vtabsir);                              <<03510>>09444000
     << get the vtab index from ldt, use global >>             <<03510>>09446000
     << buffer buff                             >>             <<03510>>09448000
     Move'From'Data'Seg(ldtdst,ldev*5,5,buff);                 <<03510>>09450000
     vtabx:=buff(1).(0:8);                                     <<03510>>09452000
     << now get the vtab entry >>                              <<03510>>09454000
     getabentry(vtabdst,vtabx,buff);                           <<03510>>09456000
     << make vol label reflect state >>                        <<03510>>09458000
     buff(12).(15:1):=state;                                   <<03510>>09460000
     putabentry(vtabdst,vtabx,buff);                           <<03510>>09462000
     SETSCRATCH(LDEV,STATE);                                            09464000
     relsir(vtabsir,vtabrelsir);                               <<03537>>09466000
     IF State = 1 THEN                                         <<03537>>09468000
     BEGIN                                                     <<03537>>09470000
     LPDT(LDEV&LSL(1)+1).SDLF:=0;<<CLEAR SERIAL BIT>>          <<SD.00>>09472000
     LPDT(LDEV&LSL(1)+1).FORS:=0;                              <<01115>>09474000
     END                                                       <<03537>>09476000
     ELSE << State was 0 - Reseting some former volume       >><<03537>>09478000
     BEGIN                                                     <<03537>>09480000
                                                               <<03537>>09482000
<< The reason we are here is to reset the                    >><<03537>>09484000
<< bits in the LPDT to indicate what kind of                 >><<03537>>09486000
<< device is now mounted.                                    >><<03537>>09488000
                                                               <<03537>>09490000
        IF Is'It'Linus(Ldev) THEN                              <<03537>>09492000
        BEGIN                                                  <<03537>>09494000
           Linusio(Ldev,Qmisc,Vlab,R,Linus'Sector,             <<03537>>09496000
                   Disc'Label'Address,Blocked'IO,NO'SPARING,   <<03537>>09498000
                   Default'Errinfo,Dummy);                     <<03537>>09500000
        END                                                    <<03537>>09502000
        ELSE                                                   <<03537>>09504000
           Discio(Ldev,R,Vlab,0D,128);                         <<03537>>09506000
        IF < THEN RETURN;                                      <<03537>>09508000
        Dtype := Disctype(Ldev,Vlab);                          <<03537>>09510000
                                                               <<03537>>09512000
<< Although Disctype can return several different            >><<03537>>09514000
<< Disc Types, only 3 of them are interesting.               >><<03537>>09516000
<< Rather than writing a bunch of code that                  >><<03537>>09518000
<< never gets executed, I will document here.                >><<03537>>09520000
<< Return value 4 - is for Foreign Volume.                   >><<03537>>09522000
<< Return value 3 - is for Scratch Volume.                   >><<03537>>09524000
<< Return value 2 - is for Serial Discs.                     >><<03537>>09526000
<< Return value 1 - is for a PV.                             >><<03537>>09528000
<< Return value 0 - is for a System Disc.                    >><<03537>>09530000
                                                               <<03537>>09532000
<< P.S. Disctype is external,defined in Pvsys.               >><<03537>>09534000
                                                               <<03537>>09536000
<< Disctype will only work this way after the                >><<03537>>09538000
<< scratch bits are reset, otherwise you always              >><<03537>>09540000
<< get 3 back.                                               >><<03537>>09542000
                                                               <<03537>>09544000
<< The only case we are interested in here is                >><<03537>>09546000
<< 2 (Successfully Scratch;reset of a Serial                 >><<03537>>09548000
<< Disc.                                                     >><<03537>>09550000
<< Case 1 - Cannot be implemented because we                 >><<03537>>09552000
<<          are never able to set and clear bit              >><<03537>>09554000
<<          #4 in the second word of LPDT.                   >><<03537>>09556000
<<          (if we cleared the bit PVPROC never              >><<03537>>09558000
<<           gets woke up by DEVREC.)                        >><<03537>>09560000
<< Case 3 - Doesn't make sense to Scratch;Reset              >><<03537>>09562000
<<          a previously scratch volume.                     >><<03537>>09564000
<< Case 0 - Don't know what to do with this case.            >><<03537>>09566000
<< Case 4 - We never enter this code.                        >><<03537>>09568000
                                                               <<03537>>09570000
        IF Dtype = 2 THEN                                      <<03537>>09572000
        BEGIN                                                  <<03537>>09574000
           LPDT(LDEV&LSL(1)+1).SDLF:=1;<<Set Serial Bit      >><<03537>>09576000
           LPDT(LDEV&LSL(1)+1).FORS:=0;<<Clear Foreign Bit.  >><<03537>>09578000
        END                                                    <<03537>>09580000
        ELSE IF Dtype = 3 LOR Dtype = 4 THEN                   <<03537>>09582000
             BEGIN                                             <<03537>>09584000
                Genmsg(Pvmsgset,Viwarn94);                     <<03537>>09586000
             END;                                              <<03537>>09588000
     END                                                       <<03537>>09590000
END << SCRATCH >>;                                                      09592000
                                                                        09594000
$PAGE "   PROCEDURE CHECK'BAD'FILES"                           <<04670>>09596000
INTEGER PROCEDURE CHECK'BAD'FILES (LDEV,NAME'SW,FILE'DISP);    <<04670>>09598000
VALUE LDEV;                                                    <<04670>>09600000
INTEGER LDEV;                                                  <<04670>>09602000
ARRAY NAME'SW,FILE'DISP;                                       <<04670>>09604000
OPTION PRIVILEGED,UNCALLABLE,VARIABLE;                         <<04670>>09606000
                                                               <<04670>>09608000
<<This procedure checks what files have bad data using as   >> <<04670>>09610000
<<an input DTT'CHANGES table (ONLY PERMANENT FILES).        >> <<04670>>09612000
<<It scans directory and if any of DTT'CHANGES entry lies in>> <<04670>>09614000
<<in a file extent it is printed and also entered into      >> <<04670>>09616000
<<NAMESW table. The file dispositon (1-bad file labels or   >> <<04670>>09618000
<<2-file with bad extents) are saved in FILEDISP table. This>> <<04670>>09620000
<<tables can be used by such procedure like DTRACK. During  >> <<04670>>09622000
<<searching the directory and file integrity sirs are locked>> <<04670>>09624000
<<The value returns by procedure means as follow: 0-OK,     >> <<04670>>09626000
<<-1 - volume not mounted and others - error.               >> <<04670>>09628000
<<The DTT'CHANGES is also updated and it contains only      >> <<04670>>09630000
<<which does not belongs entirely to any permanent file.    >> <<04670>>09632000
<<Note. The DTT'CHANGES table has diffrent format for CS80  >> <<04670>>09634000
<<than for non-CS80 discs.                                  >> <<04670>>09636000
                                                               <<04670>>09638000
BEGIN                                                          <<04670>>09640000
INTEGER I,J,K,NUMENTRIES;                                      <<04670>>09642000
INTEGER MVTABX := 0,THISVOL := 0;                              <<04670>>09644000
ARRAY NAMESW (0:((MAXSECTTRK+2)*12+11));                       <<04670>>09646000
INTEGER ARRAY FILEDISP(0:(MAXSECTTRK+2));                      <<04670>>09648000
DOUBLE ARRAY TRACK'START (0:120);                              <<04670>>09650000
DOUBLE ARRAY TRACK'END (0:120);                                <<04670>>09652000
INTEGER ARRAY DIRPARMS (0:9);                                  <<04670>>09654000
ARRAY VOL'SET'LDEV (0:MAX'DISCS);                              <<04670>>09656000
ARRAY DUM(0:10);                                               <<04670>>09658000
DOUBLE ADDR;                                                   <<04670>>09660000
INTEGER ADDR1 = ADDR;                                          <<04670>>09662000
INTEGER ADDR2 = ADDR+1;                                        <<04670>>09664000
LOGICAL A,B,DEL'ENTRY;                                         <<04670>>09666000
LOGICAL PMAP = Q-4;                                            <<04670>>09668000
DEFINE NAME'SW'F = PMAP.(14:1)#;                               <<04670>>09670000
DEFINE FILE'DISP'F =PMAP.(15:1)#;                              <<04670>>09672000
                                                               <<04670>>09674000
CHECK'BAD'FILES := 0;                                          <<04670>>09676000
IF DTT'CHANGES = 0 THEN                                        <<04670>>09678000
   RETURN;                                                     <<04670>>09680000
                                                               <<04670>>09682000
IF CS'80 THEN                                                  <<04670>>09684000
   BEGIN                                                       <<04670>>09686000
   J := 0;                                                     <<04670>>09688000
   FOR I := 1 UNTIL DTT'CHANGES DO                             <<04670>>09690000
      BEGIN                                                    <<04670>>09692000
      ADDR1 := DTT'CHANGES (J:=J+1);                           <<04670>>09694000
      ADDR2 := DTT'CHANGES (J:=J+1);                           <<04670>>09696000
      TRACK'START (I) := ADDR;                                 <<04670>>09698000
      TRACK'END (I) := ADDR + DBL (DTT'CHANGES(J:=J+1)-1);     <<04670>>09700000
      END;                                                     <<04670>>09702000
   END                                                         <<04670>>09704000
ELSE  <<Non - CS80 discs>>                                     <<04670>>09706000
   FOR I:= 1 UNTIL DTT'CHANGES DO                              <<04670>>09708000
      BEGIN                                                    <<04670>>09710000
      TRACK'START(I) := DBL(DTT'CHANGES(I).DTCF)*DBL(SECTRK);  <<04670>>09712000
      TRACK'END(I) := TRACK'START(I)+DBL(SECTRK-1);            <<04670>>09714000
      END;                                                     <<04670>>09716000
                                                               <<04670>>09718000
IF NOT VOLUME'MOUNTED(LDEV,THISVOL,MVTABX,VOL'SET'LDEV) THEN   <<04670>>09720000
   BEGIN                                                       <<04670>>09722000
   CHECK'BAD'FILES := -1;                                      <<04670>>09724000
   RETURN;                                                     <<04670>>09726000
   END;                                                        <<04670>>09728000
                                                               <<04670>>09730000
A := GETSIR (FILESIR);                                         <<04670>>09732000
B := GETSIR (DIRSIR);                                          <<04670>>09734000
                                                               <<04670>>09736000
CHECK'DIR:                                                     <<04670>>09738000
                                                               <<04670>>09740000
NAMESW := "  ";                                                <<04670>>09742000
MOVE NAMESW(1) := NAMESW,((MAXSECTTRK+2)*12+11);               <<04670>>09744000
FILEDISP := 0;                                                 <<04670>>09746000
MOVE FILEDISP(1) := FILEDISP,(MAXSECTTRK);                     <<04670>>09748000
DIRPARMS    := 0;                                              <<04670>>09750000
DIRPARMS(1) := @VOL'SET'LDEV;                                  <<04670>>09752000
DIRPARMS(2) := THISVOL;           <<Volume index>>             <<04670>>09754000
DIRPARMS(3) := DTT'CHANGES;       <<# of entries>>             <<04670>>09756000
DIRPARMS(4) := @TRACK'START;                                   <<04670>>09758000
DIRPARMS(5) := @TRACK'END;                                     <<04670>>09760000
DIRPARMS(6) := @NAMESW;                                        <<04670>>09762000
DIRPARMS(7) := @FILEDISP;                                      <<04670>>09764000
DIRPARMS(8) := 0;                                              <<04670>>09766000
                                                               <<04670>>09768000
DIRECSCAN (%120,0D,DUM,DUM,DUM,DTRACK'RECIP,DIRPARMS,MVTABX);  <<04670>>09770000
IF <> THEN                                                     <<04670>>09772000
   BEGIN                                                       <<04670>>09774000
   CHECK'BAD'FILES := DIRECERR;                                <<04670>>09776000
   GOTO ERROR;                                                 <<04670>>09778000
   END;                                                        <<04670>>09780000
                                                               <<04670>>09782000
NUMENTRIES := DIRPARMS(3);                                     <<04670>>09784000
IF FILE'DISP >= MAXSECTTRK THEN                                <<04670>>09786000
   IF NUMENTRIES <> 0 THEN                                     <<04670>>09788000
      IF NOT NAME'SW'F THEN                                    <<04670>>09790000
         GOTO CHECK'DIR      <<NAMESW table was full>>         <<04670>>09792000
      ELSE                                                     <<04670>>09794000
         BEGIN  <<Remove used entries from DTT'CHANGES>>       <<04670>>09796000
         J := 0;                                               <<04670>>09798000
         FOR I := 1 UNTIL DTT'CHANGES DO                       <<04670>>09800000
            BEGIN                                              <<04670>>09802000
            DEL'ENTRY := TRUE;                                 <<04670>>09804000
            IF CS'80 THEN                                      <<04670>>09806000
               BEGIN                                           <<04670>>09808000
               ADDR1 := DTT'CHANGES (J:=J+1);                  <<04670>>09810000
               ADDR2 := DTT'CHANGES (J:=J+1);                  <<04670>>09812000
               J := J+1;   <<Skip size>>                       <<04670>>09814000
               END                                             <<04670>>09816000
            ELSE                                               <<04670>>09818000
               ADDR := DBL(DTT'CHANGES(I).DTCF)*DBL(SECTRK);   <<04670>>09820000
            FOR K := 1 UNTIL NUMENTRIES DO                     <<04670>>09822000
               IF ADDR = TRACK'START(K) THEN                   <<04670>>09824000
                  BEGIN                                        <<04670>>09826000
                  DEL'ENTRY := FALSE;                          <<04670>>09828000
                  K := NUMENTRIES;                             <<04670>>09830000
                  END;                                         <<04670>>09832000
            IF DEL'ENTRY THEN                                  <<04670>>09834000
               IF I <> DTT'CHANGES THEN                        <<04670>>09836000
                  BEGIN                                        <<04670>>09838000
                  IF CS'80 THEN                                <<04670>>09840000
                     MOVE DTT'CHANGES(J:=J-3) :=               <<04670>>09842000
                          DTT'CHANGES(J+3),(DTT'CHANGES*3-J)   <<04670>>09844000
                  ELSE                                         <<04670>>09846000
                     MOVE DTT'CHANGES(I) :=                    <<04670>>09848000
                          DTT'CHANGES(I+1),(DTT'CHANGES-1);    <<04670>>09850000
                  I := I-1;                                    <<04670>>09852000
                  DTT'CHANGES := DTT'CHANGES-1;                <<04670>>09854000
                  END;                                         <<04670>>09856000
            END;                                               <<04670>>09858000
         END                                                   <<04670>>09860000
   ELSE                                                        <<04670>>09862000
      DTT'CHANGES := 0                                         <<04670>>09864000
ELSE                                                           <<04670>>09866000
   DTT'CHANGES := 0;                                           <<04670>>09868000
                                                               <<04670>>09870000
XIT :                                                          <<04670>>09872000
IF NAME'SW'F THEN                                              <<04670>>09874000
   MOVE NAME'SW := NAMESW,(FILEDISP*12);                       <<04670>>09876000
IF FILE'DISP'F THEN                                            <<04670>>09878000
   MOVE FILE'DISP := FILEDISP,(FILEDISP+1);                    <<04670>>09880000
ERROR:                                                         <<04670>>09882000
RELSIR (DIRSIR,B);                                             <<04670>>09884000
RELSIR (FILESIR,A);                                            <<04670>>09886000
END;                                                           <<04670>>09888000
$PAGE "   COPY FUNCTION   -   SORT'ENTRIES PROCEDURE"          <<04670>>09890000
PROCEDURE SORT'ENTRIES;                                        <<04670>>09892000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>09894000
                                                               <<04670>>09896000
<<This procedure sorts DTT/DSCT entries.                    >> <<04670>>09898000
                                                               <<04670>>09900000
BEGIN                                                          <<04670>>09902000
INTEGER I,J,SECOND'EL,LAST'EL;                                 <<04670>>09904000
DOUBLE TEMP;                                                   <<04670>>09906000
INTEGER TEMP1 = TEMP;                                          <<04670>>09908000
                                                               <<04670>>09910000
IF DTT <= 1 THEN                                               <<04670>>09912000
   RETURN;                                                     <<04670>>09914000
                                                               <<04670>>09916000
IF CS'80 OR FORVOL THEN                                        <<04670>>09918000
   BEGIN                                                       <<04670>>09920000
   SECOND'EL := DTT(DSCT'FIRST'ENTRY)/DTT(DSCT'ENTRY'SIZE)+1;  <<04670>>09922000
   LAST'EL := SECOND'EL+DTT(DSCT'NUMBER'OF'ENTRIES)-2;         <<04670>>09924000
   I := (LAST'EL+1) * DTT(DSCT'ENTRY'SIZE);                    <<04670>>09926000
   FOR I := LAST'EL STEP -1 UNTIL SECOND'EL DO                 <<04670>>09928000
      FOR J := SECOND'EL UNTIL I DO                            <<04670>>09930000
         BEGIN                                                 <<04670>>09932000
         IF DTTD(J) < DTTD(J-1) THEN                           <<04670>>09934000
            BEGIN                                              <<04670>>09936000
            TEMP := DTTD(J);                                   <<04670>>09938000
            DTTD(J) := DTTD(J-1);                              <<04670>>09940000
            DTTD(J-1) := TEMP;                                 <<04670>>09942000
            END;                                               <<04670>>09944000
         END;                                                  <<04670>>09946000
   END                                                         <<04670>>09948000
ELSE <<NON CS80 DEVICES>>                                      <<04670>>09950000
   BEGIN                                                       <<04670>>09952000
   SECOND'EL := 2;                                             <<04670>>09954000
   LAST'EL := DTT;                                             <<04670>>09956000
   FOR I := LAST'EL STEP -1 UNTIL SECOND'EL DO                 <<04670>>09958000
      FOR J := SECOND'EL UNTIL I DO                            <<04670>>09960000
         BEGIN                                                 <<04670>>09962000
         IF DTT(J) < DTT(J-1) THEN                             <<04670>>09964000
            BEGIN                                              <<04670>>09966000
            TEMP1 := DTT(J);                                   <<04670>>09968000
            DTT(J) := DTT(J-1);                                <<04670>>09970000
            DTT(J-1) := TEMP1;                                 <<04670>>09972000
            END;                                               <<04670>>09974000
         END;                                                  <<04670>>09976000
   END;                                                        <<04670>>09978000
END;                                                           <<04670>>09980000
$PAGE "   COPY FUNCTION    -   PROCEDURE REMOVE'ENTRY"         <<04670>>09982000
PROCEDURE REMOVE'ENTRY (ADDR,TRACK);                           <<04670>>09984000
VALUE ADDR,TRACK;                                              <<04670>>09986000
LOGICAL TRACK;                                                 <<04670>>09988000
DOUBLE ADDR;                                                   <<04670>>09990000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>09992000
                                                               <<04670>>09994000
<<This procedure removes single entry or if TRACK is true   >> <<04670>>09996000
<<then it removes all entries which belong to the same track>> <<04670>>09998000
                                                               <<04670>>10000000
BEGIN                                                          <<04670>>10002000
INTEGER I;                                                     <<04670>>10004000
LOGICAL SUSPECT;   <<True if suspect/deleted sector/track>>    <<04670>>10006000
DOUBLE ADDRX,ADDRS;                                            <<04670>>10008000
                                                               <<04670>>10010000
IF DTT = 0 THEN                                                <<04670>>10012000
   RETURN;                                                     <<04670>>10014000
IF TRACK THEN                                                  <<04670>>10016000
   ADDR := ADDR - DBL(ADDR MODD LOGICAL(SECTRK));              <<04670>>10018000
                                                               <<04670>>10020000
FOR I := 1 UNTIL DTT DO                                        <<04670>>10022000
   BEGIN                                                       <<04670>>10024000
   IF CS'80 OR FORVOL THEN                                     <<04670>>10026000
      BEGIN                                                    <<04670>>10028000
      ADDRX := DTTD(DTT(DSCT'FIRST'ENTRY'INDEX)/               <<04670>>10030000
                    DTT(DSCT'ENTRY'SIZE) + I - 1);             <<04670>>10032000
      ADDRS := ADDRX - DBL(ADDRX MODD LOGICAL(SECTRK));        <<04670>>10034000
      SUSPECT := TRUE;                                         <<04670>>10036000
      END                                                      <<04670>>10038000
   ELSE                                                        <<04670>>10040000
      BEGIN                                                    <<04670>>10042000
      ADDRX := ADDRS := DBL(DTT(I).TRKF * SECTRK);             <<04670>>10044000
      SUSPECT := IF DTT(I).DTCF <> 3 THEN TRUE ELSE FALSE;     <<04670>>10046000
      END;                                                     <<04670>>10048000
                                                               <<04670>>10050000
   IF TRACK AND (ADDR = ADDRS) AND SUSPECT OR                  <<04670>>10052000
      NOT TRACK AND (ADDR = ADDRX) AND SUSPECT THEN            <<04670>>10054000
      BEGIN                                                    <<04670>>10056000
      IF I <> DTT THEN                                         <<04670>>10058000
         IF CS'80 OR FORVOL THEN                               <<04670>>10060000
            MOVE                                               <<04670>>10062000
            DTT(DTT(DSCT'FIRST'ENTRY'INDEX) + (I-1)*2) :=      <<04670>>10064000
            DTT(DTT(DSCT'FIRST'ENTRY'INDEX) + (I)*2),          <<04670>>10066000
            (DTT'SIZE-I*2)                                     <<04670>>10068000
         ELSE                                                  <<04670>>10070000
            MOVE DTT(I) := DTT(I+1),(DTT'SIZE-2-I)             <<04670>>10072000
      ELSE                                                     <<04670>>10074000
         IF CS'80 OR FORVOL THEN                               <<04670>>10076000
            DTTD(DTT(DSCT'FIRST'ENTRY'INDEX)/                  <<04670>>10078000
                 DTT(DSCT'ENTRY'SIZE) + I - 1) := 0D           <<04670>>10080000
         ELSE                                                  <<04670>>10082000
            DTT(I) := 0;                                       <<04670>>10084000
      DTT := DTT - 1;                                          <<04670>>10086000
      END;                                                     <<04670>>10088000
   END;                                                        <<04670>>10090000
END;                                                           <<04670>>10092000
$PAGE "   COPY FUNCTION   -   PROCEDURE GET'ENTRY"             <<04670>>10094000
LOGICAL PROCEDURE GET'ENTRY (ADDR,SIZE);                       <<04670>>10096000
DOUBLE ADDR,SIZE;                                              <<04670>>10098000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10100000
                                                               <<04670>>10102000
<<This procedure extracts entry from the DTT/DSCT.          >> <<04670>>10104000
                                                               <<04670>>10106000
BEGIN                                                          <<04670>>10108000
INTEGER I;                                                     <<04670>>10110000
DEFINE SECTOR = FALSE#;                                        <<04670>>10112000
IF DTT = 0 THEN                                                <<04670>>10114000
   BEGIN                                                       <<04670>>10116000
   GET'ENTRY := FALSE;                                         <<04670>>10118000
   RETURN;                                                     <<04670>>10120000
   END;                                                        <<04670>>10122000
                                                               <<04670>>10124000
GET'ENTRY := TRUE;                                             <<04670>>10126000
IF CS'80 OR FORVOL THEN                                        <<04670>>10128000
   BEGIN                                                       <<04670>>10130000
   ADDR := DTTD (DTT(DSCT'FIRST'ENTRY'INDEX)/                  <<04670>>10132000
                 DTT(DSCT'ENTRY'SIZE));                        <<04670>>10134000
   SIZE := 1D;                                                 <<04670>>10136000
   END                                                         <<04670>>10138000
ELSE                                                           <<04670>>10140000
   BEGIN                                                       <<04670>>10142000
   ADDR := 0D;                                                 <<04670>>10144000
   FOR I := 1 UNTIL DTT DO                                     <<04670>>10146000
      IF DTT(I).DTCF <> 3 THEN                                 <<04670>>10148000
         BEGIN                                                 <<04670>>10150000
         ADDR := DBL (DTT(I).TRKF * SECTRK);                   <<04670>>10152000
         SIZE := DBL (SECTRK);                                 <<04670>>10154000
         I := DTT;                                             <<04670>>10156000
         END;                                                  <<04670>>10158000
   IF ADDR = 0D THEN                                           <<04670>>10160000
      BEGIN                                                    <<04670>>10162000
      GET'ENTRY := FALSE;                                      <<04670>>10164000
      RETURN;                                                  <<04670>>10166000
      END;                                                     <<04670>>10168000
   END;                                                        <<04670>>10170000
REMOVE'ENTRY(ADDR,SECTOR);                                     <<04670>>10172000
END;                                                           <<04670>>10174000
                                                               <<04670>>10176000
                                                               <<04670>>10178000
$PAGE "   COPY FUNCTION   -   PROCEDURE BUILD'DSCT"            <<04670>>10180000
PROCEDURE BUILD'DSCT;                                          <<04670>>10182000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10184000
                                                               <<04670>>10186000
<<This procedure bulids Defective Sector Table in memory.   >> <<04670>>10188000
                                                               <<04670>>10190000
BEGIN                                                          <<04670>>10192000
DTT := 0;                                                      <<04670>>10194000
MOVE DTT(1) := DTT,(DTT'SIZE-1);                               <<04670>>10196000
DTT(DSCT'FIRST'ENTRY'INDEX) := DSCT'OFFSET'TO'FIRST'ENTRY;     <<04670>>10198000
DTT(DSCT'ENTRY'SIZE) := DSCT'SIZE'OF'ENTRY;                    <<04670>>10200000
DTT(DSCT'MAX'NUMBER'OF'ENTRIES) := DSCT'MAX'ENTRIES;           <<04670>>10202000
END;                                                           <<04670>>10204000
                                                               <<04670>>10206000
$PAGE "   COPY FUNCTION - PROCEDURE CREATE'AND'LOCK'DFS'DST"   <<04670>>10208000
LOGICAL PROCEDURE CREATE'AND'LOCK'DFS'DST (LDEV);              <<04670>>10210000
VALUE LDEV;                                                    <<04670>>10212000
INTEGER LDEV;                                                  <<04670>>10214000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10216000
                                                               <<04670>>10218000
<<This procedure creates and locks disc free space data     >> <<04670>>10220000
<<segment. If device is downed (copy function required) the >> <<04670>>10222000
<<DFS segment does not exist. The DOWN command releases     >> <<04670>>10224000
<<DFS DST.                                                  >> <<04670>>10226000
                                                               <<04670>>10228000
BEGIN                                                          <<04670>>10230000
ARRAY LDT(0:LDT'ENTRY'SIZE-1);                                 <<04670>>10232000
DEFINE AVAIL = 3).(2:1#;                                       <<04670>>10234000
MOVE'FROM'DATA'SEG (LDT'DST,LDEV*LDT'ENTRY'SIZE,               <<04670>>10236000
                    LDT'ENTRY'SIZE,LDT);                       <<04670>>10238000
DOWNDEV := IF LDT(AVAIL) THEN                                  <<04670>>10240000
              FALSE                                            <<04670>>10242000
           ELSE                                                <<04670>>10244000
              TRUE;                                            <<04670>>10246000
IF DOWNDEV AND                                                 <<04670>>10248000
   CREATE'DFS'DATA'SEG(LDEV,,,IF SYS THEN TRUE ELSE FALSE) AND <<04670>>10250000
   LOCK'DFS'DATA'SEG (LDEV) OR                                 <<04670>>10252000
   LOCK'DFS'DATA'SEG (LDEV) THEN                               <<04670>>10254000
   CREATE'AND'LOCK'DFS'DST := TRUE                             <<04670>>10256000
ELSE                                                           <<04670>>10258000
   CREATE'AND'LOCK'DFS'DST := FALSE;                           <<04670>>10260000
END;                                                           <<04670>>10262000
$PAGE "   COPY FUNCTION - PROCEDURE UNLOCK'AND'DELETE'DFS'DST" <<04670>>10264000
PROCEDURE UNLOCK'AND'DELETE'DFS'DST (LDEV);                    <<04670>>10266000
VALUE LDEV;                                                    <<04670>>10268000
INTEGER LDEV;                                                  <<04670>>10270000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10272000
                                                               <<04670>>10274000
<<This procedure unlocks and removes disc free space data   >> <<04670>>10276000
<<segment.                                                  >> <<04670>>10278000
                                                               <<04670>>10280000
BEGIN                                                          <<04670>>10282000
UNLOCK'DFS'DATA'SEG;                                           <<04670>>10284000
IF DOWNDEV THEN                                                <<04670>>10286000
   BEGIN                                                       <<04670>>10288000
   DEALLOCATE'DFS'DATA'SEG (LDEV);                             <<04670>>10290000
   DELETE'DFS'DATA'SEG (LDEV);                                 <<04670>>10292000
   END;                                                        <<04670>>10294000
END;                                                           <<04670>>10296000
$PAGE "   COPY FUNCTION   -   PROCEDURE REASSIGN'TRACK"        <<04670>>10298000
LOGICAL PROCEDURE REASSIGN'TRACK (LDEV,ADDR);                  <<04670>>10300000
VALUE LDEV,ADDR;                                               <<04670>>10302000
INTEGER LDEV;                                                  <<04670>>10304000
DOUBLE ADDR;                                                   <<04670>>10306000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10308000
                                                               <<04670>>10310000
<<This procedure reassigns track for NON CS80 discs.         >><<04670>>10312000
<<TRK represents entry from the DTT (track address +         >><<04670>>10314000
<<disposition field). Before the track is reassigned it tries>><<04670>>10316000
<<to recover (read) suspect sector. If track is reassigned   >><<04670>>10318000
<<that its entry is inputed into destination DTT. The deleted>><<04670>>10320000
<<tracks, if any, are reassigned because read will fail.     >><<04670>>10322000
                                                               <<04670>>10324000
BEGIN                                                          <<04670>>10326000
INTEGER ALT,IOSTATUS,TRACK;                                    <<04670>>10328000
DOUBLE DISC'ADDR;                                              <<04670>>10330000
ARRAY DTT'TEMP (0:DTT'SIZE);                                   <<04670>>10332000
DEFINE DTRK=4#;   <<Defective track>>                          <<04670>>10334000
DEFINE SECTOR=0#;                                              <<04670>>10336000
                                                               <<04670>>10338000
REASSIGN'TRACK := TRUE;                                        <<04670>>10340000
                                                               <<04670>>10342000
<<Reassign track>>                                             <<04670>>10344000
                                                               <<04670>>10346000
ALT := DTT(DTTALT);                                            <<04670>>10348000
IF ALT >= (MAXLPS * TRKCYL) THEN                               <<04670>>10350000
   BEGIN                                                       <<04670>>10352000
   REASSIGN'TRACK := FALSE;                                    <<04670>>10354000
   RETURN;                                                     <<04670>>10356000
   END;                                                        <<04670>>10358000
TRACK := INT(ADDR/DBL(SECTRK));                                <<04670>>10360000
                                                               <<04670>>10362000
<<Enter reassigned track addr. into destination disc DTT>>     <<04670>>10364000
                                                               <<04670>>10366000
MOVE DTT'TEMP := DTT,(DTT+1);  <<Save original DTT>>           <<04670>>10368000
IOSTATUS := 1;                                                 <<04670>>10370000
DISCIO (LDEV,R,DTT,1D,DTT'SIZE,IOSTATUS);                      <<04670>>10372000
IF <> THEN                                                     <<04670>>10374000
   GOTO ERR;                                                   <<04670>>10376000
REMOVE'ENTRY (ADDR,SECTOR);                                    <<04670>>10378000
IOSTATUS := 2;                                                 <<04670>>10380000
DISCIO (LDEV,R,BUFF,ADDR,SECTRK*SECSIZE,IOSTATUS);             <<04670>>10382000
IF <> THEN                                                     <<04670>>10384000
   BEGIN                                                       <<04670>>10386000
   ADDDTTENTRY (TRACK&LSL(2) + 3);                             <<04670>>10388000
   IF < THEN                                                   <<04670>>10390000
      BEGIN                                                    <<04670>>10392000
      GENMSG(PVMSGSET,VIERR37);                                <<04670>>10394000
      GOTO ERR;                                                <<04670>>10396000
      END                                                      <<04670>>10398000
   ELSE                                                        <<04670>>10400000
      BEGIN                                                    <<04670>>10402000
      FLAGTRACK (LDEV,TRACK,ALT);                              <<04670>>10404000
      IF <> THEN                                               <<04670>>10406000
         GOTO ERR;                                             <<04670>>10408000
      END;                                                     <<04670>>10410000
   END;                                                        <<04670>>10412000
IOSTATUS := 1;                                                 <<04670>>10414000
DISCIO (LDEV,W,DTT,1D,DTT'SIZE,IOSTATUS);                      <<04670>>10416000
IF <> THEN                                                     <<04670>>10418000
   BEGIN                                                       <<04670>>10420000
   TRACKINIT (LDEV,ADDR,-1D,SECTRK*SECSIZE,DTRK);              <<04670>>10422000
ERR:                                                           <<04670>>10424000
   MOVE DTT := DTT'TEMP,(DTT'TEMP+1);                          <<04670>>10426000
   REASSIGN'TRACK := FALSE;                                    <<04670>>10428000
   RETURN;                                                     <<04670>>10430000
   END;                                                        <<04670>>10432000
                                                               <<04670>>10434000
MOVE DTT := DTT'TEMP,(DTT'TEMP+1);                             <<04670>>10436000
                                                               <<04670>>10438000
<<Check reassigned track>>                                     <<04670>>10440000
IOSTATUS := 2;                                                 <<04670>>10442000
DISCIO (LDEV,R,BUFF,ADDR,SECTRK*SECSIZE,IOSTATUS);             <<04670>>10444000
IF <> THEN                                                     <<04670>>10446000
   REASSIGN'TRACK := REASSIGN'TRACK (LDEV,ADDR);               <<04670>>10448000
                                                               <<04670>>10450000
END;                                                           <<04670>>10452000
$PAGE "   COPY FUNCTION   -   PROCEDURE SPARE'SECTOR"          <<04670>>10454000
LOGICAL PROCEDURE SPARE'SECTOR (LDEV,ADDR);                    <<04670>>10456000
VALUE LDEV,ADDR;                                               <<04670>>10458000
INTEGER LDEV;                                                  <<04670>>10460000
DOUBLE ADDR;                                                   <<04670>>10462000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10464000
                                                               <<04670>>10466000
<<This procedure spare suspect sector (if it cannot recover)>> <<04670>>10468000
<<and remove entry from the DSCT.                           >> <<04670>>10470000
                                                               <<04670>>10472000
BEGIN                                                          <<04670>>10474000
INTEGER IOSTATUS;                                              <<04670>>10476000
ARRAY DTT'TEMP (0:DTT'SIZE);                                   <<04670>>10478000
LOGICAL SPARE;                                                 <<04670>>10480000
DEFINE SECTOR = 0#;                                            <<04670>>10482000
                                                               <<04670>>10484000
SPARE := SPARE'SECTOR := TRUE;                                 <<04670>>10486000
                                                               <<04670>>10488000
<<Check if sector is recoverable - test full track>>           <<04670>>10490000
                                                               <<04670>>10492000
IOSTATUS := 2;                                                 <<04670>>10494000
DISCIO (LDEV,INIT'UTIL,ADDR,RW'ERT,1,IOSTATUS);                <<04670>>10496000
IF <> THEN                                                     <<04670>>10498000
   BEGIN                                                       <<04670>>10500000
                                                               <<04670>>10502000
<<Spare sector>>                                               <<04670>>10504000
                                                               <<04670>>10506000
   IOSTATUS := 1;                                              <<04670>>10508000
   DISCIO (LDEV,SPARE'BLOCK,ADDR,NO'RETAIN'DATA,0,IOSTATUS);   <<04670>>10510000
   IF <> THEN                                                  <<04670>>10512000
      BEGIN                                                    <<04670>>10514000
      SPARE'SECTOR := FALSE;                                   <<04670>>10516000
      RETURN;                                                  <<04670>>10518000
      END;                                                     <<04670>>10520000
                                                               <<04670>>10522000
   <<Check spared sector>>                                     <<04670>>10524000
                                                               <<04670>>10526000
   SPARE := SPARE'SECTOR := SPARE'SECTOR (LDEV,ADDR);          <<04670>>10528000
   END;                                                        <<04670>>10530000
                                                               <<04670>>10532000
<<Remove entry from DSCT>>                                     <<04670>>10534000
                                                               <<04670>>10536000
IF NOT FORVOL AND SPARE THEN                                   <<04670>>10538000
   BEGIN                                                       <<04670>>10540000
   MOVE DTT'TEMP := DTT,(DTT'SIZE);  <<Save>>                  <<04670>>10542000
   IOSTATUS := 1;                                              <<04670>>10544000
   DISCIO (LDEV,R,DTT,1D,DTT'SIZE,IOSTATUS);                   <<04670>>10546000
   IF = THEN                                                   <<04670>>10548000
      BEGIN                                                    <<04670>>10550000
      REMOVE'ENTRY (ADDR,SECTOR);                              <<04670>>10552000
      IOSTATUS := 1;                                           <<04670>>10554000
      DISCIO (LDEV,W,DTT,1D,DTT'SIZE,IOSTATUS)                 <<04670>>10556000
      END;                                                     <<04670>>10558000
   MOVE DTT := DTT'TEMP,(DTT'SIZE);  <<Restore>>               <<04670>>10560000
   END;                                                        <<04670>>10562000
END;                                                           <<04670>>10564000
                                                               <<04670>>10566000
$PAGE "   COPY FUNCTION   -   PROCEDURE RECOVER'SPACE"         <<04670>>10568000
LOGICAL PROCEDURE RECOVER'SPACE (LDEV,ADDR);                   <<04670>>10570000
VALUE LDEV,ADDR;                                               <<04670>>10572000
INTEGER LDEV;                                                  <<04670>>10574000
DOUBLE ADDR;                                                   <<04670>>10576000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10578000
                                                               <<04670>>10580000
<<This procedure reassign track for non CS80 discs or spares>> <<04670>>10582000
<<sector (CS80 discs).                                      >> <<04670>>10584000
                                                               <<04670>>10586000
BEGIN                                                          <<04670>>10588000
IF CS'80 THEN                                                  <<04670>>10590000
   RECOVER'SPACE := SPARE'SECTOR (LDEV,ADDR)                   <<04670>>10592000
ELSE                                                           <<04670>>10594000
   RECOVER'SPACE := IF FLOPPY OR FORVOL THEN                   <<04670>>10596000
                       FALSE                                   <<04670>>10598000
                    ELSE                                       <<04670>>10600000
                       REASSIGN'TRACK(LDEV,ADDR);              <<04670>>10602000
END;                                                           <<04670>>10604000
$PAGE "   COPY FUNCTION   -   PROCEDURE ADD'DTT'ENTRY"         <<04670>>10606000
PROCEDURE ADD'DTT'ENTRY (FDEV,TDEV,ADDR);                      <<04670>>10608000
VALUE FDEV,TDEV,ADDR;                                          <<04670>>10610000
INTEGER FDEV,TDEV;                                             <<04670>>10612000
DOUBLE ADDR;                                                   <<04670>>10614000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10616000
                                                               <<04670>>10618000
<<This procedure enters suspect sector/track into DTT/DSCT. >> <<04670>>10620000
                                                               <<04670>>10622000
BEGIN                                                          <<04670>>10624000
INTEGER FIRST'ENTRY,INDEX:=0,TRACK,IOSTAT:=1;                  <<04670>>10626000
INTEGER ARRAY DTTF(0:DTT'SIZE-1);                              <<04670>>10628000
                                                               <<04670>>10630000
IF CS'80 OR FORVOL THEN                                        <<04670>>10632000
                                                               <<04670>>10634000
<<Update DSCT - CS80 devices only>>                            <<04670>>10636000
                                                               <<04670>>10638000
   BEGIN                                                       <<04670>>10640000
   FIRST'ENTRY := DTT(DSCT'FIRST'ENTRY'INDEX)/                 <<04670>>10642000
                  DTT(DSCT'SIZE'OF'ENTRY);                     <<04670>>10644000
   FOR INDEX := FIRST'ENTRY UNTIL FIRST'ENTRY+DTT-1 DO         <<04670>>10646000
      IF ADDR = DTTD(INDEX) THEN                               <<04670>>10648000
         RETURN;                                               <<04670>>10650000
   IF DTT >= DTT (DSCT'MAX'NUMBER'OF'ENTRIES) THEN             <<04670>>10652000
      BEGIN                                                    <<04670>>10654000
      GENMSG(PVMSGSET,VIERR37);                                <<04670>>10656000
      RETURN;                                                  <<04670>>10658000
      END;                                                     <<04670>>10660000
   DTT := DTT + 1;                                             <<04670>>10662000
   DTTD (INDEX) := ADDR;                                       <<04670>>10664000
   END                                                         <<04670>>10666000
ELSE                                                           <<04670>>10668000
                                                               <<04670>>10670000
<<Update DTT - NON CS80 devices>>                              <<04670>>10672000
                                                               <<04670>>10674000
   BEGIN                                                       <<04670>>10676000
                                                               <<04670>>10678000
   <<Check if not a deleted track>>                            <<04670>>10680000
                                                               <<04670>>10682000
   DTTF := 1;                                                  <<04670>>10684000
   DISCIO(FDEV,R,DTTF,1D,DTT'SIZE,IOSTAT);                     <<04670>>10686000
   IF = THEN                                                   <<04670>>10688000
      BEGIN                                                    <<04670>>10690000
      TRACK := INTEGER(ADDR//LOGICAL(SECTRK));                 <<04670>>10692000
      WHILE (INDEX:=INDEX+1) <= DTTF DO                        <<04670>>10694000
         IF DTTF(INDEX) = TRACK&LSL(2)+2 THEN                  <<04670>>10696000
            INDEX := DTTF + 2;                                 <<04851>>10698000
      END;                                                     <<04670>>10700000
   IF INDEX <> (DTTF + 1) THEN                                 <<04851>>10702000
      BEGIN                                                    <<04670>>10704000
      ADDDTTENTRY (TRACK&LSL(2));                              <<04670>>10706000
      IF < THEN                                                <<04670>>10708000
         GENMSG(PVMSGSET,VIERR37);                             <<04670>>10710000
      END;                                                     <<04670>>10712000
    END;                                                       <<04670>>10714000
                                                               <<04670>>10716000
END;                                                           <<04670>>10718000
$PAGE "   COPY FUNCTION   -   PROCEDURE CHECK'PV'ADDR"         <<04670>>10720000
LOGICAL PROCEDURE CHECK'PV'ADDR (LDEV,ADDR,SIZE);              <<04670>>10722000
VALUE LDEV,ADDR,SIZE;                                          <<04670>>10724000
INTEGER LDEV;                                                  <<04670>>10726000
DOUBLE ADDR,SIZE;                                              <<04670>>10728000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10730000
                                                               <<04670>>10732000
<<This procedure checks if sector(s) is(are) used by File   >> <<04670>>10734000
<<System. For private volumes it checks with disc free space>> <<04670>>10736000
<<bit map.                                                  >> <<04670>>10738000
                                                               <<04670>>10740000
BEGIN                                                          <<04670>>10742000
INTEGER LCRIT;                                                 <<04670>>10744000
CHECK'PV'ADDR := TRUE;                                         <<04670>>10746000
LCRIT := SETCRITICAL;                                          <<04670>>10748000
IF CREATE'DFS'DATA'SEG(LDEV,,,IF SYS THEN TRUE ELSE FALSE) THEN<<04670>>10750000
   BEGIN                                                       <<04670>>10752000
   IF GET'SPECIFIC'DISC'SPACE (LDEV,ADDR,SIZE) = 0 THEN        <<04670>>10754000
      BEGIN                                                    <<04670>>10756000
      CHECK'PV'ADDR := FALSE;                                  <<04670>>10758000
      RETURN'DISC'SPACE (LDEV,ADDR,SIZE);                      <<04670>>10760000
      END                                                      <<04670>>10762000
   ELSE                                                        <<04670>>10764000
      CHECK'PV'ADDR := TRUE;                                   <<04670>>10766000
   UNLOCK'AND'DELETE'DFS'DST (LDEV);                           <<04670>>10768000
   END;                                                        <<04670>>10770000
RESETCRITICAL (LCRIT);                                         <<04670>>10772000
END;                                                           <<04670>>10774000
$PAGE "   COPY FUNCTION   -   CHECK'SD'ADDR"                   <<04670>>10776000
LOGICAL PROCEDURE CHECK'SD'ADDR (LDEV,START'ADDR,SIZE);        <<04670>>10778000
VALUE LDEV,START'ADDR,SIZE;                                    <<04670>>10780000
INTEGER LDEV;                                                  <<04670>>10782000
DOUBLE START'ADDR,SIZE;                                        <<04670>>10784000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10786000
                                                               <<04670>>10788000
<<This procedure checks if sector(s) belongs to valid part  >> <<04670>>10790000
<<of serial disc. If a sector(s) lies in a "hole" it returns>> <<04670>>10792000
<<false otherwise true.                                     >> <<04670>>10794000
                                                               <<04670>>10796000
BEGIN                                                          <<04670>>10798000
INTEGER INDEX,G'TYPE,IOSTAT,SECBUF,I;                          <<04670>>10800000
DOUBLE END'ADDR,B'HOLE,E'HOLE,GTAB'ADDR;                       <<04670>>10802000
INTEGER B'HOLE1 = B'HOLE;                                      <<04670>>10804000
INTEGER E'HOLE1 = E'HOLE;                                      <<04670>>10806000
ARRAY GTAB (*) = BUFF;                                         <<04670>>10808000
DOUBLE ARRAY GTABD (*) = GTAB;                                 <<04670>>10810000
DEFINE GTAB'START = 4D#;                                       <<04670>>10812000
DEFINE GTAB'SIZE = INT(GTAB(-3))#;  <<Set by CALC'SD'SIZE>>    <<04670>>10814000
DEFINE GTAB'SEC = GTABD(-1)#;  <<Set by CALC'SD'SIZE>>         <<04670>>10816000
END'ADDR := START'ADDR + SIZE - 1D;                            <<04670>>10818000
CHECK'SD'ADDR := TRUE;                                         <<04670>>10820000
SECBUF := BUFFSIZE/SECSIZE-1; <<One extra sector>>             <<04670>>10822000
GTAB'ADDR := 0D;                                               <<04670>>10824000
                                                               <<04670>>10826000
<<Check if the bad sector lies in the gap table.            >> <<04670>>10828000
                                                               <<04670>>10830000
IF END'ADDR < (GTAB'START + DOUBLE (GTAB'SIZE)) OR             <<04670>>10832000
   START'ADDR < (GTAB'START + DOUBLE (GTAB'SIZE)) THEN         <<04670>>10834000
   RETURN;                                                     <<04670>>10836000
                                                               <<04670>>10838000
<<Read SECBUF number of gap table sector to buffer and look >> <<04670>>10840000
<<for begin of hole.                                        >> <<04670>>10842000
                                                               <<04670>>10844000
DO                                                             <<04670>>10846000
   BEGIN                                                       <<04670>>10848000
   IOSTAT := 2;                                                <<04670>>10850000
   IF (INT (GTAB'ADDR) + SECBUF) > GTAB'SIZE THEN              <<04670>>10852000
      SECBUF := GTAB'SIZE - (INT(GTAB'ADDR) + SECBUF);         <<04670>>10854000
   IF GTAB'ADDR <> GTAB'SEC THEN                               <<04670>>10856000
      IF NOT DLIO (LDEV,R,GTAB,GTAB'ADDR+GTAB'START,           <<04670>>10858000
                   (SECBUF+1)*SECSIZE,IOSTAT) THEN             <<04670>>10860000
         RETURN;                                               <<04670>>10862000
   GTAB'SEC := GTAB'ADDR;                                      <<04670>>10864000
   I := IF GTAB'SEC = 0D THEN 2 ELSE 0;                        <<04670>>10866000
   FOR INDEX := I UNTIL (SECBUF*SECSIZE-1)&LSR(1) DO           <<04670>>10868000
      BEGIN                                                    <<04670>>10870000
      B'HOLE := GTABD(INDEX);                                  <<04670>>10872000
      G'TYPE := B'HOLE1.(0:3);                                 <<04670>>10874000
      IF G'TYPE = 1 OR G'TYPE = 7 THEN                         <<04670>>10876000
         RETURN;                                               <<04670>>10878000
      B'HOLE1.(0:3) := 0;                                      <<04670>>10880000
      IF G'TYPE = 2 THEN                                       <<04670>>10882000
         BEGIN  <<Beginning of hole>>                          <<04670>>10884000
         E'HOLE := GTABD(INDEX+1);  <<End of hole>>            <<04670>>10886000
         E'HOLE1.(0:3) := 0;                                   <<04670>>10888000
         IF B'HOLE <= START'ADDR AND                           <<04670>>10890000
            E'HOLE >= END'ADDR THEN                            <<04670>>10892000
               BEGIN                                           <<04670>>10894000
               CHECK'SD'ADDR := FALSE;                         <<04670>>10896000
               RETURN;                                         <<04670>>10898000
               END;                                            <<04670>>10900000
         END;                                                  <<04670>>10902000
      END;                                                     <<04670>>10904000
   GTAB'ADDR := GTAB'ADDR + DOUBLE (SECBUF);                   <<04670>>10906000
   END                                                         <<04670>>10908000
UNTIL (GTAB'ADDR < DOUBLE (GTAB'SIZE));                        <<04670>>10910000
END;                                                           <<04670>>10912000
$PAGE "   COPY FUNCTION   -   PROCEDURE USED'SPACE"            <<04670>>10914000
LOGICAL PROCEDURE USED'SPACE (LDEV,ADDR,SIZE);                 <<04670>>10916000
VALUE LDEV,ADDR,SIZE;                                          <<04670>>10918000
INTEGER LDEV;                                                  <<04670>>10920000
DOUBLE ADDR,SIZE;                                              <<04670>>10922000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10924000
                                                               <<04670>>10926000
<<This procedure checks if a sector(s) lies in valid portion>> <<04670>>10928000
<<of data. It returns value of TRUE if yes.                 >> <<04670>>10930000
                                                               <<04670>>10932000
BEGIN                                                          <<04670>>10934000
IF PVOL OR SYS THEN                                            <<04670>>10936000
   USED'SPACE := CHECK'PV'ADDR (LDEV,ADDR,SIZE)                <<04670>>10938000
ELSE                                                           <<04670>>10940000
   IF SERIALD THEN                                             <<04670>>10942000
      USED'SPACE := CHECK'SD'ADDR (LDEV,ADDR,SIZE)             <<04670>>10944000
   ELSE                                                        <<04670>>10946000
      USED'SPACE := TRUE;                                      <<04670>>10948000
END;                                                           <<04670>>10950000
$PAGE "   COPY FUNCTION   -   PROCEDURE CHECK'SECTOR"          <<04670>>10952000
PROCEDURE CHECK'SECTOR (LDEV,START'ADDR,SIZE);                 <<04670>>10954000
VALUE LDEV,START'ADDR,SIZE;                                    <<04670>>10956000
INTEGER LDEV;                                                  <<04670>>10958000
DOUBLE START'ADDR,SIZE;                                        <<04670>>10960000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>10962000
                                                               <<04670>>10964000
<<This procedure checks if a sector(s) lies in bit map or in>> <<04670>>10966000
<<bit map descriptor for private volumes or system volumes. >> <<04670>>10968000
<<For PV master volume it checks if a sectors belongs to    >> <<04670>>10970000
<<directory.                                                >> <<04670>>10972000
                                                               <<04670>>10974000
BEGIN                                                          <<04670>>10976000
INTEGER BMSIZE,DTSIZE,LEN;                                     <<04670>>10978000
DOUBLE START'DIR,END'DIR,START'BM,START'DT,END'ADDR;           <<04670>>10980000
ARRAY TEXT(0:20);                                              <<04670>>10982000
ARRAY VLAB (*) = BUFF;                                         <<04670>>10984000
DOUBLE HEAD'CYL;                                               <<04670>>10986000
INTEGER HEAD = HEAD'CYL;                                       <<04670>>10988000
INTEGER CYL  = HEAD'CYL + 1;                                   <<04670>>10990000
                                                               <<04670>>10992000
END'ADDR := START'ADDR + SIZE-1D;                              <<04670>>10994000
TEXT := 0;                                                     <<04670>>10996000
IF PVOL OR SYS THEN                                            <<04670>>10998000
   IF GET'DISC'INFO (LDEV,VLAB,TRUE,,,,,START'BM,BMSIZE,       <<04670>>11000000
                     START'DT,DTSIZE) THEN                     <<04670>>11002000
      BEGIN                                                    <<04670>>11004000
      START'DIR := DBL(VLAB(DISC'LAB'DIRBASE));                <<04670>>11006000
      END'DIR := START'DIR+DBL(VLAB(DISC'LAB'DIRSIZE))-1D;     <<04670>>11008000
                                                               <<04670>>11010000
      <<Check directory - PV master volume only>>              <<04670>>11012000
                                                               <<04670>>11014000
      IF PVOL AND VLAB(DISC'LAB'TYPE'WORD).DISC'LAB'MV AND     <<04670>>11016000
         START'DIR <= END'ADDR AND                             <<04670>>11018000
         END'DIR >= START'ADDR THEN                            <<04670>>11020000
            BEGIN                                              <<04670>>11022000
            MOVE TEXT := ("     * (DIRECTORY) *",%0);          <<04670>>11024000
            LEN := -20;                                        <<04670>>11026000
            END                                                <<04670>>11028000
      ELSE                                                     <<04670>>11030000
                                                               <<04670>>11032000
         <<Check bit map>>                                     <<04670>>11034000
                                                               <<04670>>11036000
         IF START'BM <= END'ADDR AND                           <<04670>>11038000
            START'BM+DBL(BMSIZE*PAGE'SIZE-1) >= START'ADDR     <<04670>>11040000
            THEN                                               <<04670>>11042000
               BEGIN                                           <<04670>>11044000
               MOVE TEXT := ("     * (DISC BIT MAP) *",0);     <<04670>>11046000
               LEN := -23;                                     <<04670>>11048000
               END                                             <<04670>>11050000
         ELSE                                                  <<04670>>11052000
                                                               <<04670>>11054000
            <<Check bit map descriptor>>                       <<04670>>11056000
                                                               <<04670>>11058000
            IF START'DT <= END'ADDR AND                        <<04670>>11060000
               START'DT+DBL((DTSIZE+SECSIZE-1)/SECSIZE-1) >=   <<04670>>11062000
               START'ADDR THEN                                 <<04670>>11064000
                  BEGIN                                        <<04670>>11066000
                  MOVE TEXT:=                                  <<04670>>11068000
                  ("     * (DISC BIT MAP DESCRIPTOR *",0);     <<04670>>11070000
                  LEN := -33;                                  <<04670>>11072000
                  END                                          <<04670>>11074000
            ELSE                                               <<04670>>11076000
                                                               <<04670>>11078000
            <<Enter DTT'CHANGES table for PROC'BAD'TRACK>>     <<04670>>11080000
                                                               <<04670>>11082000
               ENT'DTT'CHANGES (START'ADDR,INT(SIZE))          <<04670>>11084000
      END                                                      <<04670>>11086000
   ELSE  <<Get'Disc'Info error>>                               <<04670>>11088000
         ENT'DTT'CHANGES (START'ADDR,INT(SIZE));               <<04670>>11090000
                                                               <<04670>>11092000
HEAD'CYL := CYLINDERHEAD(INT(START'ADDR/DBL(SECTRK)),LDEV);    <<04670>>11094000
GENMSG (PVMSGSET,VIWARN131,%22110,@START'ADDR,                 <<04670>>11096000
        @END'ADDR,CYL,HEAD,,-OUTF);                            <<04670>>11098000
IF TEXT <> 0 THEN                                              <<04670>>11100000
   FWRITE (OUTF,TEXT,LEN,0);                                   <<04670>>11102000
                                                               <<04670>>11104000
END;                                                           <<04670>>11106000
$PAGE "   COPY FUNCTION   -   PROCEDURE VERIFY'MEDIA"          <<04670>>11108000
LOGICAL PROCEDURE VERIFY'MEDIA (LDEV,DISC'SIZE);               <<04670>>11110000
VALUE LDEV,DISC'SIZE;                                          <<04670>>11112000
INTEGER LDEV;                                                  <<04670>>11114000
DOUBLE DISC'SIZE;                                              <<04670>>11116000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11118000
                                                               <<04670>>11120000
<<This procedure reads/verifies data in used part of media  >> <<04670>>11122000
<<Any encouterd bad sector address is recorded in DTT/DSCT  >> <<04670>>11124000
<<However for LINUS it keeps DSCT in memory.                >> <<04670>>11126000
                                                               <<04670>>11128000
BEGIN                                                          <<04670>>11130000
INTEGER SIZE,IOSTAT,FUNC,LEN,INDEX;                            <<04851>>11132000
INTEGER ARRAY DTT (0:DTT'SIZE);                                <<04851>>11134000
DOUBLE ADDR := 0D;                                             <<04851>>11136000
DEFINE GTAB'SEC = BUFFD(-1)#;                                  <<04851>>11138000
                                                               <<04851>>11140000
VERIFY'MEDIA := TRUE;                                          <<04851>>11142000
DISCIO (LDEV,R,DTT,1D,DTT'SIZE);                               <<04851>>11144000
IF <> THEN                                                     <<04851>>11146000
   BEGIN                                                       <<04851>>11148000
   VERIFY'MEDIA := FALSE;                                      <<04851>>11150000
   RETURN;                                                     <<04851>>11152000
   END;                                                        <<04851>>11154000
IF SERIALD AND NOT CS'80 THEN                                  <<04851>>11156000
   GTAB'SEC := -1D;                                            <<04851>>11158000
                                                               <<04851>>11160000
WHILE ADDR < DISC'SIZE DO                                      <<04851>>11162000
   BEGIN                                                       <<04851>>11164000
   IOSTAT := 2;                                                <<04851>>11166000
   IF CS'80 THEN                                               <<04851>>11168000
                                                               <<04851>>11170000
<<CS80 DEVICES>>                                               <<04851>>11172000
                                                               <<04851>>11174000
      BEGIN                                                    <<04851>>11176000
      BUFFD := (DISC'SIZE - ADDR) * DBL(SECSIZE&LSL(1));       <<04851>>11178000
      DLIO(LDEV,FUNC:=VERIFY'CS'80,BUFF,ADDR,2,IOSTAT);        <<04851>>11180000
      IF IOSTAT.GSTATUS = SUCCESSFUL THEN                      <<04851>>11182000
         RETURN;                                               <<04851>>11184000
      END                                                      <<04851>>11186000
   ELSE                                                        <<04851>>11188000
                                                               <<04851>>11190000
<<NON CS80 DEVICES>>                                           <<04851>>11192000
                                                               <<04851>>11194000
      BEGIN                                                    <<04851>>11196000
      SIZE:=IF (DISC'SIZE-ADDR)*DBL(SECSIZE) >= DBL(BUFFSIZE+1)<<04851>>11198000
               THEN BUFFSIZE + 1                               <<04851>>11200000
            ELSE INT (DISC'SIZE-ADDR) * SECSIZE;               <<04851>>11202000
      LEN:=DISCIO(LDEV,FUNC:=R,BUFF,ADDR,SIZE,IOSTAT);         <<04851>>11204000
      BUFFD := ADDR + DBL (LEN/SECSIZE - 1);                   <<04851>>11206000
      END;                                                     <<04851>>11208000
   IF IOSTAT.GSTATUS <> SUCCESSFUL THEN                        <<04851>>11210000
      <<Check if read error. In case of deleted track an    >> <<04851>>11212000
      <<invalid address error status is returned.           >> <<04851>>11214000
      IF NOT (IOSTAT.TSTATUS = TRKERR LOR                      <<04851>>11216000
         IOSTAT.TSTATUS = INVADDR) THEN                        <<04851>>11218000
         BEGIN                                                 <<04851>>11220000
         DISCERROR (LDEV,FUNC,IOSTAT,ADDR,STAT.(8:8),DELP);    <<04851>>11222000
         GENMSG (PVMSGSET,VIERR0);                             <<04851>>11224000
         VERIFY'MEDIA := FALSE;                                <<04851>>11226000
         RETURN;                                               <<04851>>11228000
         END                                                   <<04851>>11230000
      ELSE                                                     <<04851>>11232000
         BEGIN                                                 <<04851>>11234000
         <<Check what sector in the buffer causes problems. >> <<04851>>11236000
         <<Unfortunatly the 7920/25 drivers does not return >> <<04851>>11238000
         <<actual number of transmited bytes/words.         >> <<04851>>11240000
         INDEX := 0;                                           <<04851>>11242000
         WHILE (INDEX := INDEX + 1) <= SIZE/SECSIZE DO         <<04851>>11244000
            BEGIN                                              <<04851>>11246000
            IOSTAT := 2;                                       <<04851>>11248000
            DISCIO(LDEV,R,BUFF,ADDR,SECSIZE,IOSTAT);           <<04851>>11250000
            IF <> THEN                                         <<04851>>11252000
               INDEX := SIZE/SECSIZE + 2;                      <<04851>>11254000
            ADDR := ADDR + 1D;                                 <<04851>>11256000
            END;                                               <<04851>>11258000
         ADDR := ADDR - 1D;                                    <<04851>>11260000
         BUFFD := ADDR;                                        <<04851>>11262000
         IF INDEX <> SIZE/SECSIZE + 1 THEN                     <<04851>>11264000
            <<Check if an encountered bad sector belongs to >> <<04851>>11266000
            <<deleted track by scanning a Defective Track   >> <<04851>>11268000
            <<Table.                                        >> <<04851>>11270000
            BEGIN                                              <<04851>>11272000
            INDEX := 0;                                        <<04851>>11274000
            WHILE (INDEX := INDEX + 1) <= DTT DO               <<04851>>11276000
               IF DTT(INDEX) =                                 <<04851>>11278000
                  INT(ADDR//LOGICAL(SECTRK))&LSL(2)+2 THEN     <<04851>>11280000
                  INDEX := DTT + 2;                            <<04851>>11282000
            IF INDEX = DTT + 1 THEN                            <<04851>>11284000
               ADD'DTT'ENTRY (LDEV,LDEV,BUFFD);                <<04851>>11286000
            END;                                               <<04851>>11288000
         END;                                                  <<04851>>11290000
                                                               <<04851>>11292000
   ADDR := BUFFD + 1D;                                         <<04851>>11294000
   END;                                                        <<04851>>11296000
                                                               <<04851>>11298000
END;                                                           <<04670>>11300000
$PAGE "   COPY FUNCTION   -   PROCEDURE PROC'IO'ERROR"         <<04670>>11302000
LOGICAL PROCEDURE PROC'IO'ERROR                                <<04670>>11304000
               (FDEV,TDEV,ADDR,DST,OFFSET,LEN,BUFSIZE,IOSTAT); <<04670>>11306000
VALUE FDEV,TDEV,ADDR,DST,OFFSET,LEN,BUFSIZE,IOSTAT;            <<04670>>11308000
INTEGER FDEV,TDEV,DST,OFFSET,LEN,BUFSIZE,IOSTAT;               <<04670>>11310000
DOUBLE ADDR;                                                   <<04670>>11312000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11314000
<<This procedure processes READ IO error.                   >> <<04670>>11316000
<<It reads rest of data to buffer and enters suspect sectors>> <<04670>>11318000
<<into destination DTT.                                     >> <<04670>>11320000
                                                               <<04670>>11322000
BEGIN                                                          <<04670>>11324000
INTEGER POINTER BUFP;                                          <<04670>>11326000
INTEGER RC;                                                    <<04670>>11328000
DOUBLE ADDRX;                                                  <<04670>>11330000
                                                               <<04670>>11332000
PROC'IO'ERROR := TRUE;                                         <<04670>>11334000
IF IOSTAT.TSTATUS <> TRKERR THEN                               <<04670>>11336000
   BEGIN                                                       <<04670>>11338000
   DISCERROR (LDEV,R,IOSTAT,ADDR,STAT.(8:8),DELP);             <<04670>>11340000
   GENMSG(PVMSGSET,VIERR0);                                    <<04670>>11342000
   PROC'IO'ERROR := FALSE;                                     <<04670>>11344000
   RETURN;                                                     <<04670>>11346000
   END;                                                        <<04670>>11348000
ADDRX := ADDR+DOUBLE(OFFSET/SECSIZE)-1D; <<TEMP!!!!!>>         <<04670>>11350000
FOR LEN := OFFSET STEP 128 UNTIL BUFSIZE DO                    <<04670>>11352000
   BEGIN                                                       <<04670>>11354000
   IOSTAT:=2;                                                  <<04670>>11356000
   BUFFD := -1D;                                               <<04670>>11358000
   DISCIO(FDEV,R,BUFF,ADDRX:=ADDRX+1D,128,IOSTAT);             <<04670>>11360000
   IF <> THEN GOTO XXX                                         <<04670>>11362000
   END;                                                        <<04670>>11364000
XXX:                                                           <<04670>>11366000
OFFSET:=0;                                                     <<04670>>11368000
LEN := LEN/SECSIZE*SECSIZE;                                    <<04670>>11370000
OFFSET := OFFSET + LEN;                                        <<04670>>11372000
ADDRX := ADDR + DOUBLE (OFFSET/SECSIZE);                       <<04670>>11374000
IF USED'SPACE (FDEV,ADDRX,1D) THEN                             <<04670>>11376000
   BEGIN                                                       <<04670>>11378000
   ADD'DTT'ENTRY (FDEV,TDEV,ADDRX);                            <<04670>>11380000
   CHECK'SECTOR (FDEV,ADDRX,1D);                               <<04670>>11382000
   END;                                                        <<04670>>11384000
OFFSET := OFFSET + SECSIZE;                                    <<04670>>11386000
@BUFP := OFFSET;                                               <<04670>>11388000
IOSTAT := 2;                                                   <<04670>>11390000
RC := BUFSIZE - OFFSET;                                        <<04670>>11392000
LEN := DISCIO(FDEV,R,BUFP,ADDRX+1D,RC,IOSTAT,DST);             <<04670>>11394000
IF IOSTAT.GSTATUS <> SUCCESSFUL THEN                           <<04670>>11396000
   PROC'IO'ERROR :=                                            <<04670>>11398000
   PROC'IO'ERROR (FDEV,TDEV,ADDR,DST,OFFSET,LEN,BUFSIZE,       <<04670>>11400000
                 IOSTAT);                                      <<04670>>11402000
END;                                                           <<04670>>11404000
$PAGE "   COPY FUNCTION   -   PROCEDURE COPY'TRACK"            <<04670>>11406000
LOGICAL PROCEDURE COPY'TRACK (FDEV,TDEV,BUFSIZE,ADDR,DST);     <<04670>>11408000
VALUE FDEV,TDEV,BUFSIZE,ADDR,DST;                              <<04670>>11410000
INTEGER FDEV,TDEV,BUFSIZE,DST;                                 <<04670>>11412000
DOUBLE ADDR;                                                   <<04670>>11414000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11416000
                                                               <<04670>>11418000
<<This procedure tries to recover bad sector/track on       >> <<04670>>11420000
<<disc. If sector/track is not recoverable, it spares or    >> <<04670>>11422000
<<reassigns sector/track and copies again an entire track   >> <<04670>>11424000
                                                               <<04670>>11426000
BEGIN                                                          <<04670>>11428000
INTEGER IOSTAT,WC,SECBUF,SIZE,LEN;                             <<04670>>11430000
INTEGER POINTER BP;                                            <<04670>>11432000
DEFINE TRACK = TRUE#;                                          <<04670>>11434000
                                                               <<04670>>11436000
DO'IT'AGAIN:                                                   <<04670>>11438000
COPY'TRACK := TRUE;                                            <<04670>>11440000
IF NOT RECOVER'SPACE(TDEV,ADDR) THEN                           <<04670>>11442000
   BEGIN                                                       <<04670>>11444000
   CHECK'SECTOR(LDEV,ADDR,DBL(SECTRK));                        <<04670>>11446000
   RETURN;                                                     <<04670>>11448000
   END;                                                        <<04670>>11450000
                                                               <<04670>>11452000
SIZE := SECTRK;                                                <<04670>>11454000
ADDR := ADDR - DBL(ADDR MODD LOGICAL(SECTRK));                 <<04670>>11456000
SECBUF := BUFSIZE/SECSIZE;                                     <<04670>>11458000
DO                                                             <<04670>>11460000
   BEGIN                                                       <<04670>>11462000
   IF SECBUF > SIZE THEN                                       <<04670>>11464000
      SECBUF := SIZE;                                          <<04670>>11466000
   @BP := 0;                                                   <<04670>>11468000
   IOSTAT := 2;                                                <<04670>>11470000
   LEN := DISCIO(FDEV,R,BP,ADDR,BUFSIZE,IOSTAT,DST);           <<04670>>11472000
   IF IOSTAT.GSTATUS <> SUCCESSFUL AND NOT PROC'IO'ERROR       <<04670>>11474000
      (FDEV,TDEV,ADDR,DST,0,LEN,BUFSIZE,IOSTAT) THEN           <<04670>>11476000
      GOTO ERR;                                                <<04670>>11478000
   IOSTAT := 5;                                                <<04670>>11480000
   DISCIO (TDEV,W,BP,ADDR,BUFSIZE,IOSTAT,DST);                 <<04670>>11482000
   IF <> THEN                                                  <<04670>>11484000
      BEGIN                                                    <<04670>>11486000
ERR:                                                           <<04670>>11488000
      COPY'TRACK := FALSE;                                     <<04670>>11490000
      RETURN;                                                  <<04670>>11492000
      END;                                                     <<04670>>11494000
   IOSTAT := 2;                                                <<04670>>11496000
   DISCIO (TDEV,R,BP,ADDR,BUFSIZE,IOSTAT,DST);                 <<04670>>11498000
   IF <> THEN                                                  <<04670>>11500000
      GOTO DO'IT'AGAIN;                                        <<04670>>11502000
   REMOVE'ENTRY (ADDR,TRACK);                                  <<04670>>11504000
   ADDR := ADDR + DBL(SECBUF);                                 <<04670>>11506000
   END                                                         <<04670>>11508000
UNTIL (SIZE := SIZE - SECBUF) = 0;                             <<04670>>11510000
END;                                                           <<04670>>11512000
$PAGE "   COPY FUNCTION   -   PROCEDURE ALLOC'DATA'SEG"        <<04670>>11514000
LOGICAL PROCEDURE ALLOC'DATA'SEG (DST1,DST2,BUFSIZE);          <<04670>>11516000
INTEGER DST1,DST2,BUFSIZE;                                     <<04670>>11518000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11520000
                                                               <<04670>>11522000
<<This procedure tries to allocate two data segments with   >> <<04670>>11524000
<<maximum size (1K granularity).                            >> <<04670>>11526000
                                                               <<04670>>11528000
BEGIN                                                          <<04670>>11530000
INTEGER I;                                                     <<04670>>11532000
ALLOC'DATA'SEG := TRUE;                                        <<04670>>11534000
DST1 := GETDATASEG (BUFSIZE,BUFSIZE);                          <<04670>>11536000
IF = THEN                                                      <<04670>>11538000
   BEGIN                                                       <<04670>>11540000
   DST2 := GETDATASEG (BUFSIZE,BUFSIZE);                       <<04670>>11542000
   IF <> THEN                                                  <<04670>>11544000
      BEGIN                                                    <<04670>>11546000
      RELDATASEG (DST1);                                       <<04670>>11548000
      ALLOC'DATA'SEG := FALSE;                                 <<04670>>11550000
      DST1 := DST2 := 0;                                       <<04670>>11552000
      END;                                                     <<04670>>11554000
   END                                                         <<04670>>11556000
ELSE                                                           <<04670>>11558000
   DST1 := 0;                                                  <<04670>>11560000
END;                                                           <<04670>>11562000
$PAGE "   COPY FUNCTION   -   PROCEDURE PROCESS'DTT"           <<04670>>11564000
LOGICAL PROCEDURE PROCESS'DTT (LDEV);                          <<04670>>11566000
VALUE LDEV;                                                    <<04670>>11568000
INTEGER LDEV;                                                  <<04670>>11570000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11572000
                                                               <<04670>>11574000
<<This procedure reassigns suspect or deleted tracks and for>> <<04670>>11576000
<<NON-CS80 discs or spares suspect sectors for CS80 discs.  >> <<04670>>11578000
                                                               <<04670>>11580000
BEGIN                                                          <<04670>>11582000
INTEGER I,IOSTAT := 1;                                         <<04670>>11584000
DOUBLE ADDR,SIZE;                                              <<04670>>11586000
PROCESS'DTT := TRUE;                                           <<04670>>11588000
IF LINUS OR FORVOL THEN                                        <<04670>>11590000
   BUILD'DSCT                                                  <<04670>>11592000
ELSE                                                           <<04670>>11594000
   BEGIN                                                       <<04670>>11596000
   DISCIO (LDEV,R,DTT,1D,DTT'SIZE,IOSTAT);                     <<04670>>11598000
   IF = AND (DTT <> 0) THEN                                    <<04670>>11600000
      BEGIN                                                    <<04670>>11602000
      IF CS'80 THEN                                            <<04670>>11604000
         BEGIN                                                 <<04670>>11606000
         GENMSG (PVMSGSET,VIWARN132,%10000,LDEV);              <<04670>>11608000
         CS80'SPARE;                                           <<04670>>11610000
         IOSTAT := 1;                                          <<04670>>11612000
         DISCIO (LDEV,W,DTT,1D,DTT'SIZE,IOSTAT);               <<04670>>11614000
         END                                                   <<04670>>11616000
      ELSE                                                     <<04670>>11618000
         FOR I := 1 UNTIL DTT DO                               <<04670>>11620000
            IF DTT(I).DTCF <> 3 THEN                           <<04670>>11622000
               BEGIN                                           <<04670>>11624000
               I := DTT;                                       <<04670>>11626000
               GENMSG (PVMSGSET,VIWARN132,%10000,LDEV);        <<04670>>11628000
               WHILE GET'ENTRY (ADDR,SIZE) DO                  <<04670>>11630000
                  IF NOT REASSIGN'TRACK (LDEV,ADDR) THEN       <<04670>>11632000
                     BEGIN                                     <<04670>>11634000
                     GENMSG (PVMSGSET,VIERR125);               <<04670>>11636000
                     GENMSG (PVMSGSET,VIERR0);                 <<04670>>11638000
                     PROCESS'DTT := FALSE;                     <<04670>>11640000
                     RETURN;                                   <<04670>>11642000
                     END;                                      <<04670>>11644000
               END;                                            <<04670>>11646000
      END;                                                     <<04670>>11648000
   END;                                                        <<04670>>11650000
END;                                                           <<04670>>11652000
$PAGE "   COPY FUNCTION   -   PROCEDURE CALC'PV'SIZE"          <<04670>>11654000
DOUBLE PROCEDURE CALC'PV'SIZE (LDEV);                          <<04670>>11656000
VALUE LDEV;                                                    <<04670>>11658000
INTEGER LDEV;                                                  <<04670>>11660000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11662000
                                                               <<04670>>11664000
<<This procedure calculates the data size of private volume  >><<04670>>11666000
<<or system disc to be copied. For NON-CS80 discs the default>><<04670>>11668000
<<value is a logical pack size and for CS80 discs it is the  >><<04670>>11670000
<<physical disc size. However, for private volumes, this     >><<04670>>11672000
<<procedure calculates the data size to be copied using      >><<04670>>11674000
<<a disc free space bit map (DFS data segment). It cannot be >><<04670>>11676000
<<done for system discs because mounted physicaly system     >><<04670>>11678000
<<discs and not included in the system volume table do not   >><<04670>>11680000
<<have the DFS data segment. The system disc which is        >><<04670>>11682000
<<included in the system volume table cannot be copied.      >><<04670>>11684000
                                                               <<04670>>11686000
BEGIN                                                          <<04670>>11688000
INTEGER LCRIT,PAGE'SIZE,LAST'PAGE'SIZE;                        <<04670>>11690000
DOUBLE DISC'SIZE,CALC'SIZE;                                    <<04670>>11692000
                                                               <<04670>>11694000
GET'DISC'INFO (LDEV,,,,,,DISC'SIZE);                           <<04670>>11696000
CALC'PV'SIZE := DISC'SIZE;                                     <<04670>>11698000
                                                               <<04670>>11700000
<<Claculate data size>>                                        <<04670>>11702000
                                                               <<04670>>11704000
LCRIT := SETCRITICAL;                                          <<04670>>11706000
IF (PVOL OR SYS) AND CREATE'AND'LOCK'DFS'DST (LDEV) THEN       <<04670>>11708000
   BEGIN                                                       <<04670>>11710000
   CALC'SIZE := DISC'SIZE;                                     <<04670>>11712000
   LAST'PAGE'SIZE := DISC'SIZE MODD BITS'PER'PAGE;             <<04670>>11714000
   DS'PAGE'NUMBER := DS'LAST'PAGE'OF'MAP + 1;                  <<04670>>11716000
   DO                                                          <<04670>>11718000
      BEGIN                                                    <<04670>>11720000
      DS'PAGE'NUMBER := DS'PAGE'NUMBER - 1;                    <<04670>>11722000
      PAGE'SIZE := DS'DESCRIPTOR'TABLE (DS'PAGE'NUMBER *       <<04670>>11724000
                   DT'ENTRY'SIZE + STARTING'SPACE);            <<04670>>11726000
      END                                                      <<04670>>11728000
   UNTIL (DS'PAGE'NUMBER <> DS'LAST'PAGE'OF'MAP) AND           <<04670>>11730000
         (PAGE'SIZE <> BITS'PER'PAGE) OR                       <<04670>>11732000
         (DS'PAGE'NUMBER = DS'LAST'PAGE'OF'MAP) AND            <<04670>>11734000
         (PAGE'SIZE <> LAST'PAGE'SIZE);                        <<04670>>11736000
XIT:                                                           <<04670>>11738000
   DS'PAGE'NUMBER := DS'PAGE'NUMBER + 1;                       <<04670>>11740000
   DS'WORD'NUMBER := 0;                                        <<04670>>11742000
   DS'BIT'NUMBER := 0;                                         <<04670>>11744000
   CALC'SIZE := CONVERT'MAP'TO'ADDRESS;                        <<04670>>11746000
   UNLOCK'AND'DELETE'DFS'DST (LDEV);                           <<04670>>11748000
   CALC'PV'SIZE := IF DISC'SIZE < CALC'SIZE THEN               <<04670>>11750000
                      DISC'SIZE                                <<04670>>11752000
                   ELSE                                        <<04670>>11754000
                      CALC'SIZE;                               <<04670>>11756000
   END;                                                        <<04670>>11758000
RESETCRITICAL (LCRIT);                                         <<04670>>11760000
END;                                                           <<04670>>11762000
$PAGE "   COPY FUNCTION   -   PROCEDURE CALC'SDISC'SIZE"       <<04670>>11764000
DOUBLE PROCEDURE CALC'SDISC'SIZE (LDEV);                       <<04670>>11766000
VALUE LDEV;                                                    <<04670>>11768000
INTEGER LDEV;                                                  <<04670>>11770000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11772000
                                                               <<04670>>11774000
<<This procedure calculates end of data for serial disc by  >> <<04670>>11776000
<<scanning gap table.                                       >> <<04670>>11778000
                                                               <<04670>>11780000
BEGIN                                                          <<04670>>11782000
INTEGER I,J,K,SIZE,IOSTAT;                                     <<04670>>11784000
ARRAY GTAB (*) = BUFF;                                         <<04670>>11786000
ARRAY VTAB (*) = BUFF;                                         <<04670>>11788000
DOUBLE ARRAY GTABD (*) = GTAB;                                 <<04670>>11790000
DEFINE GTAB'SEC = BUFFD(-1)#;                                  <<04670>>11792000
DEFINE GTAB'SIZE = BUFF(-3)#;                                  <<04670>>11794000
DEFINE GTAB'START = 4D#;                                       <<04670>>11796000
                                                               <<04670>>11798000
GTAB'SEC := -1D;   <<Initialize - gap buffer empty>>           <<04670>>11800000
CALC'SDISC'SIZE := 0D;                                         <<04670>>11802000
IOSTAT := 1;                                                   <<04670>>11804000
IF NOT DLIO (LDEV,R,VTAB,0D,SECSIZE,IOSTAT) THEN               <<04670>>11806000
   RETURN;                                                     <<04670>>11808000
GTAB'SIZE := BUFF(16);                                         <<04670>>11810000
                                                               <<04670>>11812000
<<Scan gap table - read gap table sector by sector.         >> <<04670>>11814000
                                                               <<04670>>11816000
FOR I := 0 UNTIL INT(GTAB'SIZE) - 1 DO                         <<04670>>11818000
   BEGIN                                                       <<04670>>11820000
   IOSTAT := 2;                                                <<04670>>11822000
   GTAB'SEC := DBL(I) + GTAB'START;                            <<04670>>11824000
   IF NOT DLIO (LDEV,R,GTAB,GTAB'SEC,SECSIZE,IOSTAT)           <<04670>>11826000
      THEN                                                     <<04670>>11828000
      GOTO ERR;                                                <<04670>>11830000
   K := 0;                                                     <<04670>>11832000
   IF I = 0 THEN                                               <<04670>>11834000
      BEGIN   <<First sector>>                                 <<04670>>11836000
      K := 4;  <<Skip header>>                                 <<04670>>11838000
      IF GTAB = -1 THEN                                        <<04670>>11840000
         BEGIN   <<No data>>                                   <<04670>>11842000
         GENMSG (PVMSGSET,VIWARN120);                          <<04670>>11844000
         RETURN;                                               <<04670>>11846000
         END;                                                  <<04670>>11848000
      END;                                                     <<04670>>11850000
   FOR J := K STEP 2 UNTIL SECSIZE - 1 DO                      <<04670>>11852000
      BEGIN                                                    <<04670>>11854000
      IF GTAB (J) = -1 THEN                                    <<04670>>11856000
         GOTO ERR;                                             <<04670>>11858000
      IF GTAB (J).(0:3) = 1 THEN                               <<04670>>11860000
         BEGIN                                                 <<04670>>11862000
         GTAB (J).(0:3) := 0;                                  <<04670>>11864000
         CALC'SDISC'SIZE := GTABD(J&LSR(1));                   <<04670>>11866000
         RETURN;                                               <<04670>>11868000
         END;                                                  <<04670>>11870000
      END;                                                     <<04670>>11872000
   END;                                                        <<04670>>11874000
ERR:                                                           <<04670>>11876000
GENMSG (PVMSGSET,VIERR119);                                    <<04670>>11878000
END;                                                           <<04670>>11880000
                                                               <<04670>>11882000
DOUBLE PROCEDURE CALC'DISC'SIZE (LDEV);                        <<04670>>11884000
VALUE LDEV;                                                    <<04670>>11886000
INTEGER LDEV;                                                  <<04670>>11888000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11890000
                                                               <<04670>>11892000
<<This procedure calculates the highest sector address      >> <<04670>>11894000
<<occupied by valid data.                                   >> <<04670>>11896000
                                                               <<04670>>11898000
BEGIN                                                          <<04670>>11900000
CALC'DISC'SIZE := IF SERIALD THEN                              <<04670>>11902000
                     CALC'SDISC'SIZE (LDEV)                    <<04670>>11904000
                  ELSE                                         <<04670>>11906000
                     CALC'PV'SIZE (LDEV);                      <<04670>>11908000
END;                                                           <<04670>>11910000
                                                               <<04670>>11912000
$PAGE "   COPY FUNCTION   -   PROCEDURE GET'COPY'KEYWORD"      <<04670>>11914000
LOGICAL PROCEDURE GET'COPY'KEYWORD (FDEV,TDEV,GEN,VER,BUFSIZE);<<04670>>11916000
INTEGER FDEV,TDEV,GEN,BUFSIZE;                                 <<04670>>11918000
LOGICAL VER;                                                   <<04670>>11920000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>11922000
                                                               <<04670>>11924000
<<This procedure parses COPY command keywords : GEN and     >> <<04670>>11926000
<<VERIFY and BUF.                                           >> <<04670>>11928000
                                                               <<04670>>11930000
BEGIN                                                          <<04670>>11932000
INTEGER I,BUF;                                                 <<04670>>11934000
BYTE POINTER P'KEYWORD;                                        <<04670>>11936000
                                                               <<04670>>11938000
@P'KEYWORD := @KEYWORD;                                        <<04670>>11940000
GEN := -1;                                                     <<04670>>11942000
VER := FALSE;                                                  <<04670>>11944000
BUFSIZE := %77600;                                             <<04670>>11946000
I := -1;                                                       <<04670>>11948000
WHILE KEYWDSPEC (I:=I+1) AND I <= 2 DO                         <<04670>>11950000
   BEGIN                                                       <<04670>>11952000
   IF P'KEYWORD = "GEN" THEN                                   <<04670>>11954000
      IF KEYPARMSPEC (I) THEN                                  <<04670>>11956000
         GEN := KEYPARMVAL (I)                                 <<04670>>11958000
      ELSE                                                     <<04670>>11960000
   ELSE                                                        <<04670>>11962000
      IF P'KEYWORD = "VER" THEN                                <<04670>>11964000
         VER := TRUE                                           <<04670>>11966000
      ELSE                                                     <<04670>>11968000
         IF P'KEYWORD = "BUF" AND                              <<04670>>11970000
            KEYPARMSPEC (I) AND                                <<04670>>11972000
            (BUF:=KEYPARMVAL(I)) > 0 AND BUF <= 32 THEN        <<04670>>11974000
            IF BUF < 32 THEN                                   <<04670>>11976000
               BUFSIZE := BUF * 1024                           <<04670>>11978000
            ELSE                                               <<04670>>11980000
         ELSE                                                  <<04670>>11982000
            BEGIN                                              <<04670>>11984000
            GET'COPY'KEYWORD := FALSE;                         <<04670>>11986000
            GENMSG (PVMSGSET,VIERR3);                          <<04670>>11988000
            RETURN;                                            <<04670>>11990000
            END;                                               <<04670>>11992000
   @P'KEYWORD := @P'KEYWORD + MAX'KEYWORD'LEN;                 <<04670>>11994000
   END;                                                        <<04670>>11996000
                                                               <<04670>>11998000
FDEV := DEVPARM(1);                                            <<04670>>12000000
TDEV := DEVPARM(2);                                            <<04670>>12002000
GET'COPY'KEYWORD := TRUE;                                      <<04670>>12004000
END;                                                           <<04670>>12006000
$PAGE "   COPY FUNCTION   -   MAIN PROCEDURE"                  <<04670>>12008000
PROCEDURE COPY;                                                         12010000
OPTION PRIVILEGED,UNCALLABLE;                                           12012000
                                                               <<04670>>12014000
<<This procedure copies data from one disc to another.       >><<04670>>12016000
<<It copies system discs, private volumes, serial discs,     >><<04670>>12018000
<<foreign discs and scratch volumes. The source and          >><<04670>>12020000
<<destination discs must be down during copy. However, if    >><<04670>>12022000
<<user copy configured system disc (active) then such disc   >><<04670>>12024000
<<cannot be downed. During copy of active system disc the    >><<04670>>12026000
<<logging facility are disable to prevent log file expension >><<04670>>12028000
<<and only one user is on the system and no temporary files  >><<04670>>12030000
<<Only logical portion of data are copied. That is true for  >><<04670>>12032000
<<private volume, system discs and serial discs. If discs has>><<04670>>12034000
<<a scratch label or it is a foreign disc then the entire    >><<04670>>12036000
<<media is copied and all bad tracks/sectors are reported.   >><<04670>>12038000
<<If the destination disc has deleted or suspected tracks/   >><<04670>>12040000
<<sectors then they are reassigned or spared (CS80).         >><<04670>>12042000
<<The COPY command has an option VERify. It allows to        >><<04670>>12044000
<<validate a data written on destination discs. If any error >><<04670>>12046000
<<(read) occurs it tries to copy again sector or track. If   >><<04670>>12048000
<<during disc to disc copy any read error occurs on source   >><<04670>>12050000
<<disc it will be entered into Defective Track/Sector Table  >><<04670>>12052000
<<of destination disc so, that user can perform a VINIT      >><<04670>>12054000
<<VERIFY command to check e.g. what files have lost data     >><<04670>>12056000
<<(it is only applicable for logicaly mounted private        >><<04670>>12058000
<<volumes or system discs.                                   >><<04670>>12060000
                                                               <<04670>>12062000
BEGIN                                                                   12064000
     INTEGER I:=-1,GEN:=-1,TRK:=-1;                                     12066000
     INTEGER TR,WC,ENT,ERR,FDEV,TDEV,FLPS,TLPS,INDEX,          <<04670>>12068000
             BUFSIZE,LEN,RIOQ,WIOQ,DST1:=0,DST2:=0,RDST,WDST,  <<04670>>12070000
             RWC,WWC,SAVLOGINFO,SAVFLAGF,INTERVAL := 1,TEMP,   <<04670>>12072000
             LPSTRK,                                           <<RK1PV>>12074000
             trklen,fsubtype,tsubtype;                         <<03510>>12076000
     INTEGER       ttype                                       <<03510>>12078000
                  ,ftype                                       <<03510>>12080000
                  ,lpage                                       <<03510>>12082000
                  ;                                            <<03510>>12086000
     DOUBLE        loc'bit'cnt                                 <<03510>>12088000
                  ;                                            <<03510>>12092000
     LOGICAL       lcrit'set                                   <<03510>>12094000
                  ,dfs'status                                  <<03510>>12096000
                  ,more                                        <<03510>>12098000
                  ,proc'status                                 <<03510>>12100000
                  ,lcrit                                       <<03510>>12102000
                  ,dfs'locked                                  <<03510>>12104000
                  ,cont                                        <<03510>>12106000
                  ;                                            <<03510>>12108000
     LOGICAL VER;   <<VERIFY FLAG>>                            <<04670>>12110000
     LOGICAL A,TFORVOL,IOSTAT;                                 <<04670>>12112000
     LOGICAL LOGGING'OFF := FALSE;                             <<04670>>12114000
     DOUBLE ADDR,DISC'ADDR,DISC'SIZE,SIZE,SECBUF;              <<04670>>12116000
     INTEGER POINTER BP := 0;                                  <<04670>>12118000
     DOUBLE VTABINFO;                                                   12120000
     INTEGER                                                            12122000
          VTABINFO1 = VTABINFO,                                         12124000
          VTBAINFO2 = VTABINFO+1;                                       12126000
     ARRAY VLAB(0:127);                                        <<RK.08>>12130000
     BYTE ARRAY VLABB(*) = VLAB;                               <<RK.08>>12132000
     << use this define to exit proc from subr >>              <<03510>>12134000
                                                               <<03510>>12136000
     DEFINE exit'procedure = ASSEMBLE(exit 0)#;                <<03510>>12138000
     DEFINE DISABLE'INT    = ASSEMBLE (SED 0)#;                <<04670>>12140000
     DEFINE ENABLE'INT     = ASSEMBLE (SED 1)#;                <<04670>>12142000
     EQUATE LOGINFO        = SYSDB + %167;                     <<04670>>12144000
     EQUATE FLAGF          = SYSDB + %176;                     <<04670>>12146000
     DEFINE LOGGINGFLAG    = (15:1)#;                          <<04670>>12148000
     DEFINE SOFTPREEMPTLOG = (11:1)#;                          <<04670>>12150000
                                                               <<03510>>12152000
                                                               <<04670>>12156000
SUBROUTINE DISABLE'LOGGING;                                    <<04670>>12158000
   BEGIN                                                       <<04670>>12160000
   <<Disable system logging>>                                  <<04670>>12162000
   GENMSG (PVMSGSET,VIWARN127);                                <<04670>>12164000
   DISABLE'INT;                                                <<04670>>12166000
   SAVLOGINFO := ABSOLUTE(LOGINFO).LOGGINGFLAG;                <<04670>>12168000
   ABSOLUTE(LOGINFO).LOGGINGFLAG := 0;                         <<04670>>12170000
   SAVFLAGF := ABSOLUTE(FLAGF).SOFTPREEMPTLOG;                 <<04670>>12172000
   ABSOLUTE(FLAGF).SOFTPREEMPTLOG := 1;                        <<04670>>12174000
   ENABLE'INT;                                                 <<04670>>12176000
   LOGGING'OFF := TRUE;                                        <<04670>>12178000
   END;                                                        <<04670>>12180000
                                                               <<04670>>12182000
SUBROUTINE ENABLE'LOGGING;                                     <<04670>>12184000
   BEGIN                                                       <<04670>>12186000
   DISABLE'INT;                                                <<04670>>12188000
   ABSOLUTE(LOGINFO).LOGGINGFLAG := SAVLOGINFO;                <<04670>>12190000
   ABSOLUTE(FLAGF).SOFTPREEMPTLOG := SAVFLAGF;                 <<04670>>12192000
   ENABLE'INT;                                                 <<04670>>12194000
   GENMSG (PVMSGSET,VIWARN128);                                <<04670>>12196000
   LOGGING'OFF := FALSE;                                       <<04670>>12198000
   END;                                                        <<04670>>12200000
                                                               <<04670>>12202000
SUBROUTINE UPDATEVTAB;                                         <<04670>>12204000
                                                               <<04670>>12206000
   <<This subroutine updates entry in volume table>>           <<04670>>12208000
                                                               <<04670>>12210000
   BEGIN                                                       <<04670>>12212000
   DISCIO (TDEV,R,VLAB,0D,SECSIZE);                            <<04670>>12214000
   IF <> THEN                                                  <<04670>>12216000
      RETURN;                                                  <<04670>>12218000
   BUFF := "  ";                                               <<04670>>12220000
   IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,TDEV,I))=0D THEN        <<04670>>12222000
   BEGIN                                                       <<04670>>12224000
      GENMSG (PVMSGSET,VIERR38,%10000,TDEV);                   <<04670>>12226000
      RETURN;                                                  <<04670>>12228000
   END;                                                        <<04670>>12230000
   INDEX := VTABINFO1.(8:8);                                   <<04670>>12232000
   A := GETSIR (VTABSIR);                                      <<04670>>12234000
   GETABENTRY (VTABDST,INDEX,BUFF);                            <<04670>>12236000
   MOVE BUFFB := VLABB (LVNAMELOC),(8),2;  <<VOLUME NAME>>     <<04670>>12238000
   MOVE * := VLABB (LVSGROUPLOC),(8),2;    <<GROUP NAME >>     <<04670>>12240000
   MOVE * := VLABB (LVSACCNTLOC),(8);      <<ACCOUNT NAME>>    <<04670>>12242000
   BUFF(12).(12:4):=IF SCRVOL THEN 3 ELSE 2;                   <<04670>>12244000
   BUFF (13) := 0;                                             <<04670>>12246000
   LPDT(TDEV&LSL(1)+1).SDLF:=IF SERIALD OR FORVOL THEN         <<04670>>12248000
                                1                              <<04670>>12250000
                             ELSE                              <<04670>>12252000
                                0;                             <<04670>>12254000
   LPDT(TDEV&LSL(1)+1).FORS:=IF FORVOL THEN                    <<04670>>12256000
                                1                              <<04670>>12258000
                             ELSE                              <<04670>>12260000
                                0;                             <<04670>>12262000
   PUTABENTRY (VTABDST,INDEX,BUFF);                            <<04670>>12264000
   RELSIR (VTABSIR,A);                                         <<04670>>12266000
   END;  <<UPDATEVATB>>                                        <<04670>>12268000
                                                               <<04670>>12270000
                                                               <<04670>>12272000
                                                               <<04670>>12274000
     IF NOT GET'COPY'KEYWORD (FDEV,TDEV,GEN,VER,BUFSIZE) THEN  <<04670>>12276000
        RETURN;                                                <<04670>>12278000
                                                               <<04670>>12280000
     IF NOT GET'DEV'INFO (TDEV,TTYPE,TSUBTYPE) THEN            <<04670>>12282000
        RETURN;                                                <<04670>>12284000
     TFORVOL := FORVOL;                                        <<04670>>12286000
     IF NOT GET'DEV'INFO (FDEV,FTYPE,FSUBTYPE) THEN            <<04670>>12288000
        RETURN;                                                <<04670>>12290000
     IF (FTYPE <> TTYPE) OR (FSUBTYPE <> TSUBTYPE) OR          <<04670>>12292000
        LINUS THEN                                             <<04670>>12294000
        BEGIN                                                  <<04670>>12296000
        GENMSG (PVMSGSET,VIERR8);                              <<04670>>12298000
        GENMSG (PVMSGSET,VIERR0);                              <<04670>>12300000
        RETURN;                                                <<04670>>12302000
        END;                                                   <<04670>>12304000
     IF NOT FORVOL AND TFORVOL THEN                            <<04670>>12306000
        INAPPROPRIATE;                                         <<04670>>12308000
     LDEV := TDEV;   <<Spare CS80>>                            <<04670>>12310000
                                                               <<04670>>12312000
     DOWNDEV := DEVSTATUS(1).DOWNF;                            <<04670>>12314000
     IF NOT DOWNDEV THEN                                       <<04670>>12316000
        IF NOT SYS OR NOT VOLUME'MOUNTED (FDEV) THEN           <<04670>>12318000
           BEGIN                                               <<04670>>12320000
           GENMSG (PVMSGSET,VIERR5,%10000,FDEV);               <<04670>>12322000
           GENMSG (PVMSGSET,VIERR0);                           <<04670>>12324000
           RETURN;                                             <<04670>>12326000
           END                                                 <<04670>>12328000
        ELSE  <<MOUNTED SYSTEM VOLUME>>                        <<04670>>12330000
           IF NOT ONLY'ONE'ON THEN                             <<04670>>12332000
              BEGIN                                            <<04670>>12334000
              GENMSG (PVMSGSET,VIERR135);                      <<04670>>12336000
              GENMSG (PVMSGSET,VIERR0);                        <<04670>>12338000
              RETURN;                                          <<04670>>12340000
              END                                              <<04670>>12342000
           ELSE                                                <<04670>>12344000
              IF ABSOLUTE(LOGINFO).LOGGINGFLAG THEN            <<04670>>12346000
                 <<Disable system logging to prevent a log  >> <<04670>>12348000
                 <<file expantion.                          >> <<04670>>12350000
                 DISABLE'LOGGING;                              <<04670>>12352000
     IF DEVSTATUS(2).DOWNF = 0 THEN                            <<04670>>12354000
        BEGIN                                                  <<04670>>12356000
        GENMSG (PVMSGSET,VIERR5,%10000,TDEV);                  <<04670>>12358000
        GENMSG (PVMSGSET,VIERR0);                              <<04670>>12360000
        GOTO XIT;                                              <<04670>>12362000
        END                                                    <<04670>>12364000
     ELSE                                                      <<04670>>12366000
        IF NOT OVERWRITE(TDEV,4) THEN                          <<04670>>12368000
           GOTO XIT;                                           <<04670>>12370000
                                                               <<04670>>12372000
     IF NOT GET'DISC'INFO(FDEV,,,,,,SIZE,,,,,,,,,,MAXLPS) THEN <<04670>>12374000
        GOTO ER;                                               <<04670>>12376000
     IF NOT GET'DISC'INFO (TDEV,,,,,,DISC'SIZE) THEN           <<04670>>12378000
        GOTO ER;                                               <<04670>>12380000
     IF SIZE <> DISC'SIZE THEN                                 <<04670>>12382000
        BEGIN                                                  <<04670>>12384000
        GENMSG (PVMSGSET,VIERR9);                              <<04670>>12386000
ER:     GENMSG (PVMSGSET,VIERR0);                              <<04670>>12388000
        GOTO XIT;                                              <<04670>>12390000
        END;                                                   <<04670>>12392000
                                                               <<04670>>12394000
     IF NOT ALLOC'DATA'SEG (DST1,DST2,BUFSIZE) THEN            <<04670>>12396000
        BEGIN                                                  <<04670>>12398000
        GENMSG(PVMSGSET,VIERR0);                               <<04670>>12400000
        GOTO XIT;                                              <<04670>>12402000
        END;                                                   <<04670>>12404000
                                                               <<04670>>12406000
     IF NOT PROCESS'DTT (TDEV) THEN                            <<04670>>12408000
     RETURN;                                                   <<04670>>12410000
                                                               <<04670>>12412000
     IF (DISC'SIZE := CALC'DISC'SIZE(FDEV)) = 0D THEN          <<04670>>12414000
        BEGIN                                                  <<04670>>12416000
        GENMSG(PVMSGSET,VIERR0);                               <<04670>>12418000
        GOTO XIT;                                              <<04670>>12420000
        END;                                                   <<04670>>12422000
     ENABLE'BREAK;                                             <<04670>>12424000
                                                               <<04670>>12426000
     IF (PVOL OR SYS) AND NOT VOLUME'MOUNTED(FDEV) THEN        <<04670>>12428000
        GENMSG (PVMSGSET,VIWARN129,%10000,FDEV);               <<04670>>12430000
     LEN := INT(DISC'SIZE*100D/SIZE);                          <<04670>>12432000
     IF LEN = 0 THEN                                           <<04670>>12434000
        LEN := 1;                                              <<04670>>12436000
     IF LEN <= 10 THEN   << If <10% then no msg >>             <<04670>>12438000
        INTERVAL := 6;                                         <<04670>>12440000
     GENMSG (PVMSGSET,VIWARN134,%10000,LEN);                   <<04670>>12442000
     SECBUF := DOUBLE(BUFSIZE/SECSIZE);                        <<04670>>12444000
     RWC := WWC := BUFSIZE;                                    <<04670>>12446000
     ADDR := IF FORVOL THEN 0D ELSE 2D;                        <<04670>>12448000
     RDST := WDST := DST2;                                     <<04670>>12450000
     DTT'CHANGES := 0;                                         <<04670>>12452000
                                                               <<04670>>12454000
     <<Scratch volume temprorary during copy>>                 <<04670>>12456000
                                                               <<04670>>12458000
     IF NOT FORVOL THEN                                        <<04670>>12460000
        BEGIN                                                  <<04670>>12462000
        SETSCRATCH (TDEV,%3);                                  <<04670>>12464000
        TEMP := SCRVOL;                                        <<04670>>12466000
        SCRVOL := 1;                                           <<04670>>12468000
        UPDATEVTAB;  <<Update VTAB >>                          <<04670>>12470000
        SCRVOL := TEMP;                                        <<04670>>12472000
        END;                                                   <<04670>>12474000
                                                               <<04670>>12476000
     << Read first 255 sectors with wait >>                    <<04670>>12478000
                                                               <<04670>>12480000
     IOSTAT := 2;                                              <<04670>>12482000
     LEN := DISCIO(FDEV,R,BP,ADDR,RWC,IOSTAT,RDST);            <<04670>>12484000
     IF (IOSTAT.GSTATUS <> SUCCESSFUL) AND NOT PROC'IO'ERROR   <<04670>>12486000
        (FDEV,TDEV,ADDR,RDST,0,LEN,RWC,IOSTAT) THEN            <<04670>>12488000
        GOTO XIT;                                              <<04670>>12490000
                                                               <<04670>>12492000
     RDST := DST1;                                             <<04670>>12494000
     ADDR := ADDR + SECBUF;                                    <<04670>>12496000
                                                               <<04670>>12498000
     DO                                                        <<04670>>12500000
        BEGIN                                                  <<04670>>12502000
                                                               <<04670>>12504000
        RIOQ := WIOQ := %407;                                  <<04670>>12506000
        RWC := IF (ADDR + SECBUF) < DISC'SIZE THEN             <<04670>>12508000
               BUFSIZE ELSE                                    <<04670>>12510000
               INTEGER(DISC'SIZE - ADDR) * SECSIZE;            <<04670>>12512000
                                                               <<04670>>12514000
        DISCIO(FDEV,R,BP,ADDR,RWC,RIOQ,RDST);                  <<04670>>12516000
        IF <> THEN                                             <<04670>>12518000
           GOTO XIT;                                           <<04670>>12520000
                                                               <<04670>>12522000
        DISCIO(TDEV,W,BP,ADDR-SECBUF,WWC,WIOQ,WDST);           <<04670>>12524000
        IF <> THEN                                             <<04670>>12526000
           GOTO XIT;                                           <<04670>>12528000
                                                               <<04670>>12530000
        TOS := WAITFORIO(RIOQ);                                <<04670>>12532000
        LEN := TOS;                                            <<04670>>12534000
        IOSTAT := TOS;                                         <<04670>>12536000
        IF (IOSTAT.GSTATUS <> SUCCESSFUL) AND NOT PROC'IO'ERROR<<04670>>12538000
           (FDEV,TDEV,ADDR,RDST,0,LEN,RWC,IOSTAT) THEN         <<04670>>12540000
           GOTO XIT;                                           <<04670>>12542000
                                                               <<04670>>12544000
        TOS := WAITFORIO(WIOQ);                                <<04670>>12546000
        DELETE;                                                <<04670>>12548000
        IOSTAT := TOS;                                         <<04670>>12550000
        IF IOSTAT.GSTATUS <> SUCCESSFUL THEN                   <<04670>>12552000
           BEGIN                                               <<04670>>12554000
           DISCERROR(TDEV,W,IOSTAT,ADDR-SECBUF,STAT.(8:8),DELP)<<04670>>12556000
           ;                                                   <<04670>>12558000
           GENMSG(PVMSGSET,VIERR0);                            <<04670>>12560000
           GOTO XIT;                                           <<04670>>12562000
           END;                                                <<04670>>12564000
                                                               <<04670>>12566000
        IF INT(ADDR*5D/DISC'SIZE) = INTERVAL THEN              <<04670>>12568000
           BEGIN                                               <<04670>>12570000
           INTERVAL := INTERVAL + 1;                           <<04670>>12572000
           GENMSG (PVMSGSET,VIWARN133,%10000,                  <<04670>>12574000
                   INT(ADDR*100D/DISC'SIZE));                  <<04670>>12576000
           END;                                                <<04670>>12578000
        IOSTAT := RDST;                                        <<04670>>12580000
        RDST := WDST;                                          <<04670>>12582000
        WDST := IOSTAT;                                        <<04670>>12584000
                                                               <<04670>>12586000
        END                                                    <<04670>>12588000
     UNTIL (ADDR := ADDR + SECBUF) > DISC'SIZE;                <<04670>>12590000
                                                               <<04670>>12592000
     WWC := RWC;                                               <<04670>>12594000
     IOSTAT := 5;                                              <<04670>>12596000
     DISCIO(TDEV,W,BP,ADDR-SECBUF,WWC,IOSTAT,WDST);            <<04670>>12598000
     IF <> THEN                                                <<04670>>12600000
        GOTO XIT;                                              <<04670>>12602000
     IF LOGGING'OFF THEN                                       <<04670>>12604000
        ENABLE'LOGGING;                                        <<04670>>12606000
                                                               <<04670>>12608000
<<Release buffers data segments                             >> <<04670>>12610000
                                                               <<04670>>12612000
     RELDATASEG(DST2);                                         <<04670>>12614000
     DST2 := 0;                                                <<04670>>12616000
                                                               <<04670>>12618000
<<Update volume label and volume table                      >> <<04670>>12620000
                                                               <<04670>>12622000
     IF NOT FORVOL THEN                                        <<04670>>12624000
        BEGIN                                                  <<04670>>12626000
        DISCIO(FDEV,R,VLAB,0D,128);                            <<04670>>12628000
        IF < THEN GOTO XIT;                                    <<04670>>12630000
        IF PVOL OR SYS THEN                                    <<04670>>12632000
           VLAB(LGENINDEX) := IF KEYWDSPEC THEN                <<04670>>12634000
                              IF GEN >= 0 THEN                 <<04670>>12636000
                                 GEN                           <<04670>>12638000
                              ELSE VLAB(LGENINDEX) ELSE        <<04670>>12640000
                              VLAB(LGENINDEX) + 1;             <<04670>>12642000
        DISCIO(TDEV,WL,VLAB,0D,128);                           <<04670>>12644000
        IF < THEN GOTO XIT;                                    <<04670>>12646000
        END;                                                   <<04670>>12648000
     UPDATEVTAB;                                               <<04670>>12650000
     IF VER THEN                                               <<04670>>12652000
                                                               <<04670>>12654000
<< VERIFY >>                                                   <<04670>>12656000
                                                               <<04670>>12658000
        BEGIN                                                  <<04670>>12660000
        GENMSG (PVMSGSET,VIWARN88);                            <<04670>>12662000
                                                               <<04670>>12664000
        IF NOT VERIFY'MEDIA (TDEV,DISC'SIZE) THEN              <<04670>>12666000
           GOTO XIT;                                           <<04670>>12668000
                                                               <<04670>>12670000
        SORT'ENTRIES;   <<SORT DTT/DSCT>>                      <<04670>>12672000
                                                               <<04670>>12674000
        DTT'CHANGES := 0;                                      <<04670>>12676000
        WHILE GET'ENTRY (ADDR,SIZE) DO                         <<04670>>12678000
           IF USED'SPACE (FDEV,ADDR,SIZE) THEN                 <<04670>>12680000
           IF NOT COPY'TRACK (FDEV,TDEV,BUFSIZE,ADDR,DST1)     <<04670>>12682000
              THEN BEGIN                                       <<04670>>12684000
              GENMSG (PVMSGSET,VIERR0);                        <<04670>>12686000
              GOTO XIT;                                        <<04670>>12688000
              END;                                             <<04670>>12690000
           END;                                                <<04670>>12692000
     IF DTT'CHANGES <> 0 AND                                   <<04670>>12694000
        (ERR := CHECK'BAD'FILES (FDEV)) <> 0 THEN              <<04670>>12696000
        IF ERR = -1 THEN                                       <<04670>>12698000
           GENMSG (PVMSGSET,VIWARN130,%10000,FDEV)             <<04670>>12700000
        ELSE                                                   <<04670>>12702000
           GENMSG (PVMSGSET,ERR);                              <<04670>>12704000
                                                               <<04670>>12706000
XIT:                                                           <<04670>>12708000
     IF DST1 <> 0 THEN                                         <<04670>>12710000
        RELDATASEG (DST1);                                     <<04670>>12712000
     IF DST2 <> 0 THEN                                         <<04670>>12714000
        RELDATASEG (DST2);                                     <<04670>>12716000
     IF LOGGING'OFF THEN                                       <<04670>>12718000
        ENABLE'LOGGING;                                        <<04670>>12720000
END  <<COPY>>;                                                 <<04670>>12722000
                                                                        12724000
$PAGE "PVINIT - USER COMMANDS: CONDENSE"                       <<RK.08>>12726000
$CONTROL SEGMENT=CONDENSE                                      <<00239>>12728000
PROCEDURE cond;                                                <<03510>>12730000
   OPTION privileged,uncallable;                               <<03510>>12732000
                                                               <<03510>>12734000
BEGIN                                                          <<03510>>12736000
                                                               <<03510>>12738000
   INTEGER        ldev                                         <<03510>>12740000
                                                               <<03510>>12742000
                 ;                                             <<03510>>12744000
                                                               <<03510>>12746000
   LOGICAL                                                     <<03510>>12748000
                  recover                                      <<03510>>12750000
                                                               <<03510>>12752000
                 ;                                             <<03510>>12754000
                                                               <<03510>>12756000
                                                               <<03510>>12758000
                                                               <<03510>>12760000
   ldev:=devparm(1);   << what device to condense >>           <<03510>>12762000
   IF foreign then inappropriate;                              <<03510>>12764000
                                                               <<03510>>12766000
   IF keywdspec THEN     << only one allowed is recover >>     <<03510>>12768000
      BEGIN                                                    <<03510>>12770000
         IF keyword <> "RECOVER" THEN                          <<03510>>12772000
            BEGIN                                              <<03510>>12774000
               genmsg(pvmsgset,vierr3);                        <<03510>>12776000
               RETURN;                                         <<03510>>12778000
            END                                                <<03510>>12780000
         ELSE    recover:=true;                                <<03510>>12782000
      END                                                      <<03510>>12784000
   ELSE    recover:=false;                                     <<03510>>12786000
                                                               <<03510>>12788000
   <<  bad disc label? >>                                      <<03510>>12790000
                                                               <<03510>>12792000
   IF unreadable'label(ldev,false) THEN RETURN;                <<03510>>12794000
                                                               <<03510>>12796000
                                                               <<03510>>12798000
   condense'disc(ldev,recover);                                <<03510>>12800000
                                                               <<03510>>12802000
                                                               <<03510>>12804000
END;     << cond >>                                            <<03510>>12806000
                                                                        12810000
$PAGE "PVINIT - USER COMMANDS: DTRACK FUNCTION "               <<00239>>12812000
$CONTROL SEGMENT=CONDENSE                                      <<00239>>12814000
PROCEDURE PROCESS'BAD'TRKS(LDEV);                              <<00239>>12816000
VALUE LDEV;                                                    <<00239>>12818000
INTEGER LDEV;                                                  <<00239>>12820000
OPTION PRIVILEGED,UNCALLABLE;                                  <<00239>>12822000
BEGIN                                                          <<00239>>12824000
     INTEGER i,j,k,pverr,                                      <<03510>>12826000
          NUMENTRIES;                                          <<00239>>12828000
     INTEGER MVTABX:=0,THISVOL:=0;                             <<00239>>12830000
     INTEGER fnum,subtype,type;                                <<03510>>12832000
     BYTE ARRAY TEMP(0:29);                                    <<00239>>12834000
     BYTE ARRAY TEMP1(0:9);                                    <<00239>>12836000
     LOGICAL A,B,C;  <<SIRS LOCKED>>                           <<00239>>12838000
     LOGICAL lcrit     << returned from setcritical >>         <<03510>>12840000
            ,dfs'status                                        <<03510>>12842000
            ,proc'status                                       <<03510>>12844000
            ,dfs'locked                                        <<03510>>12846000
            ,lcrit'set                                         <<03510>>12848000
            ,logging'off                                       <<03510>>12850000
            ,purge                                             <<03620>>12852000
            ,purge'all                                         <<03620>>12854000
            ;                                                  <<03510>>12856000
     INTEGER savloginfo      << save logging bit >>            <<03510>>12858000
            ,savflagf        << save soft error  >>            <<03510>>12860000
            ;                                                  <<03510>>12862000
     INTEGER ARRAY VDTAB(0:32) = Q;                            <<00239>>12866000
     ARRAY VTAB(*) = DB+0;                                     <<00239>>12868000
     ARRAY                                                     <<00239>>12870000
          VLAB(*)      = BUFF,                                 <<00239>>12872000
          VSDEFN(*)    = BUFF,                                 <<00239>>12874000
          MVTABENT(*)  = BUFF;                                 <<00239>>12876000
     DOUBLE ARRAY MVTABENT'3D(*) = MVTABENT(3);                <<00239>>12880000
     ARRAY VSID(0:11);                                         <<00239>>12882000
     ARRAY DUM(*) = VSID;  <<DUMMY PARAMETER TO DIRSCAN>>      <<00239>>12884000
     INTEGER POINTER VTABENT;                                  <<00239>>12886000
     INTEGER ARRAY DIRPARMS(0:9);                              <<00239>>12888000
     INTEGER VOL'COUNT;                                        <<00239>>12892000
    <<NOTE--NAMESW AND FILE'DISP ARRAYS HAVE 2 EXTRA ENTRIES>> <<00866>>12896000
    <<THIS IS A FUDGE FACTOR TO AVOID POSSIBLE OVERFLOW>>      <<00866>>12898000
     ARRAY NAMESW(0:(((MAXSECTTRK+2)*12)+11));                 <<00866>>12900000
     BYTE ARRAY NAMES(*) = NAMESW;                             <<00239>>12902000
     ARRAY FNAME(*) = NAMESW(0);                               <<00239>>12904000
     ARRAY GNAME(*) = NAMESW(4);                               <<00239>>12906000
     ARRAY ANAME(*) = NAMESW(8);                               <<00239>>12908000
     DOUBLE ARRAY TRACK'START(0:120);                          <<00239>>12910000
     DOUBLE ARRAY TRACK'END(0:120);                            <<00239>>12912000
     DOUBLE  qtrack'start; << track'start(i),in split stack >> <<03510>>12914000
     DOUBLE ADDR;                                              <<03620>>12916000
     INTEGER ADDR1 = ADDR,                                     <<03620>>12918000
             ADDR2 = ADDR+1;                                   <<03620>>12920000
     INTEGER ARRAY FILE'DISP(0:(MAXSECTTRK+2));                <<00866>>12922000
     EQUATE FOPTIONS = %2001,                                  <<00239>>12924000
            AOPTIONS = %10501,                                 <<00239>>12926000
            DELETE'FILE = 4;  << FOR FCLOSE >>                 <<00239>>12928000
                                                               <<00239>>12930000
     << use this define to exit proc from subr >>              <<03510>>12932000
                                                               <<03510>>12934000
     DEFINE exit'procedure = ASSEMBLE(exit 1)#;                <<03510>>12936000
                                                               <<03510>>12938000
                                                               <<00239>>12940000
     << used to define enable/disable logging  >>              <<03510>>12942000
                                                               <<03510>>12944000
     DEFINE disable'int= ASSEMBLE(sed 0)#;                     <<03510>>12946000
     DEFINE enable'int = ASSEMBLE(sed 1)#;                     <<03510>>12948000
     EQUATE loginfo= sysdb +%167;                              <<03510>>12950000
     EQUATE flagf  = sysdb +%176;                              <<03510>>12952000
     DEFINE loggingflag = (15:1)#;  << = 0 no logging >>       <<03510>>12954000
     DEFINE softpreemptlog = (11:1)#;                          <<03510>>12956000
                          << = 1 keep stats, but dont >>       <<03510>>12958000
                            <<log-used when know will >>       <<03510>>12960000
                   << eventually recover from "error" >>       <<03510>>12962000
                                                               <<03510>>12964000
     SUBROUTINE LEAVE(MSGNUM);                                 <<00239>>12966000
     VALUE MSGNUM;                                             <<00239>>12968000
     INTEGER MSGNUM;                                           <<00239>>12970000
     BEGIN                                                     <<00239>>12972000
         IF logging'off THEN                                   <<03510>>12974000
             BEGIN                                             <<03510>>12976000
               << now enable logging if it was previously >>   <<03510>>12978000
               << enabled                                 >>   <<03510>>12980000
               disable'int;                                    <<03510>>12982000
               ABSOLUTE(loginfo).loggingflag:=savloginfo;      <<03510>>12984000
               ABSOLUTE(flagf).softpreemptlog:=savflagf;       <<03510>>12986000
               enable'int;                                     <<03510>>12988000
            END;                                               <<03510>>12990000
                                                               <<03510>>12992000
          RELSIR(DIRSIR,C);                                    <<00239>>12994000
          RELSIR(LDTSIR,B);                                    <<00239>>12996000
          RELSIR(FILESIR,A);                                   <<00239>>12998000
          IF MSGNUM > 0 THEN                                   <<00239>>13000000
             GENMSG(PVMSGSET,MSGNUM);                          <<00239>>13002000
          CC := IF MSGNUM < 0 THEN CCE                         <<00239>>13004000
                ELSE CCL;  << DIDN'T FINISH >>                 <<00239>>13006000
         << generate a message to say logging enabled if >>    <<03510>>13008000
         << it was before                                >>    <<03510>>13010000
                                                               <<03510>>13012000
         IF logging'off THEN                                   <<03510>>13014000
            BEGIN                                              <<03510>>13016000
               genmsg(pvmsgset,viwarn87,,,,,,,0);              <<03510>>13018000
               logging'off:=false;                             <<03510>>13020000
            END;                                               <<03510>>13022000
                                                               <<03510>>13024000
          exit'procedure;                                      <<03510>>13026000
     END <<LEAVE>>;                                            <<00239>>13028000
     SUBROUTINE call'leave(err);                               <<03510>>13030000
        value err;                                             <<03510>>13032000
        LOGICAL err;                                           <<03510>>13034000
                                                               <<03510>>13036000
     BEGIN                                                     <<03510>>13038000
                                                               <<03510>>13040000
$IF X3=ON                                                      <<03510>>13042000
         debug;                                                <<03510>>13044000
$IF                                                            <<03510>>13046000
        IF dfs'locked THEN Unlock'Dfs'Data'Seg;                <<03510>>13048000
        IF lcrit'set THEN resetcritical(lcrit);                <<03510>>13050000
        leave(vierr34);                                        <<03510>>13052000
     END;                                                      <<03510>>13054000
<< Procedure to flag the tracks as defective or reassigned   >><<03510>>13056000
<< IT will only work for private volumes which are up or     >><<03510>>13058000
<< have a down pending or logically mounted                  >><<03510>>13060000
<< Before this routine is called, "getfunction" checks to mak>><<03510>>13062000
<< sure this is true or will error off. "dtrack" checks for  >><<03510>>13064000
<< only'one'on. Spoolfiles around are ok cuz can only do this>><<03510>>13066000
<< for pv, and they are never spooled.                       >><<03510>>13068000
<< Also shouldn't have temp files alloc on LDEV,             >><<03510>>13070000
<< only'one'on checks for any temp files                     >><<03510>>13072000
<< Get the file,ldt,and dirc sir. Verify that "ldev" is in   >><<03510>>13074000
<< mounted vol table. Convert the track addresses of what is >><<03510>>13076000
<< being chged to sector addresses. THen run through the dirc>><<03510>>13078000
<< looking for files on those addresses(delete these files)  >><<03510>>13080000
<< Then for these deleted tracks, call DFSM routines to      >><<03510>>13082000
<< mark this track as allocated. NOTE ther may be lost space >><<03510>>13084000
<< on this track so call "Must'Set'Reset'Bit'Map             >><<03510>>13086000
<< NOTICE that this routine operates in split stack mode     >><<03510>>13088000
<< in two places-mvtab access and When calling the DFSM      >><<03510>>13090000
<< routines!!!                                               >><<03510>>13092000
                                                               <<03510>>13094000
                                                               <<00239>>13096000
     dfs'locked:=false;  << initialize >>                      <<03510>>13098000
     lcrit'set:=false;                                         <<03510>>13100000
     logging'off:=false;   << initialize >>                    <<03510>>13102000
     Get'Disc'Info(ldev,,,,type,subtype);                      <<03510>>13104000
     IF (type=fh'disc'type LAND                                <<03510>>13108000
             st'2660'2m <=subtype <=st'2660'4m )               <<03510>>13110000
        OR                                                     <<03510>>13112000
        (type=mh'disc'type LAND                                <<03510>>13114000
             up'7900 <=subtype <=st'2888 ) THEN RETURN;        <<03510>>13116000
                                                               <<03510>>13120000
     << logging enabled >>                                     <<03510>>13122000
                                                               <<03510>>13124000
     IF ABSOLUTE(loginfo).loggingflag THEN                     <<03510>>13126000
        BEGIN                                                  <<03510>>13128000
                                                               <<03510>>13130000
        << going to disable system logging because i dont wan>><<03510>>13132000
        << to get hung up on file sir if log file needs ext  >><<03510>>13134000
           << first generate a message to console/log file   >><<03510>>13136000
           genmsg(pvmsgset,viwarn86,,,,,,,0);                  <<03510>>13138000
                                                               <<03510>>13140000
           disable'int;                                        <<03510>>13142000
           savloginfo:=ABSOLUTE(loginfo).loggingflag;          <<03510>>13144000
           ABSOLUTE(loginfo).loggingflag:=0;                   <<03510>>13146000
           savflagf:=ABSOLUTE(flagf).softpreemptlog;           <<03510>>13148000
           ABSOLUTE(flagf).softpreemptlog:=1;                  <<03510>>13150000
           enable'int;                                         <<03510>>13152000
           logging'off:=true;                                  <<03510>>13154000
        END;                                                   <<03510>>13156000
                                                               <<03510>>13158000
     A:=GETSIR(FILESIR);                                       <<00239>>13160000
     B:=GETSIR(LDTSIR);                                        <<00239>>13162000
     C:=GETSIR(DIRSIR);                                        <<00239>>13164000
     IF NOT ONLY'ONE'ON THEN                                   <<00239>>13166000
        BEGIN                                                  <<00239>>13168000
        GENMSG(PVMSGSET,VIWARN9);                              <<00239>>13170000
        LEAVE(0);                                              <<00239>>13172000
        END;                                                   <<00239>>13174000
     IF type <> floppy'disc'type AND                           <<03510>>13176000
        subtype <> floppy'disc'subtype THEN                    <<03510>>13178000
     BEGIN << HP7920 TYPE FAMILY >>                            <<01533>>13180000
        TOS := REQSTATUS (LDEV);                               <<01533>>13182000
        ASSEMBLE (DELB);                                       <<01533>>13184000
        IF TOS.(9:2) <> 1 THEN  << REQUIRES FORMAT SWITCH >>   <<01533>>13186000
        BEGIN                                                  <<01533>>13188000
           GENMSG (PVMSGSET,VIERR33);                          <<01533>>13190000
           GENMSG (PVMSGSET,VIERR0);                           <<01533>>13192000
           LEAVE(0);                                           <<01533>>13194000
        END;                                                   <<01533>>13196000
     END;                                                      <<01533>>13198000
     VDTAB:=0; MOVE VDTAB(1):=VDTAB,(32);<<ZERO VOL-DEV TABLE>><<00239>>13200000
     IF LOGICAL(LPDT((LDEV & LSL(1))+1).NSDF) THEN             <<00239>>13202000
     BEGIN                                                     <<00239>>13204000
          DISCIO(LDEV,R,VLAB,0D,128);                          <<00239>>13206000
          IF < THEN leave(vierr85); << i/o err >>              <<03510>>13208000
          MOVE VSID   :=VLAB(LVOLDIR),(4);       <<SET>>       <<00239>>13212000
          MOVE VSID(4):=VLAB(LVSGROUPLOC'),(4);  <<GROUP>>     <<00239>>13214000
          MOVE VSID(8):=VLAB(LVSACCNTLOC'),(4);  <<ACCOUNT>>   <<00239>>13216000
          GETVSDEFN(VSID,VSDEFN,,PVERR);                       <<00239>>13218000
          IF <> THEN                                           <<00239>>13220000
          BEGIN                                                <<00239>>13222000
               GENMSG(PVMSGSET,PVERR);                         <<00239>>13224000
               leave(vierr85);                                 <<03510>>13226000
          END;                                                 <<00239>>13228000
          MVTABX:=VSDEFN(VDMISC).MVTABXF;                      <<00239>>13230000
          IF = THEN  <<VOLUME SET NOT MOUNTED>>                <<00239>>13232000
          BEGIN                                                <<00239>>13234000
               GENMSG(PVMSGSET,VIWARN5);                       <<00239>>13236000
               LEAVE(0);                                       <<00239>>13238000
          END;                                                 <<00239>>13240000
          VOL'COUNT := VSDEFN(VDINFO).NUMVOL;                  <<00239>>13242000
          GETMVTABENTRY(MVTABX,MVTABENT);                      <<00239>>13244000
          FOR I:=1 UNTIL VOL'COUNT DO                          <<00239>>13248000
          BEGIN                                                <<00239>>13250000
               IF MVTABENT'3D(I) <> 0D THEN  <<VOL MOUNTED>>   <<00239>>13252000
               BEGIN                                           <<00239>>13254000
                    VDTAB(I):=MVTABENT((I & LSL(1))+3).LDEVF;  <<00239>>13256000
                    IF VDTAB(I) = LDEV THEN THISVOL:=I;        <<00239>>13258000
               END                                             <<00239>>13260000
               ELSE                                            <<00239>>13262000
               BEGIN                                           <<00239>>13264000
                    GENMSG(PVMSGSET,VIWARN5);                  <<00239>>13266000
                    LEAVE(0);                                  <<00239>>13268000
               END;                                            <<00239>>13270000
          END;                                                 <<00239>>13272000
          IF THISVOL = 0 THEN  <<THIS DEV NOT PART OF SET>>    <<00239>>13274000
          BEGIN                                                <<00239>>13276000
               GENMSG(PVMSGSET,VIERR39);                       <<00239>>13278000
               leave(vierr85);                                 <<03510>>13280000
          END;                                                 <<00239>>13282000
     END ELSE                                                  <<00239>>13284000
     BEGIN                                                     <<00239>>13286000
           << this code makes no sense since "getfunction" >>  <<03510>>13288000
           << never allows a sys disc to come here & the   >>  <<03510>>13290000
           << algorithm used doesn't know about spool files>>  <<03510>>13292000
           << which may be on sys discs                    >>  <<03510>>13294000
          I:=0;                                                <<00239>>13296000
          MVTABX := 0;                                         <<00239>>13300000
          GETMVTABENTRY(MVTABX,MVTABENT);                      <<00239>>13302000
          EXCHANGEDB(VTABDST);                                 <<00239>>13306000
          WHILE (I:=I+1) <= INTEGER(VTAB(2)) DO                <<00239>>13308000
          BEGIN                                                <<00239>>13310000
               @VTABENT:=@VTAB(I*INTEGER(VTAB.(8:8)));         <<00239>>13312000
               IF VTABENT(12).LDEVF <> 0 THEN  <<ENTRY IN USE>><<00239>>13314000
               BEGIN                                           <<00239>>13316000
                    VDTAB(I):=VTABENT(12).LDEVF;               <<00239>>13318000
                    IF VDTAB(I) = LDEV THEN THISVOL:=I;        <<00239>>13320000
               END;                                            <<00239>>13322000
          END;                                                 <<00239>>13324000
          EXCHANGEDB(0);                                       <<00239>>13326000
     END;                                                      <<00239>>13330000
                                                               <<00239>>13332000
   IF CS'80 THEN                                               <<03620>>13334000
     BEGIN                                                     <<03620>>13336000
     J := 0;                                                   <<03620>>13338000
     FOR I := 1 UNTIL DTT'CHANGES DO                           <<03620>>13340000
        BEGIN                                                  <<03620>>13342000
        ADDR1 := DTT'CHANGES(J:=J+1);                          <<03620>>13344000
        ADDR2 := DTT'CHANGES(J:=J+1);                          <<03620>>13346000
        TRACK'START(I) := ADDR;                                <<03620>>13348000
        TRACK'END(I) := ADDR + DBL(DTT'CHANGES(J:=J+1)-1);     <<03620>>13350000
        END;                                                   <<03620>>13352000
     END                                                       <<03620>>13354000
     ELSE                                                      <<03620>>13356000
     FOR I := 1 UNTIL DTT'CHANGES DO                           <<00239>>13358000
        BEGIN                                                  <<00239>>13360000
       track'start(i):=DBL(sectrk) * DBL( dtt'changes(i).      <<03510>>13362000
                                        dtt'track'number );    <<03510>>13364000
        TRACK'END(I) := TRACK'START(I) + DBL(SECTRK-1);        <<03620>>13366000
        END;                                                   <<00239>>13368000
                                                               <<00866>>13370000
     << "maxsecttrk" was an arbitrary choice- leave it for   >><<03510>>13372000
     << now- the def won't be true when BFD is added         >><<03510>>13374000
    DO   <<CAN ONLY PROCESS A FINITE NUMBER OF FILES, SO...>>  <<00866>>13376000
    BEGIN  <<PROCESS UP TO MAXSECTTRK FILES>>                  <<00866>>13378000
     NUMENTRIES := DTT'CHANGES;                                <<00239>>13380000
     NAMESW := "  ";                                           <<00239>>13382000
     MOVE NAMESW(1) := NAMESW, ((MAXSECTTRK+1)*12);            <<00239>>13384000
     FILE'DISP := 0;                                           <<00239>>13386000
     MOVE FILE'DISP(1) := FILE'DISP(0),(MAXSECTTRK-1);         <<00866>>13388000
                                                               <<00239>>13390000
     DIRPARMS(1):=@VDTAB;                                      <<00239>>13392000
     DIRPARMS(2):=THISVOL;                                     <<00239>>13394000
     DIRPARMS(3):=NUMENTRIES;                                  <<00239>>13396000
     DIRPARMS(4):=@TRACK'START;                                <<00239>>13398000
     DIRPARMS(5):=@TRACK'END;                                  <<00239>>13400000
     DIRPARMS(6):=@NAMESW;                                     <<00239>>13402000
     DIRPARMS(7):=@FILE'DISP;                                  <<00239>>13404000
     DIRPARMS(8):=0;                                           <<03620>>13406000
                                                               <<00239>>13408000
     DIRPARMS:=0;  <<RECIP TYPE>>                              <<00239>>13410000
     DIRECSCAN(%120,0D,DUM,DUM,DUM,                            <<00239>>13412000
               DTRACK'RECIP,DIRPARMS,MVTABX);                  <<00239>>13414000
     IF <> THEN                                                <<00239>>13416000
     BEGIN                                                     <<00239>>13418000
          GENMSG(PVMSGSET,DIRECERR);                           <<00239>>13420000
          GENMSG(PVMSGSET,VIERR0);                             <<00239>>13422000
          leave(vierr85);                                      <<03510>>13424000
     END;                                                      <<00239>>13426000
     IF DIRPARMS < -1  THEN   <<DISC ERROR IN DTRACK'RECIP>>   <<00866>>13428000
     BEGIN                                                     <<00239>>13430000
          leave(vierr85);                                      <<03510>>13432000
     END;                                                      <<00239>>13434000
                                                               <<00239>>13436000
    IF FILE'DISP <> 0 THEN   <<ARE THERE ANY FILE TO PURGE ?>> <<03620>>13438000
      BEGIN                                                    <<03620>>13440000
      << DO YOU WANT DELETE ALL BAD FILES (Y/N) ? >>           <<03620>>13442000
      GENMSG(PVMSGSET,VIWARN107,0,,,,,,,,,,%100000);           <<03620>>13444000
      I := READ(PBUFW,-10);                                    <<03620>>13446000
      PURGE'ALL := IF I > 0 AND PBUF = "Y" THEN TRUE           <<03620>>13448000
                                           ELSE FALSE;         <<03620>>13450000
      END;                                                     <<03620>>13452000
     TEMP1(8) := " ";                                          <<00239>>13454000
    I := 0;                                                    <<00239>>13456000
     WHILE (I:=I+1) <= FILE'DISP DO                            <<00239>>13458000
        BEGIN                                                  <<00239>>13460000
        J := -1;                                               <<00239>>13462000
        TOS := @TEMP;                                          <<00239>>13464000
        WHILE (J:=J+1) < 3 DO                                  <<00239>>13466000
           BEGIN                                               <<00239>>13468000
           MOVE TEMP1 := NAMES(I*24+J*8),(8);                  <<00239>>13470000
           MOVE * := TEMP1 WHILE AN,1;                         <<00239>>13472000
           IF J < 2 THEN MOVE * := ".",2                       <<00239>>13474000
              ELSE MOVE * := 0,2;                              <<00239>>13476000
           END;  << OF WHILE J < 3 >>                          <<00239>>13478000
        DEL;  << STACKED @TEMP >>                              <<00239>>13480000
        IF FILE'DISP(I) = 1 THEN << FLAB ON BADTRACK >>        <<00239>>13482000
           BEGIN                                               <<00239>>13484000
           TOS := DIRECPURGE(0,0D,ANAME(I*12),GNAME(I*12),     <<00239>>13486000
                             FNAME(I*12),MVTABX);              <<00239>>13488000
           J := TOS;                                           <<00239>>13490000
           K := TOS;                                           <<00239>>13492000
           IF <> THEN                                          <<00239>>13494000
              BEGIN                                            <<00239>>13496000
              GENMSG(PVMSGSET,VIERR71,%11000,J,K,@TEMP);       <<00239>>13498000
              END                                              <<00239>>13500000
           ELSE GENMSG(PVMSGSET,VIWARN8,0,@TEMP);              <<00239>>13502000
           END << OF FLAB ON BADTRACK >>                       <<00239>>13504000
        ELSE                                                   <<00239>>13506000
           IF NOT PURGE'ALL THEN                               <<03620>>13508000
             BEGIN                                             <<03620>>13510000
             << DO YOU WANT SAVE FILE xxx (Y/N) ? >>           <<03620>>13512000
             GENMSG(PVMSGSET,VIWARN108,0,@TEMP,,,,,,,,,        <<03620>>13514000
                    %100000);                                  <<03620>>13516000
             K := READ(PBUFW,-10);                             <<03620>>13518000
             PURGE := IF K>0 AND PBUF="Y" THEN FALSE           <<03620>>13520000
                                          ELSE TRUE;           <<03620>>13522000
             END;                                              <<03620>>13524000
           IF PURGE'ALL OR PURGE THEN                          <<03620>>13526000
           BEGIN << EXTENT ON BAD TRACK >>                     <<00239>>13528000
           FNUM := MUSTOPEN(TEMP,FOPTIONS,AOPTIONS);           <<00239>>13530000
           IF = THEN                                           <<00239>>13532000
              BEGIN                                            <<00239>>13534000
              FCLOSE(FNUM,DELETE'FILE,0);                      <<00239>>13536000
              IF <> THEN                                       <<00239>>13538000
                 GENMSG(PVMSGSET,VIERR73,0,@TEMP)              <<00239>>13540000
              ELSE GENMSG(PVMSGSET,VIWARN8,0,@TEMP);           <<00239>>13542000
              END  << OF IF = ... >>                           <<00239>>13544000
           ELSE GENMSG(PVMSGSET,VIERR72,0,@TEMP);              <<00239>>13546000
           END; << OF EXTENTS ON BAD TRACK >>                  <<00239>>13548000
        END;  << OF FOR I := 1 UNTIL FILEDISP >>               <<00239>>13550000
    END    <<PROCESS UP TO MAXSECTTRK FILES>>                  <<00866>>13552000
    UNTIL  FILE'DISP < MAXSECTTRK;  <<NO MORE TO DO>>          <<00866>>13554000
   IF CS'80 THEN                                               <<03620>>13556000
      <<CHECK ALL DSCT ENTRIES IF THERE ARE ONO ZERO>>         <<03620>>13558000
      <<THIS VALUES REPRESENTS UNSPARED SECTORS     >>         <<03620>>13560000
      <<IF ANY UNSPARED SECTORS THEN DELETE FROM    >>         <<03620>>13562000
      <<BIT MAP                                     >>         <<03620>>13564000
      ELSE                                                     <<03620>>13566000
      BEGIN                                                    <<03620>>13568000
     << now that all files have been deleted(if they lie on  >><<03510>>13570000
     << a deleted trk -                                      >><<03510>>13572000
     << take the whole deleted track out of DFSM             >><<03510>>13574000
     i:=1;                                                     <<03510>>13576000
     WHILE i <= dtt'changes                                    <<03510>>13578000
     DO BEGIN                                                  <<03510>>13580000
        IF dtt'disp(i):=0 THEN    << disp is deleted >>        <<03510>>13582000
           BEGIN                                               <<03510>>13584000
              lcrit:=setcritical;                              <<03510>>13586000
              lcrit'set:=true;                                 <<03510>>13588000
              qtrack'start:=track'start(i); << q rel >>        <<03510>>13590000
              dfs'status:=Lock'Dfs'Data'Seg(ldev);             <<03510>>13592000
              IF NOT(dfs'status) THEN call'leave(dfs'status);  <<03510>>13594000
              dfs'locked:=true;                                <<03510>>13596000
              <<==   in SPLIT STACK MODE   ==>>                <<03510>>13598000
              ds'disc'address:=qtrack'start;                   <<03510>>13600000
              Convert'Address'To'Map;                          <<03510>>13602000
              ds'number'of'sectors:=DBL(sectrk);               <<03510>>13604000
              Must'Set'Reset'Bit'Map(false);                   <<03510>>13606000
              IF NOT(ds'error'status) THEN                     <<03510>>13608000
                        call'leave(ds'error'status);           <<03510>>13610000
              Unlock'Dfs'Data'Seg;                             <<03510>>13612000
              dfs'locked:=false;                               <<03510>>13614000
              resetcritical(lcrit);                            <<03510>>13616000
              lcrit'set:=false;                                <<03510>>13618000
              <<==   NOT in SPLIT STACK    ==>                 <<03510>>13620000
           END;                                                <<03510>>13622000
        flagtrack(ldev,dtt'changes(i).(0:14),dtt'disp(i));     <<03510>>13624000
        i:=i+1;                                                <<03510>>13626000
    END;                                                       <<03510>>13628000
      END;                                                     <<03620>>13630000
     LEAVE(-1);                                                <<00239>>13632000
     END; << OF PROCESS'BAD'TRACKS >>                          <<00239>>13634000
                                                               <<00239>>13636000
PROCEDURE DTRACK;                                                       13638000
OPTION PRIVILEGED,UNCALLABLE;                                           13640000
BEGIN                                                                   13642000
     << looks at the defective tracks table                  >><<03510>>13644000
     << there are 5 types of discs:                          >><<03510>>13646000
     << 1 foreign - inappropiate (GETFUNCTION caught)        >><<03510>>13648000
     << 2 serial  - inappropiate (GETFUNCTION caught)        >><<03510>>13650000
     << 3 scratch - no dirc, no bit map, no descr            >><<03510>>13652000
     << 4 sys disc- old code would check for dirc in         >><<03510>>13654000
     <<             disc label in fields that dont exist     >><<03510>>13656000
     <<             in sys disc label therefore no dirc      >><<03510>>13658000
     <<             but descr and bit map                    >><<03510>>13660000
     << 5 pv      - maybe dirc, has bit map, descr           >><<03510>>13662000
     INTEGER TYPE;                                             <<03620>>13666000
     INTEGER disckind;                                         <<03510>>13668000
     INTEGER I, N'OF'SEC;                                      <<04290>>13670000
     EQUATE d'system = 0,   << returned from disktype >>       <<03510>>13672000
            d'private = 1,                                     <<03510>>13674000
            d'serial = 2,                                      <<03510>>13676000
            d'scratch = 3,                                     <<03510>>13678000
            d'foreign = 4                                      <<03510>>13680000
           ;                                                   <<03510>>13682000
     DOUBLE     bmaddr    << bit map address >>                <<03510>>13684000
               ,dtaddr    << descr address   >>                <<03510>>13686000
               ;                                               <<03510>>13688000
                                                                        13690000
     LDEV:=DEVPARM(1);                                                  13692000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01115>>13694000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN;              <<00239>>13696000
     DISCIO(LDEV,R,BUFF,0D,128);  <<LABEL>>                             13698000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13700000
     TOS:=buff(disc'lab'map'high);                             <<03510>>13702000
     TOS:=buff(disc'lab'map'low);                              <<03510>>13704000
     bmaddr:=TOS;                                              <<03510>>13706000
     TOS:=buff(disc'lab'dt'high);                              <<03510>>13708000
     TOS:=buff(disc'lab'dt'low);                               <<03510>>13710000
     dtaddr:=TOS;                                              <<03510>>13712000
     disckind:=disctype(ldev,buff);                            <<03510>>13714000
     IF disckind = d'serial THEN << GETFUNCTION already >>     <<03510>>13716000
        BEGIN << caught, just to make code clearer >>          <<03510>>13718000
           genmsg(pvmsgset,deverr8);                           <<03510>>13720000
           RETURN;                                             <<03510>>13722000
        END;                                                   <<03510>>13724000
     GET'DISC'INFO(LDEV,,,,TYPE,,,,,,,,,,SECTRK);              <<03620>>13726000
     CS'80 := FALSE;                                           <<03620>>13728000
     IF TYPE =CS'80'TYPE THEN                                  <<03620>>13730000
        BEGIN                                                  <<03620>>13732000
        CS'80 := TRUE;                                         <<03620>>13734000
SECTRK := 92; <<TEMPRORARY UNTIL GET'DISC'INFO IS FIXED>>      <<03620>>13736000
        END;                                                   <<03620>>13738000
     DISCIO(LDEV,R,DTT,1D,128);                                         13740000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13742000
     N'OF'SEC := DTT;                                          <<04290>>13744000
TRY'AGAIN:                                                     <<03620>>13746000
     IF disckind = d'scratch THEN                              <<03510>>13748000
        dttanalysis(ldev)                                      <<03510>>13750000
     ELSE                                                      <<03510>>13752000
        BEGIN                                                  <<03510>>13754000
           IF disckind = d'system THEN                         <<03510>>13756000
              dttanalysis(ldev,,,bmaddr,                       <<03510>>13758000
                          dtaddr)                              <<03510>>13760000
           ELSE                                                <<03510>>13762000
              BEGIN                                            <<03510>>13764000
                 IF buff(disc'lab'type'word).disc'lab'mv THEN  <<03510>>13766000
                    dttanalysis(ldev,                          <<03510>>13768000
                                 DBL( buff(disc'lab'dirbase) ),<<03510>>13770000
                                 buff(disc'lab'dirsize)        <<03510>>13772000
                                ,bmaddr                        <<03510>>13774000
                                ,dtaddr )                      <<03510>>13776000
                 ELSE                                          <<03510>>13778000
                    dttanalysis(ldev,,,bmaddr,                 <<03510>>13780000
                                dtaddr );                      <<03510>>13782000
              END;  << pv >>                                   <<03510>>13784000
        END;                                                   <<03510>>13786000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13788000
     IF = THEN  <<NO DTT ENTRIES>>                                      13790000
     BEGIN                                                              13792000
          MOVE MSG:="** NO SUSPECT TRACKS/SECTORS FOUND";      <<03620>>13794000
          PRINT(MSGW,-34,0);                                   <<03620>>13796000
     END ELSE                                                           13798000
     BEGIN                                                     <<00239>>13800000
          IF DTT'CHANGES <> 0 THEN PROCESS'BAD'TRKS(LDEV);     <<00239>>13802000
          IF < THEN RETURN;                                    <<00239>>13804000
           IF STATUS = 0 THEN                                  <<03620>>13806000
              IF DTT <> 0 THEN GOTO TRY'AGAIN                  <<03620>>13808000
              ELSE                                             <<03620>>13810000
              ELSE IF DTT <> 0 THEN                            <<03620>>13812000
              BEGIN                                            <<03620>>13814000
              MOVE PBUF :=                                     <<03620>>13816000
              "IO ERROR DURING SPARING - DTRACK TERMINATED ";  <<03620>>13818000
              FWRITE(OUTF,PBUFW,-44,0);                        <<03620>>13820000
              END;                                             <<03620>>13822000
     END;                                                      <<00239>>13824000
     << CS'80 discs only.                                    >><<04290>>13826000
     << The lack of spare tracks will cause that some of     >><<04290>>13828000
     << suspect sectors are not spared and will remain in    >><<04290>>13830000
     << the DSCT. However the DSCT count must be updated and >><<04290>>13832000
     << items in the DSCT must be sorted to eliminate empty  >><<04290>>13834000
     << slots. The updated DSCT is written back to the disc. >><<04290>>13836000
     IF CS'80 THEN                                             <<04290>>13838000
        BEGIN                                                  <<04290>>13840000
        DTT := N'OF'SEC;                                       <<04290>>13842000
        SORT'DSCT;                                             <<04290>>13844000
        DTT := 0;                                              <<04290>>13846000
        I := DTT(DSCT'FIRST'ENTRY'INDEX)/                      <<04290>>13848000
             DTT(DSCT'ENTRY'SIZE)-1;                           <<04290>>13850000
        N'OF'SEC := N'OF'SEC + I;                              <<04290>>13852000
        WHILE DTTD( I := I+1 ) <> 0D AND I <= N'OF'SEC DO      <<04290>>13854000
           DTT := DTT + 1;                                     <<04290>>13856000
        END;                                                   <<04290>>13858000
     DISCIO(LDEV,W,DTT,1D,128);  <<WRITE UPDATED DTT>>                  13860000
     IF < THEN RETURN;  <<DISC I/O ERROR>>                              13862000
END << DTRACK >>;                                                       13864000
                                                                        13866000
$PAGE "PVINIT - USER COMMANDS: STATUS FUNCTIONS"               <<00239>>13868000
PROCEDURE DELVOL;                                                       13870000
OPTION PRIVILEGED,UNCALLABLE;                                           13872000
BEGIN                                                                   13874000
END << DELVOL >>;                                                       13876000
                                                                        13878000
$CONTROL SEGMENT=PVSTATUS                                      <<RK1PV>>13880000
PROCEDURE DSTAT;                                                        13882000
OPTION PRIVILEGED,UNCALLABLE;                                           13884000
BEGIN                                                                   13886000
     INTEGER DEV:=0,ERRNUM;                                             13888000
     LOGICAL STATUS;                                                    13890000
                                                                        13892000
     IF KEYWDSPEC THEN  <<CHECK PARAMETER>>                             13894000
     BEGIN                                                              13896000
          IF KEYWDLEN > 3 THEN                                          13898000
          BEGIN                                                         13900000
               GENMSG(PVMSGSET,VIERR3);                                 13902000
               RETURN;                                                  13904000
          END;                                                          13906000
          IF KEYWORD = "ALL" OR KEYWORD = "@" THEN DEV:=-1 ELSE<<RK.08>>13908000
          BEGIN                                                         13910000
               DEV:=BINARY(KEYWORD,KEYWDLEN);                           13912000
               IF <> OR DEV <= 0 THEN                                   13914000
               BEGIN                                                    13916000
                    GENMSG(PVMSGSET,VIERR15);                           13918000
                    RETURN;                                             13920000
               END;                                                     13922000
          END;                                                          13924000
     END;                                                               13926000
                                                                        13928000
     ERRNUM:=DSTATCOM(2,DEV);                                           13930000
     IF <> THEN                                                         13932000
     BEGIN                                                              13934000
          IF (DEVERR1<=ERRNUM<=DEVERR9) THEN                            13936000
             BEGIN                                                      13938000
                  CHECKDISC(DEV,STATUS);                                13940000
                  DEVERROR(DEV,STATUS)                                  13942000
             END;                                                       13944000
     END;                                                               13946000
END << DSTAT >>;                                                        13948000
                                                                        13950000
$PAGE "PVINIT - USER COMMANDS: PRINT FUNCTIONS"                         13952000
                                                                        13954000
PROCEDURE PDEFN;                                                        13956000
OPTION PRIVILEGED,UNCALLABLE;                                           13958000
BEGIN                                                                   13960000
     INTEGER I,LEN,INDEX,NAMELEN;                                       13962000
     INTEGER PVERR = I;  <<ERROR NUMBER FOR GENMSG>>                    13964000
     LOGICAL VMASK;                                                     13966000
     DOUBLE DIRESULT;                                                   13968000
     INTEGER                                                            13970000
          DIRESULT1 = DIRESULT,                                         13972000
          DIRESULT2 = DIRESULT+1;                                       13974000
     ARRAY VSDEFN(0:59);                                                13976000
     BYTE ARRAY VSDEFNB(*) = VSDEFN;                                    13978000
     BYTE ARRAY TEMP(0:27);                                    <<00112>>13980000
                                                                        13982000
     IF VSID = "*" THEN  <<LOOK FOR HOME VOLUME SET>>                   13984000
     BEGIN                                                              13986000
          DIRESULT:=DIRECFIND (%10,0D,VSIDW(8),VSIDW(4),       <<RK.08>>13988000
                               VSIDW,VSDEFN);                  <<RK.08>>13990000
          IF <> THEN                                                    13992000
          BEGIN                                                         13994000
               PVERR:=IF DIRESULT2 = 2 THEN (DIRESULT1+SYSTEMUSE)<<.09>>13996000
                      ELSE DIRECERR;                                    13998000
               GENMSG(PVMSGSET,PVERR);                                  14000000
               RETURN;                                                  14002000
          END;                                                          14004000
          IF VSDEFNB(68) = "  " THEN  <<NO NHOME VOLUME SET>>           14006000
          BEGIN                                                         14008000
               I:=0; MSG(8):=" ";                                       14010000
               TOS:=@PBUF;                                              14012000
               WHILE (I:=I+1) <= 2 DO                                   14014000
               BEGIN                                                    14016000
                    MOVE MSG:=VSID(I*8),(8);                            14018000
                    MOVE  * :=MSG WHILE AN,1;                           14020000
                    MOVE  * :=".",2;                                    14022000
               END;                                                     14024000
               LEN:=TOS-@PBUF-1;                                        14026000
               PBUF(LEN):=0;  <<GENMSG STOPPER>>                        14028000
               GENMSG(PVMSGSET,NOHVSET,0,@PBUF);                        14030000
               RETURN;                                                  14032000
          END;                                                          14034000
          MOVE VSID:=VSDEFNB(68),(8),2;                                 14036000
          MOVE * :=VSDEFNB(60),(8),2;                                   14038000
          MOVE * :=VSDEFNB(52),(8);                                     14040000
     END;                                                               14042000
    DIRESULT:=DIRECFIND(%40,0D,VSIDW(8),VSIDW(4),VSIDW,VSDEFN);<<RK.08>>14044000
     IF <> THEN                                                         14046000
     BEGIN                                                              14048000
          PVERR:=IF DIRESULT2 = 2 THEN (DIRESULT1+SYSTEMUSE)   <<RK.09>>14050000
                 ELSE DIRECERR;                                         14052000
          GENMSG(PVMSGSET,PVERR);                                       14054000
          RETURN;                                                       14056000
     END;                                                               14058000
     I:=-1;                                                             14060000
     TOS:=@MSG;                                                         14062000
     WHILE (I:=I+1) < 3 DO                                              14064000
     BEGIN                                                              14066000
          MOVE * := VSID(I*8),(8),2;                                    14068000
          MOVE * := " ",2;                                              14070000
     END;                                                               14072000
     I:=-1;                                                             14074000
     TOS:=@TEMP;                                               <<00112>>14076000
     WHILE (I:=I+1) < 3 DO                                              14078000
     BEGIN                                                              14080000
          MOVE * :=MSG(I*9) WHILE AN,1;                                 14082000
          IF I <> 2 THEN MOVE * :=".",2;                                14084000
     END;                                                               14086000
     NAMELEN:=TOS-@TEMP;                                       <<00112>>14088000
     IF VSDEFN(4).(0:1) THEN                                            14090000
     BEGIN                                                              14092000
          MOVE PBUF:=" CLASS DEFINITION: ",2;                           14094000
          MOVE * :=TEMP,(NAMELEN),2;                           <<00112>>14096000
          LEN:=TOS-@PBUF;                                               14098000
     END ELSE                                                           14100000
     BEGIN                                                              14102000
          MOVE PBUF:=" SET DEFINITION: ",2;                             14104000
          MOVE * :=TEMP,(NAMELEN),2;                           <<00112>>14106000
          MOVE * := "     MVTAB INDEX: ",2;                             14108000
          LEN:=TOS-@PBUF;                                               14110000
          LEN:=LEN+ASCII(VSDEFN(VDMISC).MVTABXF,10,PBUF(LEN));          14112000
     END;                                                               14114000
     FWRITE(OUTF,PBUFW,-LEN,0);                                <<RK.08>>14116000
     MOVE PBUF:=" NUMBER OF VOLUMES:     VOLUME MASK: %         ";      14118000
     ASCII(VSDEFN(VDINFO).(0:4),10,PBUF(20));                           14120000
     ASCII(VSDEFN(VDINFO).(8:8), 8,PBUF(38));                           14122000
     FWRITE(OUTF,PBUFW,-44,0);                                 <<RK.08>>14124000
     IF VSDEFN(VDMISC).(0:1) THEN  <<CLASS ENTRY>>                      14126000
     BEGIN                                                              14128000
          MOVE PBUF:=" MASTER REFERENCE:   ";                           14130000
          MOVE PBUF(19):=VSDEFNB(28),(8),2;                             14132000
          MOVE *:=".",2;                                                14134000
          MOVE *:=VSDEFNB(20),(8),2;                                    14136000
          MOVE *:=".",2;                                                14138000
          MOVE *:=VSDEFNB(12),(8);                                      14140000
          FWRITE(OUTF,PBUFW,-45,0);                            <<RK.08>>14142000
          RETURN;                                                       14144000
     END;                                                               14146000
     MOVE PBUF:=" INDEX   MEMBER   SUBTYPE";                            14148000
     FWRITE(OUTF,PBUFW,-25,0);                                 <<RK.08>>14150000
     MOVE PBUF:=" -----  --------  -------";                            14152000
     FWRITE(OUTF,PBUFW,-25,0);                                 <<RK.08>>14154000
     INDEX:=0;                                                          14156000
     VMASK:=VSDEFN(VDINFO).(8:8);                                       14158000
     WHILE VMASK <> 0 DO                                                14160000
     BEGIN                                                              14162000
          INDEX:=INDEX+1;                                               14164000
          IF VMASK THEN                                                 14166000
          BEGIN                                                         14168000
               PBUF:=" "; MOVE PBUF(1):=PBUF,(24);                      14170000
               MOVE PBUF(8):=VSDEFNB((INDEX*6) & LSL(1)),(8);           14172000
               ASCII(INDEX,10,PBUF(3));                                 14174000
               ASCII(VSDEFN((INDEX*6)+5).(0:8),10,PBUF(21));            14176000
               FWRITE(OUTF,PBUFW,-23,0);                       <<RK.08>>14178000
          END;                                                          14180000
          VMASK:=VMASK & LSR(1);                                        14182000
     END;                                                               14184000
END << PDEFN >>;                                                        14186000
                                                                        14188000
$PAGE "PROCEDURE PLABEL"                                       <<03537>>14190000
PROCEDURE PLABEL;                                                       14192000
OPTION PRIVILEGED,UNCALLABLE;                                           14194000
BEGIN                                                                   14196000
     INTEGER I,LOC,LDEV;                                                14198000
     ARRAY VLAB(*) = BUFF;                                              14200000
     BYTE ARRAY VLABB(*) = BUFF;                                        14202000
     LOGICAL SCRATCH'PACK;                                     <<00145>>14204000
     INTEGER Qmisc := 0;                                       <<03537>>14206000
     LOGICAL Dummy;                                            <<03537>>14208000
     DEFINE                                                             14210000
          MV      = VLAB(LDEVINFO).MVF#,                                14212000
          SERIALF = (2:1)#,                                    <<RK.03>>14214000
          SERIAL  = VLAB(LDEVINFO).SERIALF#,                   <<RK.03>>14216000
          SYSTEM  = DEVSTATUS(1).(10:1)#,                               14218000
          SCRATCH = VLAB(LDEVINFO).SCRATCHF#;                           14220000
                                                                        14222000
     DEFINE NSD = LOGICAL(LPDT(LDEV & LSL(1)+1).NSDF)#;                 14224000
                                                                        14226000
     Vlab := 0; MOVE Vlab(1) := Vlab,(Linus'Sector - 1);       <<03537>>14228000
     LDEV:=DEVPARM(1);                                                  14230000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01278>>14232000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN;              <<00239>>14234000
     IF Is'It'Linus(Ldev) THEN                                 <<03537>>14236000
     BEGIN                                                     <<03537>>14238000
          Linusio(Ldev,Qmisc,Vlab,R,Linus'Sector,              <<03537>>14240000
                  Disc'Label'Address,Blocked'IO,NO'SPARING,    <<03537>>14242000
                  Default'Errinfo,Dummy);                      <<03537>>14244000
     END                                                       <<03537>>14246000
     ELSE                                                      <<03537>>14248000
          DISCIO(Ldev,R,Vlab,0D,128);                          <<03537>>14250000
     IF < THEN RETURN;                                                  14252000
     SPACE(1);                                                 <<00239>>14254000
     MOVE PBUF := " Ldev    ";                                 <<03537>>14256000
     ASCII(LDEV,10,PBUF(6));                                            14258000
     FWRITE(OUTF,PBUFW,-8,0);                                  <<RK.08>>14260000
     MOVE PBUF:=(" Volume Name:          , Type:  , Subtype: ",<<03537>>14262000
               "            ");                                <<RK.05>>14264000
     ASCII(VLAB(LDEVINFO).(6:6),10,PBUF(31));                           14266000
     ASCII(VLAB(LDEVINFO).(12:4),10,PBUF(43));                          14268000
     SCRATCH'PACK := SCRATCHVOL(LDEV);                         <<00145>>14270000
     IF < THEN RETURN;                                         <<00145>>14272000
     IF DISCTYPE(LDEV,VLAB) = 4 THEN                           <<03537>>14274000
          MOVE PBUF(14) := "*Foreign*"                         <<03537>>14276000
     ELSE                                                      <<03537>>14278000
     IF SCRATCH'PACK THEN                                      <<03537>>14280000
          MOVE PBUF(14) := "*Scratch*"                         <<03537>>14282000
     ELSE                                                      <<03537>>14284000
     IF DISCTYPE(LDEV,VLAB) = 2 THEN                           <<03537>>14286000
          MOVE PBUF(14) := "*Serial*"                          <<03537>>14288000
     ELSE                                                      <<03537>>14290000
     BEGIN                                                              14292000
          MOVE PBUF(14):=VLABB(LVNAMELOC),(8);                          14294000
          IF NSD THEN  <<REMOVABLE VOLUME>>                             14296000
          BEGIN                                                         14298000
               FWRITE(OUTF,PBUFW,-45,0);                       <<RK.08>>14300000
               MOVE PBUF:=                                     <<03537>>14302000
               " Create Date:         , Generation:      ";    <<03537>>14304000
               DATECONV(VLAB(LINITDATE),PBUF(14));                      14306000
               ASCII(VLAB(LGENINDEX),10,PBUF(36));                      14308000
               FWRITE(OUTF,PBUFW,-40,0);                       <<RK.08>>14310000
               MOVE PBUF :=                                    <<03537>>14312000
               " VS Name:         , Group:         ,";         <<03537>>14314000
               MOVE PBUF(36) := " Account:         ";          <<03537>>14316000
               MOVE PBUF(10):=VLABB(LVOLDIRLOC),(8);                    14318000
               MOVE PBUF(27):=VLABB(LVSGROUPLOC),(8);                   14320000
               MOVE PBUF(46):=VLABB(LVSACCNTLOC),(8);                   14322000
               IF MV THEN                                               14324000
               BEGIN                                                    14326000
                    FWRITE(OUTF,PBUFW,-54,0);                  <<RK.08>>14328000
                    MOVE PBUF :=" Master Volume Information -";<<03537>>14330000
                    FWRITE(OUTF,PBUFW,-28,0);                  <<RK.08>>14332000
                    MOVE PBUF :=                               <<03537>>14334000
                    "  Dir. Base:     , Dir. Size:     ";      <<03537>>14336000
                    ASCII(VLAB(LDIRBASE),10,PBUF(13));                  14338000
                    ASCII(VLAB(LDIRSIZE),10,PBUF(30));                  14340000
                    FWRITE(OUTF,PBUFW,-34,0);                  <<RK.08>>14342000
                    MOVE PBUF :=                               <<03537>>14344000
                    "  Volume Directory";                      <<03537>>14346000
                    FWRITE(OUTF,PBUFW,-18,0);                  <<RK.08>>14348000
                    MOVE PBUF := "    Name     Subtype ";      <<03537>>14350000
                    FWRITE(OUTF,PBUFW,-21,0);                  <<RK.08>>14352000
                    MOVE PBUF:="  --------   ------- ";                 14354000
                    LOC:=LVOLDIRLOC;                                    14356000
                    FOR I:=1 UNTIL INTEGER(VLAB(LVDIRINFO).(0:4)) DO    14358000
                    BEGIN                                               14360000
                         FWRITE(OUTF,PBUFW,-21,0);             <<RK.08>>14362000
                         LOC:=LOC+(VOLDIRENTSIZE & LSL(1));             14364000
                         PBUF:=" "; MOVE PBUF(1):=PBUF,(53);            14366000
                         MOVE PBUF(2):=VLABB(LOC),(8);  <<NAME>>        14368000
                         ASCII(VLAB(LOC&LSR(1)+5).(0:8),10,PBUF(16));   14370000
                    END;                                                14372000
               END;                                                     14374000
          END;                                                          14376000
     END;                                                               14378000
     FWRITE(OUTF,PBUFW,-54,0);                                 <<RK.08>>14380000
END << PLABEL >>;                                                       14382000
                                                                        14384000
$PAGE "PROCEDURE PDTRACK"                                      <<03536>>14386000
PROCEDURE PDTRACK;                                                      14388000
OPTION PRIVILEGED,UNCALLABLE;                                           14390000
BEGIN                                                                   14392000
     INTEGER I,ALT,LEN,LDEV,DISP,TRACK,INDEX,MAXLPS,SUBTYPE;            14394000
     INTEGER      sectrk                                       <<03510>>14396000
                 ,lps          << in cylinders >>              <<03510>>14398000
                 ,trkcyl                                       <<03510>>14400000
                 ;                                             <<03510>>14402000
     LOGICAL      proc'status                                  <<03510>>14404000
                 ;                                             <<03510>>14406000
     INTEGER Type := 0;                                        <<03536>>14408000
     INTEGER Status := 0;                                      <<03536>>14412000
     DOUBLE CYLHEAD;                                                    14414000
     INTEGER                                                            14416000
          HEAD = CYLHEAD,                                               14418000
          CYL  = CYLHEAD+1;                                             14420000
     BYTE ARRAY MHEAD1(0:53)=PB:=                                       14422000
          "             FIRST     LAST                  ALTERNATE";     14424000
     BYTE ARRAY MHEAD2(0:53)=PB:=                                       14426000
          " CYL HEAD   SECTOR    SECTOR      STATUS     CYL  HEAD";     14428000
     BYTE ARRAY STATS(*)=PB := "    SUSPECT     SUSPECT ALT ", <<03537>>14430000
          "    DELETED     REASSIGNED  UNREADABLE ALT";                 14432000
                                                                        14434000
     LDEV:=DEVPARM(1);                                                  14436000
     IF FOREIGN THEN INAPPROPRIATE;                            <<01115>>14438000
     Type    := Ldevtotype(Ldev);                              <<03536>>14440000
     Subtype := 0;                                             <<03536>>14442000
     Subtype := Ldevtosubtype(Ldev);                           <<03536>>14444000
     IF Type >= 0 LAND Type < CS'80'Type THEN                  <<03536>>14446000
     BEGIN                                                     <<03536>>14448000
                                                               <<03536>>14450000
<< Only Types 0,1,2 have a Defective Tracks Table.           >><<03536>>14452000
<< Type 3 has a Defective Sector Table (DSCT).               >><<03536>>14454000
<< We handle it much differently.                            >><<03536>>14456000
<< Note that with the CS'80 family, having a bad volume      >><<03536>>14458000
<< label does not necessarily imply that the DSCT is bad.    >><<03536>>14460000
                                                               <<03536>>14462000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN;              <<00239>>14466000
     DISCIO(LDEV,R,DTT,1D,128);  <<READ IN DTT>>                        14468000
     IF < THEN RETURN;                                                  14470000
     PRINTLDEV(LDEV);                                          <<03536>>14472000
     proc'status:=Get'Disc'Info(ldev,,,,,,,,,,,,,,             <<03510>>14474000
                         sectrk,,lps,trkcyl);                  <<03510>>14476000
     IF not(proc'status) THEN RETURN;                          <<03510>>14478000
     maxlps:=lps * trkcyl -dtt(dtt'next'alt'track); <<in trks>><<03510>>14480000
     MOVE PBUF:=" LOGICAL PACK SIZE = ",2;                              14482000
     TOS:=ASCII(DTT(DTTLPS),10,BPS0);                                   14484000
     ASSEMBLE(ADD);                                                     14486000
     MOVE * :=" CYLINDERS, ",2;                                         14488000
     TOS:=ASCII(MAXLPS,10,BPS0);                                        14490000
     ASSEMBLE(ADD);  <<UPDATE BUFFER POINTER>>                          14492000
     MOVE * :=" ALTERNATE TRACKS AVAILABLE",2;                          14494000
     LEN:=TOS-@PBUF;                                                    14496000
     FWRITE(OUTF,PBUFW,-LEN,0);                                <<RK.08>>14498000
     IF DTT=0 THEN   <<NO ENTRIES IN TABLE>>                            14500000
     BEGIN                                                              14502000
          MOVE PBUF:=" NO DEFECTIVE OR SUSPECT TRACKS FOUND";           14504000
          FWRITE(OUTF,PBUFW,-37,0);                            <<RK.08>>14506000
     END ELSE                                                           14508000
     BEGIN  <<PRINT TABLE>>                                             14510000
          MOVE PBUF:=MHEAD1,(54);                                       14512000
          FWRITE(OUTF,PBUFW,-54,0);                            <<RK.08>>14514000
          MOVE PBUF:=MHEAD2,(54);                                       14516000
          FWRITE(OUTF,PBUFW,-54,0);                            <<RK.08>>14518000
          I:=0;                                                         14520000
          WHILE (I:=I+1)<=DTT DO                                        14522000
          BEGIN  <<LIST EACH ENTRY>>                                    14524000
               PBUF:=" "; MOVE PBUF(1):=PBUF,(57);                      14526000
               track:=dtt(i).dtt'track'number;                 <<03510>>14528000
               cylhead:=cylinderhead(track,ldev);              <<03510>>14530000
               ASCII(CYL,10,PBUF(1));  <<CYLINDER #>>                   14532000
               ASCII(HEAD,10,PBUF(6));  <<HEAD #>>                      14534000
               TOS:=0;                                                  14536000
               TOS:=TRACK;                                              14538000
               TOS:=TOS ** LOGICAL(sectrk);                    <<03510>>14540000
               ASSEMBLE(DDUP,DZRO; DXCH,CAB);                           14542000
               TOS:=sectrk;                                    <<03510>>14544000
               ASSEMBLE(DECA,DADD);  <<LAST SECTOR>>                    14546000
               LEN:=DASCII(*,10,RBUF);      << LAST SECTOR >>  <<01379>>14548000
               MOVE PBUF(21):=RBUF,(LEN);                      <<01379>>14550000
               LEN:=DASCII(*,10,RBUF);     << FIRST SECTOR >>  <<01379>>14552000
               MOVE PBUF(11):=RBUF,(LEN);                      <<01379>>14554000
               DISP:=DTT(I).(14:2);  <<RECORD TYPE>>                    14556000
               IF DISP=0 AND TRACK=DTT(X:=X+1)&LSR(2) THEN              14558000
               DISP:=4;  <<UNREADABLE ALTERNATE>>                       14560000
               MOVE PBUF(29):=STATS(DISP*14),(14);                      14562000
               TOS:=OUTF;  <<FOR FWRITE>>                               14564000
               TOS:=@PBUF & LSR(1);  <<FOR FWRITE>>                     14566000
               IF LOGICAL(DISP) THEN                                    14568000
               BEGIN  <<THERE IS AN ALTERNATE>>                         14570000
                    TOS:=ALTTRACK(LDEV,TRACK);                          14572000
                    IF < THEN RETURN;  <<DISC I/O ERROR>>               14574000
                    IF (ALT:=TOS) = -2 THEN                             14576000
                    BEGIN <<CAN'T READ ALTERNATE>>                      14578000
                         ADDDTTENTRY(TRACK&LSL(2));                     14580000
                         IF = THEN  <<ENTRY ADDED TO TABLE>>            14582000
                         BEGIN                                          14584000
                              MOVE PBUF(30) := STATS(56),(14); <<03537>>14586000
                              DISCIO(LDEV,W,DTT,1D,128);                14588000
                              IF < THEN RETURN;                         14590000
                         END;                                           14592000
                         TOS:=-45;  <<LINE COUNT>>                      14594000
                    END ELSE                                            14596000
                    BEGIN                                               14598000
                         cylhead:=cylinderhead(alt,ldev);      <<03510>>14600000
                         ASCII(CYL,10,PBUF(45)); <<ALTERNATE CYLINDER>> 14602000
                         ASCII(HEAD,10,PBUF(51));  <<ALTERNATE HEAD>>   14604000
                         TOS:=-53;  <<LINE COUNT>>                      14606000
                    END;                                                14608000
               END ELSE                                                 14610000
               TOS:=-45;                                                14612000
               FWRITE(*,*,*,0);                                         14614000
               IF DTT(I+1)=TRACK&LSL(2)+3 THEN I:=I+1; <<SKIP>>         14616000
          END;                                                          14618000
     END;                                                               14620000
     END                                                       <<03536>>14622000
     ELSE  << Not type 0, 1 or 2.                            >><<03536>>14624000
     BEGIN                                                     <<03536>>14626000
        IF Type = CS'80'Type THEN << Don't want other types. >><<03536>>14628000
        BEGIN                                                  <<03536>>14630000
           IF Subtype = St'9110 THEN                           <<03536>>14632000
           BEGIN                                               <<03536>>14634000
              Genmsg(Pvmsgset,Viwarn95);                       <<03536>>14636000
              << Linus doesn't have a DSCT.                  >><<03536>>14638000
              IF Diag'Entry THEN Print'Linus'Spares(Ldev);     <<03583>>14640000
              RETURN;                                          <<03536>>14642000
           END                                                 <<03536>>14644000
           ELSE  << A CS'80 Disc.                            >><<03536>>14646000
           BEGIN                                               <<03536>>14648000
              Dtt := 0;                                        <<03536>>14650000
              Move Dtt(1) := Dtt,(dtt'size - 1);               <<03536>>14652000
              Status := 0;                                     <<03536>>14654000
              Discio(Ldev,R,Dtt,Disc'Label'Address,            <<03536>>14656000
                    Sector'Size,Status);                       <<03536>>14658000
              IF < THEN                                        <<03536>>14660000
                 Genmsg(Pvmsgset,Viwarn96);                    <<03536>>14662000
                 << Couldn't read the label.                 >><<03536>>14664000
              Dtt := 0;                                        <<03536>>14666000
              Move Dtt(1) := Dtt,(dtt'size - 1);               <<03536>>14668000
              Status := 0;                                     <<03536>>14670000
              Discio(Ldev,R,Dtt,Dsct'Disc'Address,             <<03536>>14672000
                    Sector'Size,Status);                       <<03536>>14674000
              IF < THEN                                        <<03536>>14676000
              BEGIN                                            <<03536>>14678000
                 Genmsg(Pvmsgset,Vierr97);                     <<03536>>14680000
                 Genmsg(Pvmsgset,Vierr0);                      <<03536>>14682000
                 << Couldn't read the DSCT.                  >><<03536>>14684000
                 GO Check'Diag; << Then returns.             >><<03583>>14686000
              END;                                             <<03536>>14688000
              IF Dtt(Dsct'Number'Of'Entries) = 0 THEN          <<03536>>14690000
              BEGIN                                            <<03536>>14692000
                 Genmsg(Pvmsgset,Viwarn98);                    <<03536>>14694000
                 GO Check'Diag; << Then returns.             >><<03583>>14696000
                 << DSCT was empty. (Great!)                 >><<03536>>14698000
              END;                                             <<03536>>14700000
                                                               <<03536>>14702000
<< Print out a header that says                              >><<03536>>14704000
<< "Num" Defective Sectors Found.                            >><<03536>>14706000
<< Send report to outfile if specified.                      >><<03536>>14708000
                                                               <<03536>>14710000
              Genmsg(Pvmsgset,Viwarn99,%010000,                <<03536>>14712000
                     Dtt(Dsct'Number'Of'Entries),              <<03536>>14714000
                     <<p2>>,<<p3>>,<<p4>>,<<p5>>,-Outf);       <<03536>>14716000
                                                               <<03536>>14718000
<< Print a detail line.                                      >><<03536>>14720000
<< "Sector Num" (decimal) Defective.                         >><<03536>>14722000
                                                               <<03536>>14724000
              FOR I := 0 UNTIL Dtt(Dsct'Number'Of'Entries) - 1 <<03536>>14726000
                                                               <<03536>>14728000
              DO Genmsg(Pvmsgset,Viwarn100,                    <<03536>>14730000
                        %020000,                               <<03536>>14732000
                @Dttd( (Dtt (Dsct'First'Entry'Index) / 2) + I),<<03536>>14734000
                        <<p2>>,<<p3>>,                         <<03536>>14736000
                        <<p4>>,<<p5>>,-Outf);                  <<03536>>14738000
                                                               <<03536>>14740000
<< The above mess picks out Double word entries              >><<03536>>14742000
<< one at a time, starting with the first one,               >><<03536>>14744000
<< which is pointed to by "Dsct'First'Entry'Index".          >><<03536>>14746000
                                                               <<03536>>14748000
    Check'Diag:                                                <<03583>>14750000
                                                               <<03583>>14752000
              IF Diag'Entry THEN Print'CS'80'Spares(Ldev);     <<03583>>14754000
                                                               <<03583>>14756000
<< Always tries to read the hardware spare table,            >><<03583>>14758000
<< even if it couldn't read the disc, then                   >><<03583>>14760000
<< returns.                                                  >><<03583>>14762000
                                                               <<03583>>14764000
            END                                                <<03536>>14766000
         END                                                   <<03536>>14768000
      END                                                      <<03536>>14770000
END << PDTRACK >>;                                                      14772000
PROCEDURE pfspace;                                             <<03510>>14776000
   OPTION privileged,uncallable;                               <<03510>>14778000
                                                               <<03510>>14780000
BEGIN                                                          <<03510>>14782000
                                                               <<03510>>14784000
<< prints out the Disc Free Space Map as a histogram      >>   <<03510>>14786000
<< or a listing of the free space entries. Format of the  >>   <<03510>>14788000
<< command is:                                            >>   <<03510>>14790000
<<             pfspace ldev[;addr]                        >>   <<03510>>14792000
<<                     all                                >>   <<03510>>14794000
<<                                                             <<03510>>14796000
<< LDEV;ADDR will print out a histogram for that specific >>   <<03510>>14798000
<< ldev. If the field "ALL" is included, then it will     >>   <<03510>>14800000
<< print out all the free space entries for that LDEV.    >>   <<03510>>14802000
<< If "ALL" is used, then it will print out a histogram   >>   <<03510>>14804000
<< for all the discs physically mounted - just like free2  >>  <<03510>>14806000
<< does                                                   >>   <<03510>>14808000
                                                               <<03510>>14810000
   INTEGER      ldev                                           <<03510>>14812000
               ;                                               <<03510>>14814000
                                                               <<03510>>14816000
   LOGICAL      call'pfre       << free2 format >>             <<03510>>14818000
               ,checkdisc'status                               <<03510>>14820000
               ,all'ldevs       << free2 and print all ldevs >><<03510>>14822000
               ;                                               <<03510>>14824000
                                                               <<03510>>14826000
                                                               <<03510>>14828000
   all'ldevs:=false;  << initialize >>                         <<03510>>14830000
                                                               <<03510>>14832000
   IF keyword = "ALL" THEN                                     <<03510>>14834000
      BEGIN                                                    <<03510>>14836000
         IF keywdspec(1) THEN   << 2nd field not allowed >>    <<03510>>14838000
            BEGIN                                              <<03510>>14840000
               genmsg(pvmsgset,vierr32);                       <<03510>>14842000
               RETURN;                                         <<03510>>14844000
            END;                                               <<03510>>14846000
         call'pfre:=true;                                      <<03510>>14848000
         all'ldevs:=true;                                      <<03510>>14850000
      END                                                      <<03510>>14852000
   ELSE                                                        <<03510>>14854000
      BEGIN                                                    <<03510>>14856000
         IF keyword <> numeric THEN                            <<03510>>14858000
            BEGIN                                              <<03510>>14860000
               genmsg(pvmsgset,vierr27);                       <<03510>>14862000
               RETURN;                                         <<03510>>14864000
            END;                                               <<03510>>14866000
         ldev:=binary(keyword,keywdlen);                       <<03510>>14868000
         IF ldev <= 0 THEN                                     <<03510>>14870000
            BEGIN                                              <<03510>>14872000
               genmsg(pvmsgset,vierr28);                       <<03510>>14874000
               RETURN;                                         <<03510>>14876000
            END;                                               <<03510>>14878000
         << do some initial checking  >>                       <<03510>>14880000
                                                               <<03510>>14882000
         checkdisc(ldev,checkdisc'status);                     <<03510>>14884000
         IF (checkdisc'status LOR mask(funct)) <>              <<03510>>14886000
            mask(funct) THEN                                   <<03510>>14888000
            BEGIN                                              <<03510>>14890000
               deverror(ldev,checkdisc'status);                <<03510>>14892000
               RETURN;                                         <<03510>>14894000
            END;                                               <<03510>>14896000
         << can you read the disc label ? >>                   <<03510>>14898000
         IF unreadable'label(ldev,false) THEN RETURN;          <<03510>>14900000
         call'pfre:=true;    << assume want free2 printout >>  <<03510>>14902000
         <<  now see if specified a second field >>            <<03510>>14904000
         IF keywdspec(1) THEN    << verify it >>               <<03510>>14906000
            BEGIN                                              <<03510>>14908000
               IF keyword(max'keyword'len) = "ADDR" THEN       <<03510>>14910000
                  call'pfre:=false                             <<03510>>14912000
               ELSE                                            <<03510>>14914000
                  BEGIN                                        <<03510>>14916000
                     genmsg(pvmsgset,vierr3);                  <<03510>>14918000
                     RETURN;                                   <<03510>>14920000
                  END;                                         <<03510>>14922000
            END;                                               <<03510>>14924000
      END;                                                     <<03510>>14926000
                                                               <<03510>>14928000
   << call the appropiate procedure to do the printout    >>   <<03510>>14930000
   << Pfre will call checkdisc to verify that the         >>   <<03510>>14932000
   << LDEVs are ok.                                       >>   <<03510>>14934000
                                                               <<03510>>14936000
   IF call'pfre THEN                                           <<03510>>14938000
      pfre(outf,all'ldevs,ldev)                                <<03510>>14940000
   ELSE                                                        <<03510>>14942000
      pfentries(outf,ldev);                                    <<03510>>14944000
                                                               <<03510>>14946000
END;   << pfspace >>                                           <<03510>>14948000
                                                                        14950000
$PAGE "PVINIT - COMMAND HANDLING FUNCTIONS"                             14952000
                                                                        14954000
$CONTROL SEGMENT=VINITCI                                       <<RK1PV>>14956000
PROCEDURE GETFUNCTION;                                                  14958000
OPTION PRIVILEGED,UNCALLABLE;                                           14960000
BEGIN                                                                   14962000
<< changes to support new DFSM. Before could only have 1  >>   <<03510>>14964000
<< keyword per command. Now can have a max of 4 keywords  >>   <<03510>>14966000
<< per command(max # fields per command is 4)             >>   <<03510>>14968000
<< For this reason, the following parms were changed:     >>   <<03510>>14970000
<<    (dimensioned)keywdlen,keyparmval,keyword,keywordspec>>   <<03510>>14972000
<<    keyparmspec                                         >>   <<03510>>14974000
<< Added new variable number'keywords                     >>   <<03510>>14976000
     INTEGER I:=0,FNCT:=0,DEVLOC:=0;                                    14978000
     INTEGER LEN,LOC,NUM,TYP,PARM,RLEN,DELIM,DEVLEN,ENDLOC,             14980000
             NUMPARMS,COMMPARM;                                         14982000
     LOGICAL OPT,STATUS,OPTMASK,TYPEMASK;                               14984000
     LOGICAL FLAGS;                                                     14986000
     DEFINE                                                             14988000
          ALPHCHAR = FLAGS.(15:1)#,                                     14990000
          NUMCHAR  = FLAGS.(14:1)#,                                     14992000
          SPECHAR  = FLAGS.(13:1)#;                                     14994000
     DOUBLE ARRAY PARMS(0:7);                                           14996000
     INTEGER ARRAY IPARMS(*) = PARMS;                                   14998000
     BYTE POINTER NAME;                                                 15000000
     BYTE ARRAY Nbuf(0:73); <<buffer must be>>                 <<03541>>15002000
                            <<as big as Rbuf>>                 <<03541>>15004000
     ARRAY PROMPT(0:1);                                        <<RK.08>>15006000
     BYTE ARRAY VSID'(0:24);                                            15008000
     BYTE ARRAY DL(0:4);                                                15010000
     BYTE ARRAY DL'(*) = PB :=",.;=",%15;                               15012000
     EQUATE                                                             15014000
          TERMCHR   = %15;                                              15016000
                                                                        15018000
     SUBROUTINE GETNEXTPARM;                                            15020000
     BEGIN                                                              15022000
          COMMPARM:=COMMPARM+1;                                         15024000
          TOS:=PARMS(COMMPARM);                                         15026000
          LEN:=S0.(0:8);                                                15028000
          FLAGS:=S0.(10:3);                                             15030000
          DELIM:=TOS.(11:5);                                            15032000
          @NAME:=TOS;                                                   15034000
     END <<GETNEXTPARM>>;                                               15036000
                                                                        15038000
     LOGICAL SUBROUTINE ILLEGALSTRING;                                  15040000
     BEGIN                                                              15042000
          ILLEGALSTRING:=TRUE;                                          15044000
          IF LEN > 8 THEN                                               15046000
          BEGIN                                                         15048000
               GENMSG(PVMSGSET,(VIERR15+TYP));                          15050000
               RETURN;                                                  15052000
          END;                                                          15054000
          IF NAME <> ALPHA THEN                                         15056000
          BEGIN                                                         15058000
               GENMSG(PVMSGSET,(VIERR18+TYP));                          15060000
               RETURN;                                                  15062000
          END;                                                          15064000
          IF SPECHAR THEN                                               15066000
          BEGIN                                                         15068000
               GENMSG(PVMSGSET,(VIERR21+TYP));                          15070000
               RETURN;                                                  15072000
          END;                                                          15074000
          ILLEGALSTRING:=FALSE;                                         15076000
     END <<ILLEGALSTRING>>;                                             15078000
                                                                        15080000
     LOGICAL SUBROUTINE CHECKPARMS;  <<ANALYZE POSITIONAL PARAMETERS>>  15082000
     BEGIN                                                              15084000
          PARM:=0;                                                      15086000
          COMMPARM:=-1;                                                 15088000
          DEVPARM:=0;                                                   15090000
          KEYWORD:=TERMCHR;  <<FOR POSSIBLE MYCOMMAND CALL>>            15092000
          @KEYWDLOC:=@RBUF(DEVLOC);                                     15094000
          MYCOMMAND(RBUF(DEVLOC),DL,7,NUMPARMS,PARMS);                  15096000
          OPTMASK:=PARMINFO(FNCT).(8:4);                                15098000
          TYPEMASK:=PARMINFO(FNCT).(0:8);                               15100000
          IF (NUM:=PARMINFO(FNCT).(12:4)) = 0 THEN  <<NO PARMS>>        15102000
          BEGIN                                                         15104000
               IF NUMPARMS <> 0 THEN                                    15106000
               BEGIN                                                    15108000
                    GETNEXTPARM;                                        15110000
                    GENMSG(PVMSGSET,VIERR25);                           15112000
                    RETURN;                                             15114000
               END;                                                     15116000
               CHECKPARMS:=TRUE;                                        15118000
               RETURN;                                                  15120000
          END;                                                          15122000
          IF NUMPARMS = 0 THEN                                          15124000
          BEGIN                                                         15126000
               IF NOT OPTMASK THEN                                      15128000
               BEGIN                                                    15130000
                    GENMSG(PVMSGSET,VIERR26);                           15132000
                    RETURN;                                             15134000
               END ELSE                                                 15136000
               PARM:=NUM;  <<FOR PARM LOOP>>                            15138000
          END;                                                          15140000
          WHILE (PARM:=PARM+1) <= NUM DO                                15142000
          BEGIN                                                         15144000
               GETNEXTPARM;                                             15146000
               DEVPARM(PARM):=0;  <<ASSUME ITS NOT A DEV PARAMETER>>    15148000
               TYP:=TYPEMASK.(14:2);                                    15150000
               TYPEMASK:=TYPEMASK & LSR(2);                             15152000
               OPT:=OPTMASK.(15:1);                                     15154000
               OPTMASK:=OPTMASK & LSR(1);                               15156000
               IF LEN = 0 AND NOT OPT THEN                              15158000
               BEGIN                                                    15160000
                    GENMSG(PVMSGSET,VIERR26);                           15162000
                    RETURN;                                             15164000
               END;                                                     15166000
               IF LEN <> 0 THEN  <<NOT AN OMITTED PARM>>                15168000
               CASE * TYP OF                                            15170000
               BEGIN                                                    15172000
                    BEGIN  << INTEGER >>                                15174000
                         IF NAME <> NUMERIC THEN                        15176000
                         BEGIN                                          15178000
                              GENMSG(PVMSGSET,VIERR27);                 15180000
                              RETURN;                                   15182000
                         END;                                           15184000
                         DEVPARM(PARM):=BINARY(NAME,LEN);               15186000
                         IF DEVPARM(PARM) <= 0 THEN                     15188000
                         BEGIN                                          15190000
                              GENMSG(PVMSGSET,VIERR28);                 15192000
                              RETURN;                                   15194000
                         END ELSE                                       15196000
                         DEVPARM:=DEVPARM+1;  <<NUMBER OF DEVS>>        15198000
                    END;                                                15200000
                    BEGIN  << VOLUME NAME >>                            15202000
                         IF ILLEGALSTRING THEN RETURN;                  15204000
                         MOVE VNAME:=NAME,(LEN);                        15206000
                    END;                                                15208000
                    BEGIN  << VOLUME SET DESIGNATOR >>                  15210000
                         I:=0;                                          15212000
                         WHILE DELIM = PERIOD DO                        15214000
                         BEGIN                                          15216000
                              IF I > 1 THEN  <<TOO MANY NAMES>>         15218000
                              BEGIN                                     15220000
                                   GENMSG(PVMSGSET,VIERR29);            15222000
                                   RETURN;                              15224000
                              END;                                      15226000
                              IF NOT(I=0 LAND NAME = "*") THEN          15228000
                              IF ILLEGALSTRING THEN RETURN;             15230000
                              MOVE VSID'(I * 8):=NAME,(LEN);            15232000
                              I:=I+1;                                   15234000
                              GETNEXTPARM;                              15236000
                         END;                                           15238000
                         IF ILLEGALSTRING THEN RETURN;                  15240000
                         MOVE VSID'(I * 8):=NAME,(LEN);                 15242000
                         VSIDSPEC:=TRUE;                                15244000
                    END;                                                15246000
                    BEGIN  << KEYWORD >>                                15248000
                         keywdlen(number'keywords):=len;       <<03510>>15250000
                         MOVE bptr'keyword:=name,(len);        <<03510>>15252000
                         bptr'keyword(len):=termchr; <<mycomm>><<03510>>15254000
                         @KEYWDLOC:=@NAME;                              15256000
                         IF DELIM = EQUALSIGN THEN  <<KEY PARM PRESENT>>15258000
                         BEGIN                                          15260000
                              GETNEXTPARM;                              15262000
                              IF LEN = 0 THEN                           15264000
                              BEGIN                                     15266000
                                   GENMSG(PVMSGSET,VIERR30);            15268000
                                   RETURN;                              15270000
                              END;                                      15272000
                              IF NAME <> NUMERIC THEN                   15274000
                              BEGIN                                     15276000
                                   GENMSG(PVMSGSET,VIERR15);            15278000
                                   RETURN;                              15280000
                              END;                                      15282000
                              keyparmval(number'keywords):=    <<03510>>15284000
                                 binary(name,len);             <<03510>>15286000
                              IF < THEN                                 15288000
                              BEGIN                                     15290000
                                   GENMSG(PVMSGSET,VIERR15);            15292000
                                   RETURN;                              15294000
                              END;                                      15296000
                              IF keyparmval(number'keywords)   <<03510>>15298000
                                 < 0 THEN                      <<03510>>15300000
                              BEGIN                                     15302000
                                   GENMSG(PVMSGSET,VIERR15);            15304000
                                   RETURN;                              15306000
                              END;                                      15308000
                              keyparmspec(number'keywords)     <<03510>>15310000
                                          :=true;              <<03510>>15312000
                         END;                                           15314000
                         keywdspec(number'keywords):=true;     <<03510>>15316000
                         << set-up for next keyword >>         <<03510>>15318000
                         @bptr'keyword:=@bptr'keyword +        <<03510>>15320000
                                        + max'keyword'len;     <<03510>>15322000
                         number'keywords:=number'keywords + 1; <<03510>>15324000
                    END;                                                15326000
               END;                                                     15328000
               WHILE DELIM <> DELIMS((FNCT * 4)+PARM-1) DO              15330000
               BEGIN                                                    15332000
                    IF DELIMS((FNCT * 4)+PARM-1) = CARRETURN THEN       15334000
                    BEGIN                                               15336000
                         GETNEXTPARM;                                   15338000
                         IF LEN = 0 THEN                                15340000
                            GENMSG(PVMSGSET,VIERR31)                    15342000
                         ELSE                                           15344000
                            GENMSG(PVMSGSET,VIERR32);                   15346000
                         RETURN;                                        15348000
                    END;                                                15350000
                    IF NOT OPTMASK THEN                                 15352000
                    BEGIN                                               15354000
                         GENMSG(PVMSGSET,VIERR26);                      15356000
                         RETURN;                                        15358000
                    END;                                                15360000
                    PARM:=PARM+1;                                       15362000
                    OPTMASK:=OPTMASK & LSR(1);                          15364000
                    TYPEMASK:=TYPEMASK & LSR(2);               <<RK.09>>15366000
               END;                                                     15368000
          END;                                                          15370000
          CHECKPARMS:=TRUE;                                             15372000
     END  <<CHECKPARMS>>;                                               15374000
                                                                        15376000
                                                                        15378000
     MOVE DL:=DL',(5);  <<MOVE IN PB-REL DLITERS>>                      15380000
     FNCT:=FUNCT:=0;  <<"ERR" FUNCTION CODE - ERROR>>                   15382000
     MOVE PROMPT:="> ";                                                 15384000
     WHILE FNCT = 0 DO  <<GET VALID FUNCTION NAME>>                     15386000
     BEGIN                                                              15388000
          RLEN:=0;                                                      15390000
          VSIDSPEC:=KEYWDSPEC:=KEYPARMSPEC:=FALSE;                      15392000
          MOVE keyparmspec(1):=keyparmspec,(max'keywords-1);   <<03510>>15394000
          MOVE keywdspec(1):=keywdspec,(max'keywords-1);       <<03510>>15396000
          RBUF:=" "; MOVE RBUF(1):=RBUF,(71);                           15398000
          VSID':=" "; MOVE VSID'(1):=VSID',(23);                        15400000
          VNAME:=" "; MOVE VNAME(1):=VNAME,(7);                         15402000
          keyword:= " "; MOVE keyword(1):=keyword,             <<03510>>15404000
                         (max'keyword'len * max'keywords-1);   <<03510>>15406000
          keywdlen:=0;                                         <<03510>>15408000
          MOVE keywdlen(1):=keywdlen,(max'keywords-1);         <<03510>>15410000
          keyparmval:=0;                                       <<03510>>15412000
          MOVE keyparmval(1):=keyparmval,(max'keywords-1);     <<03510>>15414000
          @bptr'keyword:=@keyword;                             <<03510>>15416000
          number'keywords:=0;                                  <<03510>>15418000
          WHILE RLEN = 0 DO                                             15420000
          BEGIN                                                         15422000
               PRINT(PROMPT,-1,%320);  <<PROMPT - NO CRLF>>             15424000
               RLEN:=READ(RBUFW,-72);                          <<RK.08>>15426000
               IF <> THEN                                      <<RK1PV>>15428000
                  BEGIN                                        <<RK1PV>>15430000
                  MOVE RBUF := "EXIT  ";                       <<RK1PV>>15432000
                  RLEN := 4;                                   <<RK1PV>>15434000
                  END;                                         <<RK1PV>>15436000
          END;                                                          15438000
          RBUF(RLEN):=TERMCHR;                                          15440000
          NBUF:=" "; MOVE NBUF(1):=NBUF,(73);                  <<03541>>15442000
          MOVE NBUF:=RBUF WHILE AS,1;                                   15444000
          DEVLOC:=TOS-@NBUF;                                            15446000
          FOR I:=1 STEP 1 UNTIL FUNCTNUM DO                             15448000
          IF NBUF = FUNCTLIST(I*8),(8) THEN  <<FUNCTION FOUND>>         15450000
          BEGIN                                                         15452000
               FNCT:=I;                                                 15454000
               I:=FUNCTNUM;  <<STOP LOOP>>                              15456000
          END;                                                          15458000
          IF FNCT = 0 THEN                                              15460000
          BEGIN                                                         15462000
               GENMSG(PVMSGSET,VIERR1);                                 15464000
          END ELSE                                                      15466000
          IF CHECKPARMS THEN                                            15468000
          BEGIN                                                         15470000
               I:=0;                                                    15472000
               << because pfspace can have it's first field >> <<03510>>15474000
               << either number or alpha, pfspace will do   >> <<03510>>15476000
               << checkdisc when it finds out that it is an >> <<03510>>15478000
               << ldev. If any of this changes, should also >> <<03510>>15480000
               << change pfspace                            >> <<03510>>15482000
               WHILE DEVPARM <> 0 DO  <<CHECK DEV PARM VALIDITY>>       15484000
               IF DEVPARM(I:=I+1) <> 0 THEN  <<HERE'S ONE>>             15486000
               BEGIN                                                    15488000
                    DEVPARM:=DEVPARM-1;                                 15490000
                    CHECKDISC(DEVPARM(I),STATUS);                       15492000
                    IF (STATUS LOR MASK(FNCT)) <> MASK(FNCT) THEN       15494000
                    BEGIN                                               15496000
                         FNCT:=DEVPARM:=0;  <<CONTINUE FNCT LOOP>>      15498000
                         DEVERROR(DEVPARM(I),STATUS);                   15500000
                    END ELSE                                            15502000
                    DEVSTATUS(I):=STATUS;                               15504000
               END;                                                     15506000
               IF VSIDSPEC AND FNCT <> 0 THEN                           15508000
               BEGIN                                                    15510000
                    VALIDVSID:=TRUE;                                    15512000
                    MOVE VSID:=VSID',(24);                              15514000
               END;                                                     15516000
          END ELSE                                                      15518000
          FNCT:=0;  <<KEEP COMMAND LOOP GOING>>                         15520000
     END;                                                               15522000
     FUNCT:=FNCT;  <<VALID REQUEST: FUNCT <> 0>>                        15524000
END << GETFUNCTION >>;                                                  15526000
$PAGE "PROCEDURE SERVOL"                                       <<03537>>15528000
$CONTROL SEGMENT=NEWPACK                                       <<RK.09>>15530000
PROCEDURE SERVOL;                                                       15532000
OPTION PRIVILEGED,UNCALLABLE;                                           15534000
BEGIN <<SERVOL>>                                                        15536000
EQUATE CYL'DVR=65, <<#CYLINDERS SUPPORTED BY DRIVER>>          <<00075>>15538000
       CYL'CNTRLR=67, <<#CYLINDERS SUPPORTED BY THE CONTROLLER>>        15540000
       SECTORS'TRACK=30,                                       <<00075>>15542000
       EOT'EOD'LENGTH=200,<<#SECTORS BETWEEN EOT AND EOD>>     <<00075>>15544000
       REQSTAT=7;                                              <<00075>>15546000
EQUATE WORDSPERSECTR=14, <<LABEL INDEX FOR START OF DESCRIP'N>><<00075>>15548000
       EOTSECTR=18, <<LABEL INDEX FOR END OF TAPE VALUE>>      <<00075>>15550000
       EODSECTR=20; <<LABEL INDEX FOR END OF DISC VALUE>>      <<00075>>15552000
DEFINE GPTSECT1=4D#,                                           <<00186>>15554000
       GPTSECT2=5D#;                                           <<00186>>15556000
DOUBLE LOG'SECT; <<LOGICAL SECTOR VALUE>>                      <<00075>>15558000
INTEGER LOG'SECTOR=LOG'SECT+1;                                 <<00075>>15560000
DOUBLE ARRAY PHY'ADR(0:0);                                     <<00075>>15562000
INTEGER TYPE,LDEV;                                             <<00075>>15564000
INTEGER    subtype;                                            <<03510>>15566000
LOGICAL STATUS;                                                <<00075>>15568000
INTEGER SDISCTYPE;                                             <<00075>>15570000
EQUATE NUMSDISCTYPES = 7,                                      <<03537>>15572000
       INITARRAYSIZE=7;                                        <<00075>>15574000
INTEGER ARRAY PHY'CYL(*)=PHY'ADR;                              <<00075>>15576000
INTEGER ARRAY STATUS'RTN(*)=PHY'ADR;                           <<00075>>15578000
INTEGER TRACKS'CYL;                                            <<00075>>15580000
INTEGER Qmisc := 0;                                            <<03537>>15584000
LOGICAL Dummy;                                                 <<03537>>15586000
INTEGER Counter := 0;                                          <<03537>>15588000
INTEGER Linus'Gap'Length := 0; << Defined later on.          >><<03537>>15590000
EQUATE Disc'Lab'BOT'Word = 16; << In serial disc label       >><<03537>>15592000
DEFINE DOUBLE'SIDED=STATUS'RTN(1).(4:1)=1#;                    <<00075>>15594000
COMMENT:                                                       <<00075>>15596000
   SDISC0TYPES - THIS ARRAY DEFINES WHICH TYPE ZERO DISCS      <<00075>>15598000
                 ARE SUPPORTED AS SERIAL DISCS.  IF THE        <<00075>>15600000
                 NTH ENTRY IN THIS ARRAY IS NON-NEGATIVE,      <<00075>>15602000
                 THEN SUBTYPE N IS SUPPORTED.  THE VALUE       <<00075>>15604000
                 IS THEN USED AS AN INDEX INTO THE ARRAY       <<00075>>15606000
                 SDISCDESC TO LOCATE THE DESCRIPTIVE           <<00075>>15608000
                 PARAMETERS FOR THAT SUBTYPE.                  <<00075>>15610000
   SDISC2TYPES - THIS ARRAY IS LIKE SDISC0TYPES, EXCEPT FOR    <<00075>>15612000
                 TYPE TWO DISCS.                               <<00075>>15614000
   SDISCDESC   - THIS ARRAY CONTAINS THE DESCRIPTIVE PARMS     <<00075>>15616000
                 FOR EACH SUPPORTED SERIAL DISC TYPE.          <<00075>>15618000
                 IT IS LOGICALLY A TWO DIMENSIONAL ARRAY STORED<<00075>>15620000
                 IN ROW-MAJOR FORMAT WITH INITARRAYSIZE        <<00075>>15622000
                 DEFINING THE ROW LENGTH AND ONE ROW FOR       <<00075>>15624000
                 EACH SUPPORTED TYPE AND NUMSDISCTYPES         <<00075>>15626000
                 DEFINING THE NUMBER OF SUPPORTED TYPES.;      <<00075>>15628000
INTEGER ARRAY SDISC0TYPES(0:15)=PB:=                           <<00075>>15630000
4(-1),0<<R7905>>,3(-1),1<<S7920>>,4<<S7925>>,2<<R7906>>,5(-1); <<00239>>15632000
INTEGER ARRAY SDISC2TYPES(0:15)=PB:=                           <<00075>>15634000
3<<S7902>>,15(-1);                                             <<00075>>15636000
INTEGER ARRAY                                                  <<03537>>15638000
  SDISC3TYPES(*) = PB :=                                       <<03537>>15640000
  6,      << LINUS >>                                          <<03537>>15642000
  -1,     << HP7911 - invalid >>                               <<03537>>15644000
  -1,     << HP7912 - invalid >>                               <<03537>>15646000
  5(-1),  << Null >>                                           <<03537>>15648000
  5,      << HP7935 >>                                         <<03537>>15650000
  7(-1);  << Null >>                                           <<03537>>15652000
INTEGER ARRAY                                                  <<03537>>15654000
  SDISCDESC(-INITARRAYSIZE:NUMSDISCTYPES*INITARRAYSIZE)=PB:=   <<03537>>15656000
<<WORDS>>   <<SECTORS>>  <<LOAD>>   <<END OF>> <<END OF>>      <<00075>>15658000
<<PER>>     <<PER>>      <<POINT>>  <<TAPE>>   <<DISC>>        <<00075>>15660000
<<SECTOR>>  <<TRACK>>                                          <<00075>>15662000
 -1,        -1,          -1,        -1,-1,     -1,-1, <<INVALID>>       15664000
128,        48,          48,        0,38199,   0,38399, <<R7905>>       15666000
128,        48,          48,        2,64327,   2,64527, <<S7920>>       15668000
128,        48,          48,        0,38199,   0,38399, <<R7906>>       15670000
128,        30,          30,        0,0,       0,0,     <<S7902>>       15672000
128,        64,          64,        7,10487,   7,10687,<<7925>><<00266>>15674000
128,        -1,          223,       24,6851,   24,7051,<<7935>><<03537>>15676000
512,        -1,          8,         0,0,       0,0,   <<LINUS>><<03537>>15678000
<< Note: Linus doesn't get it's values from here.            >><<03537>>15680000
0;                                                             <<00075>>15682000
ARRAY Buff(0:Linus'Sector - 1);                                <<03537>>15686000
BYTE ARRAY BUFFB(*)  = BUFF;                                   <<RK.09>>15688000
ARRAY Buf2(0:Linus'Sector - 1);                                <<03537>>15690000
DOUBLE EOT'SECTOR,EOD'SECTOR;                                  <<DL089>>15692000
INTEGER EOT'SECTOR0=EOT'SECTOR,EOT'SECTOR1=EOT'SECTOR+1,       <<DL089>>15694000
        EOD'SECTOR0=EOD'SECTOR,EOD'SECTOR1=EOD'SECTOR+1;       <<DL089>>15696000
DOUBLE VTABINFO;                                               <<RK.09>>15698000
INTEGER                                                        <<RK.09>>15700000
     A, VTABX, I,                                              <<RK.09>>15702000
     VTABINFO1 = VTABINFO,                                     <<RK.09>>15704000
     VTBAINFO2 = VTABINFO+1;                                   <<RK.09>>15706000
ARRAY LABELDATA(0:127)=PB:=6(0),                                        15708000
                           %20000,                                      15710000
                           3(0),                                        15712000
                           %51505, <<"SE">>                             15714000
                           %51104, <<"RD">>                             15716000
                           %44523, <<"IS">>                             15718000
                           %41440, <<"C ">>                             15720000
                           114(0);                                      15722000
                                                                        15724000
LDEV:=DEVPARM(1);                                                       15726000
     Linus := Is'It'Linus(Ldev);                               <<03537>>15728000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN RETURN ELSE          <<03739>>15730000
     IF DEVSTATUS(1).DOWNF = 0 THEN                                     15732000
     BEGIN                                                              15734000
          TOS:=SCRATCHVOL(LDEV);                                        15736000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                         15738000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>15740000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>15742000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>15744000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>15746000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>15748000
          RETURN;                                              <<01615>>15750000
     END                                                       <<RK.08>>15752000
     ELSE IF NOT OVERWRITE(LDEV,5) THEN RETURN;                <<RK.08>>15754000
     IF Linus THEN                                             <<03537>>15756000
     BEGIN                                                     <<03537>>15758000
          Type    := Ldevtotype(Ldev);                         <<03537>>15760000
          Subtype := Ldevtosubtype(Ldev);                      <<03537>>15762000
     END                                                       <<03537>>15764000
     ELSE                                                      <<03537>>15766000
          Get'Disc'Info(ldev,,,,type,subtype);                 <<03537>>15768000
Buff := 0; MOVE Buff(1) := Buff,(Linus'Sector - 1);            <<03537>>15770000
MOVE BUFF:=LABELDATA,(128);                                             15772000
buff(disc'lab'type'word).disc'lab'type:=type;                  <<03510>>15776000
buff(disc'lab'type'word).disc'lab'subtype:=subtype;            <<03510>>15778000
IF NOT Linus THEN <<We want to do this junk                  >><<03537>>15780000
BEGIN                                                          <<03537>>15782000
IF type <> mh'disc'type AND                                    <<03510>>15784000
   TYPE <> CS'80'TYPE AND                                      <<03537>>15786000
   type <> floppy'disc'type THEN                               <<03510>>15788000
   BEGIN                                                       <<00075>>15790000
   GENMSG(PVMSGSET,VIERR28,%10000,LDEV);                       <<00075>>15792000
   GENMSG(PVMSGSET,VIERR0);                                    <<00075>>15794000
   RETURN;                                                     <<00075>>15796000
   END;                                                        <<00075>>15798000
sdisctype:=IF type=mh'disc'type THEN                           <<03510>>15800000
   sdisc0types(subtype)                                        <<03510>>15802000
ELSE IF TYPE = CS'80'TYPE THEN                                 <<03537>>15804000
  SDISC3TYPES(SUBTYPE)                                         <<03537>>15806000
ELSE                                                           <<03510>>15808000
   sdisc2types(subtype);                                       <<03510>>15810000
IF SDISCDESC(SDISCTYPE*INITARRAYSIZE)=-1 THEN                  <<00075>>15812000
   BEGIN <<INVALID SUBTYPE>>                                   <<00075>>15814000
   GENMSG(PVMSGSET,VIERR8,%10000,LDEV);                        <<00075>>15816000
   GENMSG(PVMSGSET,VIERR0);                                    <<00075>>15818000
   RETURN;                                                     <<00075>>15820000
   END;  <<INVALID SUBTYPE>>                                   <<00075>>15822000
MOVE BUFF(WORDSPERSECTR):=SDISCDESC(SDISCTYPE*INITARRAYSIZE),  <<00075>>15824000
(INITARRAYSIZE);                                               <<00075>>15826000
IF type = floppy'disc'type THEN                                <<03510>>15828000
   BEGIN <<FIND EOT AND EOD>>                                  <<00075>>15830000
   COMMENT:                                                    <<00075>>15832000
   SINCE THE DRIVER ASSUMES THAT THERE ARE 65 LOGICAL          <<00075>>15834000
   CYLINDERS AND THE CONTROLLER ONLY GUARENTEES VALID          <<00075>>15836000
   DATA TRANSFERS TO THE FIRST 67 PHYSICAL CYLINDERS,          <<00075>>15838000
   THE END OF DISC IS DEFINED AS THE NUMBER OF SECTORS         <<00075>>15840000
   IN THE FIRST 65 LOGICAL CYLINDERS THAT RESIDE ON THE        <<00075>>15842000
   FIRST 67 PHYSICAL CYLINDERS.                                <<00075>>15844000
   ;                                                           <<00075>>15846000
   LOG'SECT:=0D; <<INITIALIZE BOTH WORDS>>                     <<00075>>15848000
   STATUS:=2; <<RETURN ANY ERROR HERE, NOT TO USER>>           <<00075>>15850000
   DISCIO(LDEV,REQSTAT,STATUS'RTN,0D,2,STATUS);                <<00075>>15852000
   IF DOUBLE'SIDED THEN                                        <<00075>>15854000
      TRACKS'CYL:=2                                            <<00075>>15856000
   ELSE                                                        <<00075>>15858000
      TRACKS'CYL:=1;                                           <<00075>>15860000
   LOG'SECTOR:=SECTORS'TRACK*TRACKS'CYL*CYL'DVR-1;             <<00075>>15862000
   DO                                                          <<00075>>15864000
      BEGIN                                                    <<00075>>15866000
      STATUS:=2; <<RETURN ANY ERROR HERE, NOT TO USER>>        <<00075>>15868000
      DISCIO(LDEV,FPA,PHY'ADR,LOG'SECT,2,STATUS);              <<00112>>15870000
      LOG'SECTOR:=LOG'SECTOR-SECTORS'TRACK;                    <<00075>>15872000
      END                                                      <<00075>>15874000
   UNTIL PHY'CYL<CYL'CNTRLR AND STATUS.GSTATUS=1;              <<00092>>15876000
   BUFF(EOTSECTR):=LOG'SECTOR-EOT'EOD'LENGTH+SECTORS'TRACK;    <<00075>>15878000
   BUFF(EODSECTR):=LOG'SECTOR+SECTORS'TRACK;                   <<00075>>15880000
   END;                                                        <<00075>>15882000
IF type = mh'disc'type THEN                                    <<03510>>15884000
   BEGIN <<VERIFY OR ADJUST EOT & EOD FOR THIS DISC>>          <<DL089>>15886000
   EOD'SECTOR0:=BUFF(EODSECTR-1);                              <<DL089>>15888000
   EOD'SECTOR1:=BUFF(EODSECTR);                                <<DL089>>15890000
   STATUS := %(2)010;  << Return error here, no msg >>         <<03537>>15892000
   DISCIO(LDEV,R,BUF2,EOD'SECTOR,128,STATUS);                  <<03537>>15894000
   IF < THEN DO                                                <<DL089>>15896000
      BEGIN <<ADJUST EOT & EOD DOWNWARD>>                      <<DL089>>15898000
      EOD'SECTOR:=EOD'SECTOR-100D;                             <<DL089>>15900000
      BUFF(EODSECTR-1):=EOD'SECTOR0;                           <<DL089>>15902000
      BUFF(EODSECTR):=EOD'SECTOR1;                             <<DL089>>15904000
      EOT'SECTOR:=EOD'SECTOR-DOUBLE(EOT'EOD'LENGTH);           <<DL089>>15906000
      BUFF(EOTSECTR-1):=EOT'SECTOR0;                           <<DL089>>15908000
      BUFF(EOTSECTR):=EOT'SECTOR1;                             <<DL089>>15910000
      STATUS := %(2)010;  << Return error here, no msg >>      <<03537>>15912000
      DISCIO(LDEV,R,BUF2,EOD'SECTOR,128,STATUS);               <<03537>>15914000
      END                                                      <<DL089>>15916000
   UNTIL >=;                                                   <<DL089>>15918000
   END;                                                        <<DL089>>15920000
IF TYPE = CS'80'TYPE THEN                                      <<03537>>15922000
  BEGIN                                                        <<03537>>15924000
  IF SUBTYPE > ST'9110  << Linus >> THEN                       <<03537>>15926000
    BEGIN                                                      <<03537>>15928000
                                                               <<03537>>15930000
  << SERIAL function for CS'80 discs - Linus elsewhere       >><<03537>>15932000
                                                               <<03537>>15934000
    IF NOT INITDSCT(LDEV) THEN RETURN; << Verify/Set up DSCT >><<03537>>15936000
                                                               <<03537>>15938000
    DISCIO(LDEV,W,DTT,1D,128); <<WRITE DSCT>>                  <<03638>>15940000
    STATUS := %(2)101;  << Print msg >>                        <<03537>>15942000
    DISCIO(LDEV,REQ'VOL'LIMIT,EOD'SECTOR,0D,2,STATUS);         <<03537>>15944000
    IF <> THEN RETURN;                                         <<03537>>15946000
                                                               <<03537>>15948000
  << Set SDISC pertinent info into disc label >>               <<03537>>15950000
                                                               <<03537>>15952000
    EOT'SECTOR := EOD'SECTOR - DOUBLE(EOT'EOD'LENGTH);         <<03537>>15954000
    BUFF(EODSECTR-1) := EOD'SECTOR0;                           <<03537>>15956000
    BUFF(EODSECTR)   := EOD'SECTOR1;                           <<03537>>15958000
    BUFF(EOTSECTR-1) := EOT'SECTOR0;                           <<03537>>15960000
    BUFF(EOTSECTR)   := EOT'SECTOR1;                           <<03537>>15962000
    END                                                        <<03537>>15964000
  END;  << CS'80 SERIAL function >>                            <<03537>>15966000
DISCIO(LDEV,WL,BUFF,0D,128);                                   <<RK1PV>>15968000
END                                                            <<03537>>15970000
ELSE << We are a Linus Drive.                                >><<03537>>15972000
BEGIN                                                          <<03537>>15974000
   IF NOT Linus'Numbers(Ldev, Buff(Wordspersectr)) THEN        <<03537>>15976000
   BEGIN                                                       <<03537>>15978000
      Genmsg(Pvmsgset,Vierr93); << It's not formatted        >><<03537>>15980000
      RETURN;                                                  <<03537>>15982000
   END;                                                        <<03537>>15984000
   Linusio(Ldev,Qmisc,Buff,WL,Linus'Sector,                    <<03537>>15986000
           Disc'Label'Address,Blocked'IO,                      <<03537>>15988000
           SKIP'SPARING,Default'Errinfo,Dummy);                <<03537>>15990000
   IF < THEN RETURN;                                           <<03537>>15992000
END; << Back to Common Code Again.                           >><<03537>>15994000
<<CLEAR GAP TABLE>>                                            <<00186>>15998000
Buf2:=-1;                                                      <<03537>>16000000
                                                               <<03537>>16002000
<< We have two buffers Buff and Buf2 for following reasons.  >><<03537>>16004000
<< 1/ When we are setting the EOT and EOD for Serial disc,   >><<03537>>16006000
<<    we are verifying that we can successfully read the     >><<03537>>16008000
<<    sector indicating End Of Data. If we can't we back     >><<03537>>16010000
<<    up the disc and try again. When we find one we can     >><<03537>>16012000
<<    read, we fill that into the info for the Serial disc   >><<03537>>16014000
<<    label.                                                 >><<03537>>16016000
<< 2/ When Serializing the Linus cartridge we write out      >><<03537>>16018000
<<    a fully initialized Linus Gap Table. We depend on      >><<03537>>16020000
<<    Buff containing valid label data for BOT so we         >><<03537>>16022000
<<    can calculate how many sectors we have to initialize.  >><<03537>>16024000
                                                               <<03537>>16026000
MOVE Buf2(1) := Buf2,(Linus'Sector - 1);                       <<03537>>16028000
IF Linus THEN                                                  <<03537>>16030000
BEGIN                                                          <<03537>>16032000
<< Initialize the whole table at once.                       >><<03537>>16034000
   Linus'Gap'Length := INTEGER( Buff(Disc'Lab'BOT'Word))  -    <<03537>>16036000
                       INTEGER( GPTSECT1 );                    <<03537>>16038000
   FOR Counter := 0 UNTIL Linus'Gap'Length - 1 DO              <<03537>>16040000
   BEGIN                                                       <<03537>>16042000
      Linusio(Ldev,Qmisc,Buf2,W,Linus'Sector,                  <<03537>>16044000
              GPTSECT1 + DOUBLE(Counter),Blocked'IO,           <<03537>>16046000
              SKIP'SPARING,Default'Errinfo,Dummy);             <<03537>>16048000
      IF < THEN RETURN;                                        <<03537>>16050000
   END                                                         <<03537>>16052000
END                                                            <<03537>>16054000
ELSE                                                           <<03537>>16056000
BEGIN << Not a linus.                                        >><<03537>>16058000
DISCIO(Ldev,W,Buf2,GPTSECT1,128);                              <<03537>>16060000
IF < THEN                                                      <<00186>>16062000
   RETURN;                                                     <<03537>>16064000
DISCIO(Ldev,W,Buf2,GPTSECT2,128);                              <<03537>>16066000
IF < THEN                                                      <<00186>>16068000
   RETURN;                                                     <<03537>>16070000
END; << Back to Common Code.                                 >><<03537>>16072000
BUFF:="  "; <<MATCH ON LDEV ONLY>>                             <<RK.09>>16074000
     I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX SEARCH>>          <<RK.09>>16076000
IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,LDEV,I)) = 0D THEN         <<RK.09>>16078000
   BEGIN                                                       <<RK.09>>16080000
   GENMSG(PVMSGSET,VIERR38,%10000,LDEV);                       <<RK.09>>16082000
   RETURN;                                                     <<RK.09>>16084000
   END;                                                        <<RK.09>>16086000
VTABX:=VTABINFO1.(8:8);  <<VTAB INDEX OF SERIAL DEVICE>>       <<RK.09>>16088000
          <<UPDATE VOLUME TABLE>>                              <<RK.09>>16090000
A:=GETSIR(VTABSIR);                                            <<RK.09>>16092000
GETABENTRY(VTABDST,VTABX,BUFF);                                <<RK.09>>16094000
MOVE BUFFB:="SERDISC ",2;   <<VOLUME NAME >>                   <<RK.09>>16096000
ASSEMBLE(DUP,DECA);                                            <<RK.09>>16098000
MOVE * := *,(16);  <<BLANK REST OF VOLUME NAME>>               <<RK.09>>16100000
BUFF(12).(14:2):=2;<<MARK AS NON-SYS DEVICE>>                  <<RK.09>>16102000
BUFF(13):=0;                                                   <<RK.09>>16104000
LPDT(LDEV&LSL(1)+1).SDLF:=1; <<SET SERIAL BIT>>                <<SD.00>>16106000
LPDT(LDEV&LSL(1)+1).FORS:=0;                                   <<01115>>16108000
PUTABENTRY(VTABDST,VTABX,BUFF);                                <<RK.09>>16110000
RELSIR(VTABSIR,A);                                             <<RK.09>>16112000
END;  <<SERVOL>>                                                        16114000
$PAGE "FOREIGN FUNCTION"                                       <<01115>>16116000
$CONTROL SEGMENT=NEWPACK                                       <<01115>>16118000
PROCEDURE FORNVOL;                                             <<01115>>16120000
OPTION PRIVILEGED,UNCALLABLE;                                  <<01115>>16122000
BEGIN <<FORNVOL>>                                              <<01115>>16124000
DOUBLE LOG'SECT; <<LOGICAL SECTOR VALUE>>                      <<01115>>16126000
INTEGER LOG'SECTOR=LOG'SECT+1;                                 <<01115>>16128000
DOUBLE ARRAY PHY'ADR(0:0);                                     <<01115>>16130000
INTEGER TYPE,LDEV;                                             <<01115>>16132000
INTEGER   subtype;                                             <<03510>>16134000
LOGICAL STATUS;                                                <<01115>>16136000
INTEGER SDISCTYPE;                                             <<01115>>16138000
EQUATE NUMSDISCTYPES=4,                                        <<01115>>16140000
       INITARRAYSIZE=7;                                        <<01115>>16142000
INTEGER ARRAY PHY'CYL(*)=PHY'ADR;                              <<01115>>16144000
INTEGER ARRAY STATUS'RTN(*)=PHY'ADR;                           <<01115>>16146000
INTEGER TRACKS'CYL;                                            <<01115>>16148000
DEFINE DOUBLE'SIDED=STATUS'RTN(1).(4:1)=1#;                    <<01115>>16150000
COMMENT:                                                       <<01115>>16152000
   SDISC0TYPES - THIS ARRAY DEFINES WHICH TYPE ZERO DISCS      <<01115>>16154000
                 ARE SUPPORTED AS FOREIGN DISCS. IF THE        <<01115>>16156000
                 NTH ENTRY IN THIS ARRAY IS NON-NEGATIVE,      <<01115>>16158000
                 THEN SUBTYPE N IS SUPPORTED.                  <<01115>>16160000
   SDISC2TYPES - THIS ARRAY IS LIKE SDISC0TYPES, EXCEPT FOR    <<01115>>16162000
                 TYPE TWO DISCS;                               <<01115>>16164000
<< SDISC3TYPES - This array is like SDISC0TYPES, except for  >><<03537>>16166000
<<               type three (CS'80) discs.                   >><<03537>>16168000
INTEGER ARRAY                                                  <<03537>>16170000
  SDISC0TYPES(*) = PB :=                                       <<03537>>16172000
  -1,     << R7900 - invalid >>                                <<03537>>16174000
  -1,     << F7900 - invalid >>                                <<03537>>16176000
  -1,     << S7900 - invalid >>                                <<03537>>16178000
  -1,     << S2888 - invalid >>                                <<03537>>16180000
  0,      << R7605 >>                                          <<03537>>16182000
  -1,     << F7905 - invalid >>                                <<03537>>16184000
  -1,     << S7905 - invalid >>                                <<03537>>16186000
  -1,     << S7905 FHD replacement - invalid >>                <<03537>>16188000
  1,      << S7920 >>                                          <<03537>>16190000
  4,      << S7925 >>                                          <<03537>>16192000
  2,      << R7906 >>                                          <<03537>>16194000
  -1,     << F7906 - invalid >>                                <<03537>>16196000
  -1,     << S7906 - invalid >>                                <<03537>>16198000
  3(-1);  << Null >>                                           <<03537>>16200000
INTEGER ARRAY SDISC2TYPES(0:15)=PB:=                           <<01115>>16204000
3<<S7902>>,15(-1);                                             <<01115>>16206000
INTEGER ARRAY                                                  <<03537>>16208000
  SDISC3TYPES(*) = PB :=                                       <<03537>>16210000
  -1,     << LINUS - invalid >>                                <<03537>>16212000
  -1,     << HP7911 - invalid >>                               <<03537>>16214000
  -1,     << HP7912 - invalid >>                               <<03537>>16216000
  5(-1),  << Null >>                                           <<03537>>16218000
  5,      << HP7935 >>                                         <<03537>>16220000
  7(-1);  << Null >>                                           <<03537>>16222000
ARRAY BUFF(0:127);                                             <<01115>>16226000
BYTE ARRAY BUFFB(*)  = BUFF;                                   <<01115>>16228000
ARRAY BUF2(0:127);                                             <<01115>>16230000
DOUBLE EOT'SECTOR,EOD'SECTOR;                                  <<01115>>16232000
INTEGER EOT'SECTOR0=EOT'SECTOR,EOT'SECTOR1=EOT'SECTOR+1,       <<01115>>16234000
        EOD'SECTOR0=EOD'SECTOR,EOD'SECTOR1=EOD'SECTOR+1;       <<01115>>16236000
DOUBLE VTABINFO;                                               <<01115>>16238000
INTEGER                                                        <<01115>>16240000
     A, VTABX, I,                                              <<01115>>16242000
     VTABINFO1 = VTABINFO,                                     <<01115>>16244000
     VTBAINFO2 = VTABINFO+1;                                   <<01115>>16246000
                                                               <<01115>>16248000
LDEV:=DEVPARM(1);                                              <<01115>>16250000
     IF UNREADABLE'LABEL(LDEV,FALSE) THEN << DO IT >> ELSE     <<01115>>16252000
     IF DEVSTATUS(1).DOWNF = 0 THEN                            <<01115>>16254000
     BEGIN                                                     <<01115>>16256000
          TOS:=SCRATCHVOL(LDEV);                               <<01115>>16258000
          IF < THEN RETURN;  <<DISC I/O ERROR>>                <<01115>>16260000
          IF NOT TOS THEN   << NOT SCRATCH LABEL >>            <<01615>>16262000
             GENMSG(PVMSGSET,VIERR6,%10000,LDEV)               <<01615>>16264000
          ELSE              << NOT DOWNED, ONLY  >>            <<01615>>16266000
             GENMSG(PVMSGSET,VIERR5,%10000,LDEV);              <<01615>>16268000
          GENMSG(PVMSGSET,VIERR0);                             <<01615>>16270000
          RETURN;                                              <<01615>>16272000
     END                                                       <<01115>>16274000
     ELSE IF NOT OVERWRITE(LDEV,6) THEN RETURN;                <<01115>>16276000
BUFF:=0; MOVE BUFF(1):=BUFF,(128);                             <<01115>>16278000
Get'Disc'Info(ldev,,,,type,subtype);                           <<03510>>16280000
IF type <> mh'disc'type AND                                    <<03510>>16282000
   TYPE <> CS'80'TYPE AND                                      <<03537>>16284000
   type <> floppy'disc'type THEN                               <<03510>>16286000
   BEGIN                                                       <<01115>>16288000
   GENMSG(PVMSGSET,VIERR28,%10000,LDEV);                       <<01115>>16290000
   GENMSG(PVMSGSET,VIERR0);                                    <<01115>>16292000
   RETURN;                                                     <<01115>>16294000
   END;                                                        <<01115>>16296000
SDISCTYPE := IF TYPE = MH'DISC'TYPE THEN SDISC0TYPES(SUBTYPE)  <<03537>>16298000
  ELSE IF TYPE = FLOPPY'DISC'TYPE THEN SDISC2TYPES(SUBTYPE)    <<03537>>16300000
  ELSE SDISC3TYPES(SUBTYPE);                                   <<03537>>16302000
IF SDISCTYPE=-1 THEN                                           <<01115>>16306000
   BEGIN <<INVALID SUBTYPE>>                                   <<01115>>16308000
   GENMSG(PVMSGSET,VIERR8,%10000,LDEV);                        <<01115>>16310000
   GENMSG(PVMSGSET,VIERR0);                                    <<01115>>16312000
   RETURN;                                                     <<01115>>16314000
   END;  <<INVALID SUBTYPE>>                                   <<01115>>16316000
DISCIO(LDEV,WL,BUFF,0D,128);                                   <<01115>>16318000
IF < THEN                                                      <<01115>>16320000
   GENMSG(PVMSGSET,VIERR0);                                    <<01115>>16322000
BUFF:="  "; <<MATCH ON LDEV ONLY>>                             <<01115>>16324000
     I:=-1;  <<DUMMY GEN INDEX FOR VTABINDEX SEARCH>>          <<01115>>16326000
IF (VTABINFO:=VTABINDEX(BUFFB,BUFFB,LDEV,I)) = 0D THEN         <<01115>>16328000
   BEGIN                                                       <<01115>>16330000
   GENMSG(PVMSGSET,VIERR38,%10000,LDEV);                       <<01115>>16332000
   RETURN;                                                     <<01115>>16334000
   END;                                                        <<01115>>16336000
VTABX:=VTABINFO1.(8:8);  <<VTAB INDEX OF SERIAL DEVICE>>       <<01115>>16338000
          <<UPDATE VOLUME TABLE>>                              <<01115>>16340000
A:=GETSIR(VTABSIR);                                            <<01115>>16342000
GETABENTRY(VTABDST,VTABX,BUFF);                                <<01115>>16344000
MOVE BUFFB:="FORNDISC",2;   <<VOLUME NAME >>                   <<01115>>16346000
ASSEMBLE(DUP,DECA);                                            <<01115>>16348000
MOVE * := *,(16);  <<BLANK REST OF VOLUME NAME>>               <<01115>>16350000
BUFF(12).(14:2):=2;<<MARK AS NON-SYS DEVICE>>                  <<01115>>16352000
BUFF(13):=0;                                                   <<01115>>16354000
LPDT(LDEV&LSL(1)+1).SDLF:=1; <<SET SER/FORN MTD BIT>>          <<01115>>16356000
LPDT(LDEV&LSL(1)+1).FORS:=1;  <<SET FOREIGN BIT>>              <<01115>>16358000
PUTABENTRY(VTABDST,VTABX,BUFF);                                <<01115>>16360000
RELSIR(VTABSIR,A);                                             <<01115>>16362000
END;  <<FORNVOL>>                                              <<01115>>16364000
$PAGE "   VERIFY FUNCTION"                                     <<04670>>16368000
PROCEDURE VERIFY;                                              <<04670>>16370000
OPTION PRIVILEGED,UNCALLABLE;                                  <<04670>>16372000
                                                               <<04670>>16374000
<<Procedure VERIFY checks if there are any bad sector or     >><<04670>>16376000
<<tracks on media. For private volumes and system volumes it >><<04670>>16378000
<<checks each sector or track from the DTT/DSCT against the  >><<04670>>16380000
<<disc free space bit map and if volume is logicaly mounted   ><<04670>>16382000
<<it will check what files have bad data. All bad sectors or >><<04670>>16384000
<<tracks of serial discs are verified with the Gap Table. If >><<04670>>16386000
<<a sector or track lies entire in a "hole" it will be not   >><<04670>>16388000
<<reported. The VERIFY keyword DTT will indicate that        >><<04670>>16390000
<<existing DTT/DSCT is examined (not applicable for LINUS or >><<04670>>16392000
<<foreign discs). Without the DTT keyword the entire media   >><<04670>>16394000
<<is physically verified. All bad sectors/tracks are entered >><<04670>>16396000
<<into the DTT/DSCT which is later used for checking. For    >><<04670>>16398000
<<private volumes, system volumes, serial discs only valid   >><<04670>>16400000
<<logical data are verified. The scratch volumes and foreign >><<04670>>16402000
<<discs are entire checked and all bad sectors/tracks are    >><<04670>>16404000
<<reported.                                                  >><<04670>>16406000
<<The VERIFY command required the device to be downed except >><<04670>>16408000
<<mounted system volume.                                     >><<04670>>16410000
                                                               <<04670>>16412000
BEGIN                                                          <<04670>>16414000
LOGICAL DTT'FLAG := FALSE;                                     <<04670>>16416000
INTEGER TYPE,SUBTYPE,ERR;                                      <<04670>>16418000
DOUBLE ADDR,SIZE,DISC'SIZE;                                    <<04670>>16420000
                                                               <<04670>>16422000
IF KEYWDSPEC THEN                                              <<04670>>16424000
   IF KEYWORD = "DTT" THEN                                     <<04670>>16426000
      DTT'FLAG := TRUE                                         <<04670>>16428000
   ELSE                                                        <<04670>>16430000
      BEGIN                                                    <<04670>>16432000
      GENMSG (PVMSGSET,VIERR3);                                <<04670>>16434000
      RETURN;                                                  <<04670>>16436000
      END;                                                     <<04670>>16438000
                                                               <<04670>>16440000
LDEV := DEVPARM(1);                                            <<04670>>16442000
                                                               <<04670>>16444000
IF NOT GET'DEV'INFO (LDEV,TYPE,SUBTYPE) THEN                   <<04670>>16446000
   RETURN;                                                     <<04670>>16448000
DOWNDEV := DEVSTATUS(1).DOWNF;                                 <<04670>>16450000
IF NOT DOWNDEV AND (NOT SYS OR NOT VOLUME'MOUNTED(LDEV)) THEN  <<04670>>16452000
   BEGIN                                                       <<04670>>16454000
   GENMSG (PVMSGSET,VIERR5,%10000,LDEV);                       <<04670>>16456000
   END;                                                        <<04670>>16458000
                                                               <<04670>>16460000
IF (SIZE := CALC'DISC'SIZE(LDEV)) = 0D THEN                    <<04670>>16462000
   BEGIN                                                       <<04670>>16464000
   GENMSG (PVMSGSET,VIERR0);                                   <<04670>>16466000
   RETURN;                                                     <<04670>>16468000
   END;                                                        <<04670>>16470000
                                                               <<04670>>16472000
IF LINUS OR FORVOL THEN                                        <<04670>>16474000
   IF DTT'FLAG THEN                                            <<04670>>16476000
      BEGIN                                                    <<04670>>16478000
      GENMSG (PVMSGSET,VIERR3);                                <<04670>>16480000
      RETURN;                                                  <<04670>>16482000
      END                                                      <<04670>>16484000
   ELSE                                                        <<04670>>16486000
      BUILD'DSCT                                               <<04670>>16488000
ELSE                                                           <<04670>>16490000
   BEGIN   <<Read DTT/DSCT>>                                   <<04670>>16492000
   DISCIO (LDEV,R,DTT,1D,DTT'SIZE);                            <<04670>>16494000
   IF <> THEN                                                  <<04670>>16496000
   RETURN;                                                     <<04670>>16498000
   END;                                                        <<04670>>16500000
                                                               <<04670>>16502000
ENABLE'BREAK;                                                  <<04670>>16504000
                                                               <<04670>>16506000
IF NOT DTT'FLAG THEN                                           <<04670>>16508000
   BEGIN                                                       <<04670>>16510000
   IF (PVOL LOR SYS) AND NOT VOLUME'MOUNTED (LDEV) THEN        <<04670>>16512000
      GENMSG (PVMSGSET,VIWARN129,%10000,LDEV);                 <<04670>>16514000
   GENMSG (PVMSGSET,VIWARN88);                                 <<04670>>16516000
   IF NOT VERIFY'MEDIA (LDEV,SIZE) THEN                        <<04670>>16518000
      RETURN;                                                  <<04670>>16520000
   END;                                                        <<04670>>16522000
                                                               <<04670>>16524000
SORT'ENTRIES;   <<SORT DTT/DSCT>>                              <<04670>>16526000
                                                               <<04670>>16528000
DTT'CHANGES := 0;                                              <<04670>>16530000
WHILE GET'ENTRY (ADDR,SIZE) DO                                 <<04670>>16532000
   IF USED'SPACE (LDEV,ADDR,SIZE) THEN                         <<04670>>16534000
      CHECK'SECTOR (LDEV,ADDR,SIZE);                           <<04670>>16536000
                                                               <<04670>>16538000
IF DTT'CHANGES <> 0 AND                                        <<04670>>16540000
   (ERR := CHECK'BAD'FILES (LDEV)) <> 0 THEN                   <<04670>>16542000
      IF ERR = -1 THEN                                         <<04670>>16544000
         GENMSG (PVMSGSET,VIWARN130,%10000,LDEV)               <<04670>>16546000
      ELSE                                                     <<04670>>16548000
         GENMSG (PVMSGSET,ERR);                                <<04670>>16550000
END; <<VERIFY>>                                                <<04670>>16552000
                                                                        16554000
$CONTROL SEGMENT=VINITCI                                       <<RK.09>>16556000
$PAGE "FUNCTION CASE STATEMENT"                                <<00239>>16558000
PROCEDURE FUNCTION;                                                     16560000
OPTION PRIVILEGED,UNCALLABLE;                                           16562000
BEGIN                                                                   16564000
     DEFINE ERR = RETURN#;  <<FUNCTION ERROR>>                          16566000
                                                                        16568000
     GETFUNCTION;                                                       16570000
     FCONTROL(1,14,MORE);                                      <<RK3PV>>16572000
DISABLE'BREAK;                                                 <<04670>>16574000
     CASE * FUNCT OF                                                    16576000
     BEGIN                                                              16578000
          ERR;        << FUNCTION ERROR >>                              16580000
          INIT;                                                         16582000
          FORMAT;     << FORMAT PACK >>                                 16584000
          SCRATCH;                                                      16586000
          COPY;                                                         16588000
          COND;                                                         16590000
          DTRACK;                                                       16592000
          DELVOL;                                                       16594000
          DSTAT;                                                        16596000
          PDEFN;                                                        16598000
          PLABEL;                                                       16600000
          PDTRACK;                                                      16602000
          PFSPACE;                                                      16604000
          SERVOL;                                                       16606000
          EXIT';      << TERMINATE  >>                                  16608000
          DEBUG;      << DEBUG CALL >>                                  16610000
          GENMSG(PVMSGSET,VIHELP);  <<HELP>>                   <<00145>>16612000
          GENMSG(PVMSGSET,VIHELP);  <<XPLAIN>>                 <<00145>>16614000
          GENMSG(PVMSGSET,VIHELP);  <<EXPLAIN>>                <<<<FDF>>16616000
          VERIFY;     << VERIFY SERIAL DISC >>                 <<03638>>16618000
          FORNVOL;                                   << FDF >> <<01115>>16620000
     END <<CASE>>;                                                      16622000
     FCONTROL(1,15,MORE);                                      <<RK3PV>>16624000
END  << FUNCTION >>;                                                    16626000
$PAGE "START UP PROCEDURE"                                     <<01115>>16628000
                                                                        16630000
PROCEDURE SETUPSHOP;                                                    16632000
OPTION PRIVILEGED,UNCALLABLE;                                           16634000
BEGIN                                                                   16636000
     BYTE ARRAY FNAME(0:7);                                             16638000
     DOUBLE ATTRIBUTES;                                        <<RK.08>>16640000
     LOGICAL ATTRIBUTES'0 = ATTRIBUTES;                        <<RK.08>>16642000
                                                                        16644000
     VALIDVSID:=FALSE;                                                  16646000
     MOVE msg:=id;                                             <<03510>>16648000
     MOVE MSG(VUFPOS) := OFFICIAL'VUUFF;                       <<04299>>16650000
     PRINT(MSGW,-43,0);                                        <<03537>>16652000
     WHO(,ATTRIBUTES,,,VGNAME,VANAME);                         <<RK.08>>16654000
     IF (ATTRIBUTES'0 LAND %102000)  = 0 <<SM,OP>> THEN        <<RK.08>>16656000
        BEGIN                                                  <<RK.08>>16658000
        MOVE MSG := "VINIT REQUIRES SM OR OP CAPABILITY";      <<RK.08>>16660000
        PRINT(MSGW,- 34,0);                                    <<RK.08>>16662000
        TERMINATE;                                             <<RK.08>>16664000
        END;                                                   <<RK.08>>16666000
     MOVE FNAME:="VINLIST ";                                            16668000
     OUTF:=FOPEN(FNAME,%414,%1); <<FOPT:CCTL,$STDLIST,ASCII;AOPT:WR>>   16670000
     IF <> THEN                                                         16672000
     BEGIN                                                              16674000
          PRINTFILEINFO(OUTF);                                          16676000
          MOVE MSG:=" ** OUTPUT FILE OPEN ERROR **";                    16678000
          PRINT(MSGW,-29,0);                                   <<RK.08>>16680000
          TERMINATE;                                                    16682000
     END;                                                               16684000
END << SETUPSHOP >>;                                                    16686000
$PAGE "   PROCEDURE TABLESPACE"                                         16688000
$CONTROL SEGMENT=NEWPACK                                                16690000
LOGICAL PROCEDURE tablespace(ldev,dtt,start'adr,nsect);        <<03510>>16692000
   VALUE ldev,start'adr,nsect;                                          16694000
   INTEGER ldev;                                                        16696000
   DOUBLE start'adr,nsect;                                              16698000
   INTEGER ARRAY dtt;                                                   16700000
   OPTION PRIVILEGED,UNCALLABLE;                                        16702000
                                                                        16704000
<<===================================================                   16706000
                                                                        16708000
                                                                        16710000
   Verify that the space is not in the deleted track area               16712000
   Return ccl if space is in the deleted track area                     16714000
   Return ccg if any kind of I/O error                                  16716000
                                                                        16718000
   Parameters:                                                          16720000
        ldev - which logical device                                     16722000
        dtt  - INTEGER array w Defective Tracks Table                   16724000
        start'adr  - DBL wd which contains the sector addr              16726000
        nsect = DBL wd has the number of sectors checking               16728000
                                                                        16730000
   Returns:                                                             16732000
       logical, depends upon CC code                                    16734000
                                                                        16736000
       CCL start'adr is in deleted area                                 16738000
           tablespace = no'error                                        16740000
       CCG I/O error from get'disc'info                                 16742000
           tablespace = error from get'disc'info                        16744000
       CCE start'adr NOT in deleted area                                16746000
           tablespace = no'error                                        16748000
                                                                        16750000
   Assumptions on entry:                                                16752000
        NONE                                                            16754000
                                                                        16756000
   Globals:                                                             16758000
            dtt - dtt'number'of'entries,dtt'track'number,               16760000
                  dtt'track'code,dtt'deleted                            16762000
                                                                        16764000
   Externals:                                                           16766000
        Get'Disc'Info                                                   16768000
                                                                        16770000
   Intrinsics:                                                          16772000
        None.                                                           16774000
                                                                        16776000
   Callers:                                                             16778000
        initdfsm,recover'init                                           16780000
                                                                        16782000
   Fixid:                                                               16784000
        This procedure was added as part of the changes for the         16786000
      new disc free space map.  The fix i.d. on the procedure           16788000
      header applies to the whole procedure.                            16790000
                                                                        16792000
   Changes:                                                             16794000
                                                                        16796000
====================================================>>                  16798000
                                                                        16800000
BEGIN                                                                   16802000
                                                                        16804000
   INTEGER      status=q-1;                                             16806000
   INTEGER      dtt'index                                               16808000
               ,sectors'per'track   << for ldev >>                      16810000
               ,type                                                    16812000
               ;                                                        16814000
   DOUBLE       end'adr    << =start'adr+nsect -1 >>                    16816000
               ,del'start  << deleted trk addr, start >>                16818000
               ,del'end    << deleted trk addr, end >>                  16820000
               ,spare'adr   << addr, in sect, of spare area >>          16822000
               ;                                                        16824000
                                                                        16826000
   LOGICAL      proc'status   << status from called procs >>            16828000
               ;                                                        16830000
                                                                        16832000
   LOGICAL      return'status  =  tablespace;                           16834000
                                                                        16836000
$PAGE                                                                   16838000
                                                                        16840000
   Get'Disc'Info(ldev,,,,type);                                         16842000
                                                                        16844000
   IF type = cs'80'type THEN  << no del trks in a DSCT >>               16846000
      BEGIN                                                             16848000
         condcode:=cce;                                                 16850000
         return'status:=no'error;                                       16852000
         RETURN;                                                        16854000
      END;                                                              16856000
                                                                        16858000
   << any defective tracks in the dtt ? >>                              16860000
   IF dtt(dtt'number'of'entries) = 0 THEN                               16862000
      BEGIN                                                             16864000
         condcode:=cce;                                                 16866000
         return'status:=no'error;                                       16868000
         RETURN;                                                        16870000
      END;                                                              16872000
                                                                        16874000
   return'status:=no'error;   << initialize >>                          16876000
                                                                        16878000
   << get the needed parameters before continuing. Need  >>             16880000
   << logical pack size(in sectors), sectors per track   >>             16882000
   << Call 2 procedures to get them                      >>             16884000
                                                                        16886000
                                                                        16888000
   proc'status:=Get'Disc'Info(ldev,,,,,,spare'adr,,,,,,,,               16890000
                              sectors'per'track);                       16892000
   IF NOT(proc'status) THEN                                             16894000
      BEGIN                                                             16896000
         condcode:=ccg;                                                 16898000
         return'status:=proc'status;                                    16900000
         RETURN;                                                        16902000
      END;                                                              16904000
                                                                        16906000
                                                                        16908000
   dtt'index:=0;                                                        16910000
   end'adr:=start'adr + nsect -1D;  << end of what to check >>          16912000
                                                                        16914000
   << run through the defective tracks table making sure that  >>       16916000
   << none of the space is in any defective track area         >>       16918000
                                                                        16920000
                                                                        16922000
   DO BEGIN                                                             16924000
      dtt'index:=dtt'index+1;   << dtt(0) is # of entries >>            16926000
      IF DBL(dtt(dtt'index).dtt'track'number) *DBL(sectors'per'track)   16928000
         < spare'adr THEN                                               16930000
         BEGIN                                                          16932000
            IF dtt(dtt'index).dtt'track'code = dtt'deleted THEN         16934000
               BEGIN                                                    16936000
                                                                        16938000
                  << calculate sector addr of deleted area >>           16940000
                                                                        16942000
                  del'start:=DBL( dtt(dtt'index).dtt'track'number )     16944000
                             * DBL( sectors'per'track );                16946000
                  del'end:=del'start + DBL( sectors'per'track )         16948000
                           - 1D;                                        16950000
                                                                        16952000
                  IF start'adr >= del'start AND                         16954000
                     end'adr   <= del'end   THEN                        16956000
                     BEGIN                                              16958000
                        condcode:=ccl;                                  16960000
                        RETURN;                                         16962000
                     END;                                               16964000
                  IF del'start >= start'adr AND                         16966000
                     del'end   <= end'adr   THEN                        16968000
                     BEGIN                                              16970000
                        condcode:=ccl;                                  16972000
                        RETURN;                                         16974000
                     END;                                               16976000
                  IF start'adr >= del'start AND                         16978000
                     start'adr <= del'end THEN                          16980000
                     BEGIN                                              16982000
                        condcode:=ccl;                                  16984000
                        RETURN;                                         16986000
                     END;                                               16988000
                  IF end'adr >= del'start AND                           16990000
                     end'adr <= del'start THEN                          16992000
                     BEGIN                                              16994000
                        condcode:=ccl;                                  16996000
                        RETURN;                                         16998000
                     END;                                               17000000
               END;        << deleted track >>                          17002000
            END;           << not in spare area >>                      17004000
                                                                        17006000
         END UNTIL dtt'index = dtt(dtt'number'of'entries);              17008000
                                                                        17010000
      <<  ok, not in deleted area >>                                    17012000
                                                                        17014000
   condcode:=cce;                                                       17016000
   return'status:=no'error;                                             17018000
                                                                        17020000
END;   << tablespace >>                                                 17022000
$PAGE  "PROCEDURE INITDFSM  "                                           17024000
$CONTROL SEGMENT=NEWPACK                                                17026000
LOGICAL PROCEDURE initdfsm(ldev,mv,dirsz,dir'adr,vlab);        <<03510>>17028000
   VALUE ldev,mv,dirsz;                                                 17030000
   LOGICAL mv;                                                          17032000
   INTEGER ldev,dirsz;                                                  17034000
   DOUBLE dir'adr;                                                      17036000
   ARRAY vlab;                                                          17038000
   OPTION PRIVILEGED,UNCALLABLE;                                        17040000
                                                                        17042000
<<===================================================                   17044000
                                                                        17046000
                                                                        17048000
      Procedure to acquire/set-up the bit map and Descriptors           17050000
      on LDEV and to acquire Dirsz number of sectors if this            17052000
      this is the master vol of the volume set(mv=true).                17054000
      Before this procedure is called it is assumed that                17056000
      the defective tracks table(DTT) is set-up                         17058000
      Also that DTT(dtt'logical'pack'size) contains the                 17060000
      logical pack size(in cylinders for MH, in track for FH) of LDEV.  17062000
      Also most of the volume label is filled in.                       17064000
      This procedure will return the diradr. Some of the parameters     17066000
      in the disc label which is returned to the calling                17068000
      procedure will not be up to date, do not depend                   17070000
      on any of them                                                    17072000
      Part of the time this procedure operates in split                 17074000
      stack mode                                                        17076000
      "handle'error" does a "EXIT" - if calling procedure               17078000
       changes, then this must be changed                               17080000
                                                                        17082000
                                                                        17084000
   Parameters:                                                          17086000
        ldev   - logical device number                                  17088000
        mv     - LOGICAL, if true then master vol of                    17090000
                 vol set                                                17092000
        dirsz  - INTEGER, size of Directory                             17094000
        diradr - returned to caller(to set up Directory)                17096000
                 DBL wd contains the address of Dirc                    17098000
        vlab   - LOGICAL array, contains the volume                     17100000
                 label partially filled in by caller.                   17102000
                 NOTE: this procedure will modify this                  17104000
                       array. This procedure will put in                17106000
                       the DFSM variables + Dirc addr and               17108000
                       write out to disc. Caller should                 17110000
                       not depend on its contents                       17112000
                                                                        17114000
   Returns:                                                             17116000
        status word in "DFSM" format                                    17118000
                                                                        17120000
   Assumptions:                                                         17122000
        If any error handle'error is called. It exits                   17124000
        exits and cuts back the stack. IF                               17126000
        calling sequence is changed, MUST change this                   17128000
                                                                        17130000
   Globals:                                                             17132000
        DFSM DST-largest'space,starting'space,ending'space,             17134000
                 dt'entry'size,ds'disc'address,                         17136000
                 ds'number'of'sectors,ds'error'status                   17138000
                 empty'buffer                                           17140000
        disc'label-disc'lab'dirty'dt'flag,                              17142000
                   disc'lab'dt'checksum,disc'lab'dfs'map'ok,            17144000
                   disc'lab'dt'low,disc'lab'dt'high,                    17146000
                   disc'lab'map'low,disc'lab'map'high,                  17148000
                   disc'lab'dirbase,disc'lab'dirsize                    17150000
        dtt-dtt'number'of'entries,dtt'track'code,                       17152000
            dtt'deleted,dtt'track'number                                17154000
                                                                        17156000
   Externals:                                                           17158000
       Get'Disc'Info,tablespace,Read'Disc,Write'Disc,                   17160000
       Create'Dfs'Data'Seg,Lock'Dfs'Data'Seg,Set'Reset'Bit'Map,         17162000
       Unlock'Dfs'Data'Seg,Deallocate'Dfs'Data'Seg                      17164000
                                                                        17166000
   Intrinsics:                                                          17168000
       quit(for debug purposes),debug                                   17170000
                                                                        17172000
   Resources:                                                           17174000
        gets a DFSM DST for work area                                   17176000
                                                                        17178000
   Callers:                                                             17180000
        init                                                            17182000
                                                                        17184000
   Fixid:                                                               17186000
      This procedure was added as part of the disc free space map       17188000
      changes, the fixid aon the procedure header applies to the        17190000
      procedure.                                                        17192000
                                                                        17194000
   Changes:                                                             17196000
                                                                        17198000
====================================================>>                  17200000
                                                                        17202000
BEGIN                                                                   17204000
                                                                        17206000
   LOGICAL  return'status  = initdfsm;                                  17208000
                                                                        17210000
   INTEGER     bit'map'sz      << in sectors >>                         17212000
              ,descr'sz        << sectors    >>                         17214000
              ,num'descr'ent   << # entries in Descr table  >>          17216000
              ,page            << used to calc the #sectors >>          17218000
              ,word            << in the last               >>          17220000
              ,bit             << page                      >>          17222000
              ,temp            << temporary varible         >>          17224000
              ,ldttlps         << log pack sz in TRACKs     >>          17226000
              ,descr'sz'wds    << #wds in descr table >>                17228000
              ,sectors'per'track                                        17230000
              ,type                                                     17232000
              ,subtype                                                  17234000
              ;                                                         17236000
                                                                        17238000
   LOGICAL     rwstat          << status ret from R/W disc  >>          17240000
              ,dfs'status      << status ret from DFS routines >>       17242000
              ,ldfs'locked     << in split stack mode          >>       17244000
              ,lcrit           << returned from setcritical >>          17246000
              ,lcrit'set       << in critical mode             >>       17248000
              ,search          << keep calling tablespace      >>       17250000
              ,proc'status     << status from called procedures >>      17252000
              ;                                                         17254000
                                                                        17256000
   DOUBLE      disc'sz         << in sectors >>                         17258000
              ,wr'adr          << used to r/w the disc      >>          17260000
              ,bit'map'adr     << address of Bit Map        >>          17262000
              ,descr'adr       << address of Descr Table    >>          17264000
              ,good'adr                                                 17266000
              ,ldiradd          << localcopy of Dirc addr  >>           17268000
                                << use in split stack mode >>           17270000
              ;                                                         17272000
                                                                        17274000
   POINTER     descr'table     << Descr table in stack      >>          17276000
              ;                                                         17278000
                                                                        17280000
$IF X3=ON                                                               17282000
   EQUATE mess'len=72;                                                  17284000
   LOGICAL ARRAY mess(0:mess'len/2-1);                                  17286000
   BYTE ARRAY bmess(*)=mess;                                            17288000
   DEFINE blank'mess= mess:="  ";                                       17290000
                      MOVE mess(1):=mess,(mess'len/2-1)#;               17292000
$IF                                                                     17294000
         << a page of bit map >>                                        17296000
   LOGICAL ARRAY      buffer(0:actual'words'per'page-1);                17298000
                                                                        17300000
   INTEGER ARRAY dtt(0:dtt'size-1)=Q;  << used in split stack >>        17302000
                                                                        17304000
   EQUATE nospace =%276; << couldn't find sp for    >>                  17306000
                         << Dir,Bit Map,Descr       >>                  17308000
                                                                        17310000
   << use this to exit from a subroutine >>                             17312000
                                                                        17314000
   DEFINE exit'procedure = ASSEMBLE(exit 5)#;                           17316000
$PAGE "   SUBROUTINE HANDLE'ERROR"                                      17318000
SUBROUTINE handle'error(err);                                  <<03510>>17320000
   VALUE err;                                                           17322000
   LOGICAL err;                                                         17324000
                                                                        17326000
<<===================================================                   17328000
                                                                        17330000
                                                                        17332000
      Any errors in initdfsm, this subroutine is called                 17334000
      It puts the passed error into the return status                   17336000
      word and EXITS by deleting the parameters off the                 17338000
      stack                                                             17340000
      NOTE: if calling sequence changes, this must change               17342000
                                                                        17344000
   Parameters:                                                          17346000
       err - error status in "DFSM" format                              17348000
                                                                        17350000
   Returns:                                                             17352000
       error status to calling procedure to let it                      17354000
       take care of error                                               17356000
                                                                        17358000
   Assumptions on entry:                                                17360000
                                                                        17362000
   Globals:                                                             17364000
      return'status(initdfsm)                                           17366000
                                                                        17368000
   Externals:                                                           17370000
           Unlock'Dfs'Data'Seg,Delete'Dfs'Data'Seg,                     17372000
           resetcritical                                                17374000
                                                                        17376000
   Intrinsics:                                                          17378000
            debug(for debug purposes)                                   17380000
                                                                        17382000
   Fixid:                                                               17384000
      This subroutine header was added as part of the disc free         17386000
      space map chenges.  The fixid on the subroutine header            17388000
      applies to the whole procedure.                                   17390000
                                                                        17392000
   Changes:                                                             17394000
                                                                        17396000
====================================================>>                  17398000
   BEGIN                                                                17400000
                                                                        17402000
$IF X3=ON                                                               17404000
            debug;                                                      17406000
$IF                                                                     17408000
                                                                        17410000
   IF ldfs'locked THEN                                                  17412000
      BEGIN                                                             17414000
         Unlock'Dfs'Data'Seg;                                           17416000
         ldfs'locked:=false;                                            17418000
         <<   don't write out, had some kind of bad r/w status >>       17420000
         Delete'Dfs'Data'Seg(ldev);                                     17422000
      END;                                                              17424000
   IF lcrit'set THEN                                                    17426000
      BEGIN                                                             17428000
         resetcritical(lcrit);                                          17430000
         lcrit'set:=false;                                              17432000
      END;                                                              17434000
                                                                        17436000
   << return status word to calling procedure >>                        17438000
   return'status:=err;                                                  17440000
   exit'procedure;                                                      17442000
END;        << handle'error >>                                          17444000
$PAGE  "    PROCEDURE INITDFSM"                                         17446000
   return'status:=0;       << initialize >>                             17448000
   ldfs'locked:=false;     << initialize >>                             17450000
   lcrit'set:=false;                                                    17452000
$IF X3=ON                                                               17454000
         PUSH(status);                                                  17456000
         TOS.(2:1):=1; << on traps - later turn off traps >>            17458000
         SET(status);                                                   17460000
$IF                                                                     17462000
                                                                        17464000
   << call procedures to get information about the disc       >>        17466000
   << Need dtt, disc size(in sectors),number of descriptor    >>        17468000
   << entries, sectors per track                              >>        17470000
   << (disc'sz-1 is the last good disc address)               >>        17472000
                                                                        17474000
                                                                        17476000
   proc'status:=Get'Disc'Info(ldev,,,,type,subtype);                    17478000
   IF NOT(proc'status) THEN handle'error(proc'status);                  17480000
   << note: sectors per track doesnt mean anything >>                   17482000
   <<       for a BFD                              >>                   17484000
   proc'status:=Get'Disc'Info(ldev,,,dtt,,,disc'sz,,                    17486000
                              num'descr'ent,,descr'sz'wds               17488000
                             ,,,,sectors'per'track);                    17490000
   IF NOT(proc'status) THEN handle'error(proc'status);                  17492000
                                                                        17494000
   <<  number of sectors in the bit map>>                               17496000
   bit'map'sz:=num'descr'ent * page'size;                               17498000
                                                                        17500000
   << number of sectors in the descriptor table >>                      17502000
   descr'sz:=descr'sz'wds/sector'size;                                  17504000
   IF (descr'sz'wds MOD sector'size) <> 0 THEN                          17506000
      descr'sz:=descr'sz +1;                                            17508000
                                                                        17510000
   << find the space for the Bit Map and Descriptors   >>               17512000
   << make sure that the space is not deleted -        >>               17514000
   << it may be reassigned(but prob of it very low)    >>               17516000
                                                                        17518000
                                                                        17520000
   << initialize the addresses >>                                       17522000
   dir'adr:=0D;                                                         17524000
   bit'map'adr:=0D;                                                     17526000
   descr'adr:=0D;                                                       17528000
                                                                        17530000
   good'adr:=beg'good'adr;                                              17532000
   search:=true;                                                        17534000
                                                                        17536000
   << try to find the descriptor+bit map in one hunk,  >>               17538000
   << if can't then try to find separately             >>               17540000
                                                                        17542000
   DO BEGIN                                                             17544000
      proc'status:=tablespace(ldev,dtt,good'adr,                        17546000
                              DBL(bit'map'sz+descr'sz) );               17548000
      IF < THEN good'adr:=good'adr+ DBL(bit'map'sz +descr'sz)           17550000
         ELSE                                                           17552000
            BEGIN                                                       17554000
               IF > THEN handle'error(proc'status)                      17556000
                  ELSE                                                  17558000
                     BEGIN                                              17560000
                        bit'map'adr:=good'adr;                          17562000
                        search:=false;                                  17564000
                     END;                                               17566000
            END;                                                        17568000
   END UNTIL NOT(search) OR (good'adr + DBL(bit'map'sz+descr'sz))       17570000
                            >= disc'sz;                                 17572000
                                                                        17574000
   IF bit'map'adr = 0D THEN   << find separately >>                     17576000
      BEGIN                                                             17578000
         search:=true;                                                  17580000
         good'adr:=beg'good'adr;                                        17582000
         DO BEGIN                                                       17584000
            proc'status:=tablespace(ldev,dtt,good'adr,                  17586000
                                    DBL(bit'map'sz) );                  17588000
            IF < THEN good'adr:=good'adr+ DBL(bit'map'sz)               17590000
               ELSE                                                     17592000
                  BEGIN                                                 17594000
                     IF > THEN handle'error(proc'status)                17596000
                        ELSE                                            17598000
                           BEGIN                                        17600000
                              bit'map'adr:=good'adr;                    17602000
                              search:=false;                            17604000
                           END;                                         17606000
                  END;                                                  17608000
         END UNTIL NOT(search) OR (good'adr + DBL(bit'map'sz))          17610000
                                  >= disc'sz;                           17612000
         IF bit'map'adr = 0D THEN handle'error(nospace);                17614000
                                                                        17616000
         search:=true;                                                  17618000
         good'adr:=bit'map'adr + DBL(bit'map'sz);                       17620000
         DO BEGIN                                                       17622000
            proc'status:=tablespace(ldev,dtt,good'adr,                  17624000
                                    DBL(descr'sz) );                    17626000
            IF < THEN good'adr:=good'adr+ DBL(descr'sz)                 17628000
               ELSE                                                     17630000
                  BEGIN                                                 17632000
                     IF > THEN handle'error(proc'status)                17634000
                        ELSE                                            17636000
                           BEGIN                                        17638000
                              descr'adr:=good'adr;                      17640000
                              search:=false;                            17642000
                           END;                                         17644000
                  END;                                                  17646000
         END UNTIL NOT(search) OR (good'adr + DBL(descr'sz) )           17648000
                                  >= disc'sz;                           17650000
                                                                        17652000
         IF descr'adr = 0D THEN handle'error(nospace);                  17654000
      END                                                               17656000
   ELSE    descr'adr:=bit'map'adr + DBL(bit'map'sz); <<found both tog >>17658000
                                                                        17660000
   IF mv THEN                                                           17662000
      BEGIN                                                             17664000
         good'adr:=descr'adr + DBL(descr'sz);                           17666000
         search:=true;                                                  17668000
         DO BEGIN                                                       17670000
            proc'status:=tablespace(ldev,dtt,good'adr,                  17672000
                          DBL(dirsz) );                                 17674000
            IF < THEN good'adr:=good'adr+ DBL(dirsz)                    17676000
               ELSE                                                     17678000
                  BEGIN                                                 17680000
                     IF > THEN handle'error(proc'status)                17682000
                        ELSE                                            17684000
                           BEGIN                                        17686000
                              dir'adr:=good'adr;                        17688000
                              ldiradd:=good'adr;<< use in split stack >>17690000
                              search:=false;                            17692000
                           END;                                         17694000
                  END;                                                  17696000
         END UNTIL NOT(search) OR (good'adr + DBL(dirsz) )              17698000
                                  >= disc'sz;                           17700000
         IF dir'adr = 0D THEN handle'error(nospace);                    17702000
$IF X3=ON                                                               17704000
         << right now there is a restriction on addr of   >>            17706000
         << Directory - file label only allows 1 wd       >>            17708000
                                                                        17710000
         IF DBL(INT(dir'adr)) <> dir'adr THEN                           17712000
            quit(999);                                                  17714000
$IF                                                                     17716000
      END;    << mv = true >>                                           17718000
                                                                        17720000
   << now allocate space for the Descr table in the stack  >>           17722000
   << allocate #entries * entrysize (in words)             >>           17724000
                                                                        17726000
                                                                        17728000
   PUSH(s);                                                             17730000
   TOS:=TOS+1;                                                          17732000
   @descr'table:=TOS;                                                   17734000
   TOS:=descr'sz'wds;   << #wds needed    >>                            17736000
   ASSEMBLE(adds 0);                                                    17738000
                                                                        17740000
   <<   initialize  >>                                                  17742000
                                                                        17744000
   descr'table:=0;                                                      17746000
   MOVE descr'table(1):=descr'table,(descr'sz'wds-1);                   17748000
                                                                        17750000
   << now create the Descr table for the disc, initialize  >>           17752000
   << the Descr table to all free                          >>           17754000
                                                                        17756000
                                                                        17758000
   descr'table   (largest'space):=0;                                    17760000
   descr'table   (starting'space):=bits'per'page;                       17762000
   descr'table   (ending'space  ):=bits'per'page;                       17764000
                                   << dont do last entry >>             17766000
   MOVE descr'table(dt'entry'size):=descr'table,(num'descr'ent *        17768000
                                     dt'entry'size - dt'entry'size*2);  17770000
                                                                        17772000
   << now figure out the last page size so can fill in the  >>          17774000
   << last Descr entry by calculating page,word,bit        >>           17776000
                                                                        17778000
                                                                        17780000
   TOS:=disc'sz-1D;    << last valid addr for disc           >>         17782000
   TOS:=DBL(bits'per'page);                                             17784000
   ASSEMBLE(ddiv;     << leaves DBL(pg#),DBL(rem)           >>          17786000
            dxch;     <<        DBL(rem),DBL(pg#)           >>          17788000
            delb);    <<        DBL(rem),INT(pg#)           >>          17790000
   page:=TOS;                                                           17792000
                                                                        17794000
   << now word and bit number                               >>          17796000
                                                                        17798000
   ASSEMBLE(delb);    << convert rem to INT                 >>          17800000
   TOS:=bits'per'word;                                                  17802000
   ASSEMBLE(div);     << leaves INT(word#),INT(bit#)        >>          17804000
   bit:=TOS;                                                            17806000
   word:=TOS;                                                           17808000
                                                                        17810000
   << now that have page,word and bit, calculate how many  >>           17812000
   << sectors are actually in the last page of bit map     >>           17814000
                                                                        17816000
                                                                        17818000
   descr'table(page*dt'entry'size + largest'space):=0;                  17820000
   descr'table(page*dt'entry'size + starting'space):=                   17822000
                 word*bits'per'word + bit + 1; << #sect,not adr >>      17824000
                                                                        17826000
   << if the last page of the bit map is a full page, then  >>          17828000
   << ending'space=starting'space. Otherwise if the last    >>          17830000
   << page is a partial page, then ending'space=0           >>          17832000
                                                                        17834000
                                                                        17836000
   IF descr'table(page*dt'entry'size + starting'space) =                17838000
      bits'per'page THEN                                                17840000
      descr'table(page*dt'entry'size + ending'space):=                  17842000
                                              bits'per'page             17844000
   ELSE                                                                 17846000
      descr'table(page*dt'entry'size +ending'space):=0;                 17848000
                                                                        17850000
                                                                        17852000
   rwstat:=Write'Disc(ldev,descr'adr,0<<stack>>,descr'table,            17854000
                      descr'sz'wds);                                    17856000
   IF NOT(rwstat) THEN handle'error(rwstat);                            17858000
                                                                        17860000
   << create and write out the bit map - page by page >>                17862000
                                                                        17864000
   buffer:=empty'buffer;                                                17866000
   MOVE buffer(1):=buffer,(words'per'page-1);                           17868000
   buffer(check'sum'word):=0;  << initialize >>                         17870000
   buffer(check'sum'word):=Make'Check'Sum(buffer,                       17872000
                                          actual'words'per'page);       17874000
                                                                        17876000
   << buffer is now set-up for all the pages except for the   >>        17878000
   << last page, write out all the bit map except for the    >>         17880000
   << last one(last one may be a partial page)                >>        17882000
                                                                        17884000
   wr'adr:=bit'map'adr;                                                 17886000
   temp<<descr'entcntr>>:=1;                                            17888000
   DO BEGIN                                                             17890000
      rwstat:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,                 17892000
                         actual'words'per'page);                        17894000
      IF NOT(rwstat) THEN handle'error(rwstat);                         17896000
      wr'adr:=wr'adr + DBL(page'size);                                  17898000
   END UNTIL (temp<<descr'entcntr>>:=temp +1) >=                        17900000
                             num'descr'ent;                             17902000
                                                                        17904000
   << now use word and bit to figure out how much of the last >>        17906000
   << page is actually part of the bit map page. The rest of  >>        17908000
   << the bit map page is filled with zeroes                  >>        17910000
                                                                        17912000
                                                                        17914000
   IF descr'table(page*dt'entry'size + starting'space) =                17916000
      bits'per'page THEN                                                17918000
      BEGIN                                                             17920000
         rwstat:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,              17922000
                            actual'words'per'page);                     17924000
         IF NOT(rwstat) THEN handle'error(rwstat);                      17926000
      END                                                               17928000
   ELSE                                                                 17930000
      BEGIN                                                             17932000
         buffer:=0;                                                     17934000
         MOVE buffer(1):=buffer,(words'per'page-1);                     17936000
         IF word > 0 THEN                 << mark full wds >>           17938000
            BEGIN                                                       17940000
               buffer:=empty'buffer;                                    17942000
               MOVE buffer(1):=buffer,(word-1); <<wont do if cnt=0 >>   17944000
            END;                                                        17946000
         temp<<bitcnt>>:=0;                                             17948000
         buffer(word).(0:1):=1;                                         17950000
         WHILE (temp<<bitcnt>>:=temp + 1) <= bit DO                     17952000
               buffer(word):=buffer(word) &ASR(1);                      17954000
         buffer(check'sum'word):=0;  << initialize >>                   17956000
         buffer(check'sum'word):=Make'Check'Sum(buffer,                 17958000
                                 actual'words'per'page);                17960000
         rwstat:=Write'disc(ldev,wr'adr,0<<stack>>,buffer,              17962000
                            actual'words'per'page);                     17964000
         IF NOT(rwstat) THEN handle'error(rwstat);                      17966000
      END;          << last page full/not full >>                       17968000
                                                                        17970000
   << everything is in the initial state. Put the address of  >>        17972000
   << the Descr table and bit map in the file label, use      >>        17974000
   << passed array "vlab", this has been partially filled     >>        17976000
   << in by the calling procedure                              >>       17978000
                                                                        17980000
                                                                        17982000
   vlab(disc'lab'dirty'dt'flag):=false;                                 17984000
   vlab(disc'lab'dt'check'sum):=0;  << initialize >>                    17986000
   vlab(disc'lab'dt'check'sum):=                                        17988000
                          Make'Check'Sum(descr'table,                   17990000
                                   descr'sz'wds);                       17992000
   vlab(disc'lab'dfs'map'ok):=true;                                     17994000
   TOS:=descr'adr;                                                      17996000
   vlab(disc'lab'dt'low):=TOS;                                          17998000
   vlab(disc'lab'dt'high):=TOS;                                         18000000
   TOS:=bit'map'adr;                                                    18002000
   vlab(disc'lab'map'low):=TOS;                                         18004000
   vlab(disc'lab'map'high):=TOS;                                        18006000
   IF mv THEN                                                           18008000
      BEGIN                                                             18010000
      << put in Dirc addr(from tablespace) and dirsize(passed) >>       18012000
      vlab(disc'lab'dirbase):=LOG(dir'adr);                             18014000
      vlab(disc'lab'dirsize):=dirsz;                                    18016000
   END;                                                                 18018000
   <<   write out the disc label Create'Dfs'Data'Seg   >>               18020000
   <<   expects the bit map and descr addr to be in disc label  >>      18022000
                                                                        18024000
                                                                        18026000
   rwstat:=Write'Disc'Label(ldev,0<<stack>>,vlab);                      18028000
   IF NOT(rwstat) THEN handle'error(rwstat);                            18030000
                                                                        18032000
   <<  There is now enough information in the Descr and      >>         18034000
   <<  and Bit map to use the globally defined DFSM          >>         18036000
   <<  routines. Use these routines to allocate space        >>         18038000
                                                                        18040000
   << initialize and get the DST for the DFSM                >>         18042000
   << use the DFSM routines to mark the areas for:           >>         18044000
   <<       1. 0 - 9 reserved                                >><<03527>>18046000
   <<       2. Bit Map                                       >>         18048000
   <<       3. Descriptor table                              >>         18050000
   <<       4. Directory                                     >>         18052000
   <<       5. Deleted tracks                                >>         18054000
                                                                        18056000
                                                                        18058000
   <<  initialize and get the DFSM                         >>           18060000
   <<  it also puts the DST # in the LDT                   >>           18062000
                                                                        18064000
                                                                        18066000
   << setcritical so no interrupts honored while accessing  >>          18068000
   << the DFSM                                              >>          18070000
                                                                        18072000
                                                                        18074000
   lcrit:=setcritical;                                                  18076000
   lcrit'set:=true;                                                     18078000
                                                                        18080000
   dfs'status:=Create'Dfs'Data'Seg(ldev,,                               18082000
                     false<<assume'dt'clean>>,                          18084000
                     true<<flag'dt'as'dirty>> );                        18086000
   IF NOT(dfs'status) THEN handle'error(dfs'status);                    18088000
                                                                        18090000
   <<   not really locking the DST, only really doing the  >>           18092000
   << the EXCHANGEDB to get at the DFSM DST- no one else knows >>       18094000
   << that this pv exists because the VOL Table entry hasn't   >>       18096000
   << been changed yet. This way only one routine has to be    >>       18098000
   << changed if place in LDT where DST# is changed            >>       18100000
                                                                        18102000
   dfs'status:=Lock'Dfs'Data'seg(ldev);                                 18104000
   IF NOT(dfs'status) THEN                                              18106000
      BEGIN                                                             18108000
         Delete'Dfs'Data'Seg(ldev); << get rid of DST >>                18110000
         handle'error(dfs'status);                                      18112000
      END;                                                              18114000
   ldfs'locked:=true;                                                   18116000
                                                                        18118000
   <<======= IN SPLIT STACK MODE ======= >>                             18120000
   <<= DO NOT USE ANY DB REL VARIABLES  =>>                             18122000
                                                                        18124000
   << mark reserved area as allocated >>                                18126000
   ds'disc'address:=start'resv'area;                                    18128000
   Convert'Address'To'Map;                                              18130000
   ds'number'of'sectors:=DBL(resv'area'sz);                             18132000
   Set'Reset'Bit'Map(false);                                            18134000
   IF NOT(ds'error'status)                                              18136000
      THEN handle'error(ds'error'status);                               18138000
                                                                        18140000
   <<         Bit Map                >>                                 18142000
   ds'disc'address:=bit'map'adr;                                        18144000
   Convert'Address'To'Map;                                              18146000
   ds'number'of'sectors:=DBl(bit'map'sz);                               18148000
   Set'Reset'Bit'Map(false);                                            18150000
   IF NOT(ds'error'status)                                              18152000
      THEN handle'error(ds'error'status);                               18154000
                                                                        18156000
   <<    Descriptor table            >>                                 18158000
   ds'disc'address:=descr'adr;                                          18160000
   Convert'Address'To'Map;                                              18162000
   ds'number'of'sectors:=DBL(descr'sz);                                 18164000
   Set'Reset'Bit'Map(false);                                            18166000
   IF NOT(ds'error'status)                                              18168000
      THEN handle'error(ds'error'status);                               18170000
                                                                        18172000
   <<     Directory      >>                                             18174000
   IF mv THEN                                                           18176000
      BEGIN                                                             18178000
         ds'disc'address:=ldiradd;                                      18180000
         Convert'Address'To'Map;                                        18182000
         ds'number'of'sectors:=DBL(dirsz);                              18184000
         Set'Reset'Bit'Map(false);                                      18186000
         If NOT(ds'error'status) THEN                                   18188000
            handle'error(ds'error'status);                              18190000
      END;                  << master volume >>                         18192000
                                                                        18194000
                                                                        18196000
   << run through the Defective Tracks Table looking  >>                18198000
   << for track which are deleted and are within      >>                18200000
   << the logical pack size                           >>                18202000
   << Take these entries out of the DFSM              >>                18204000
                                                                        18206000
                                                                        18208000
   IF type <> cs'80'type THEN << ok dtt may have del trks >>            18210000
   BEGIN                                                                18212000
   temp << dtt'entcntr >> :=1;                                          18214000
                                                                        18216000
   WHILE temp << dtt'entcntr >> <= dtt(dtt'number'of'entries)           18218000
   DO BEGIN                                                             18220000
      IF dtt(temp).dtt'track'code = dtt'deleted AND                     18222000
         DBL( dtt(temp).dtt'track'number ) * DBL(sectors'per'track)     18224000
         < disc'sz THEN                                                 18226000
         BEGIN                                                          18228000
            ds'disc'address:=DBL( dtt(temp).dtt'track'number )          18230000
                             * DBL( sectors'per'track );                18232000
            Convert'Address'To'Map;                                     18234000
            ds'number'of'sectors:=DBL( sectors'per'track );             18236000
            Set'Reset'Bit'Map(false);                                   18238000
            IF NOT(ds'error'status)                                     18240000
               THEN handle'error(ds'error'status);                      18242000
         END;      << deleted out of DFSM >>                            18244000
                                                                        18246000
      temp<<dtt'entcntr>> :=temp +1;                                    18248000
      END; << defective track entries >>                                18250000
                                                                        18252000
   END;   << not a cs'80 disc >>                                        18254000
                                                                        18256000
                                                                        18258000
   <<    release the DFSM Dst     >>                                    18260000
   Unlock'Dfs'Data'Seg;                                                 18262000
   ldfs'locked:=false;                                                  18264000
                                                                        18266000
   <<==== NOT IN SPLIT STACK ======>>                                   18268000
                                                                        18270000
   << all the reserved, bit map and Descriptor table space  >>          18272000
   << (and maybe                                            >>          18274000
   << Directory(if master vol) is marked                          >>    18276000
   << as allocated. THe device LDEV is still "downed". Get rid of >>    18278000
   << the DST so that when user does "up" the DST will be         >>    18280000
   << allocated and initialized. This is to keep the INIT oper-   >>    18282000
   << ation separate from a user access to the LDEV.              >>    18284000
                                                                        18286000
   <<  write out all the buffers in the DFSM DST that   >>              18288000
   <<  are marked as dirty                              >>              18290000
                                                                        18292000
                                                                        18294000
   dfs'status:=Deallocate'Dfs'Data'Seg(ldev);                           18296000
   IF NOT(dfs'status) THEN handle'error(dfs'status);                    18298000
                                                                        18300000
   << get rid of data seg and clear out DST# in LDT        >>           18302000
                                                                        18304000
   Delete'Dfs'Data'Seg(ldev);                                           18306000
                                                                        18308000
   resetcritical(lcrit);                                                18310000
   lcrit'set:=false;                                                    18312000
                                                                        18314000
$IF X3=ON                                                               18316000
   << for debug purposes print out the addresses >>                     18318000
   blank'mess;                                                          18320000
   MOVE bmess:="bit map adr=";                                          18322000
   temp:=dascii(bit'map'adr,8,bmess(12));                               18324000
   MOVE bmess(11+11+5):="size=";                                        18326000
   temp:=11+11+5+6;                                                     18328000
   temp:=ascii(bit'map'sz,8,bmess(temp));                               18330000
   print(mess,-mess'len,%40);                                           18332000
                                                                        18334000
   blank'mess;                                                          18336000
   MOVE bmess:="descr adr=";                                            18338000
   temp:=dascii(descr'adr,8,bmess(10));                                 18340000
   MOVE bmess(9+11+5):="size=";                                         18342000
   temp:=9+11+5+6;                                                      18344000
   temp:=ascii(descr'sz,8,bmess(temp));                                 18346000
   print(mess,-mess'len,%40);                                           18348000
                                                                        18350000
   IF mv THEN                                                           18352000
      BEGIN                                                             18354000
         blank'mess;                                                    18356000
         MOVE bmess:="directory adr=";                                  18358000
         temp:=dascii(dir'adr,8,bmess(14));                             18360000
         MOVE bmess(13+11+5):="size=";                                  18362000
         temp:=13+11+5+6;                                               18364000
         temp:=ascii(dirsz,8,bmess(temp));                              18366000
         print(mess,-mess'len,%40);                                     18368000
      END;                                                              18370000
$IF                                                                     18372000
                                                                        18374000
   return'status:=no'error;                                             18376000
                                                                        18378000
   END;   << initdfsm >>                                                18380000
$PAGE "   PROCEDURE PFENTRIES"                                          18382000
$CONTROL SEGMENT=PVSTATUS                                               18384000
PROCEDURE pfentries(listfn,ldev);                              <<03510>>18386000
   VALUE listfn,ldev;                                                   18388000
   INTEGER listfn,ldev;                                                 18390000
   OPTION PRIVILEGED,UNCALLABLE;                                        18392000
                                                                        18394000
BEGIN                                                                   18396000
                                                                        18398000
<<===================================================                   18400000
                                                                        18402000
   print out a listing of free space entries                            18404000
   This procedure operates part of the time                             18406000
   in split stack mode. Can control-y to                                18408000
   interrupt the printing of entries, but                               18410000
   will continue to process the DFSM so that                            18412000
   can printout the totals at the end.                                  18414000
   Will lock the DFSM DST, collect 15 entries,                          18416000
   (1/4 of a page), save the page,word,bit                              18418000
   number, then print out the entries.                                  18420000
   Note there may be a loss of entries, since                           18422000
   the DFSM DST is locked, unlocked, printed,                           18424000
   then the whole cycle starts over again                               18426000
   NOTE: err'pfentries and relock does an EXIT(2)                       18428000
         IF calling sequence changes then must                          18430000
         change this                                                    18432000
         Also if hit control-y this will do an EXIT(2)                  18434000
                                                                        18436000
   Parameters:                                                          18438000
       listfn - filenumber of the list device                           18440000
       ldev   - logical device # of the device that                     18442000
                is being printed                                        18444000
                                                                        18446000
   Returns:                                                             18448000
       nothing, handles all errors here                                 18450000
                                                                        18452000
   Assumptions:                                                         18454000
          Will honor control-y, but will only quit                      18456000
          printout in 2 subroutines and at the end                      18458000
          of pfentries when printing out totals -                       18460000
          header & print'buffer. ALL 3 places are                       18462000
          not in split stack mode and DFSM DST is                       18464000
          NOT locked. All 3 places will do an EXIT(2)                   18466000
          IF you add any fwrites then must check after                  18468000
          fwrite to see if control-y set. This is so                    18470000
          that printout wont be mangled - there is                      18472000
          an SR on the previous pfspace on mangled                      18474000
          output.                                                       18476000
                                                                        18478000
   Globals:                                                             18480000
       DFSM Dst-ds'page'ptr,ds'error'status,ds'page'number,             18482000
                ds'word'number,ds'bit'number,                           18484000
                ds'last'page'of'map,ds'starting'word'number,            18486000
                ds'starting'bit'number                                  18488000
       ldt-ldt2,ldt'vol'index                                           18490000
       vol'table-vol'ent'size,vol'ldev,scratch,unformatted              18492000
       lpdt-lpdt'entry'size,nsdf,ser'forn                               18494000
       lentry/lentrysize( Q rel) array which contains                   18496000
       15 entries- addr/size which is printed when filled               18498000
       calls procedure controly when someone hits it                    18500000
       DB rel variable req'brk - set to false when                      18502000
       enter                                                            18504000
       bad'page(flagged'bad)                                            18506000
                                                                        18508000
                                                                        18510000
   Externals:                                                           18512000
       Unlock'Dfs'Data'Seg,setcritical,resetcritical,                   18514000
       Lock'Dfs'Data'Seg,Get'Page,Scan'Page                             18516000
                                                                        18518000
   Intrinsics:                                                          18520000
        print'file'info,fwrite,debug,dascii                             18522000
        xcontrap                                                        18524000
                                                                        18526000
   Resources:                                                           18528000
        uses sys global ptr to lpdt                                     18530000
      MVTAB sir (table not actually accessed)                  ((DSF02))18532000
                                                                        18534000
   Callers:                                                             18536000
      pfspace                                                           18538000
                                                                        18540000
   Fixid:                                                               18542000
      This procedure was added as part of the new disc free space       18544000
      map.  The fixid on the procedure header applies to the whole      18546000
      procedure.                                                        18548000
                                                                        18550000
   Changes:                                                             18552000
                                                               ((DSF02))18554000
      Fix to only print free space for private volumes that    ((DSF02))18556000
      are logically mounted.  This is to keep a physical       ((DSF02))18558000
      dismount from happening while free space is being        ((DSF02))18560000
      listed.                                                  ((DSF02))18562000
                                                               ((DSF02))18564000
                                                                        18566000
      Changes to print out the number of DFSM pages on a       ((DFS01))18568000
      volume.                                                  ((DFS01  18570000
                                                               ((DFS01  18572000
====================================================>>                  18574000
                                                                        18576000
$PAGE                                                                   18578000
   INTEGER        lpage         << page # in bit map >>                 18580000
                 ,lword                                                 18582000
                 ,lbit                                                  18584000
                 ,buffcnt       << how many buffers in pg >>            18586000
                 ,charptr                                               18588000
                 ,lentryptr      << index into lentry >>                18590000
                 ,index          << dummy parm        >>                18592000
                 ,dummy                                                 18594000
                 ,sectrk       << sectors per track >>                  18596000
                 ,trkcyl       << tracks per cylinder >>                18598000
                 ,controly'dummy  << for xcontrap >>                    18600000
                 ;                                                      18602000
                                                                        18604000
   LOGICAL        proc'status   << returned from calling procs >>       18606000
                 ,more'pages                                            18608000
                 ,cantfind      << pages marked as bad  >>              18610000
                 ,cont                                                  18612000
                 ,lpg'end       << end of pg?(scan'page) >>             18614000
                 ,ldfs'locked   << dfsm dst locked       >>             18616000
                 ,lcrit'set                                             18618000
                 ,lcrit         << returned from setcritical >>         18620000
                 ,ldone          << finished w DFSM   >>                18622000
                 ,no'start'addr  << need entry addr   >>                18624000
                 ;                                                      18626000
                                                                        18628000
   DOUBLE         lsectcnt                                              18630000
                 ,laddr                                                 18632000
                 ,savsectcnt                                            18634000
                 ,savladdr                                              18636000
                 ,totentries   << total # entries >>                    18638000
                 ,totfs        << total free space >>                   18640000
                 ,max'space    << maximum fs size >>                    18642000
                 ,disc'size    << #sectors for ldev >>                  18644000
                 ;                                                      18646000
                                                                        18648000
   INTEGER bad'page'count;                                     <<03724>>18650000
                                                                        18652000
   <<  used to get the vol table, ldt entry and various >>              18654000
   <<  defs                                             >>              18656000
                                                                        18658000
   INTEGER array temp(0:15);                                            18660000
                                                                        18662000
   EQUATE ldt1 = 1;                                                     18664000
   DEFINE ldt'vol'index =(0:8)#;                                        18666000
   EQUATE vol'ent'size = %16;                                           18668000
   DEFINE vol'ldev = temp(%14).(0:8)#;                                  18670000
   DEFINE scratch = temp(%14).(15:1)=1#;                                18672000
   DEFINE unformatted = temp(%14).(13:1)=1#;                            18674000
   EQUATE lpdt'entry'size = 2;                                          18676000
   DEFINE ser'forn = (10:2)#;                                           18678000
   DEFINE mounted'pv = (5:1)#;                                 <<03756>>18680000
   DEFINE nsd = (4:1)#;                                        <<03756>>18682000
                                                               <<03756>>18684000
   LOGICAL mvtab'sir'flag,                                     <<03756>>18686000
           have'mvtab'sir := FALSE;                            <<03756>>18688000
                                                               <<03756>>18690000
                                                                        18692000
   << used in creating the printout  >>                                 18694000
                                                                        18696000
   EQUATE         max'buff'per'page   = 4;                              18698000
   EQUATE         max'lentry          = 15;                             18700000
   EQUATE         entries'per'line    = 3;                              18702000
   EQUATE         left'just           = 8;                              18704000
   EQUATE         max'field'size      = 9;                              18706000
                                                                        18708000
   DOUBLE ARRAY lentry(0:max'lentry-1) = Q;                             18710000
   DOUBLE ARRAY lentrysize(0:max'lentry-1) = Q;                         18712000
                                                                        18714000
                                                                        18716000
   EQUATE         p'buffer'len = 72;                                    18718000
                                                                        18720000
   LOGICAL ARRAY lp'buffer(0:p'buffer'len/2 -1 );                       18722000
   BYTE ARRAY    p'buffer(*)=lp'buffer;                                 18724000
                                                                        18726000
   DEFINE blank'buffer = p'buffer:=" ";                                 18728000
                         MOVE p'buffer(1):=p'buffer,                    18730000
                                             (p'buffer'len-1)#;         18732000
                                                                        18734000
                                                                        18736000
   << Page descriptor entry flagged as no good page? >>                 18738000
                                                                        18740000
   DEFINE  flagged'bad = ds'descriptor'table( (lpage *                  18742000
                         dt'entry'size)+ largest'space )= bad'page#;    18744000
                                                                        18746000
   << error in creating the print file ? >>                             18748000
                                                                        18750000
   EQUATE write'error = %01;  << for err'pfentries >>                   18752000
                                                                        18754000
   << this is used to exit procedure from subroutine >>                 18756000
                                                                        18758000
   DEFINE exit'procedure = ASSEMBLE(exit 2)#;                           18760000
                                                                        18762000
   << this is for all the exits because control-y    >>                 18764000
   << was hit and must exit the procedure            >>                 18766000
                                                                        18768000
   DEFINE controlygetout = IF req'brk THEN                              18770000
                              BEGIN                                     18772000
                                 space(1);                              18774000
                                 exit'procedure;                        18776000
                              END#;                                     18778000
$PAGE "   SUBROUTINES FOR PFENTRIES"                                    18780000
   SUBROUTINE forget'it;                                       <<03510>>18782000
   BEGIN                                                                18784000
<<===========================                                           18786000
                                                                        18788000
          it's a disc, but not one which has a DFSM                     18790000
                                                                        18792000
   Assumptions:                                                         18794000
         will print out a message and then will EXIT.                   18796000
         IF calling sequence changes, this must change.                 18798000
                                                                        18800000
   Intrinsics:                                                          18802000
        fwrite,ascii                                                    18804000
                                                                        18806000
   Changes:                                                             18808000
                                                                        18810000
===========================>>                                           18812000
                                                                        18814000
      blank'buffer;                                                     18816000
                                                                        18818000
      MOVE p'buffer:="LDEV ";                                           18820000
      dummy:=ascii(ldev,10,p'buffer(5));                                18822000
      dummy:=dummy<<ldev>> + 5<<"LDEV">> + 1<<sp>>;                     18824000
      MOVE p'buffer(dummy):=                                            18826000
        "not mounted or has no DFSM ";                                  18828000
      fwrite(listfn,lp'buffer,-p'buffer'len,%40);                       18830000
                                                                        18832000
      exit'procedure;                                                   18834000
                                                                        18836000
   END;  << forget'it >>                                                18838000
                                                                        18840000
                                                                        18842000
                                                                        18844000
   SUBROUTINE err'pfentries(err);                              <<03510>>18846000
      VALUE err;                                                        18848000
      INTEGER err;                                                      18850000
                                                                        18852000
   BEGIN                                                                18854000
                                                                        18856000
<<===========================                                           18858000
                                                                        18860000
          error routine - exits from whole procedure                    18862000
                                                                        18864000
   Parameters:                                                          18866000
         err - error status in "DFSM" format                            18868000
               NOTE: this procedure takes liberties                     18870000
               w status word. %01 Always means that                     18872000
               ok status, so if comes here w %01                        18874000
               its an I/O error on listfn                               18876000
                                                                        18878000
   Assumptions:                                                         18880000
         NOTE that this routine exits from procedure                    18882000
         with an EXIT. IF  calling sequence changes                     18884000
         this must change.                                              18886000
                                                                        18888000
                                                                        18890000
   Externals:                                                           18892000
        Unlock'Dfs'Data'Seg,resetcritical                               18894000
                                                                        18896000
   Intrinsics:                                                          18898000
         print'file'info,fwrite,ascii,debug                             18900000
                                                                        18902000
   Changes:                                                             18904000
                                                                        18906000
===========================>>                                           18908000
                                                                        18910000
      IF ldfs'locked THEN Unlock'Dfs'Data'Seg;                          18912000
      IF lcrit'set THEN                                                 18914000
         BEGIN                                                          18916000
         resetcritical(lcrit);                                          18918000
         lcrit'set:=false;                                              18920000
      END;                                                              18922000
                                                               <<03756>>18924000
      IF have'mvtab'sir THEN                                   <<03756>>18926000
         BEGIN  << Release MVTAB sir >>                        <<03756>>18928000
            Relsir (mvtabsir, mvtab'sir'flag);                 <<03756>>18930000
            have'mvtab'sir := FALSE;                           <<03756>>18932000
         END;   << Release MVTAB sir >>                        <<03756>>18934000
                                                               <<03756>>18936000
                                                                        18938000
      IF err = write'error THEN print'file'info(listfn)                 18940000
      ELSE                                                              18942000
         BEGIN                                                          18944000
            blank'buffer;                                               18946000
            MOVE p'buffer:="ERROR STATUS=";                             18948000
            dummy:=ascii(err,8,p'buffer(13));                           18950000
            MOVE p'buffer(22):="REL ADR=";                              18952000
            index<<dummy>> :=s0;  << address >>                         18954000
            dummy:=ascii(index,8,p'buffer(30));                         18956000
            fwrite(listfn,lp'buffer,-p'buffer'len,%40);                 18958000
         END;                                                           18960000
                                                                        18962000
$IF X3=ON                                                               18964000
          debug;                                                        18966000
$IF                                                                     18968000
                                                                        18970000
      exit'procedure;                                                   18972000
                                                                        18974000
                                                                        18976000
                                                                        18978000
   END;   << err'pfentries >>                                           18980000
$PAGE                                                                   18982000
                                                                        18984000
   SUBROUTINE unlock;                                          <<03510>>18986000
                                                                        18988000
   BEGIN                                                                18990000
                                                                        18992000
<<===========================                                           18994000
                                                                        18996000
   Assumptions:                                                         18998000
        in split stack mode when enter, DB reset when                   19000000
        leave this subroutine                                           19002000
                                                                        19004000
   Globals:                                                             19006000
       DFSM DST-ds'word'number,ds'bit'number                            19008000
                                                                        19010000
   Externals:                                                           19012000
         Unlock'Dfs'Data'Seg,resetcritical                              19014000
                                                                        19016000
   Changes:                                                             19018000
                                                                        19020000
===========================>>                                           19022000
                                                                        19024000
   lword:=ds'word'number;                                               19026000
   lbit:=ds'bit'number;                                                 19028000
   Unlock'Dfs'Data'Seg;                                                 19030000
   resetcritical(lcrit);                                                19032000
   ldfs'locked:=false;                                                  19034000
   lcrit'set:=false;                                                    19036000
                                                                        19038000
   END;   << unlock >>                                                  19040000
                                                                        19042000
                                                                        19044000
                                                                        19046000
   SUBROUTINE relock;                                          <<03510>>19048000
                                                                        19050000
   BEGIN                                                                19052000
                                                                        19054000
<<===========================                                           19056000
                                                                        19058000
         get back into split stack mode and get DFSM                    19060000
                                                                        19062000
   Assumptions:                                                         19064000
        DB at stack, will reset DB back to DFSM if can                  19066000
        NOTE: if cant get DFSM dst then will do an                      19068000
              EXIT 2 . IF calling sequence changes, the                 19070000
              this must change.                                         19072000
                                                                        19074000
   Globals:                                                             19076000
       DFSM DST-ds'page'ptr,ds'page'number,ds'bit'number                19078000
                                                                        19080000
   Intrinsics:                                                          19082000
        Lock'Dfs'Data'Seg,resetcritical                                 19084000
                                                                        19086000
   Changes:                                                             19088000
                                                                        19090000
===========================>>                                           19092000
                                                                        19094000
                                                                        19096000
   lcrit:=setcritical;                                                  19098000
   lcrit'set:=true;                                                     19100000
                                                                        19102000
   proc'status:=Lock'Dfs'Data'Seg(ldev);                                19104000
   IF NOT(proc'status) THEN                                             19106000
      BEGIN   << when finished printing alloc disab >>                  19108000
         resetcritical(lcrit);                                          19110000
         lcrit'set:=false;                                              19112000
         blank'buffer;                                                  19114000
         MOVE p'buffer:=                                                19116000
         "Allocation has been disabled on LDEV";                        19118000
         dummy:=ascii(ldev,10,p'buffer(37));                            19120000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19122000
         IF <> THEN err'pfentries(write'error);                         19124000
                                                                        19126000
         << now return cuz only looking at one entry >>                 19128000
                                                                        19130000
         exit'procedure;                                                19132000
                                                                        19134000
      END;                                                              19136000
   ldfs'locked:=true;                                                   19138000
                                                                        19140000
   @ds'page'ptr:=Get'Page(lpage);                                       19142000
   IF NOT(ds'error'status) THEN err'pfentries(ds'error'status);         19144000
                                                                        19146000
   ds'page'number:=lpage;                                               19148000
   ds'word'number:=lword;                                               19150000
   ds'bit'number:=lbit;                                                 19152000
                                                                        19154000
   END;   << relock >>                                                  19156000
                                                                        19158000
                                                                        19160000
                                                                        19162000
$PAGE                                                                   19164000
   SUBROUTINE header;                                          <<03510>>19166000
                                                                        19168000
   BEGIN                                                                19170000
                                                                        19172000
<<===========================                                           19174000
                                                                        19176000
   prints out heading at top of page                                    19178000
                                                                        19180000
   Assumptions:                                                         19182000
      DB at stack when called                                           19184000
      will see if user hit control-y and will exit from                 19186000
      procedure                                                         19188000
                                                                        19190000
   Intrinsics:                                                          19192000
     fwrite                                                             19194000
                                                                        19196000
   Changes:                                                             19198000
                                                                        19200000
===========================>>                                           19202000
                                                                        19204000
   << user wants to quit printout ? >>                                  19206000
                                                                        19208000
      controlygetout;                                                   19210000
                                                                        19212000
      blank'buffer;                                                     19214000
      MOVE p'buffer:=" ADDRESS      SIZE  ";                            19216000
      MOVE p'buffer(25):=p'buffer,(p'buffer'len-25);                    19218000
      fwrite(listfn,lp'buffer,-p'buffer'len,%40);                       19220000
      IF <> THEN err'pfentries(write'error);                            19222000
      controlygetout;                                                   19224000
      blank'buffer;                                                     19226000
      MOVE p'buffer:=" _______      ____";                              19228000
      MOVE p'buffer(25):=p'buffer,(p'buffer'len-25);                    19230000
      fwrite(listfn,lp'buffer,-p'buffer'len,%40);                       19232000
      IF <> THEN err'pfentries(write'error);                            19234000
      controlygetout;                                                   19236000
      space(1);                                                         19238000
      controlygetout;                                                   19240000
                                                                        19242000
   END;  << header >>                                                   19244000
                                                                        19246000
                                                                        19248000
                                                                        19250000
   SUBROUTINE print'buffer;                                    <<03510>>19252000
                                                                        19254000
   BEGIN                                                                19256000
                                                                        19258000
<<===========================                                           19260000
                                                                        19262000
      print out the entries which are in lentry/lentrysize              19264000
                                                                        19266000
   Assumptions:                                                         19268000
      DB at stack, may or maynot have a full buffer                     19270000
      to print out                                                      19272000
      will see if user hit control-y and will exit                      19274000
      from procedure                                                    19276000
                                                                        19278000
   Intrinsics:                                                          19280000
      dascii,fwrite                                                     19282000
                                                                        19284000
   Changes:                                                             19286000
                                                                        19288000
===========================>>                                           19290000
                                                                        19292000
   << user wants to quit printout ? >>                                  19294000
                                                                        19296000
   controlygetout;                                                      19298000
                                                                        19300000
   blank'buffer;                                                        19302000
                                                                        19304000
   charptr:=0;    << initialize >>                                      19306000
   index:=0;                                                            19308000
                                                                        19310000
   WHILE index < lentryptr DO                                           19312000
      BEGIN                                                             19314000
         dummy:=dascii(lentry(index),10,p'buffer(charptr));             19316000
         << left justify "addr" and "size" >>                           19318000
         IF dummy < max'field'size THEN                                 19320000
            BEGIN                                                       19322000
               MOVE p'buffer(charptr+left'just):=                       19324000
                       p'buffer(charptr+dummy-1),(-dummy);              19326000
               p'buffer(charptr):=" ";                                  19328000
               MOVE p'buffer(charptr+1):=p'buffer(charptr),             19330000
                                      (max'field'size-dummy-1);         19332000
            END;                                                        19334000
         dummy:=dascii(lentrysize(index),10,p'buffer(charptr+11));      19336000
         IF dummy < max'field'size THEN                                 19338000
            BEGIN                                                       19340000
               MOVE p'buffer(charptr+11+left'just):=                    19342000
                       p'buffer(charptr+11+dummy-1),(-dummy);           19344000
               p'buffer(charptr+11):=" ";                               19346000
               MOVE p'buffer(charptr+11 +1):=                           19348000
                    p'buffer(charptr+11),(max'field'size-dummy-1);      19350000
            END;                                                        19352000
         charptr:=charptr + 25;                                         19354000
         index:=index + 1;                                              19356000
                                                                        19358000
         IF (index MOD entries'per'line) = 0 THEN                       19360000
            BEGIN                                                       19362000
               <<   full line, print it out >>                          19364000
               fwrite(listfn,lp'buffer,-p'buffer'len,%40);              19366000
               IF <> THEN err'pfentries(write'error);                   19368000
               controlygetout;                                          19370000
               blank'buffer;                                            19372000
               charptr:=0;                                              19374000
            END;          << print a line >>                            19376000
      END;  << all done w entries in buffer >>                          19378000
                                                                        19380000
   << printing out a short buffer - may have a partially >>             19382000
   << filled line to print out                           >>             19384000
                                                                        19386000
   IF (lentryptr < max'lentry) AND                                      19388000
      ( (index MOD entries'per'line) <> 0 ) THEN                        19390000
      BEGIN                                                             19392000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19394000
         IF <> THEN err'pfentries(write'error);                         19396000
         controlygetout;                                                19398000
         charptr:=0;    << re-init >>                                   19400000
      END;                                                              19402000
                                                                        19404000
   <<  increment buffcnt( #buffers per page ) >>                        19406000
                                                                        19408000
   buffcnt:=buffcnt + 1;                                                19410000
   IF buffcnt = max'buff'per'page THEN                                  19412000
      BEGIN                                                             19414000
         space(5);                                                      19416000
         controlygetout;                                                19418000
         buffcnt:=0;                                                    19420000
      END;                                                              19422000
                                                                        19424000
   END;   << print'buffer >>                                            19426000
                                                                        19428000
$PAGE                                                                   19430000
   SUBROUTINE put'into'array;                                  <<03510>>19432000
                                                                        19434000
   BEGIN                                                                19436000
                                                                        19438000
<<===========================                                           19440000
                                                                        19442000
      puts lsectcnt/laddr into arrays lentry/lentrysize so that         19444000
      they are ready to printout                                        19446000
                                                                        19448000
   Assumptions:                                                         19450000
          DB at DFSM dst                                                19452000
                                                                        19454000
   Changes:                                                             19456000
                                                                        19458000
===========================>>                                           19460000
                                                                        19462000
      lentry(lentryptr):=laddr;                                         19464000
      lentrysize(lentryptr):=lsectcnt;                                  19466000
                                                                        19468000
   << totals for end of print out >>                                    19470000
                                                                        19472000
      totentries:=totentries +1D;                                       19474000
      totfs:=totfs+lsectcnt;                                            19476000
      IF lsectcnt > max'space THEN max'space:=lsectcnt;                 19478000
                                                                        19480000
      lentryptr:=lentryptr + 1;                                         19482000
                                                                        19484000
                                                                        19486000
      lsectcnt:=0D;    << re-initialize >>                              19488000
      laddr:=0D;                                                        19490000
                                                                        19492000
   END;  << put'into'array >>                                           19494000
                                                                        19496000
                                                                        19498000
                                                                        19500000
   SUBROUTINE output;                                          <<03510>>19502000
                                                                        19504000
   BEGIN                                                                19506000
                                                                        19508000
<<===========================                                           19510000
                                                                        19512000
         print out the full buffer                                      19514000
         when done printing, re-initialize arrays                       19516000
         lentry/lentrysize                                              19518000
                                                                        19520000
   Assumptions:                                                         19522000
       DB at DFSM DST when called                                       19524000
                                                                        19526000
   Globals:                                                             19528000
        lentry/lentrysize is re-initialized                             19530000
                                                                        19532000
   Changes:                                                             19534000
                                                                        19536000
===========================>>                                           19538000
                                                                        19540000
      unlock;                                                           19542000
      IF buffcnt = 0 THEN header;                                       19544000
      print'buffer;                                                     19546000
                                                                        19548000
      <<  zero out lentry/lentrysize  >>                                19550000
                                                                        19552000
      lentry:=0D;                                                       19554000
      MOVE lentry(1):=lentry,(max'lentry-1);                            19556000
      lentrysize:=0D;                                                   19558000
      MOVE lentrysize(1):=lentrysize,(max'lentry-1);                    19560000
      lentryptr:=0;                                                     19562000
                                                                        19564000
      relock;                                                           19566000
                                                                        19568000
   END;   << output >>                                                  19570000
                                                                        19572000
                                                                        19574000
                                                                        19576000
   DOUBLE SUBROUTINE convert'startmap'addr;                    <<03510>>19578000
                                                                        19580000
   BEGIN                                                                19582000
                                                                        19584000
<<===========================                                           19586000
                                                                        19588000
      converts a map address to a sector address                        19590000
      exactly the same as "convert'map'to'address" except               19592000
      this routine uses ds'starting'word'number and                     19594000
      ds'starting'bit'number                                            19596000
      This will return the sector address of where                      19598000
      space was found on ds'page'number                                 19600000
      Operates in split stack mode using parms from                     19602000
      DFSM DST                                                          19604000
                                                                        19606000
   Assumptions:                                                         19608000
       DB at DFSM DST                                                   19610000
                                                                        19612000
   Globals:                                                             19614000
       uses DFSM DST defs - ds'page'number,                             19616000
        ds'starting'word'number,ds'starting'bit'number                  19618000
       bits'per'page,bits'per'word                                      19620000
                                                                        19622000
   Changes:                                                             19624000
                                                                        19626000
===========================>>                                           19628000
                                                                        19630000
                                                                        19632000
   convert'startmap'addr:=( DBL(ds'page'number) * DBL(bits'per'page) )  19634000
                  + DBL( (ds'starting'word'number * bits'per'word)      19636000
                         +ds'starting'bit'number );                     19638000
                                                                        19640000
   END;  << convert'startmap'addr >>                                    19642000
$PAGE  "  PROCEDURE PFENTRIES"                                          19644000
                                                                        19646000
                                                                        19648000
   << verify that ldev really has a DFSM before >>                      19650000
   << beginning                                 >>                      19652000
   << since checkdisc already verified that it  >>                      19654000
   << is a disc go to the LDT to ge the vol     >>                      19656000
   << table index                               >>                      19658000
                                                                        19660000
   Move'From'Data'Seg(ldtdst,ldev*ldtent,ldtent,                        19662000
                      temp);                                            19664000
   dummy<<vol index>>:=temp(ldt1).ldt'vol'index;                        19666000
   Move'From'Data'Seg(vol'table'dst,dummy*vol'ent'size,                 19668000
                      vol'ent'size,temp);                               19670000
                                                                        19672000
   IF vol'ldev <> 0 AND scratch OR unformatted                          19674000
      THEN  forget'it;                                                  19676000
                                                                        19678000
   << a deleted vol ? - wd 0 of vol ent = 0 >>                          19680000
                                                                        19682000
   IF temp = 0 THEN   forget'it;                                        19684000
                                                                        19686000
   << is it foreign or serial ? >>                                      19688000
                                                                        19690000
   IF lpdt(vol'ldev*lpdt'entry'size + 1).nsdf = 1                       19692000
      AND                                                               19694000
      lpdt(vol'ldev*lpdt'entry'size + 1).ser'forn <> 0                  19696000
      THEN    forget'it;                                                19698000
                                                                        19700000
                                                                        19702000
   << initialize the DB rel flag before going into >>                   19704000
   << split stack mode                             >>                   19706000
                                                                        19708000
   req'brk:=false;                                                      19710000
                                                                        19712000
   << arm control-y trap >>                                             19714000
                                                                        19716000
   xcontrap(@controly,controly'dummy);                                  19718000
                                                                        19720000
   << initialize some counters >>                                       19722000
                                                                        19724000
   totentries:=0D;                                                      19726000
   totfs:=0D;                                                           19728000
   max'space:=0D;                                                       19730000
      bad'page'count := 0;                                     <<03724>>19732000
                                                                        19734000
   lentry:=0D;                                                          19736000
   MOVE lentry(1):=lentry,(max'lentry-1);                               19738000
   lentrysize:=0D;                                                      19740000
   MOVE lentrysize(1):=lentrysize,(max'lentry-1);                       19742000
                                                                        19744000
   lcrit'set:=false;                                                    19746000
   lcrit:=setcritical;                                                  19748000
   lcrit'set:=true;                                                     19750000
                                                                        19752000
        << print out "LDEV: n"  >>                                      19754000
                                                                        19756000
   blank'buffer;                                                        19758000
   MOVE p'buffer:="LDEV: ";                                             19760000
   dummy:=ascii(ldev,10,p'buffer(5));                                   19762000
   fwrite(listfn,lp'buffer,-20,%40);                                    19764000
   IF <> THEN err'pfentries(write'error);                               19766000
                                                                        19768000
   << If the LDEV is a PV, then it must be logically >>        <<03756>>19770000
   << mounted to list the free space (so it can not  >>        <<03756>>19772000
   << be physically dismounted under us).  If it is  >>        <<03756>>19774000
   << logically mounted we hold the MVTAB sir until  >>        <<03756>>19776000
   << listing of free space is complete to prevent   >>        <<03756>>19778000
   << a dismount.                                    >>        <<03756>>19780000
                                                               <<03756>>19782000
   IF lpdt (ldev*lpdt'entry'size + 1).nsd = 1 THEN             <<03756>>19784000
      BEGIN  << Its a PV >>                                    <<03756>>19786000
                                                               <<03756>>19788000
         mvtab'sir'flag := Getsir (mvtabsir);                  <<03756>>19790000
         have'mvtab'sir := TRUE;                               <<03756>>19792000
         IF lpdt (ldev*lpdt'entry'size + 1).mounted'pv         <<03756>>19794000
            = 0 THEN                                           <<03756>>19796000
            BEGIN  << Not logically mounted >>                 <<03756>>19798000
                                                               <<03756>>19800000
               Genmsg (pvmsgset, 34);                          <<03756>>19802000
               Relsir (mvtabsir, mvtab'sir'flag);              <<03756>>19804000
               have'mvtab'sir := FALSE;                        <<03756>>19806000
                                                               <<03756>>19808000
               resetcritical (lcrit);                          <<03756>>19810000
               lcrit'set := FALSE;                             <<03756>>19812000
                                                               <<03756>>19814000
               RETURN;                                         <<03756>>19816000
                                                               <<03756>>19818000
            END;   << Not logically mounted >>                 <<03756>>19820000
                                                               <<03756>>19822000
      END;   << Its a PV >>                                    <<03756>>19824000
                                                               <<03756>>19826000
   << lock the DFSM DST and go into split stack mode >>                 19828000
                                                                        19830000
   proc'status:=Lock'Dfs'Data'Seg(ldev);                                19832000
   IF NOT(proc'status) THEN                                             19834000
      BEGIN                                                             19836000
                                                               <<03756>>19838000
         IF have'mvtab'sir THEN                                <<03756>>19840000
            BEGIN  << Release MVTAB sir >>                     <<03756>>19842000
               Relsir (mvtabsir, mvtab'sir'flag);              <<03756>>19844000
               have'mvtab'sir := FALSE;                        <<03756>>19846000
            END;   << Release MVTAB sir >>                     <<03756>>19848000
                                                               <<03756>>19850000
         resetcritical(lcrit);                                          19852000
         lcrit'set:=false;                                              19854000
         MOVE p'buffer:=                                                19856000
         "Allocation has been disabled on LDEV";                        19858000
         dummy:=ascii(ldev,10,p'buffer(37));                            19860000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19862000
         IF <> THEN err'pfentries(write'error);                         19864000
                                                                        19866000
         << now return since there is nothing to print >>               19868000
                                                                        19870000
         RETURN;                                                        19872000
      END;                                                              19874000
   ldfs'locked:=true;                                                   19876000
                                                                        19878000
   << ** in split stack mode  ** >>                                     19880000
                                                                        19882000
   << find the first page which doesnt have the Descriptor >>           19884000
   << entry marked as bad                                   >>          19886000
                                                                        19888000
   lpage:=0;                                                            19890000
   cantfind:=false;                                                     19892000
   cont:=true;                                                          19894000
                                                                        19896000
   WHILE cont DO                                                        19898000
      BEGIN                                                             19900000
         IF flagged'bad THEN                                            19902000
            BEGIN                                                       19904000
               lpage:=lpage+1;                                          19906000
               bad'page'count := bad'page'count + 1;           <<03724>>19908000
               IF lpage > ds'last'page'of'map THEN                      19910000
                  BEGIN                                                 19912000
                     cantfind:=true;                                    19914000
                     cont:=false;                                       19916000
                  END;                                                  19918000
            END                                                         19920000
         ELSE     cont:=false;                                          19922000
      END;                                                              19924000
                                                                        19926000
   IF cantfind THEN                                                     19928000
      BEGIN                                                             19930000
         Unlock'Dfs'Data'Seg;                                           19932000
         ldfs'locked:=false;                                            19934000
         resetcritical(lcrit);                                          19936000
         lcrit'set:=false;                                              19938000
                                                               <<03756>>19940000
         IF have'mvtab'sir THEN                                <<03756>>19942000
            BEGIN  << Release MVTAB sir >>                     <<03756>>19944000
               Relsir (mvtabsir, mvtab'sir'flag);              <<03756>>19946000
               have'mvtab'sir := FALSE;                        <<03756>>19948000
            END;   << Release MVTAB sir >>                     <<03756>>19950000
                                                               <<03756>>19952000
                                                                        19954000
         << print out a message saying bad DFSM >>                      19956000
                                                                        19958000
         blank'buffer;                                                  19960000
         MOVE p'buffer:="LDEV ";                                        19962000
         dummy:=ascii(ldev,10,p'buffer(5));                             19964000
         dummy:=dummy<<ldev>> + 1<<sp>> + 5<<"LDEV">>;                  19966000
         MOVE p'buffer(dummy):="has bad DFSM ";                         19968000
         fwrite(listfn,lp'buffer,-p'buffer'len,%40);                    19970000
         IF <> THEN err'pfentries(write'error);                         19972000
                                                                        19974000
         << now return since there is nothing to print >>               19976000
                                                                        19978000
         RETURN;                                                        19980000
      END;                                                              19982000
                                                                        19984000
   @ds'page'ptr:=Get'Page(lpage);                                       19986000
   IF NOT(ds'error'status) THEN err'pfentries(ds'error'status);         19988000
                                                                        19990000
   ds'page'number:=lpage;                                               19992000
   ds'word'number:=0;   << initialize to start a beg of page >>         19994000
   ds'bit'number:=0;                                                    19996000
   lsectcnt:=0D;                                                        19998000
   ldone:=false;                                                        20000000
   laddr:=0D;                                                           20002000
   no'start'addr:=true;                                                 20004000
                                                                        20006000
   << initialize some cntrs for the print out >>                        20008000
                                                                        20010000
   buffcnt:=0;                                                          20012000
   lentryptr:=0;                                                        20014000
                                                                        20016000
      << while looking at the pages have to worry about >>              20018000
      << encountering a bad page, if space really does  >>              20020000
      << span pages                                     >>              20022000
                                                                        20024000
      DO BEGIN                                                          20026000
         lpg'end:=Scan'Page;                                            20028000
         << either found space here & none on prev pg; space >>         20030000
         << on prev pg none here; or both                    >>         20032000
         IF lsectcnt = 0D AND ds'bit'count = 0 THEN                     20034000
            GO TO next'ent;    << didnt find anything >>                20036000
                                                                        20038000
         IF no'start'addr THEN                                          20040000
            BEGIN                                                       20042000
               laddr:=convert'startmap'addr;                            20044000
               no'start'addr:=false;                                    20046000
            END;                                                        20048000
                                                                        20050000
         IF lpg'end THEN       << at end of a page    >>                20052000
            BEGIN                                                       20054000
               IF lpage = ds'last'page'of'map  << last pg & at end >>   20056000
                  THEN BEGIN                                            20058000
                     <<     last pg     >>                              20060000
                     lsectcnt:=lsectcnt + DBL(ds'bit'count);            20062000
                     put'into'array;                                    20064000
                     IF lentryptr = max'lentry THEN output;             20066000
                     no'start'addr:=true;                               20068000
                  END                                                   20070000
               ELSE             << not last pg >>                       20072000
                  BEGIN                                                 20074000
                     IF ds'bit'count = 0 THEN                           20076000
                        BEGIN                                           20078000
                           << space from prev pg & none here >>         20080000
                           put'into'array;                              20082000
                           IF lentryptr = max'lentry THEN output;       20084000
                           no'start'addr:=true;                         20086000
                        END                                             20088000
                     ELSE    << maybe more contg sp on next pg >>       20090000
                        lsectcnt:=lsectcnt + DBL(ds'bit'count);         20092000
               END;           << lpage = ds'last'page'of'map >>         20094000
            END               << lpg'end = true      >>                 20096000
                                                                        20098000
                                                                        20100000
         ELSE                                                           20102000
            BEGIN             << space somewhere in middle of pg >>     20104000
               IF lsectcnt = 0D THEN                                    20106000
                  BEGIN                                                 20108000
                     << found space in middle >>                        20110000
                     lsectcnt:=DBL(ds'bit'count);                       20112000
                     put'into'array;                                    20114000
                     IF lentryptr = max'lentry THEN output;             20116000
                     no'start'addr:=true;                               20118000
                  END                                                   20120000
               ELSE            << lsectcnt <> 0 >>                      20122000
                  BEGIN                                                 20124000
                     IF ds'starting'word'number = 0 AND                 20126000
                        ds'starting'bit'number  = 0                     20128000
                        THEN BEGIN                                      20130000
                           << sp on prev pg and at front current >>     20132000
                           << but havent hit the end of the page >>     20134000
                           lsectcnt:=lsectcnt + DBL(ds'bit'count);      20136000
                           put'into'array;                              20138000
                           IF lentryptr = max'lentry THEN output;       20140000
                           no'start'addr:=true;                         20142000
                        END                                             20144000
                     ELSE                                               20146000
                        BEGIN                                           20148000
                           << had sp on prev pg, none in front >>       20150000
                           << but found some somewhere in pg   >>       20152000
                           << save the addr/size of space found>>       20154000
                           << because may have to unlock the   >>       20156000
                           << DFSM to print                    >>       20158000
                                                                        20160000
                           savsectcnt:=DBL(ds'bit'count);               20162000
                           savladdr:=convert'startmap'addr;             20164000
                           put'into'array;                              20166000
                           IF lentryptr = max'lentry THEN output;       20168000
                           lsectcnt:=savsectcnt;                        20170000
                           laddr:=savladdr;                             20172000
                           put'into'array;                              20174000
                           IF lentryptr = max'lentry THEN output;       20176000
                           no'start'addr:=true;                         20178000
                     END;      << ds'starting'word... >>                20180000
                                                                        20182000
               END;            << lsectcnt = AND <> 0 >>                20184000
            END;               << lpg'end  T AND F    >>                20186000
next'ent:                                                               20188000
                << didnt find anything from "Scan'Page" >>              20190000
                                                                        20192000
         << see if have to swap pages; find the next good page          20194000
            if the next page is marked as bad in the Descriptor         20196000
            table, then any space that is in lsectcnt must be           20198000
            put into space'info since there will be no contiguous       20200000
            space across pages                                          20202000
         >>                                                             20204000
         IF lpg'end THEN                                                20206000
            BEGIN                                                       20208000
               IF lpage = ds'last'page'of'map THEN ldone:=true          20210000
               ELSE                                                     20212000
                  BEGIN                                                 20214000
                     ldone:=false;   << more pages to go >>             20216000
                     lpage:=lpage+1;                                    20218000
                     cantfind:=true;                                    20220000
                     DO BEGIN  << find pg w good Descr entry >>         20222000
                        IF flagged'bad THEN                             20224000
                           BEGIN                                        20226000
                              IF lsectcnt <> 0D THEN                    20228000
                                 BEGIN                                  20230000
                                    put'into'array;                     20232000
                                    IF lentryptr = max'lentry THEN      20234000
                                       output;                          20236000
                                    no'start'addr:=true;                20238000
                                 END;                                   20240000
                              lpage:=lpage+1;                           20242000
                              bad'page'count :=                <<03724>>20244000
                                       bad'page'count + 1;     <<03724>>20246000
                           END                                          20248000
                        ELSE                                            20250000
                           BEGIN                                        20252000
                              @ds'page'ptr:=get'page(lpage);            20254000
                              IF ds'error'status THEN  << good status >>20256000
                                 BEGIN                                  20258000
                                    cantfind:=false;                    20260000
                                    ds'page'number:=lpage;              20262000
                                    ds'word'number:=0; << init  >>      20264000
                                    ds'bit'number:=0;                   20266000
                                 END                                    20268000
                              ELSE   lpage:=lpage+1;                    20270000
                        END;    << flagged'bad  T F >>                  20272000
                     END UNTIL lpage > ds'last'page'of'map              20274000
                            OR NOT(cantfind);                           20276000
                     IF lpage > ds'last'page'of'map THEN ldone:=true;   20278000
                  END;    << lpage = <> last page >>                    20280000
               END;       << lpg'end  T           >>                    20282000
                                                                        20284000
      END UNTIL ldone;         << done with this disc >>                20286000
                                                                        20288000
                                                                        20290000
   Unlock'Dfs'Data'Seg;                                                 20292000
   ldfs'locked := false;                                                20294000
   resetcritical(lcrit);                                                20296000
   lcrit'set:=false;                                                    20298000
                                                               <<03756>>20300000
   IF have'mvtab'sir THEN                                      <<03756>>20302000
      BEGIN  << Release MVTAB sir >>                           <<03756>>20304000
         Relsir (mvtabsir, mvtab'sir'flag);                    <<03756>>20306000
         have'mvtab'sir := FALSE;                              <<03756>>20308000
      END;   << Release MVTAB sir >>                           <<03756>>20310000
                                                               <<03756>>20312000
                                                                        20314000
   << if anything in lentry must print it out >>                        20316000
                                                                        20318000
   IF lentryptr <> 0 THEN                                               20320000
      BEGIN                                                             20322000
         IF buffcnt = 0 THEN header;                                    20324000
         print'buffer;                                                  20326000
      END;                                                              20328000
                                                                        20330000
                                                                        20332000
   << user wants to quit printout ? >>                                  20334000
                                                                        20336000
   controlygetout;                                                      20338000
                                                                        20340000
   << Print out number of bad pages, if any >>                 <<03724>>20342000
                                                               <<03724>>20344000
   IF bad'page'count <> 0 THEN                                 <<03724>>20346000
      BEGIN  << Print bad pages >>                             <<03724>>20348000
                                                               <<03724>>20350000
         blank'buffer;                                         <<03724>>20352000
         MOVE p'buffer := "LDEV ", 2;                          <<03724>>20354000
         TOS := TOS + Ascii (ldev, 10 ,bps0);                  <<03724>>20356000
         MOVE * := " has ", 2;                                 <<03724>>20358000
         TOS := TOS + Ascii (bad'page'count, 10, bps0);        <<03724>>20360000
         MOVE * := " pages of the Disc Free Space Map ", 2;    <<03724>>20362000
         dummy := -(TOS - @p'buffer);                          <<03724>>20364000
         Fwrite (listfn, lp'buffer, dummy, 0);                 <<03724>>20366000
         IF <> THEN err'pfentries (write'error);               <<03724>>20368000
         blank'buffer;                                         <<03724>>20370000
         MOVE p'buffer := "marked as bad.  Up to ", 2;         <<03724>>20372000
         TOS := TOS + Dascii (DOUBLE (bits'per'page) *         <<03724>>20374000
                              DOUBLE (bad'page'count), 10,     <<03724>>20376000
                              bps0);                           <<03724>>20378000
         MOVE * := " sectors of disc space may be lost.", 2;   <<03724>>20380000
         dummy := -(TOS - @p'buffer);                          <<03724>>20382000
         Fwrite (listfn, lp'buffer, dummy, 0);                 <<03724>>20384000
         IF <> THEN err'pfentries (write'error);               <<03724>>20386000
                                                               <<03724>>20388000
      END;   << Print bad pages >>                             <<03724>>20390000
                                                               <<03724>>20392000
   <<  print out the end totals >>                                      20394000
                                                                        20396000
   proc'status:=Get'Disc'info(ldev,,,,,,disc'size);                     20398000
   IF NOT(proc'status) THEN err'pfentries(proc'status);                 20400000
                                                                        20402000
   blank'buffer;                                                        20404000
   MOVE p'buffer:=" NO. ENTRIES: ";                                     20406000
   dummy:=dascii(totentries,10,p'buffer(17));                           20408000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20410000
   IF <> THEN err'pfentries(write'error);                               20412000
   controlygetout;                                                      20414000
                                                                        20416000
   blank'buffer;                                                        20418000
   MOVE p'buffer:=" TOTAL VOLUME CAPACITY: ";                           20420000
   dummy:=dascii(disc'size,10,p'buffer(26));                            20422000
   index<<dummyparm>>:=dummy+27;                                        20424000
   MOVE p'buffer(index):="SECTORS";                                     20426000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20428000
   IF <> THEN err'pfentries(write'error);                               20430000
   controlygetout;                                                      20432000
                                                                        20434000
   blank'buffer;                                                        20436000
   MOVE p'buffer:=" TOTAL FREE SPACE AVAILABLE: ";                      20438000
   dummy:=dascii(totfs,10,p'buffer(29));                                20440000
   index<<dummyparm>>:=dummy+30;                                        20442000
   MOVE p'buffer(index):="SPACE";                                       20444000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20446000
   IF <> THEN err'pfentries(write'error);                               20448000
   controlygetout;                                                      20450000
                                                                        20452000
   blank'buffer;                                                        20454000
   MOVE p'buffer:=" MAXIMUM CONTIGUOUS AREA: ";                         20456000
   dummy:=dascii(max'space,10,p'buffer(26));                            20458000
   index<<dummyparm>>:=dummy+27;                                        20460000
   MOVE p'buffer(index):="SECTORS";                                     20462000
   fwrite(listfn,lp'buffer,-p'buffer'len,%40);                          20464000
   IF <> THEN err'pfentries(write'error);                               20466000
   controlygetout;  << just to be consistant >>                         20468000
                                                                        20470000
                                                                        20472000
END;   << pfentries >>                                                  20474000
$PAGE "   PROCEDURE RECOVER'RECEIP"                                     20476000
$CONTROL SEGMENT=CONDENSE                                               20478000
INTEGER PROCEDURE recover'receip(ntry,level,parms,sirs);       <<03510>>20480000
   VALUE level,parms,sirs;                                              20482000
   INTEGER level,parms;                                                 20484000
   DOUBLE sirs;                                                         20486000
   ARRAY ntry;                                                          20488000
   OPTION PRIVILEGED,UNCALLABLE;                                        20490000
                                                                        20492000
BEGIN                                                                   20494000
                                                                        20496000
<<===================================================                   20498000
                                                                        20500000
   this routine is called with DB at Directory DST and                  20502000
   Directory sir locked                                                 20504000
      RETURNS:                                                          20506000
              cond'receip.(15:1)                                        20508000
                                 0 dirc sir not released                20510000
                                 1 dirc sir released                    20512000
              cond'receip.(13:2)                                        20514000
                                 0 continue traversal                   20516000
                                 1 skip subtrees                        20518000
                                 2 stop traversal                       20520000
                                                                        20522000
   Parameters:                                                          20524000
           ntry - pointer to dirc entry in Dirc DST                     20526000
                  (may be file,grp,acct entry)                          20528000
           level - what kind of entry "ntry" is                         20530000
           parms - pointer to DB rel array that                         20532000
                   caller of Dirc is passing here                       20534000
           sirs - sir word for Dirc sir(if you wanted                   20536000
                  to release the Dirc sir)                              20538000
                                                                        20540000
   Returns:                                                             20542000
         status flag , see intro discussion                             20544000
         if terminate scan then                                         20546000
         whattodo = -1    and                                           20548000
         msgmo has private vol msg # for caller to print out            20550000
                                                                        20552000
   Assumptions:                                                         20554000
         Assumes that DB at Dirc DST when enter and will                20556000
         be reset on exit                                               20558000
         Since in split stack mode when enter this routine              20560000
         cannot have any indirect arrays                                20562000
                                                                        20564000
   Globals:                                                             20566000
         file entry in Dirc                                             20568000
         sysdb                                                          20570000
         file label - flchecksum,flmisc,flstatus,flsrlx                 20572000
         pvmsgs - viwarn60,vierr64                                      20574000
         vinit'error                                                    20576000
                                                                        20578000
   Callers:                                                             20580000
          condense'disc(via Dirc)                                       20582000
                                                                        20584000
   Fixid:                                                               20586000
      This procedure was part of the changes for the new disc free      20588000
      space map.  The fixid on the procedure header applies to the      20590000
      whole procedure.                                                  20592000
                                                                        20594000
   Changes:                                                             20596000
                                                                        20598000
====================================================>>                  20600000
                                                                        20602000
   INTEGER         return'status       = recover'receip;                20604000
   DEFINE          sir'status          = (15:1)#;                       20606000
   EQUATE          sir'released        = 0;                             20608000
   EQUATE          sir'not'released    = 1;                             20610000
   DEFINE          dirscanstatus       =(13:2)#;                        20612000
   EQUATE          continue'traversal  = 0;                             20614000
   EQUATE          skip'subtree        = 1;                             20616000
   EQUATE          stop'traversal      = 2;                             20618000
                                                                        20620000
   INTEGER         deltaq              = Q+0;                           20622000
   ARRAY           arrq0(*)            = Q-0;                           20624000
   INTEGER ARRAY   rparms(*);                                           20626000
   ARRAY           vol'set'ldevs(*);     << vol to ldev conv table >>   20628000
   DOUBLE ARRAY    ntryd(*)            = ntry;                          20630000
                                                                        20632000
   INTEGER       numexts                                                20634000
                ,i              << temp,index >>                        20636000
                ,index          << dummy,temp,index >>                  20638000
                ,vtab'of'flab   << vol table index of flab >>           20640000
                ,flab'ldev                                              20642000
                ,mychecksum     << of file label >>                     20644000
                ,dst                                                    20646000
                  ,flaberr  <<flab error flag>>                <<03777>>20648000
                ;                                                       20650000
                                                                        20652000
   LOGICAL       discspace'status                                       20654000
                ,proc'status                                            20656000
                ;                                                       20658000
                                                                        20660000
   DOUBLE        numberofsectors                                        20662000
                ,getaddr                                                20664000
                ,flabaddr                                               20666000
                ,release'sectors                                        20668000
                ,dproc'status   << for purgethefile >>                  20670000
                ;                                                       20672000
                                                                        20674000
   INTEGER POINTER  flab;                                               20676000
   DOUBLE  POINTER  dflab;                                              20678000
   BYTE    POINTER  bflab;                                              20680000
   << rparms definitions >>                                             20682000
                                                                        20684000
   DEFINE          whattodo             = rparms(0)#;                   20686000
   DEFINE          volumesetldevs       = rparms(1)#;                   20688000
   DEFINE          msgno                = rparms(2)#;                   20690000
   DEFINE          condldev             = rparms(3)#;                   20692000
   DEFINE          thisvol              = rparms(4)#;                   20694000
   DEFINE          p'mvtabx             = rparms(5)#;                   20696000
                                                                        20698000
   EQUATE   buffer'len = 36;                                            20700000
   LOGICAL POINTER buffer;                                              20702000
   BYTE POINTER bbuffer;                                                20704000
   BYTE POINTER buf'ptr;                                                20706000
   DEFINE blank'buffer = buffer:="  ";                                  20708000
                         MOVE buffer(1):=buffer,                        20710000
                                         (buffer'len-1)#;               20712000
                                                                        20714000
                                                                        20716000
$PAGE "SUBROUTINE PURGETHEFILE "                                        20718000
SUBROUTINE purgethefile;                                       <<03510>>20720000
BEGIN                                                                   20722000
                                                                        20724000
<<===================================================                   20726000
                                                                        20728000
   while trying to recover this file found an extent that               20730000
   was already allocated. To prevent errors we are going                20732000
   to purge the file from the Directory. When you purge                 20734000
   the file from the Directory, it decrements the group                 20736000
   and accnt space by the amount of file space, but it                  20738000
   doesn't return the extents. We dont want to return the               20740000
   the space since one extent is already bad. Will recover              20742000
   the space on other LDEVs when do recover on them                     20744000
                                                                        20746000
   Globals:                                                             20748000
        uses flab                                                       20750000
       direcpurgefile                                                   20752000
                                                                        20754000
   Changes:                                                             20756000
                                                                        20758000
====================================================>>                  20760000
                                                                        20762000
   << figure out the amount of space the file has so you  >>            20764000
   << can release the space from the Dirc grp and acct    >>            20766000
   << entry                                               >>            20768000
                                                                        20770000
   release'sectors:=0D;                                                 20772000
   index:=-1;                                                           20774000
   WHILE (index:=index+1) <= numexts DO                                 20776000
      BEGIN                                                             20778000
         IF index = numexts THEN release'sectors:=release'sectors +     20780000
                                 DBL(LOG(flab(fllastext)))              20782000
         ELSE                                                           20784000
            release'sectors:=release'sectors +                          20786000
                             DBL(LOG(flab(flext)));                     20788000
      END;                                                              20790000
                                                                        20792000
   dproc'status:=direcpurgefile(release'sectors,                        20794000
                                index <<dummy parm >>,                  20796000
                                flab(flacctname),                       20798000
                                flab(flgrpname),                        20800000
                                flab(fllocname),                        20802000
                                p'mvtabx                                20804000
                               );                                       20806000
                                                                        20808000
   << not checking DBL wd Dirc status because already found >>          20810000
   << the flab and no one was using it and none of the other>>          20812000
   << error returns apply to deleting a file entry          >>          20814000
                                                                        20816000
   << now generate a message to tell the user what we did   >>          20818000
                                                                        20820000
   blank'buffer;                                                        20822000
   MOVE bbuffer:=bflab,(8);                                             20824000
   SCAN bbuffer UNTIL "  ",1;                                           20826000
   @buf'ptr:=TOS;                                                       20828000
   buf'ptr:=".";                                                        20830000
   @buf'ptr:=@buf'ptr+1;                                                20832000
   MOVE buf'ptr:=bflab(8),(8);                                          20834000
   SCAN buf'ptr UNTIL "  ",1;                                           20836000
   @buf'ptr:=TOS;                                                       20838000
   buf'ptr:=".";                                                        20840000
   @buf'ptr:=@buf'ptr+1;                                                20842000
   MOVE buf'ptr:=bflab(16),(8);                                         20844000
   SCAN buf'ptr UNTIL "  ",1;                                           20846000
   @buf'ptr:=TOS;                                                       20848000
   buf'ptr:=0;                                                          20850000
   genmsg(pvmsgset,vierr59,%0,@bbuffer);                                20852000
                                                                        20854000
END;  << purgethefile >>                                                20856000
$PAGE "PROCEDURE RECOVER'RECEIP"                                        20858000
   return'status:=0;   << clear it >>                                   20860000
                                                                        20862000
   <<   set sir'status now since never going to release it >>           20864000
                                                                        20866000
   return'status.sir'status:=sir'not'released;                          20868000
                                                                        20870000
   TOS:=ntryd(2);                                                       20872000
   vtab'of'flab:=s1.(0:8);                                              20874000
   s1.(0:8):=0;                                                         20876000
   flaberr := ntry(2).(0:1);                                   <<03777>>20878000
   flabaddr:=TOS;                                                       20880000
                                                                        20882000
   << get out of split stack mode, set back to stack >>                 20884000
                                                                        20886000
   dst:=exchangedb(0);                                                  20888000
                                                                        20890000
   << set ptr to   rparms  >>                                           20892000
                                                                        20894000
   @rparms:=@arrq0(parms-deltaq);                                       20896000
                                                                        20898000
   IF level <> filelevel THEN                                           20900000
      BEGIN                                                             20902000
         IF whattodo = -1 THEN                                          20904000
            return'status.dirscanstatus:=stop'traversal                 20906000
         ELSE                                                           20908000
            return'status.dirscanstatus:=continue'traversal;            20910000
         exchangedb(dst);                                               20912000
         RETURN;                                                        20914000
      END;                                                              20916000
                                                                        20918000
   << pick up the file label address and vol table address  >>          20920000
   << out of the Directory file entry                       >>          20922000
                                                                        20924000
   << check for bad file entries, only 2 cases I know of    >>          20926000
   <<    file label addr = %77777777                        >>          20928000
   <<                      supposedly if restoring a file   >>          20930000
   <<                      and system crashes               >>          20932000
   <<    ntry(2)           word 2 of Dirc file entry has    >>          20934000
   <<                      bit (0:1) set                    >>          20936000
   <<                      Dirc's way of marking a bad file >>          20938000
   <<                      file label (prob I/O error )     >>          20940000
                                                                        20942000
   IF flabaddr = bad'addr OR flaberr = dirc'bad'file THEN      <<03777>>20944000
      BEGIN                                                             20946000
         << file is marked as bad in dirc so dont   >>                  20948000
         << try to recover it. A user cannot access >>                  20950000
         << this file via FOPEN. Just leave in DIRC >>                  20952000
         return'status.dirscanstatus:=continue'traversal;               20954000
         exchangedb(dst);                                               20956000
         RETURN;                                                        20958000
      END;                                                              20960000
                                                                        20962000
   << allocate all the arrays >>                                        20964000
                                                                        20966000
   PUSH(s);                                                             20968000
   TOS:=TOS+1;                                                          20970000
   @flab:=TOS;                                                          20972000
   TOS:=sector'size;                                                    20974000
   ASSEMBLE(adds 0);                                                    20976000
                                                                        20978000
   @dflab:=@flab;                                                       20980000
   @bflab:=(@flab) &lsl(1);                                             20982000
                                                                        20984000
   PUSH(s);                                                             20986000
   TOS:=TOS+1;                                                          20988000
   @buffer:=TOS;                                                        20990000
   TOS:=buffer'len;                                                     20992000
   ASSEMBLE(adds 0);                                                    20994000
                                                                        20996000
   @bbuffer:=(@buffer) &lsl(1);                                         20998000
                                                                        21000000
   << set up ptr to ldevs in vol set >>                                 21002000
                                                                        21004000
   @vol'set'ldevs:=volumesetldevs;                                      21006000
   << ldev of file label isn't in vol set def then          >>          21008000
   << don't look at the rest of this file label             >>          21010000
   IF (flab'ldev:=vol'set'ldevs(vtab'of'flab)) = 0 THEN                 21012000
      BEGIN                                                             21014000
         return'status.dirscanstatus:=continue'traversal;               21016000
         exchangedb(dst);                                               21018000
         RETURN;                                                        21020000
      END;                                                              21022000
                                                                        21024000
   << read in the file label for this file  >>                          21026000
                                                                        21028000
   proc'status:=Read'Disc(flab'ldev,flabaddr,0,flab,sector'size);       21030000
   IF NOT(proc'status) THEN                                             21032000
      BEGIN                                                             21034000
         << Cant read file label so cant recover. To >>                 21036000
         << prevent errors, not going to recover this>>                 21038000
         << file, mark as bad in Dirc and continue   >>                 21040000
         genmsg(pvmsgset,viwarn74,%12000,flab'ldev,                     21042000
                @flabaddr);                                             21044000
         genmsg(pvmsgset,viwarn60);                                     21046000
         return'status.dirscanstatus:=continue'traversal;               21048000
                                                                        21050000
         exchangedb(dst);                                               21052000
         ntry(2).(0:1):=dirc'bad'file;                                  21054000
         dds(dadirty).dirtyf:=1;                                        21056000
         dirwrite(a);                                                   21058000
         RETURN;                                                        21060000
      END;                                                              21062000
                                                                        21064000
   << check the checksum - another test for a good label >>             21066000
                                                                        21068000
   oldchecksum;                                                         21070000
   mychecksum:=TOS;                                                     21072000
   IF mychecksum <> flab(flchecksum) THEN                               21074000
      BEGIN                                                             21076000
         << print out a nice error msg >>                               21078000
         blank'buffer;                                                  21080000
         MOVE bbuffer:=bflab,(8);                                       21082000
         SCAN bbuffer UNTIL "  ",1;                                     21084000
         @buf'ptr:=TOS;                                                 21086000
         buf'ptr:=".";                                                  21088000
         @buf'ptr:=@buf'ptr+1;                                          21090000
         MOVE buf'ptr:=bflab(8),(8);                                    21092000
         SCAN buf'ptr UNTIL "  ",1;                                     21094000
         @buf'ptr:=TOS;                                                 21096000
         buf'ptr:=".";                                                  21098000
         @buf'ptr:=@buf'ptr+1;                                          21100000
         MOVE buf'ptr:=bflab(16),(8);                                   21102000
         SCAN buf'ptr UNTIL "  ",1;                                     21104000
         @buf'ptr:=TOS;                                                 21106000
         buf'ptr:=0;                                                    21108000
         << now since file has checksum error dont >>                   21110000
         << recover - mark as bad in Dirc          >>                   21112000
         genmsg(pvmsgset,viwarn75,%0,@bbuffer);                         21114000
         genmsg(pvmsgset,viwarn60);                                     21116000
         return'status.dirscanstatus:=continue'traversal;               21118000
                                                                        21120000
         exchangedb(dst);                                               21122000
         ntry(2).(0:1):=dirc'bad'file;                                  21124000
         dds(dadirty).dirtyf:=1;                                        21126000
         dirwrite(a);                                                   21128000
         RETURN;                                                        21130000
      END;                                                              21132000
                                                                        21134000
   << before you began recovering, it checked to make sure >>           21136000
   << no one else is on - how did this ever happen ?       >>           21138000
   << quit recovering because its too dangerous with files >>           21140000
   << open                                                 >>           21142000
                                                                        21144000
   IF ( flab(flmisc).flstatus <> 0 OR flab(flmisc).flsrlx <> 0 )        21146000
      AND                                                               21148000
      flab(flcoldloadid) = sys'cold'loadid THEN                         21150000
      BEGIN                                                             21152000
         blank'buffer;                                                  21154000
         MOVE bbuffer:=bflab,(8);                                       21156000
         SCAN bbuffer UNTIL "  ",1;                                     21158000
         @buf'ptr:=TOS;                                                 21160000
         buf'ptr:=".";                                                  21162000
         @buf'ptr:=@buf'ptr+1;                                          21164000
         MOVE buf'ptr:=bflab(8),(8);                                    21166000
         SCAN buf'ptr UNTIL "  ",1;                                     21168000
         @buf'ptr:=TOS;                                                 21170000
         buf'ptr:=".";                                                  21172000
         @buf'ptr:=@buf'ptr+1;                                          21174000
         MOVE buf'ptr:=bflab(16),(8);                                   21176000
         SCAN buf'ptr UNTIL "  ",1;                                     21178000
         @buf'ptr:=TOS;                                                 21180000
         buf'ptr:=0;                                                    21182000
         genmsg(pvmsgset,vierr64,%0,@bbuffer);                          21184000
         << put in ldt so no one can allocate/deallocate >>             21186000
         Process'Dfs'Error(condldev,vinit'error,3);                     21188000
         whattodo:=-1;                                                  21190000
         msgno:=vierr0;  << abort >>                                    21192000
                                                                        21194000
         return'status.dirscanstatus:=stop'traversal;                   21196000
         exchangedb(dst);                                               21198000
         RETURN;                                                        21200000
      END;                                                              21202000
                                                                        21204000
                                                                        21206000
   << now get back all the space for the file >>                        21208000
                                                                        21210000
   numexts:=flab(flsect'numext).flnumexts;                              21212000
                                                                        21214000
   i:=-1;  << initialize >>                                             21216000
   WHILE (i:=i+1) <= numexts DO                                         21218000
      BEGIN                                                             21220000
         IF flab(flvol+i*2).flvolnum = thisvol THEN                     21222000
            BEGIN                                                       21224000
               TOS:=dflab(dflext+i);                                    21226000
               s1.(0:8):=0;                                             21228000
               getaddr:=TOS;                                            21230000
               IF i = numexts THEN                                      21232000
                  numberofsectors:=DBL(LOGICAL(flab(                    21234000
                                            fllastext)))                21236000
               ELSE                                                     21238000
                  numberofsectors:=DBL(LOGICAL(flab(                    21240000
                                            flext)));                   21242000
                                                                        21244000
               << now go and get the space back >>                      21246000
                                                                        21248000
               discspace'status:=Get'Specific'Disc'Space(               21250000
                                    condldev,getaddr,                   21252000
                                    numberofsectors);                   21254000
               IF discspace'status <> 0 THEN                            21256000
                  BEGIN                                                 21258000
                     << space not available >>                          21260000
                     IF discspace'status = 1 THEN                       21262000
                        BEGIN                                           21264000
                           purgethefile;                                21266000
                           return'status.dirscanstatus:=                21268000
                                    continue'traversal;                 21270000
                           exchangedb(dst);                             21272000
                           RETURN;                                      21274000
                        END                                             21276000
                     ELSE                                               21278000
                        BEGIN                                           21280000
                           << couldnt alloc because of >>               21282000
                           << errors in DFSM           >>               21284000
                           whattodo:=-1;                                21286000
                           msgno:=vierr0;                               21288000
                           genmsg(pvmsgset,vierr61);                    21290000
                           return'status.dirscanstatus:=                21292000
                                       stop'traversal;                  21294000
                           exchangedb(dst);                             21296000
                           RETURN;                                      21298000
                        END;                                            21300000
                                                                        21302000
                  END;                                                  21304000
                                                                        21306000
            END;  << this vol >>                                        21308000
      END;  << run through all extents >>                               21310000
                                                                        21312000
   << now set back to Dirc >>                                           21314000
                                                                        21316000
   return'status.dirscanstatus:=continue'traversal;                     21318000
                                                                        21320000
   exchangedb(dst);                                                     21322000
                                                                        21324000
END;    << recover'receip >>                                            21326000
$PAGE "   PROCEDURE RECOVER'INIT"                                       21328000
$CONTROL SEGMENT=CONDENSE                                               21330000
LOGICAL PROCEDURE recover'init(mv,ldev);                       <<03510>>21332000
   VALUE mv,ldev;                                                       21334000
   INTEGER ldev;                                                        21336000
   LOGICAL mv;                                                          21338000
                                                                        21340000
BEGIN                                                                   21342000
                                                                        21344000
<<===================================================                   21346000
                                                                        21348000
   Before can begin  to recover must initialize the DFSM to             21350000
   all free state.  Before beginning to wipe out the disc               21352000
   make sure that the DFSM(bit map + descriptors) and Dirc              21354000
   is not in a deleted area                                             21356000
   NOTE that cond'disc already checked for any suspect trks             21358000
         in any of the vols of the vol set                              21360000
    THis is the 1st pass of recover - must be very careful              21362000
    about handling errors and letting user know what is                 21364000
    is going on so that they know what to do - we dont want             21366000
    them to reload                                                      21368000
                                                                        21370000
   Parameters:                                                          21372000
          mv - logical, if T then its the master vol                    21374000
               of vol set                                               21376000
          ldev - logical device number                                  21378000
                                                                        21380000
   Returns:                                                             21382000
          t if everything ok                                            21384000
          f if error so that caller will terminate                      21386000
                                                                        21388000
   Globals:                                                             21390000
          pvmsgs - vierr55,vierr56,vierr61,                             21392000
                   vierr62,vierr68,vierr69                              21394000
          disc label - disc'lab'dfs'map'ok,disc'lab'dirty,dt'flag,      21396000
                       disc'lab'dt'checksum                             21398000
          DFSM def - dt'entry'size,bits'per'page,bits'per'word          21400000
                     largest'space,starting'space,ending'space,         21402000
                     empty'buffer,words'per'page,ds'disc'address,       21404000
                     ds'number'of'sectors,ds'error'status               21406000
          DFSM "errors" - dt'write'error,bit'map'write'error,           21408000
                          disc'label'read'error,                        21410000
                          disc'label'write'error                        21412000
          dtt - dtt'number'of'entries,dtt'track'number                  21414000
                                                                        21416000
   Fixid:                                                               21418000
       This procedure was added as part of the disc free space map      21420000
       changes, the fixid on the procedure header applies to the        21422000
       whole procedure.                                                 21424000
                                                                        21426000
   Changes:                                                             21428000
                                                                        21430000
====================================================>>                  21432000
                                                                        21434000
                                                                        21436000
   INTEGER             bit'map'pages   << # pages(mult of sect) >>      21438000
                      ,dt'size            << in words >>                21440000
                      ,page                                             21442000
                      ,word                                             21444000
                      ,bit                                              21446000
                      ,dummy                                            21448000
                      ,sectors'per'track                                21450000
                      ,type                                             21452000
                      ,subtype                                          21454000
                      ;                                                 21456000
                                                                        21458000
   LOGICAL             proc'status                                      21460000
                      ,lcrit                                            21462000
                      ;                                                 21464000
                                                                        21466000
   DOUBLE              bit'map'address                                  21468000
                      ,bit'map'size    << in sectors >>                 21470000
                      ,dt'address                                       21472000
                      ,dt'size'sectors                                  21474000
                      ,dirbase                                          21476000
                      ,dirsize                                          21478000
                      ,disc'size                                        21480000
                      ,wr'adr                                           21482000
                      ;                                                 21484000
                                                                        21486000
   << if everything went ok, then true ELSE false >>                    21488000
   LOGICAL     return'status=recover'init;                              21490000
                                                                        21492000
   LOGICAL ARRAY       temp(0:sector'size-1);                           21494000
   LOGICAL  ARRAY buffer(0:actual'words'per'page-1);                    21496000
                                                                        21498000
   POINTER             descr'table;                                     21500000
                                                                        21502000
   << this is q direct cuz used in split stack mode >>                  21504000
   INTEGER ARRAY       dtt(0:dtt'size-1)=Q;                             21506000
                                                                        21508000
   << initialize >>                                                     21510000
                                                                        21512000
   return'status:=true;                                                 21514000
                                                                        21516000
                                                                        21518000
      << sectors per track doesnt mean anything for BFD >>              21520000
      proc'status:=Get'Disc'Info(ldev,,,dtt,type,subtype,               21522000
                                 disc'size,                             21524000
                bit'map'address,bit'map'pages,dt'address,               21526000
                dt'size,,,,sectors'per'track );                         21528000
   IF NOT(proc'status) THEN                                             21530000
      BEGIN                                                             21532000
         genmsg(pvmsgset,vierr62);                                      21534000
         return'status:=false;                                          21536000
         RETURN;                                                        21538000
      END;                                                              21540000
                                                                        21542000
   bit'map'size:=DBL(bit'map'pages)*DBL(page'size);                     21544000
   dt'size'sectors:=DBL(dt'size/sector'size);                           21546000
   IF (dt'size MOD sector'size) <> 0 THEN dt'size'sectors:=             21548000
                                    dt'size'sectors+1D;                 21550000
                                                                        21552000
   IF mv THEN     << read flab to get Directory address/size >>         21554000
      BEGIN                                                             21556000
         proc'status:=Get'Disc'Info(ldev,temp,true);                    21558000
         IF NOT(proc'status) THEN                                       21560000
            BEGIN                                                       21562000
               genmsg(pvmsgset,vierr62);                                21564000
               return'status:=false;                                    21566000
               RETURN;                                                  21568000
            END;                                                        21570000
         dirbase:=DBL( temp(disc'lab'dirbase) );                        21572000
         dirsize:=DBL( temp(disc'lab'dirsize) );                        21574000
      END;                                                              21576000
                                                                        21578000
   << check to make sure that there are no deleted trks >>              21580000
   << in the reserved area- we must put the dt'table,   >>              21582000
   << bit map, Dirc in the same place                   >>              21584000
   proc'status:=tablespace(ldev,dtt,bit'map'address,                    21586000
                           bit'map'size);                               21588000
   IF < THEN                                                            21590000
      BEGIN                                                             21592000
         genmsg(pvmsgset,vierr68);                                      21594000
         return'status:=false;                                          21596000
         RETURN;                                                        21598000
      END                                                               21600000
   ELSE                                                                 21602000
      IF > THEN                                                         21604000
         BEGIN                                                          21606000
            genmsg(pvmsgset,vierr62);                                   21608000
            return'status:=false;                                       21610000
            RETURN;                                                     21612000
         END;                                                           21614000
                                                                        21616000
   proc'status:=tablespace(ldev,dtt,dt'address,dt'size'sectors);        21618000
   IF < THEN                                                            21620000
      BEGIN                                                             21622000
         genmsg(pvmsgset,vierr68);                                      21624000
         return'status:=false;                                          21626000
         RETURN;                                                        21628000
      END                                                               21630000
   ELSE                                                                 21632000
      IF > THEN                                                         21634000
         BEGIN                                                          21636000
            genmsg(pvmsgset,vierr62);                                   21638000
            return'status:=false;                                       21640000
            RETURN;                                                     21642000
         END;                                                           21644000
                                                                        21646000
   IF mv THEN                                                           21648000
      BEGIN                                                             21650000
         proc'status:=tablespace(ldev,dtt,dirbase,dirsize);             21652000
         IF < THEN                                                      21654000
            BEGIN                                                       21656000
               genmsg(pvmsgset,vierr68);                                21658000
               return'status:=false;                                    21660000
               RETURN;                                                  21662000
            END                                                         21664000
         ELSE IF > THEN                                                 21666000
                 BEGIN                                                  21668000
                    genmsg(pvmsgset,vierr62);                           21670000
                    return'status:=false;                               21672000
                    RETURN;                                             21674000
                 END;                                                   21676000
      END;                                                              21678000
                                                                        21680000
   << now mark the word in the disc label- so that if      >>           21682000
   << anything happens before you can finish recovering -  >>           21684000
   << (system crashes), no one will be able to allocate    >>           21686000
   << on this device and can just start recover again      >>           21688000
   << NOTE if in trying to w/r any of the DFSM or          >>           21690000
   <<      disc label, just mark ldt extension as bad      >>           21692000
   <<      this way no one will be able to to allocate on  >>           21694000
   <<      this device since the state of the bit map,     >>           21696000
   <<      dt'table may be partially initialized           >>           21698000
   <<      if system does crash when system comes up it    >>           21700000
   <<      will try to read these areas and it will mark   >>           21702000
   <<      as bad, dont worry, only worry about NOW -      >>           21704000
   <<      we dont want anyone to use it                   >>           21706000
                                                                        21708000
   << if cant mark the disc label then just return         >>           21710000
   << since havent done anything yet                       >>           21712000
                                                                        21714000
   proc'status:=Read'Disc(ldev,disc'label'address,0,                    21716000
                          temp,sector'size);                            21718000
   IF NOT(proc'status) THEN                                             21720000
      BEGIN                                                             21722000
         genmsg(pvmsgset,vierr62);                                      21724000
         return'status:=false;                                          21726000
         RETURN;                                                        21728000
      END;                                                              21730000
   temp(disc'lab'dfs'map'ok):=false;                                    21732000
   proc'status:=Write'Disc'Label(ldev,0,temp);                          21734000
   IF NOT(proc'status) THEN                                             21736000
      BEGIN                                                             21738000
         genmsg(pvmsgset,vierr62);                                      21740000
         return'status:=false;                                          21742000
         RETURN;                                                        21744000
      END;                                                              21746000
                                                                        21748000
   << now everything is ok so go and mark the descriptors  >>           21750000
   << and bit map to initial state. Already have the file, >>           21752000
   << ldt,dirc sir locked up, also system logging disabled >>           21754000
   << Since disc is mounted, it already has a DFSM DST.    >>           21756000
   << OR if allocation has been disabled, maybe there is no DST. >>     21758000
   << Since you are the only one on- NO ONE should be lined>>           21760000
   << up for the DFSM DST so delete it. IF allocation is   >>           21762000
   << disabled then it will just clear the bits in the     >>           21764000
   << ldt extension. NOTE the Delete''Dfs'Data'Seg gets the>>           21766000
   << ldt sir but you already have it so its ok            >>           21768000
   << From here on, if ther is any I/O errors, leave   >>               21770000
   << the disc'lab'dfs'map'ok as false and mark the ldt    >>           21772000
   << extension as this ldev is bad. The area that     >>               21774000
   << will be reading/writting are needed area and if  >>               21776000
   << something is wrong w them then no one should     >>               21778000
   << be allocating/deallocating                       >>               21780000
                                                                        21782000
   << forget about calling Deallocate cuz going to rebuild >>           21784000
   << the DFSM                                             >>           21786000
   Delete'Dfs'Data'Seg(ldev);                                           21788000
                                                                        21790000
   << now get the descriptor buffer & initialize >>                     21792000
   PUSH(s);                                                             21794000
   TOS:=TOS+1;                                                          21796000
   @descr'table:=TOS;                                                   21798000
   TOS:=dt'size;      << in words >>                                    21800000
   ASSEMBLE(adds 0);                                                    21802000
                                                                        21804000
   << initialize the table >>                                           21806000
                                                                        21808000
   descr'table:=0;                                                      21810000
   MOVE descr'table(1):=descr'table,(dt'size-1);                        21812000
                                                                        21814000
   << now create the Descr table for the disc, initialize  >>           21816000
   << the Descr table to all free                          >>           21818000
                                                                        21820000
                                                                        21822000
   descr'table   (largest'space):=0;                                    21824000
   descr'table   (starting'space):=bits'per'page;                       21826000
   descr'table   (ending'space  ):=bits'per'page;                       21828000
                                   << dont do last entry >>             21830000
   MOVE descr'table(dt'entry'size):=descr'table,(bit'map'pages *        21832000
                                     dt'entry'size - dt'entry'size*2);  21834000
                                                                        21836000
   << now figure out the last page size so can fill in the >>           21838000
   << last Descr entry by calculating page,word,bit        >>           21840000
                                                                        21842000
                                                                        21844000
   TOS:=disc'size-1D;    << last valid addr for disc           >>       21846000
   TOS:=DBL(bits'per'page);                                             21848000
   ASSEMBLE(ddiv;     << leaves DBL(pg#),DBL(rem)           >>          21850000
            dxch;     <<        DBL(rem),DBL(pg#)           >>          21852000
            delb);    <<        DBL(rem),INT(pg#)           >>          21854000
   page:=TOS;                                                           21856000
                                                                        21858000
   << now word and bit number                               >>          21860000
                                                                        21862000
   ASSEMBLE(delb);    << convert rem to INT                 >>          21864000
   TOS:=bits'per'word;                                                  21866000
   ASSEMBLE(div);     << leaves INT(word#),INT(bit#)        >>          21868000
   bit:=TOS;                                                            21870000
   word:=TOS;                                                           21872000
                                                                        21874000
   << now that have page,word and bit, calculate how many  >>           21876000
   << sectors are actually in the last page of bit map     >>           21878000
                                                                        21880000
                                                                        21882000
   descr'table(page*dt'entry'size + largest'space):=0;                  21884000
   descr'table(page*dt'entry'size + starting'space):=                   21886000
                 word*bits'per'word + bit + 1; << #sect,not adr >>      21888000
                                                                        21890000
   << if the last page of the bit map is a full page, then  >>          21892000
   << ending'space=starting'space. Otherwise if the last    >>          21894000
   << page is a partial page, then ending'space=0           >>          21896000
                                                                        21898000
                                                                        21900000
   IF descr'table(page*dt'entry'size + starting'space) =                21902000
      bits'per'page THEN                                                21904000
      descr'table(page*dt'entry'size + ending'space):=                  21906000
                                              bits'per'page             21908000
   ELSE                                                                 21910000
      descr'table(page*dt'entry'size +ending'space):=0;                 21912000
                                                                        21914000
                                                                        21916000
   proc'status:=Write'Disc(ldev,dt'address,0<<stack>>,descr'table,      21918000
                      dt'size);                                         21920000
   IF NOT(proc'status) THEN                                             21922000
      BEGIN                                                             21924000
         genmsg(pvmsgset,vierr61);                                      21926000
         return'status:=false;                                          21928000
         proc'status.error'type:=dt'write'error;                        21930000
         Process'Dfs'Error(ldev,proc'status,[8/50,8/4]);                21932000
         RETURN;                                                        21934000
      END;                                                              21936000
                                                                        21938000
   << create and write out the bit map - page by page >>                21940000
                                                                        21942000
   buffer:=empty'buffer;                                                21944000
   MOVE buffer(1):=buffer,(words'per'page-1);                           21946000
   buffer(check'sum'word):=0;  << initialize >>                         21948000
   buffer(check'sum'word):=Make'Check'Sum(buffer,                       21950000
                                          actual'words'per'page);       21952000
                                                                        21954000
   << buffer is now set-up for all the pages except for the   >>        21956000
   << last page, write out all the bit map except for the     >>        21958000
   << last one(last one may be a partial page)                >>        21960000
                                                                        21962000
   wr'adr:=bit'map'address;                                             21964000
   dummy<<descr'entcntr>>:=1;                                           21966000
   DO BEGIN                                                             21968000
      proc'status:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,            21970000
                         actual'words'per'page);                        21972000
      IF NOT(proc'status) THEN                                          21974000
         BEGIN                                                          21976000
            genmsg(pvmsgset,vierr61);                                   21978000
            return'status:=false;                                       21980000
            proc'status.error'type:=bit'map'write'error;                21982000
            Process'Dfs'Error(ldev,proc'status,[8/51,8/4]);             21984000
         END;                                                           21986000
      wr'adr:=wr'adr + DBL(page'size);                                  21988000
   END UNTIL (dummy<<descr'entcntr>>:=dummy +1) >=                      21990000
                             bit'map'pages;                             21992000
                                                                        21994000
   << now use word and bit to figure out how much of the last  >>       21996000
   << page is actually part of the bit map page. The rest of   >>       21998000
   << the bit map page is filled with zeroes                   >>       22000000
                                                                        22002000
                                                                        22004000
   IF descr'table(page*dt'entry'size + starting'space) =                22006000
      bits'per'page THEN                                                22008000
      BEGIN                                                             22010000
         proc'status:=Write'Disc(ldev,wr'adr,0<<stack>>,buffer,         22012000
                            actual'words'per'page);                     22014000
         IF NOT(proc'status) THEN                                       22016000
            BEGIN                                                       22018000
               genmsg(pvmsgset,vierr61);                                22020000
               return'status:=false;                                    22022000
               proc'status.error'type:=bit'map'write'error;             22024000
               Process'Dfs'Error(ldev,proc'status,[8/52,8/4]);          22026000
               RETURN;                                                  22028000
            END;                                                        22030000
      END                                                               22032000
   ELSE                                                                 22034000
      BEGIN                                                             22036000
         buffer:=0;                                                     22038000
         MOVE buffer(1):=buffer,(words'per'page-1);                     22040000
         IF word > 0 THEN                 << mark full wds >>           22042000
            BEGIN                                                       22044000
               buffer:=empty'buffer;                                    22046000
               MOVE buffer(1):=buffer,(word-1); <<wont do if cnt=0 >>   22048000
            END;                                                        22050000
         dummy<<bitcnt>>:=0;                                            22052000
         buffer(word).(0:1):=1;                                         22054000
         WHILE (dummy<<bitcnt>>:=dummy + 1) <= bit DO                   22056000
               buffer(word):=buffer(word) &ASR(1);                      22058000
         buffer(check'sum'word):=0;  << initialize >>                   22060000
         buffer(check'sum'word):=Make'Check'Sum(buffer,                 22062000
                                 actual'words'per'page);                22064000
         proc'status:=Write'disc(ldev,wr'adr,0<<stack>>,buffer,         22066000
                            actual'words'per'page);                     22068000
         IF NOT(proc'status) THEN                                       22070000
            BEGIN                                                       22072000
               genmsg(pvmsgset,vierr61);                                22074000
               return'status:=false;                                    22076000
               proc'status.error'type:=bit'map'write'error;             22078000
               Process'Dfs'Error(ldev,proc'status,[8/53,8/4]);          22080000
               RETURN;                                                  22082000
            END;                                                        22084000
                                                                        22086000
      END;          << last page full/not full >>                       22088000
                                                                        22090000
   << now everything in initial state make the disc label >>            22092000
   << reflect this                                        >>            22094000
                                                                        22096000
   proc'status:=Read'Disc(ldev,disc'label'address,0,                    22098000
                          temp,sector'size);                            22100000
   IF NOT(proc'status) THEN                                             22102000
      BEGIN                                                             22104000
         genmsg(pvmsgset,vierr69);                                      22106000
         return'status:=false;                                          22108000
         proc'status.error'type:=disc'label'read'error;                 22110000
         Process'Dfs'Error(ldev,proc'status,[8/54,8/4]);                22112000
         RETURN;                                                        22114000
      END;                                                              22116000
   temp(disc'lab'dirty'dt'flag):=false;                                 22118000
   temp(disc'lab'dt'checksum):=make'check'sum(descr'table,              22120000
                                       dt'size);                        22122000
   << must set to ok or Create'Dfs'Data'Seg wont create >>              22124000
   << a DFSM DST. Will mark as "bad" later              >>              22126000
   temp(disc'lab'dfs'map'ok):=true;                                     22128000
                                                                        22130000
   proc'status:=Write'Disc'Label(ldev,0,temp);                          22132000
   IF NOT(proc'status) THEN                                             22134000
       BEGIN                                                            22136000
          genmsg(pvmsgset,vierr69);                                     22138000
          return'status:=false;                                         22140000
          proc'status.error'type:=disc'label'write'error;               22142000
          Process'Dfs'Error(ldev,proc'status,[8/55,8/4]);               22144000
          RETURN;                                                       22146000
       END;                                                             22148000
                                                                        22150000
   <<  There is now enough information in the Descr and   >>            22152000
   <<  and Bit map to use the globally defined DFSM       >>            22154000
   <<  routines. Use these routines to allocate space     >>            22156000
                                                                        22158000
   << initialize and get the DST for the DFSM             >>            22160000
   << use the DFSM routines to mark the areas for:        >>            22162000
   <<       1. 0 - 47 reserved                            >>            22164000
   <<       2. Bit Map                                    >>            22166000
   <<       3. Descriptor table                           >>            22168000
   <<       4. Directory                                  >>            22170000
   <<       5. Deleted tracks                             >>            22172000
                                                                        22174000
                                                                        22176000
   <<  initialize and get the DFSM                       >>             22178000
   <<  it also puts the DST # in the LDT                 >>             22180000
                                                                        22182000
                                                                        22184000
   << setcritical so no interrupts honored while accessing  >>          22186000
   << the DFSM                                              >>          22188000
                                                                        22190000
                                                                        22192000
   lcrit:=setcritical;                                                  22194000
   << dont forget to reset critical if error exit >>                    22196000
                                                                        22198000
   proc'status:=Create'Dfs'Data'Seg(ldev,,                              22200000
                     false<<assume'dt'clean>>,                          22202000
                     true<<flag'dt'as'dirty>> );                        22204000
   IF NOT(proc'status) THEN                                             22206000
      BEGIN                                                             22208000
         resetcritical(lcrit);                                          22210000
         IF proc'status = get'dst'error OR                              22212000
            proc'status = get'vm'error THEN                             22214000
            genmsg(pvmsgset,vierr55)                                    22216000
         ELSE genmsg(pvmsgset,vierr69);                                 22218000
         return'status:=false;                                          22220000
         Process'Dfs'Error(ldev,proc'status,[8/56,8/4]);                22222000
         << now mark the disc label disc'lab'dfs'map'ok >>              22224000
         << as false, just in case the system crashes >>                22226000
         proc'status:=Read'Disc(ldev,disc'label'address,                22228000
                                0,temp,sector'size);                    22230000
         temp(disc'lab'dfs'map'ok):=false;                              22232000
         proc'status:=Write'Disc'Label(ldev,0,temp);                    22234000
         RETURN;                                                        22236000
      END;                                                              22238000
                                                                        22240000
   << now read in the disc label again and mark  >>                     22242000
   << disc'lab'dfs'map'ok as false. This way     >>                     22244000
   << if anything happens before all the files   >>                     22246000
   << are recovered, when system comes up alloc  >>                     22248000
   << is disabled - very nice for recovery       >>                     22250000
                                                                        22252000
   proc'status:=Read'Disc(ldev,disc'label'address,                      22254000
                    0,temp,sector'size);                                22256000
   IF NOT(proc'status) THEN                                             22258000
      BEGIN                                                             22260000
         resetcritical(lcrit);                                          22262000
         genmsg(pvmsgset,vierr69);                                      22264000
         return'status:=false;                                          22266000
         Delete'Dfs'Data'Seg(ldev);                                     22268000
         proc'status.error'type:=disc'label'read'error;                 22270000
         Process'Dfs'Error(ldev,proc'status,[8/57,8/4]);                22272000
         RETURN;                                                        22274000
      END;                                                              22276000
   temp(disc'lab'dfs'map'ok):=false;                                    22278000
   proc'status:=Write'Disc'label(ldev,0,temp);                          22280000
   IF NOT(proc'status) THEN                                             22282000
      BEGIN                                                             22284000
         resetcritical(lcrit);                                          22286000
         genmsg(pvmsgset,vierr69);                                      22288000
         return'status:=false;                                          22290000
         Delete'Dfs'Data'Seg(ldev);                                     22292000
         proc'status.error'type:=disc'label'write'error;                22294000
         Process'Dfs'Error(ldev,proc'status,[8/58,8/4]);                22296000
         RETURN;                                                        22298000
      END;                                                              22300000
   <<   not really locking the DST, only really doing the      >>       22302000
   << the EXCHANGEDB to get at the DFSM DST- no one else can   >>       22304000
   << use this pv                                               >>      22306000
   << This way only one routine has to be                       >>      22308000
   << changed if place in LDT where DST# is changed             >>      22310000
                                                                        22312000
   proc'status:=Lock'Dfs'Data'seg(ldev);                                22314000
   IF NOT(proc'status) THEN                                             22316000
      BEGIN                                                             22318000
         << how could this ever happen ? >>                             22320000
         resetcritical(lcrit);                                          22322000
         genmsg(pvmsgset,vierr56);                                      22324000
         return'status:=false;                                          22326000
         Delete'Dfs'Data'Seg(ldev); << get rid of DST >>                22328000
         Process'Dfs'Error(ldev,proc'status,[8/59,8/4]);                22330000
         RETURN;                                                        22332000
      END;                                                              22334000
                                                                        22336000
   <<======= IN SPLIT STACK MODE ======= >>                             22338000
   <<= DO NOT USE ANY DB REL VARIABLES  =>>                             22340000
                                                                        22342000
   << mark reserved area as allocated >>                                22344000
   ds'disc'address:=start'resv'area;                                    22346000
   Convert'Address'To'Map;                                              22348000
   ds'number'of'sectors:=DBL(resv'area'sz);                             22350000
   Set'Reset'Bit'Map(false);                                            22352000
   IF NOT(ds'error'status) THEN                                         22354000
      BEGIN                                                             22356000
         proc'status:=ds'error'status;                                  22358000
         Unlock'Dfs'Data'Seg;                                           22360000
         genmsg(pvmsgset,vierr56);                                      22362000
         Delete'Dfs'Data'Seg(ldev);                                     22364000
         resetcritical(lcrit);                                          22366000
         return'status:=false;                                          22368000
         Process'Dfs'Error(ldev,proc'status,[8/60,8/4]);                22370000
         RETURN;                                                        22372000
      END;                                                              22374000
                                                                        22376000
   <<         Bit Map                >>                                 22378000
   ds'disc'address:=bit'map'address;                                    22380000
   Convert'Address'To'Map;                                              22382000
   ds'number'of'sectors:=bit'map'size;                                  22384000
   Set'Reset'Bit'Map(false);                                            22386000
   IF NOT(ds'error'status) THEN                                         22388000
      BEGIN                                                             22390000
         proc'status:=ds'error'status;                                  22392000
         Unlock'Dfs'Data'Seg;                                           22394000
         genmsg(pvmsgset,vierr56);                                      22396000
         Delete'Dfs'Data'Seg(ldev);                                     22398000
         resetcritical(lcrit);                                          22400000
         return'status:=false;                                          22402000
         Process'Dfs'Error(ldev,proc'status,[8/61,8/4]);                22404000
         RETURN;                                                        22406000
      END;                                                              22408000
                                                                        22410000
   <<    Descriptor table            >>                                 22412000
   ds'disc'address:=dt'address;                                         22414000
   Convert'Address'To'Map;                                              22416000
   ds'number'of'sectors:=dt'size'sectors;                               22418000
   Set'Reset'Bit'Map(false);                                            22420000
   IF NOT(ds'error'status) THEN                                         22422000
      BEGIN                                                             22424000
         proc'status:=ds'error'status;                                  22426000
         Unlock'Dfs'Data'Seg;                                           22428000
         genmsg(pvmsgset,vierr56);                                      22430000
         Delete'Dfs'Data'Seg(ldev);                                     22432000
         resetcritical(lcrit);                                          22434000
         return'status:=false;                                          22436000
         Process'Dfs'Error(ldev,proc'status,[8/62,8/4]);                22438000
         RETURN;                                                        22440000
      END;                                                              22442000
                                                                        22444000
   <<     Directory      >>                                             22446000
   IF mv THEN                                                           22448000
      BEGIN                                                             22450000
         ds'disc'address:=dirbase;                                      22452000
         Convert'Address'To'Map;                                        22454000
         ds'number'of'sectors:=dirsize;                                 22456000
         Set'Reset'Bit'Map(false);                                      22458000
         If NOT(ds'error'status) THEN                                   22460000
            BEGIN                                                       22462000
               proc'status:=ds'error'status;                            22464000
               Unlock'Dfs'Data'Seg;                                     22466000
               genmsg(pvmsgset,vierr56);                                22468000
               Delete'Dfs'Data'Seg(ldev);                               22470000
               resetcritical(lcrit);                                    22472000
               return'status:=false;                                    22474000
               Process'Dfs'Error(ldev,proc'status,[8/63,8/4]);          22476000
               RETURN;                                                  22478000
            END;                                                        22480000
      END;                  << master volume >>                         22482000
                                                                        22484000
                                                                        22486000
   << run through the Defective Tracks Table looking     >>             22488000
   << for track which are deleted and are within         >>             22490000
   << the logical pack size                              >>             22492000
   << Take these entries out of the DFSM                 >>             22494000
                                                                        22496000
                                                                        22498000
   IF type <> cs'80'type THEN  << ok dtt may have del entries >>        22500000
   BEGIN                                                                22502000
   dummy << dtt'entcntr >> :=1;                                         22504000
                                                                        22506000
   WHILE dummy << dtt'entcntr >> <= dtt(dtt'number'of'entries)          22508000
   DO BEGIN                                                             22510000
      IF dtt(dummy).dtt'track'code = dtt'deleted AND                    22512000
         DBL( dtt(dummy).dtt'track'number ) * DBL(sectors'per'track)    22514000
         < disc'size THEN                                               22516000
         BEGIN                                                          22518000
            ds'disc'address:=DBL( dtt(dummy).dtt'track'number )         22520000
                             * DBL( sectors'per'track );                22522000
            Convert'Address'To'Map;                                     22524000
            ds'number'of'sectors:=DBL( sectors'per'track );             22526000
            Set'Reset'Bit'Map(false);                                   22528000
            IF NOT(ds'error'status) THEN                                22530000
               BEGIN                                                    22532000
                  proc'status:=ds'error'status;                         22534000
                  Unlock'Dfs'Data'Seg;                                  22536000
                  genmsg(pvmsgset,vierr56);                             22538000
                  Delete'Dfs'Data'Seg(ldev);                            22540000
                  resetcritical(lcrit);                                 22542000
                  return'status:=false;                                 22544000
                  Process'Dfs'Error(ldev,proc'status,[8/64,8/4]);       22546000
                  RETURN;                                               22548000
               END;                                                     22550000
         END;      << deleted out of DFSM >>                            22552000
                                                                        22554000
      dummy<<dtt'entcntr>> :=dummy +1;                                  22556000
      END; << defective track entries >>                                22558000
                                                                        22560000
   END;   << not cs'80 >>                                               22562000
                                                                        22564000
                                                                        22566000
   <<    release the DFSM Dst     >>                                    22568000
   Unlock'Dfs'Data'Seg;                                                 22570000
                                                                        22572000
                                                                        22574000
   << now resetcritical before exit >>                                  22576000
                                                                        22578000
   resetcritical(lcrit);                                                22580000
   << now in initial state, ready to recover the files >>               22582000
                                                                        22584000
   END;    << recover'init >>                                           22586000
$PAGE "   PROCEDURE CHECKSTATUS"                                        22588000
$CONTROL SEGMENT=CONDENSE                                               22590000
LOGICAL PROCEDURE checkdfsmstatus(ldev);                       <<03510>>22592000
   VALUE ldev;                                                          22594000
   INTEGER ldev;                                                        22596000
   OPTION PRIVILEGED,UNCALLABLE;                                        22598000
                                                                        22600000
<<===================================================                   22602000
                                                                        22604000
       looks at the ldt extension to see if any error                   22606000
       for this DFSM. Return'Disc'Space doesnt return                   22608000
       any error status and we really need to know                      22610000
       must not be in split stack mode                                  22612000
                                                                        22614000
   Parameters:                                                          22616000
          ldev - logical device number                                  22618000
                                                                        22620000
   Returns:                                                             22622000
          DFSM status word which was stored in the                      22624000
          LDT extension                                                 22626000
                                                                        22628000
   Assumptions:                                                         22630000
         MUST NOT be in split stack mode !                              22632000
                                                                        22634000
   Globals:                                                             22636000
        ldt'dst,ldt'entry'size                                          22638000
                                                                        22640000
   Callers:                                                             22642000
       cond'receip                                                      22644000
                                                                        22646000
   Fixid:                                                               22648000
      This procedure was added as part of the disc free space           22650000
      map changes, the fixid on the procedure header applies to the     22652000
      whole procedure.                                                  22654000
                                                                        22656000
   Changes:                                                             22658000
                                                                        22660000
====================================================>>                  22662000
BEGIN                                                                   22664000
                                                                        22666000
                                                                        22668000
   INTEGER array ldt'entry(0:ldt'entry'size-1);                         22670000
   INTEGER ldtx'entry'offset;                                           22672000
   LOGICAL return'status = checkdfsmstatus;                             22674000
                                                                        22676000
                                                                        22678000
   TOS:=@ldt'entry;                                                     22680000
   TOS:=ldt'dst;                                                        22682000
   TOS:=0;                                                              22684000
   TOS:=ldt'entry'size;                                                 22686000
   ASSEMBLE(mfds 4);                                                    22688000
                                                                        22690000
   ldtx'entry'offset:=ldt'entry(1) + ldt'entry(3) +                     22692000
                      ldev*ldt'entry'size;                              22694000
                                                                        22696000
   TOS:=@ldt'entry;                                                     22698000
   TOS:=ldt'dst;                                                        22700000
   TOS:=ldtx'entry'offset;                                              22702000
   TOS:=ldt'entry'size;                                                 22704000
   ASSEMBLE(mfds 4);                                                    22706000
                                                                        22708000
   return'status:=ldt'entry(ldtx'dfs'error'word);                       22710000
                                                                        22712000
END;   << checkstatus >>                                                22714000
$PAGE "  PROCEDURE COND'RECEIP "                                        22716000
$CONTROL SEGMENT=CONDENSE                                               22718000
INTEGER PROCEDURE cond'receip(ntry,level,parms,sirs);          <<03510>>22720000
   VALUE level,parms,sirs;                                              22722000
   INTEGER level,parms;                                                 22724000
   DOUBLE sirs;                                                         22726000
   ARRAY ntry;                                                          22728000
   OPTION PRIVILEGED,UNCALLABLE;                                        22730000
                                                                        22732000
BEGIN                                                                   22734000
                                                                        22736000
<<===================================================                   22738000
                                                                        22740000
   this routine is called with DB at Directory DST and                  22742000
   Directory sir locked                                                 22744000
      RETURNS:                                                          22746000
              cond'receip.(15:1)                                        22748000
                                 0 dirc sir not released                22750000
                                 1 dirc sir released                    22752000
              cond'receip.(13:2)                                        22754000
                                 0 continue traversal                   22756000
                                 1 skip subtrees                        22758000
                                 2 stop traversal                       22760000
   If any errors from DFSM, it terminates scan and                      22762000
   aborts. Tell calling procedure by whattodo =-1                       22764000
                                                                        22766000
   Parameters:                                                          22768000
        ntry - pointer to Dirc entry in Dirc DST                        22770000
               (may be file,grp or acct entry)                          22772000
        level - what kind of Dirc entry ntry is                         22774000
        parms - DB rel ptr to array that caller passed                  22776000
                to Dirc routine                                         22778000
        sirs - if want to release the Dirc sir, use this                22780000
               to pass to relsir                                        22782000
                                                                        22784000
   Returns:                                                             22786000
        see intro for format of return word                             22788000
        If any error and must terminate                                 22790000
              whattodo = -1                                             22792000
              msgno    = private vol msg no. for caller                 22794000
                         to print out                                   22796000
                                                                        22798000
   Assumptions:                                                         22800000
           NOTE: this routine is called in split stack mode             22802000
                 therefore no indirect arrays                           22804000
          DB is set to Dirc on entry and will be reset on               22806000
          exit. Dirc sir will NOT be released.                          22808000
                                                                        22810000
   Globals:                                                             22812000
       flab def - flchecksum,flmisc,flstatus,flsrlx,                    22814000
                  flcoldloadid,flsect'numext,                           22816000
                  flnumexts,flvolnum,flastext,flext,                    22818000
                  dflext                                                22820000
       file entry in Directory                                          22822000
       sysdb                                                            22824000
       pverrmsg - viwarn74,viwarn75,vierr77,                            22826000
                  viwarn78,vierr81,vierr82                              22828000
                                                                        22830000
   Callers:                                                             22832000
       Directory who was called by cond                                 22834000
                                                                        22836000
   Fixid:                                                               22838000
      This procedure was added as part of the new disc free space       22840000
      map, the fixid on the procedure header applies to the             22842000
      whole procedure.                                                  22844000
                                                                        22846000
   Changes:                                                             22848000
                                                                        22850000
====================================================>>                  22852000
                                                                        22854000
   INTEGER         return'status       = cond'receip;                   22856000
   DEFINE          sir'status          = (15:1)#;                       22858000
   EQUATE          sir'released        = 0;                             22860000
   EQUATE          sir'not'released    = 1;                             22862000
   DEFINE          dirscanstatus       =(13:2)#;                        22864000
   EQUATE          continue'traversal  = 0;                             22866000
   EQUATE          skip'subtree        = 1;                             22868000
   EQUATE          stop'traversal      = 2;                             22870000
                                                                        22872000
   INTEGER         deltaq              = Q+0;                           22874000
   ARRAY           arrq0(*)            = Q-0;                           22876000
   INTEGER ARRAY   rparms(*);                                           22878000
   ARRAY           vol'set'ldevs(*);     << vol to ldev conv table >>   22880000
   DOUBLE ARRAY    ntryd(*)            = ntry;                          22882000
   DEFINE          glinkage            = integer(ntry (%30))#; <<03777>>22884000
                                                                        22886000
   INTEGER         vtab'of'flab                                         22888000
                  ,flab'ldev                                            22890000
                  ,mychecksum                                           22892000
                  ,dst                                                  22894000
                  ,i                    << index >>                     22896000
                  ,discspace'status                                     22898000
                  ,numexts           << # exts-1 >>                     22900000
                  ,trans'status      << when r/w exts,what >>           22902000
                                     << to do if error     >>           22904000
                  ,trans'words       << # words writting   >>           22906000
                  ,pv     << pv=0 - system otherwise PV >>     <<03777>>22908000
                  ,flaberr  <<flab error flag>>                <<03777>>22910000
                  ;                                                     22912000
                                                                        22914000
   LOGICAL         proc'status                                          22916000
                  ;                                                     22918000
                                                                        22920000
   DOUBLE          flabaddr                                             22922000
                  ,oldaddr                                              22924000
                  ,newaddr                                              22926000
                  ,numberofsectors                                      22928000
                  ,extent        << cntr # exts wrote  >>               22930000
                  ,write'address                                        22932000
                  ,read'address                                         22934000
                  ,ddummy                                               22936000
                  ;                                                     22938000
                                                                        22940000
   INTEGER POINTER flab;                                                22942000
   DOUBLE  POINTER dflab;                                               22944000
   BYTE POINTER bflab;                                                  22946000
   INTEGER POINTER newflab;                                             22948000
   DOUBLE  POINTER dnewflab;                                            22950000
                                                                        22952000
                                                                        22954000
                                                                        22956000
                                                                        22958000
   EQUATE   buffer'len = 36;                                            22960000
   LOGICAL POINTER buffer;                                              22962000
   BYTE POINTER bbuffer;                                                22964000
   BYTE POINTER buf'ptr;                                                22966000
   DEFINE blank'buffer = buffer:="  ";                                  22968000
                         MOVE buffer(1):=buffer,                        22970000
                                         (buffer'len-1)#;               22972000
                                                                        22974000
<< use global array buff for transferring >>                            22976000
                                                                        22978000
   INTEGER POINTER transfer;   << global array buff >>                  22980000
   EQUATE trans'sector'size = buffsize'; << in sect >>                  22982000
                                                                        22984000
                                                                        22986000
   << rparms definitions >>                                             22988000
                                                                        22990000
   DEFINE          whattodo             = rparms(0)#;                   22992000
   DEFINE          volumesetldevs       = rparms(1)#;                   22994000
   DEFINE          msgno                = rparms(2)#;                   22996000
   DEFINE          condldev             = rparms(3)#;                   22998000
   DEFINE          thisvol              = rparms(4)#;                   23000000
   DEFINE          p'mvtabx             = rparms(5)#;                   23002000
$PAGE " SUBROUTINE CLEANUP "                                            23004000
SUBROUTINE cleanup;                                            <<03510>>23006000
                                                                        23008000
   BEGIN                                                                23010000
                                                                        23012000
<<===================================================                   23014000
                                                                        23016000
   This subroutine tries to cleanup the mess when you                   23018000
   encounter an I/O error on writting the FLAB                          23020000
   There are 2 cases:                                                   23022000
   1. I/O error on writting flab to new space that just                 23024000
      got                                                               23026000
         keep this space because somethings wrong with it               23028000
         and make new flab have the old ext addr. Dont                  23030000
         have to write the flab cuz already there.                      23032000
         Continue trying to move this file.                             23034000
   2. I/O error on writting flab and extent that got is                 23036000
      NOT the one which contains the file label                         23038000
         mark the Directory as bad so that cant access                  23040000
         it and tell the user. Then return to the Dirc                  23042000
         routine cuz we dont want to look at this file                  23044000
         anymore                                                        23046000
                                                                        23048000
   Assumptions:                                                         23050000
         NOT in split stack mode                                        23052000
                                                                        23054000
   Globals:                                                             23056000
        flab defs - dflext,flcchecksum                                  23058000
        File entry in Dirc                                              23060000
        pvmsgs - viwarn78                                               23062000
                                                                        23064000
        modifies  - newflab, Dirc file entry                            23066000
                                                                        23068000
   Changes:                                                             23070000
                                                                        23072000
====================================================>>                  23074000
                                                                        23076000
      IF i = 0 THEN     << case 1 >>                                    23078000
         BEGIN                                                          23080000
            dnewflab(dflext+i):=dflab(dflext+i);                        23082000
            newchecksum;                                                23084000
            newflab(flchecksum):=TOS;                                   23086000
            << keep this bad space so no one else >>                    23088000
            << can get it                         >>                    23090000
            flabaddr:=oldaddr;  << set back flab addr >>                23092000
         END                                                            23094000
      ELSE                                                              23096000
         BEGIN          << case 2 >>                                    23098000
                                                                        23100000
            exchangedb(dst);   << go to Dirc >>                         23102000
            ntry(2).(0:1):=dirc'bad'file;                               23104000
            dds(dadirty).dirtyf:=1;                                     23106000
            dirwrite(a);                                                23108000
            dst:=exchangedb(0);                                         23110000
                                                                        23112000
            << now gen a msg >>                                         23114000
            blank'buffer;                                               23116000
            MOVE bbuffer:=bflab,(8);                                    23118000
            SCAN bbuffer UNTIL "  ",1;                                  23120000
            @buf'ptr:=TOS;                                              23122000
            buf'ptr:=".";                                               23124000
            @buf'ptr:=@buf'ptr+1;                                       23126000
            MOVE buf'ptr:=bflab(8),(8);                                 23128000
            SCAN buf'ptr UNTIL "  ",1;                                  23130000
            @buf'ptr:=TOS;                                              23132000
            buf'ptr:=".";                                               23134000
            @buf'ptr:=@buf'ptr+1;                                       23136000
            MOVE buf'ptr:=bflab(16),(8);                                23138000
            SCAN buf'ptr UNTIL "  ",1;                                  23140000
            @buf'ptr:=TOS;                                              23142000
            buf'ptr:=0;                                                 23144000
            genmsg(pvmsgset,viwarn83,%0,                                23146000
                   @bbuffer);                                           23148000
                                                                        23150000
                                                                        23152000
            << dont have to do any changes to new flab >>               23154000
            << cuz we arent going to do anything w this>>               23156000
            << file anymore                            >>               23158000
                                                                        23160000
            Return'Disc'Space(condldev,newaddr,                         23162000
                              numberofsectors);                         23164000
            << dont care about status >>                                23166000
         END;                                                           23168000
                                                                        23170000
   END;   << cleanup >>                                                 23172000
$PAGE " PROCEDURE COND'RECEIP "                                         23174000
                                                                        23176000
                                                                        23178000
   << ** in split stack mode when enter this procedure ** >>            23180000
                                                                        23182000
                                                                        23184000
   return'status:=0;   << clear it >>                                   23186000
   << never releasing sir so set status here >>                         23188000
   return'status.sir'status:=sir'not'released;                          23190000
                                                                        23192000
   << pick up the file label address and vol table address  >>          23194000
   << out of the Directory file entry                       >>          23196000
                                                                        23198000
   TOS:=ntryd(2);                                                       23200000
   vtab'of'flab:=s1.(0:8);                                              23202000
   s1.(0:8):=0;                                                         23204000
   flabaddr:=TOS;                                                       23206000
   pv := glinkage.(0:1);      << get type of group >>          <<03777>>23208000
   flaberr := ntry(2).(0:1);                                   <<03777>>23210000
                                                                        23212000
   << ** get out of split stack mode, set back to stack ** >>           23214000
                                                                        23216000
   dst:=exchangedb(0);                                                  23218000
                                                                        23220000
   << set ptr to   rparms  >>                                           23222000
                                                                        23224000
   @rparms:=@arrq0(parms-deltaq);                                       23226000
                                                                        23228000
   IF level <> filelevel THEN                                           23230000
      BEGIN                                                             23232000
         IF whattodo = -1 THEN                                          23234000
            return'status.dirscanstatus:=stop'traversal                 23236000
         ELSE                                                           23238000
            << If COND system volume then skip all groups   >> <<03777>>23240000
            << which belong to private volume.              >> <<03777>>23242000
            IF level = grouplevel AND                          <<03777>>23244000
               p'mvtabx = 0 AND pv = 1 THEN                    <<03777>>23246000
            return'status.dirscanstatus:=skip'subtree          <<03777>>23248000
            ELSE                                               <<03777>>23250000
            return'status.dirscanstatus:=continue'traversal;            23252000
         exchangedb(dst);                                               23254000
         RETURN;                                                        23256000
      END;                                                              23258000
                                                                        23260000
   << check for bad file entries, only 2 cases I know of    >>          23262000
   <<    file label addr = %77777777                        >>          23264000
   <<                      supposedly if restoring a file   >>          23266000
   <<                      and system crashes               >>          23268000
   <<    ntry(2)           word 2 of Dirc file entry has    >>          23270000
   <<                      bit (0:1) set                    >>          23272000
   <<                      Dirc's way of marking a bad file >>          23274000
   <<                      file label (prob I/O error )     >>          23276000
                                                                        23278000
   IF flabaddr = bad'addr OR flaberr = dirc'bad'file THEN      <<03777>>23280000
      BEGIN                                                             23282000
         return'status.dirscanstatus:=continue'traversal;               23284000
         exchangedb(dst);                                               23286000
         RETURN;                                                        23288000
      END;                                                              23290000
                                                                        23292000
   << allocate all the arrays >>                                        23294000
                                                                        23296000
   PUSH(s);                                                             23298000
   TOS:=TOS+1;                                                          23300000
   @flab:=TOS;                                                          23302000
   TOS:=sector'size;                                                    23304000
   ASSEMBLE(adds 0);                                                    23306000
                                                                        23308000
   @dflab:=@flab;                                                       23310000
   @bflab:=(@flab) &lsl(1);                                             23312000
                                                                        23314000
   PUSH(s);                                                             23316000
   TOS:=TOS+1;                                                          23318000
   @newflab:=TOS;                                                       23320000
   TOS:=sector'size;                                                    23322000
   ASSEMBLE(adds 0);                                                    23324000
                                                                        23326000
   @dnewflab:=@newflab;                                                 23328000
                                                                        23330000
   PUSH(s);                                                             23332000
   TOS:=TOS+1;                                                          23334000
   @buffer:=TOS;                                                        23336000
   TOS:=buffer'len;                                                     23338000
   ASSEMBLE(adds 0);                                                    23340000
                                                                        23342000
   @bbuffer:=(@buffer) &lsl(1);                                         23344000
                                                                        23346000
   @transfer:=@buff(0);                                                 23348000
                                                                        23350000
   << set up ptr to ldevs in vol set >>                                 23352000
                                                                        23354000
   @vol'set'ldevs:=volumesetldevs;                                      23356000
   << ldev of file label isn't in vol set def then          >>          23358000
   << don't look at the rest of this file label             >>          23360000
   IF (flab'ldev:=vol'set'ldevs(vtab'of'flab)) = 0 THEN                 23362000
      BEGIN                                                             23364000
         return'status.dirscanstatus:=continue'traversal;               23366000
         exchangedb(dst);                                               23368000
         RETURN;                                                        23370000
      END;                                                              23372000
                                                                        23374000
   << read in the file label for this file  >>                          23376000
                                                                        23378000
   proc'status:=Read'Disc(flab'ldev,flabaddr,0,flab,sector'size);       23380000
   IF NOT(proc'status) THEN                                             23382000
      BEGIN                                                             23384000
         genmsg(pvmsgset,viwarn74,%12000,flab'ldev,                     23386000
                @flabaddr);                                             23388000
         return'status.dirscanstatus:=continue'traversal;               23390000
         exchangedb(dst);                                               23392000
         RETURN;                                                        23394000
      END;                                                              23396000
                                                                        23398000
   << check the checksum - another test for a good label >>             23400000
                                                                        23402000
   oldchecksum;                                                         23404000
   mychecksum:=TOS;                                                     23406000
   IF mychecksum <> flab(flchecksum) THEN                               23408000
      BEGIN                                                             23410000
         << print out a nice error msg >>                               23412000
         blank'buffer;                                                  23414000
         MOVE bbuffer:=bflab,(8);                                       23416000
         SCAN bbuffer UNTIL "  ",1;                                     23418000
         @buf'ptr:=TOS;                                                 23420000
         buf'ptr:=".";                                                  23422000
         @buf'ptr:=@buf'ptr+1;                                          23424000
         MOVE buf'ptr:=bflab(8),(8);                                    23426000
         SCAN buf'ptr UNTIL "  ",1;                                     23428000
         @buf'ptr:=TOS;                                                 23430000
         buf'ptr:=".";                                                  23432000
         @buf'ptr:=@buf'ptr+1;                                          23434000
         MOVE buf'ptr:=bflab(16),(8);                                   23436000
         SCAN buf'ptr UNTIL "  ",1;                                     23438000
         @buf'ptr:=TOS;                                                 23440000
         buf'ptr:=0;                                                    23442000
         genmsg(pvmsgset,viwarn75,%0,@bbuffer);                         23444000
         return'status.dirscanstatus:=continue'traversal;               23446000
         exchangedb(dst);                                               23448000
         RETURN;                                                        23450000
      END;                                                              23452000
                                                                        23454000
   << now make sure that it's ok to move this file   >>                 23456000
   << There are system files which have a ldev/addr in sys >>           23458000
   << global area, such as sl,catalog,confdata. On a       >>           23460000
   << running system these files will be open so they will >>           23462000
   << never be touched, but if a stand-alone did a cond    >>           23464000
   << it would have to make sure it didnt touch these files>>           23466000
                                                                        23468000
   IF ( flab(flmisc).flstatus <> 0 OR flab(flmisc).flsrlx <> 0 )        23470000
      AND                                                               23472000
      flab(flcoldloadid) = sys'cold'loadid THEN                         23474000
      BEGIN                                                             23476000
         return'status.dirscanstatus:=continue'traversal;               23478000
         exchangedb(dst);                                               23480000
         RETURN;                                                        23482000
      END;                                                              23484000
                                                                        23486000
   << now run through the file label looking for extent on   >>         23488000
   << this ldev                                               >>        23490000
                                                                        23492000
   numexts:=flab(flsect'numext).flnumexts;                              23494000
                                                                        23496000
   MOVE newflab:=flab,(sector'size);   << copy flab >>                  23498000
                                                                        23500000
   i:=-1;   << initialize for scan >>                                   23502000
   WHILE (i:=i+1) <= numexts DO                                         23504000
      BEGIN                                                             23506000
         IF flab(flvol+i*2).flvolnum = thisvol THEN                     23508000
            BEGIN                                                       23510000
               TOS:=dflab(dflext+i);                                    23512000
               s1.(0:8):=0;                                             23514000
               oldaddr:=TOS;                                            23516000
                                                                        23518000
               IF i = numexts THEN      << what's ext sz >>             23520000
                  numberofsectors:=DBL(LOGICAL(flab(fllastext)))        23522000
               ELSE                                                     23524000
                  numberofsectors:=DBL(LOGICAL(flab(flext)));           23526000
                                                                        23528000
               << call Get'Disc'Space to find space           >>        23530000
               << this is very dependent upon the disc space  >>        23532000
               << routines. It assumes that they do a FIRST   >>        23534000
               << fit. Condense depends upon this!!           >>        23536000
               << Locate'Free'space and Find'Page run through >>        23538000
               << the descriptors to try to find space to     >>        23540000
               << satisfy the request. Set'Reset'Bit'Map is   >>        23542000
               << the one who actually changes the bits.      >>        23544000
               << IF in setting/resetting the bits it finds   >>        23546000
               << that they are not in the correct state, it  >>        23548000
               << will disable'int allocation on this ldev and>>        23550000
               << send a message to the operator              >>        23552000
               << We will abide by disc'space and not continue>>        23554000
               << CONDensing this ldev because the bit map    >>        23556000
               << /descriptors are messed up and to continue  >>        23558000
               << condensing would just mess it up more       >>        23560000
               << pass back a status to main routine to       >>        23562000
               << tell that aborted                           >>        23564000
               << NOTE: Get'Disc'Space assumes that is at     >>        23566000
               <<       the stack                             >>        23568000
                                                                        23570000
another'ext:   << this label is if I got a i/o error on       >>        23572000
               << moving the extent, I want to get another    >>        23574000
               << extent                                      >>        23576000
                                                                        23578000
               newaddr:=0D;                                             23580000
               discspace'status:=Get'Disc'Space(condldev,               23582000
                                  numberofsectors,newaddr );            23584000
               IF discspace'status <> 0 THEN                            23586000
                  BEGIN                                                 23588000
                     IF discspace'status = 1 THEN                       23590000
                                                                        23592000
                        << couldnt get the space for this >>            23594000
                        << extent so quit looking at this >>            23596000
                        << file. IF any previous extents  >>            23598000
                        << got moved the flab already got >>            23600000
                        << updated                        >>            23602000
                                                                        23604000
                        go to exit                                      23606000
                     ELSE                                               23608000
                                                                        23610000
                        BEGIN  << some kind of problem w DFSM >>        23612000
                                                                        23614000
                           whattodo:=-1; << terminate scan >>           23616000
                           msgno:=vierr0;                               23618000
                           genmsg(pvmsgset,vierr77);                    23620000
                           IF discspace'status = 2 THEN                 23622000
                              genmsg(pvmsgset,vierr82)                  23624000
                           ELSE                                         23626000
                              genmsg(pvmsgset,viwarn81);                23628000
                           return'status.dirscanstatus:=                23630000
                                      stop'traversal;                   23632000
                           exchangedb(dst);                             23634000
                           RETURN;                                      23636000
                        END;                                            23638000
                     END;                                               23640000
                                                                        23642000
               << now since we are depending upon the  >>               23644000
               << the disc space  routine to do our    >>               23646000
               << moving for us- check to make sure we >>               23648000
               << are really condensing toward the     >>               23650000
               << low part of the disc                 >>               23652000
                                                                        23654000
               IF newaddr >= oldaddr THEN << forget it, >>              23656000
                  BEGIN                 << dont move  >>                23658000
                     Return'Disc'Space(condldev,newaddr,                23660000
                                       numberofsectors);                23662000
                     GO TO cont'trans;                                  23664000
                  END;                                                  23666000
                                                                        23668000
                                                                        23670000
               << now write out the extent to new address    >>         23672000
                                                                        23674000
               trans'status:=0;  << if i/o error >>                     23676000
               extent:=0D;                                              23678000
               write'address:=newaddr;                                  23680000
               read'address:=oldaddr;                                   23682000
               trans'words:=trans'sector'size * sector'size;            23684000
                                                                        23686000
               WHILE extent < numberofsectors DO                        23688000
                  BEGIN                                                 23690000
                     << not a full transfer ? >>                        23692000
                     IF extent + DBL(trans'sector'size) >               23694000
                        numberofsectors THEN                            23696000
                        trans'words:=INT(numberofsectors-extent)        23698000
                                      * sector'size;                    23700000
                     proc'status:=Read'Disc(condldev,                   23702000
                                  read'address,0,transfer,              23704000
                                  trans'words);                         23706000
                     IF NOT(proc'status) THEN                           23708000
                        BEGIN                                           23710000
                           << this is a hokey way of getting  >>        23712000
                           << out of this loop                >>        23714000
                           extent:=numberofsectors;                     23716000
                           trans'status:=1;                             23718000
                        END                                             23720000
                     ELSE                                               23722000
                        BEGIN                                           23724000
                           proc'status:=Write'Disc(condldev,            23726000
                                        write'address,0,transfer,       23728000
                                        trans'words);                   23730000
                           IF NOT(proc'status) THEN                     23732000
                              BEGIN                                     23734000
                                 << something wrong w this space,  >>   23736000
                                 << keep it                        >>   23738000
                                 GO TO another'ext;                     23740000
                              END;                                      23742000
                           read'address:=read'address+                  23744000
                                       DBL(trans'sector'size);          23746000
                           write'address:=write'address+                23748000
                                          DBL(trans'sector'size);       23750000
                           extent:=extent + DBL(                        23752000
                                   trans'words/sector'size);            23754000
                        END;                                            23756000
                  END; << of moving this extent >>                      23758000
                                                                        23760000
               IF trans'status = 1 THEN                                 23762000
                  BEGIN                                                 23764000
                     << error on read of extent do not move >>          23766000
                     Return'Disc'Space(condldev,newaddr,                23768000
                                       numberofsectors);                23770000
                  END                                                   23772000
               ELSE                                                     23774000
                  IF trans'status = 0 THEN << a ok >>                   23776000
                     BEGIN                                              23778000
                        << combine vol index + new addr into >>         23780000
                        << 1 word                            >>         23782000
                        TOS:=newaddr;                                   23784000
                        s1.(0:8):=thisvol;                              23786000
                        dnewflab(dflext+i):=TOS;                        23788000
                                                                        23790000
                        << did move the file label >>                   23792000
                        IF i=0 THEN                                     23794000
                           flabaddr:=newaddr;                           23796000
                                                                        23798000
                        << now update the file label every- >>          23800000
                        << time you move an extent. This may>>          23802000
                        << be a lot of I/O but it saves the >>          23804000
                        << user a reload/init               >>          23806000
                                                                        23808000
                        newchecksum;                                    23810000
                        newflab(flchecksum):=TOS;                       23812000
                                                                        23814000
                        proc'status:=Write'Disc(flab'ldev,              23816000
                                   flabaddr,0,newflab,                  23818000
                                   sector'size);                        23820000
                        IF NOT(proc'status) THEN                        23822000
                           BEGIN                                        23824000
                              cleanup;                                  23826000
                              IF i <> 0 THEN                            23828000
                                 << got an I/O error on >>              23830000
                                 << wr flab and not the >>              23832000
                                 << extent that just got>>              23834000
                                 GO TO exit                             23836000
                              ELSE                                      23838000
                                 << got a new flab extent>>             23840000
                                 << but had an I/O error >>             23842000
                                 << on wr to that addr so>>             23844000
                                 << not going to move    >>             23846000
                                 << this extent- will try>>             23848000
                                 << rest of extents      >>             23850000
                                 GO TO cont'trans;                      23852000
                           END;                                         23854000
                                                                        23856000
                        << had good I/O status on write >>              23858000
                        << did the file label move if so>>              23860000
                        << must update the Dirc         >>              23862000
                                                                        23864000
                        IF i = 0 THEN                                   23866000
                           BEGIN                                        23868000
                              ddummy:=dnewflab(dflext+i);               23870000
                              exchangedb(dst);  << sp stack >>          23872000
                              ntryd(2):=ddummy;                         23874000
                              dds(dadirty).dirtyf:=1;                   23876000
                              dirwrite(a);                              23878000
                              dst:=exchangedb(0);                       23880000
                           END;                                         23882000
                                                                        23884000
                        << now release the old space >>                 23886000
                                                                        23888000
                        TOS:=dflab(dflext+i);                           23890000
                        s1.(0:8):=0;                                    23892000
                        ddummy:=TOS;                                    23894000
                        Return'Disc'Space(condldev,ddummy,              23896000
                                     numberofsectors);                  23898000
                        proc'status:=checkdfsmstatus(condldev);         23900000
                        IF NOT(proc'status) THEN                        23902000
                           BEGIN  << gen a warn msg >>                  23904000
                              blank'buffer;                             23906000
                              MOVE bbuffer:=bflab,(8);                  23908000
                              SCAN bbuffer UNTIL "  ",1;                23910000
                              @buf'ptr:=TOS;                            23912000
                              buf'ptr:=".";                             23914000
                              @buf'ptr:=@buf'ptr+1;                     23916000
                              MOVE buf'ptr:=bflab(8),(8);               23918000
                              SCAN buf'ptr UNTIL "  ",1;                23920000
                              @buf'ptr:=TOS;                            23922000
                              buf'ptr:=".";                             23924000
                              @buf'ptr:=@buf'ptr+1;                     23926000
                              MOVE buf'ptr:=bflab(16),(8);              23928000
                              SCAN buf'ptr UNTIL "  ",1;                23930000
                              @buf'ptr:=TOS;                            23932000
                              buf'ptr:=0;                               23934000
                              genmsg(pvmsgset,viwarn78,%0,              23936000
                                     @bbuffer);                         23938000
                           END;                                         23940000
                     END;  << good/bad trans status >>                  23942000
                                                                        23944000
cont'trans:       << come here if we couldn't move the >>               23946000
                  << the extent, Get'Disc'Space gave   >>               23948000
                  << a larger addr or                  >>               23950000
                  << I/O on writting flab continue     >>               23952000
                  << looking                           >>               23954000
            END; << ext vol = thisvol >>                                23956000
      END;     << run through all extent >>                             23958000
                                                                        23960000
                                                                        23962000
exit:     << no space avail for an extent of a file  >>                 23964000
          << so quit looking at this file OR         >>                 23966000
          << I/O error on writting updated flab -    >>                 23968000
          << marked as bad in Dirc so quit looking   >>                 23970000
          << at this file                            >>                 23972000
                                                                        23974000
   << now set back to DIRC >>                                           23976000
                                                                        23978000
   return'status.dirscanstatus:=continue'traversal;                     23980000
                                                                        23982000
   exchangedb(dst);                                                     23984000
                                                                        23986000
END;      << cond'receip >>                                             23988000
$PAGE "   PROCEDURE NO'SUSPECT'TRACKS"                                  23990000
$CONTROL SEGMENT=NEWPACK                                                23992000
   LOGICAL PROCEDURE no'suspect'tracks(ldev);                  <<03510>>23994000
      VALUE ldev;                                                       23996000
      INTEGER ldev;                                                     23998000
      OPTION PRIVILEGED,UNCALLABLE;                                     24000000
                                                                        24002000
   BEGIN                                                                24004000
                                                                        24006000
<<===================================================                   24008000
                                                                        24010000
         returns false if can't read DTT or has                         24012000
         a suspect track                                                24014000
                                                                        24016000
   Parameters:                                                          24018000
           ldev - logical device number                                 24020000
                                                                        24022000
   Returns:                                                             24024000
         T   if ok                                                      24026000
         F   if any suspect tracks or I/O error                         24028000
                                                                        24030000
   Globals:                                                             24032000
         dtt defs - dtt'number'of'entries,dtt'track'code,               24034000
                    dtt'suspect                                         24036000
                                                                        24038000
   Callers:                                                             24040000
        condense'disc                                                   24042000
                                                                        24044000
   Fixid:                                                               24046000
      This procedure was added as part of the changes for the           24048000
      new disc free space map, the fixid on the procedure header        24050000
      applies to the whole procedure.                                   24052000
                                                                        24054000
   Changes:                                                             24056000
                                                                        24058000
====================================================>>                  24060000
                                                                        24062000
                                                                        24064000
      INTEGER                                                           24066000
                   i                                                    24068000
                 ,type                                                  24070000
                  ;                                                     24072000
                                                                        24074000
      LOGICAL        proc'status                                        24076000
                    ;                                                   24078000
                                                                        24080000
      LOGICAL      return'status = no'suspect'tracks                    24082000
                  ;                                                     24084000
                                                                        24086000
                                                                        24088000
      proc'status:=Get'Disc'Info(ldev,,,dtt,type);                      24090000
      IF NOT(proc'status) THEN                                          24092000
         BEGIN                                                          24094000
            return'status:=false;                                       24096000
            RETURN;                                                     24098000
         END;                                                           24100000
                                                                        24102000
      IF type = cs'80'type THEN                                         24104000
         BEGIN                                                          24106000
            IF dtt(dsct'number'of'entries) = 0 THEN                     24108000
               return'status:=true  << no suspect >>                    24110000
            ELSE                                                        24112000
               return'status:=false;  << are suspect >>                 24114000
            RETURN;                                                     24116000
         END;                                                           24118000
                                                                        24120000
      IF dtt(dtt'number'of'entries) = 0 THEN                            24122000
         BEGIN                                                          24124000
            return'status:=true;                                        24126000
            RETURN;                                                     24128000
         END;                                                           24130000
                                                                        24132000
      i:=0;                                                             24134000
      WHILE (i:=i+1) <= dtt(dtt'number'of'entries) DO                   24136000
         BEGIN                                                          24138000
            IF dtt(i).dtt'track'code = dtt'suspect THEN                 24140000
               BEGIN                                                    24142000
                  return'status:=false;                                 24144000
                  RETURN;                                               24146000
               END;                                                     24148000
         END;                                                           24150000
                                                                        24152000
      return'status:=true;                                              24154000
                                                                        24156000
   END;    << no'suspect'tracks >>                                      24158000
$PAGE "   PROCEDURE CONDENSE'DISC "                                     24160000
$CONTROL SEGMENT=CONDENSE                                               24162000
PROCEDURE condense'disc(ldev,recover);                         <<03510>>24164000
   VALUE ldev,recover;                                                  24166000
   INTEGER ldev;                                                        24168000
   LOGICAL recover;                                                     24170000
   OPTION PRIVILEGED,UNCALLABLE;                                        24172000
                                                                        24174000
BEGIN                                                                   24176000
                                                                        24178000
<<===================================================                   24180000
                                                                        24182000
   Verifies the ldev and gets the vol set def for                       24184000
   the vol set that LDEV is a member.                                   24186000
   Once it determines that it is ok, it either                          24188000
   RECOVERs and CONDenses or just CONDenses                             24190000
                                                                        24192000
   Parameters:                                                          24194000
        ldev - logical device number                                    24196000
        recover - logical, if T then want to recover a                  24198000
                  private vol else just condensing ldev                 24200000
                                                                        24202000
   Assumptions:                                                         24204000
        ldev has already been verified as a good ldev                   24206000
        the vol set must be mounted                                     24208000
        turn logging off if was enabled because when                    24210000
        begin to cond/recover it has the file,                          24212000
        dirc,ldt sir locked. The old cond only called                   24214000
         genmsg at most twice but this version calls                    24216000
        genmsg a lot more and there is a possibility                    24218000
        of getting hung up on trying to get an extent                   24220000
        To prevent this, turn logging off.                              24222000
                                                                        24224000
   Globals:                                                             24226000
        sysdb                                                           24228000
        logging flags                                                   24230000
        disc label - disc'lab'type'word,disc'lab'mv,                    24232000
                     disc'lab'set,disc'lab'group'name,                  24234000
                     disc'lab'accnt'name                                24236000
        pvmsgs - vierr0,vierr1,viwarn5,viwarn6,                         24238000
                 vwarn7,vierr67,vierr63,vierr77,                        24240000
                 viwarn80,viwarn81,vierr84                              24242000
                 direcerr                                               24244000
        mvtab entry - mvtablev                                          24246000
        vol table - vol'table'ldev,vol'ent'ldev                         24248000
                                                                        24250000
   Resources:                                                           24252000
         file,ldt,dirc sir                                              24254000
                                                                        24256000
   Callers:                                                             24258000
       cond                                                             24260000
                                                                        24262000
   Fixid:                                                               24264000
      This procedure was added as part of the disc free space map       24266000
      changes, the fixid on the procedure header applies to the         24268000
      whole procedure.                                                  24270000
                                                                        24272000
   Changes:                                                             24274000
                                                                        24276000
====================================================>>                  24278000
                                                                        24280000
   INTEGER            msgnum                                            24282000
                     ,mvtabx                                            24284000
                     ,volume'count                                      24286000
                     ,dirldev                                           24288000
                     ,i           << index,dummy >>                     24290000
                     ,offset      << index,dummy >>                     24292000
                     ,cond'index  << index of ldev in vol'set'ldevs >>  24294000
                     ,savloginfo  << save logging bit >>                24296000
                     ,savflagf   << soft error flag >>                  24298000
                     ;                                                  24300000
    LOGICAL           mv                                                24302000
                     ,proc'status                                       24304000
                     ,dirsirret                                         24306000
                     ,ldtsirret                                         24308000
                     ,filesirret                                        24310000
                     ,logging'off                                       24312000
                     ;                                                  24314000
                                                                        24316000
   DOUBLE             dirbase                                           24318000
                     ,ddummy                                            24320000
                                                                        24322000
                     ;                                                  24324000
                                                                        24326000
   INTEGER ARRAY   rparms(0:9); << 10 wds to receip rout >>             24328000
                                                                        24330000
   DEFINE    whattodo       = rparms(0)#;                               24332000
   DEFINE    volumesetldevs = rparms(1)#;                               24334000
   DEFINE    msgno          = rparms(2)#;                               24336000
   DEFINE    cond'ldev      = rparms(3)#;                               24338000
   DEFINE    thisvolnum     = rparms(4)#;                               24340000
   DEFINE    p'mvtabx       = rparms(5)#;                               24342000
   << 6-9 unused right now >>                                           24344000
                                                                        24346000
   << temp buffer user to get various data structures >>                24348000
                                                                        24350000
   INTEGER ARRAY      temp(0:sector'size-1);                            24352000
   INTEGER ARRAY      vlab(*)    = temp;                                24354000
   INTEGER ARRAY      vsdefn(*)  = temp;                                24356000
   INTEGER ARRAY      mvtabent(*)= temp;                                24358000
   INTEGER ARRAY      vol'ent(*) = temp;                                24360000
                                                                        24362000
   LOGICAL ARRAY      vsid(0:11);  << vol name,grp,accnt >>             24364000
   LOGICAL ARRAY      dummy(*)=vsid;  << used as dummy to DIREC >>      24366000
                                                                        24368000
                                                                        24370000
   INTEGER POINTER    vol'set'ldevs;                                    24372000
                                                                        24374000
   DEFINE             non'sys'domain = lpdt(ldev*2+1).nsdf = 1#;        24376000
                                                                        24378000
   << used to define enable/disable logging  >>                         24380000
                                                                        24382000
   DEFINE disable'int= ASSEMBLE(sed 0)#;                                24384000
   DEFINE enable'int = ASSEMBLE(sed 1)#;                                24386000
   EQUATE loginfo= sysdb +%167;                                         24388000
   EQUATE flagf  = sysdb +%176;                                         24390000
   DEFINE loggingflag = (15:1)#;  << = 0 no logging >>                  24392000
   DEFINE softpreemptlog = (11:1)#;  << = 1 keep stats, but dont >>     24394000
                                       <<log-used when know will >>     24396000
                              << eventually recover from "error" >>     24398000
                                                                        24400000
                                                                        24402000
   << use this to exit the procedure from subroutine >>                 24404000
                                                                        24406000
   DEFINE exit'procedure=ASSEMBLE(exit 2)#;                             24408000
                                                                        24410000
                                                                        24412000
   SUBROUTINE leave(msgnum);                                   <<03510>>24414000
      VALUE msgnum;                                                     24416000
      INTEGER msgnum;                                                   24418000
                                                                        24420000
<<===================================================                   24422000
                                                                        24424000
   called if any errors and must exit from procedure                    24426000
   Optionally prints out an pverr msg if msgnum <> 0                    24428000
   Will also turn logging back on if was previously                     24430000
   enabled                                                              24432000
                                                                        24434000
   Parameters:                                                          24436000
          msgnum - pvmsg number to print out, only if                   24438000
                   <> 0                                                 24440000
                                                                        24442000
   Assumptions:                                                         24444000
          Does an EXIT 2 from procedure if calling sequence             24446000
          changes this MUST change                                      24448000
                                                                        24450000
   Globals:                                                             24452000
        logging flags                                                   24454000
        pvmsgs - viwarn80                                               24456000
                                                                        24458000
   Resources:                                                           24460000
        releases the dirc,ldt,file sirs                                 24462000
                                                                        24464000
   Changes:                                                             24466000
                                                                        24468000
====================================================>>                  24470000
   BEGIN                                                                24472000
                                                                        24474000
      IF msgnum <> 0 THEN                                               24476000
         genmsg(pvmsgset,msgnum);                                       24478000
                                                                        24480000
$IF X3=ON                                                               24482000
      debug;                                                            24484000
$IF                                                                     24486000
                                                                        24488000
   << allow logging >>                                                  24490000
                                                                        24492000
   IF logging'off THEN                                                  24494000
      BEGIN                                                             24496000
         disable'int;                                                   24498000
         ABSOLUTE(loginfo).loggingflag:=savloginfo;                     24500000
         ABSOLUTE(flagf).softpreemptlog:=savflagf;                      24502000
         enable'int;                                                    24504000
      END;                                                              24506000
                                                                        24508000
   << now release the sirs >>                                           24510000
                                                                        24512000
   relsir(dirsir,dirsirret);                                            24514000
   relsir(ldtsir,ldtsirret);                                            24516000
   relsir(filesir,filesirret);                                          24518000
                                                                        24520000
  << generate a message saying that turned logging back on >>           24522000
  << if enabled                                            >>           24524000
   IF logging'off THEN                                                  24526000
      BEGIN                                                             24528000
         genmsg(pvmsgset,viwarn80,,,,,,,0);                             24530000
         logging'off:=false;                                            24532000
      END;                                                              24534000
                                                                        24536000
                                                                        24538000
      exit'procedure;                                                   24540000
                                                                        24542000
   END;   << leave >>                                                   24544000
$PAGE                                                                   24546000
   logging'off:=false;   << initialize >>                               24548000
                                                                        24550000
   rparms:=0;                                                           24552000
   MOVE rparms(1):=rparms,(9);                                          24554000
                                                                        24556000
   << now do some initial checking before actually condensing >>        24558000
   << the disc                                                >>        24560000
                                                                        24562000
   << get space for storing the ldevs from the mvtab entry    >>        24564000
   << right now the max amount of discs configurable is 16    >>        24566000
                                                                        24568000
   PUSH(s);                                                             24570000
   TOS:=TOS+1;                                                          24572000
   @vol'set'ldevs:=TOS;                                                 24574000
   TOS:=max'discs+1;       << waste entry 0 >>                          24576000
   ASSEMBLE(adds 0);                                                    24578000
                                                                        24580000
                                                                        24582000
   << initialize  vol'set'ldevs >>                                      24584000
   vol'set'ldevs:=0;                                                    24586000
   MOVE vol'set'ldevs(1):=vol'set'ldevs,(max'discs);                    24588000
                                                                        24590000
   << logging enabled >>                                                24592000
                                                                        24594000
   IF ABSOLUTE(loginfo).loggingflag THEN                                24596000
      BEGIN                                                             24598000
                                                                        24600000
         << going to disable system logging because i dont want >>      24602000
         << to get hung up on file sir if log file needs an extent >>   24604000
         << first generate a message to console/log file        >>      24606000
         genmsg(pvmsgset,viwarn79,,,,,,,0);                             24608000
                                                                        24610000
         disable'int;                                                   24612000
         savloginfo:=ABSOLUTE(loginfo).loggingflag;                     24614000
         ABSOLUTE(loginfo).loggingflag:=0;                              24616000
         savflagf:=ABSOLUTE(flagf).softpreemptlog;                      24618000
         ABSOLUTE(flagf).softpreemptlog:=1;                             24620000
         enable'int;                                                    24622000
         logging'off:=true;                                             24624000
      END;                                                              24626000
                                                                        24628000
   << now get all the sirs before beginning to check >>                 24630000
   << everything                                     >>                 24632000
                                                                        24634000
   filesirret:=getsir(filesir);                                         24636000
   ldtsirret:=getsir(ldtsir);                                           24638000
   dirsirret:=getsir(dirsir);                                           24640000
                                                                        24642000
   << is it a system domain or non-system domain disc ? >>              24644000
   << do some checking for this                         >>              24646000
                                                                        24648000
   IF non'sys'domain THEN                                               24650000
      BEGIN                                                             24652000
                                                                        24654000
         << if recovering the disc check to see if      >>              24656000
         << anyone is on or has temp files, $oldpass    >>              24658000
         << if so generate a warning                    >>              24660000
         << must be the only one on because dont want   >>              24662000
         << anyone getting space on the recover disc    >>              24664000
         << plus have dirc sir so no one can access/    >>              24666000
         << modify any file - cuz only have 1 dirc sir, >>              24668000
         << not one for each vol set                    >>              24670000
                                                                        24672000
         IF recover AND NOT(special'entry) THEN                         24674000
            IF NOT(only'one'on) THEN                                    24676000
            BEGIN                                                       24678000
               genmsg(pvmsgset,viwarn6);                                24680000
               recover:=false;  << just cond, dont recover >>           24682000
            END;                                                        24684000
                                                                        24686000
         << read the disc label to get the vol set name >>              24688000
         << group, account                              >>              24690000
                                                                        24692000
         proc'status:=Read'Disc(ldev,0D,0,vlab<<temp>>,sector'size);    24694000
         IF NOT(proc'status) THEN leave(vierr63);                       24696000
                                                                        24698000
         << is it a master volume ? >>                                  24700000
         mv:=vlab(disc'lab'type'word).disc'lab'mv;                      24702000
                                                                        24704000
                                                                        24706000
         MOVE vsid:=vlab(disc'lab'set),(4);                             24708000
         MOVE vsid(4):=vlab(disc'lab'group'name),(4);                   24710000
         MOVE vsid(8):=vlab(disc'lab'accnt'name),(4);                   24712000
                                                                        24714000
         getvsdefn(vsid,vsdefn<<temp>>,,msgnum);                        24716000
         IF <> THEN                                                     24718000
            BEGIN                                                       24720000
               genmsg(pvmsgset,msgnum);                                 24722000
               leave(vierr84);                                          24724000
            END;                                                        24726000
                                                                        24728000
         mvtabx:=vsdefn(vdmisc).mvtabxf;                                24730000
         IF mvtabx = 0 THEN  << a non-sys domain disc must >>           24732000
            BEGIN            << be > 0                     >>           24734000
               genmsg(pvmsgset,viwarn5);                                24736000
               leave(0);                                                24738000
            END;                                                        24740000
                                                                        24742000
         volume'count:=vsdefn(vdinfo).numvol;                           24744000
                                                                        24746000
         getmvtabentry(mvtabx,mvtabent<<temp>>);                        24748000
                                                                        24750000
         << get the ldev & address of the vol set directory >>          24752000
         dirldev:=mvtabent(mvtabldev).ldevf;                            24754000
         TOS:=mvtabent(mvtabldev);                                      24756000
         TOS:=TOS.(8:8);          << strip off "ldev" >>                24758000
         TOS:=mvtabent(mvtabldev+1);                                    24760000
         dirbase:=TOS;                                                  24762000
                                                                        24764000
         << look at the mvtab entry and get the ldevs of  >>            24766000
         << all the vols in the volset and make sure all  >>            24768000
         << of the vols in the vol set are mounted        >>            24770000
                                                                        24772000
         << look at word 2 of 2 word mvtab entry entry >>               24774000
                                                                        24776000
         cond'index:=-1;    << initialize >>                            24778000
         offset:=5;                                                     24780000
         i:=0;    << waste entry 0 >>                                   24782000
         WHILE (i:=i+1) <= volume'count DO                              24784000
           BEGIN                                                        24786000
              vol'set'ldevs(i):=mvtabent( offset+(i-1)*2 ).ldevf;       24788000
              IF vol'set'ldevs(i) = 0 THEN << all vols must >>          24790000
                 BEGIN                     << be mounted    >>          24792000
                    genmsg(pvmsgset,viwarn5);                           24794000
                    leave(0);                                           24796000
                 END                                                    24798000
              ELSE  IF vol'set'ldevs(i)=ldev THEN                       24800000
                       cond'index:=i;                                   24802000
           END;                                                         24804000
                                                                        24806000
        << is ldev a part of this vol set? >>                           24808000
                                                                        24810000
        IF cond'index < 0 THEN                                          24812000
           BEGIN                                                        24814000
              genmsg(pvmsgset,vierr39);                                 24816000
              leave(0);                                                 24818000
           END;                                                         24820000
     END                                                                24822000
  ELSE                                                                  24824000
     BEGIN         << check sys domain ldev >>                          24826000
                                                                        24828000
        << asked for "recover" of sys disc - not allowed >>             24830000
        IF recover THEN                                                 24832000
           BEGIN                                                        24834000
              genmsg(pvmsgset,viwarn7);                                 24836000
              recover:=false;                                           24838000
           END;                                                         24840000
        mvtabx:=0;   << get sys mvtab entry >>                          24842000
        getmvtabentry(mvtabx,mvtabent <<temp>>);                        24844000
                                                                        24846000
        << get the sys ldev and directory address >>                    24848000
                                                                        24850000
        dirldev:=mvtabldev.ldevf;                                       24852000
        TOS:=mvtabent(mvtabldev);                                       24854000
        TOS:=TOS.(8:8);   << strip off ldev >>                          24856000
        TOS:=mvtabent(mvtabldev+1);                                     24858000
        dirbase:=TOS;                                                   24860000
                                                                        24862000
        << now since the mvtab table doesnt have all the  >>            24864000
        << sys ldevs, look at the volume table to find    >>            24866000
        << all the ldevs                                  >>            24868000
                                                                        24870000
        << get the header info >>                                       24872000
                                                                        24874000
        Move'From'Data'Seg(vol'table'dst,0,16,vol'ent);                 24876000
        volume'count:=vol'ent(num'sys'vol);                             24878000
        offset:=vol'ent(0).vol'table'ent'size; <<or sz of ent >>        24880000
                                                                        24882000
                                                                        24884000
        cond'index:=-1;                                                 24886000
        i:=0;      << waste entry 0 >>                                  24888000
        WHILE (i:=i+1) <= volume'count DO                               24890000
           BEGIN                                                        24892000
              Move'From'Data'Seg(vol'table'dst,i*offset,                24894000
                              offset,vol'ent);                          24896000
              << a deleted vol has vol'ent(0) = 0 >>                    24898000
              IF vol'ent(vol'table'ldev).vol'ent'ldev <>                24900000
                 0 AND vol'ent(0) <> 0 THEN                             24902000
                 BEGIN                                                  24904000
                    vol'set'ldevs(i):=vol'ent(vol'table'ldev)           24906000
                                      .vol'ent'ldev;                    24908000
                    IF vol'set'ldevs(i)=ldev THEN                       24910000
                       cond'index:=i;                                   24912000
                 END;                                                   24914000
           END;                                                         24916000
                                                                        24918000
        IF cond'index < 0 THEN                                          24920000
           BEGIN                                                        24922000
              genmsg(pvmsgset,vierr39);                                 24924000
              leave(vierr84);                                           24926000
           END;                                                         24928000
                                                                        24930000
     END;                                                               24932000
                                                                        24934000
   << check all the ldevs for any suspect tracks >>                     24936000
   << NOTE volume'count for sys disc is the max  >>                     24938000
   <<      number of vols, not actual vols-this  >>                     24940000
   <<      is what vol'table(2) has              >>                     24942000
                                                                        24944000
   i:=0;  << waste entry 0 >>                                           24946000
   WHILE (i:=i+1) <= volume'count DO                                    24948000
      BEGIN                                                             24950000
         IF vol'set'ldevs(i) <> 0 THEN                                  24952000
            BEGIN                                                       24954000
               proc'status:=no'suspect'tracks(vol'set'ldevs(i));        24956000
               IF NOT(proc'status) THEN                                 24958000
                  BEGIN                                                 24960000
                     genmsg(pvmsgset,vierr67,%10000,                    24962000
                            vol'set'ldevs(i));                          24964000
                  END;                                                  24966000
            END;                                                        24968000
      END;                                                              24970000
                                                                        24972000
   << you are finally done with all the checking  >>                    24974000
   << now actually cond the disc                  >>                    24976000
                                                                        24978000
                                                                        24980000
   volumesetldevs:=@vol'set'ldevs;                                      24982000
   cond'ldev:=ldev;                                                     24984000
   thisvolnum:=cond'index;                                              24986000
   p'mvtabx:=mvtabx;                                                    24988000
                                                                        24990000
   IF recover THEN                                                      24992000
      BEGIN                                                             24994000
         << tell user that RECOVER is beginning >>                      24996000
         genmsg(pvmsgset,viwarn57);                                     24998000
                                                                        25000000
         proc'status:=recover'init(mv,ldev);                            25002000
         IF NOT(proc'status) THEN leave(vierr0);                        25004000
                                                                        25006000
         << now begin to recover the files >>                           25008000
                                                                        25010000
         ddummy:=direcscan(%120,0D,dummy,dummy,dummy,                   25012000
                           recover'receip,rparms,mvtabx);               25014000
         << an error from the Directory or in receip >>                 25016000
         IF <> THEN   << from Directory >>                              25018000
            BEGIN                                                       25020000
               genmsg(pvmsgset,direcerr);                               25022000
               leave(vierr0);                                           25024000
            END                                                         25026000
         ELSE                                                           25028000
            IF whattodo = -1 THEN                                       25030000
               leave(msgno);                                            25032000
                                                                        25034000
         << finished Recovery, set disc'lab'dfs'map'ok  >>              25036000
         << to true                                     >>              25038000
                                                                        25040000
         proc'status:=Read'Disc(ldev,disc'label'address,                25042000
                                 0,temp,sector'size);                   25044000
         temp(disc'lab'dfs'map'ok):=true;                               25046000
         proc'status:=Write'Disc'Label(ldev,0,temp);                    25048000
                                                                        25050000
         << tell the user so he knows whats going on >>                 25052000
                                                                        25054000
         genmsg(pvmsgset,viwarn58);                                     25056000
                                                                        25058000
         whattodo:=0;    << initialize for 2nd pass through Dirc >>     25060000
         msgno:=0;                                                      25062000
                                                                        25064000
         << now condense it >>                                          25066000
                                                                        25068000
         ddummy:=direcscan(%120,0D,dummy,dummy,dummy,                   25070000
                           cond'receip,rparms,mvtabx);                  25072000
                                                                        25074000
         IF <> THEN     << error from dirc >>                           25076000
            BEGIN                                                       25078000
               genmsg(pvmsgset,direcerr);                               25080000
               leave(vierr0);                                           25082000
            END                                                         25084000
         ELSE                                                           25086000
            IF whattodo = -1 THEN leave(msgno);                         25088000
      END                                                               25090000
   ELSE                                                                 25092000
      BEGIN     << regular cond >>                                      25094000
                                                                        25096000
         << before beginning to COND, make sure that the >>             25098000
         << LDEV has allocation enabled                  >>             25100000
         proc'status:=checkdfsmstatus(ldev);                            25102000
         IF NOT(proc'status) THEN                                       25104000
            BEGIN                                                       25106000
               genmsg(pvmsgset,vierr77);                                25108000
               leave(viwarn81);                                         25110000
            END;                                                        25112000
                                                                        25114000
         << dont care about the 2 word status because >>                25116000
         << i am looking at the whole Directory &     >>                25118000
         << not modifying anything                    >>                25120000
         ddummy:=direcscan(%120,0D,dummy,dummy,dummy,cond'receip,       25122000
                   rparms,mvtabx);                                      25124000
         << an error from the Directory or in receip routine >>         25126000
         IF <> THEN   << from directory >>                              25128000
            BEGIN                                                       25130000
               genmsg(pvmsgset,direcerr);                               25132000
               leave(vierr0);                                           25134000
            END                                                         25136000
         ELSE    << from virecip routine  >>                            25138000
            BEGIN                                                       25140000
               IF whattodo = -1 THEN leave(msgno);                      25142000
            END;                                                        25144000
   END;                                                                 25146000
                                                                        25148000
   IF logging'off THEN                                                  25150000
       BEGIN                                                            25152000
         << now enable logging if it was previously enabled >>          25154000
         disable'int;                                                   25156000
         ABSOLUTE(loginfo).loggingflag:=savloginfo;                     25158000
         ABSOLUTE(flagf).softpreemptlog:=savflagf;                      25160000
         enable'int;                                                    25162000
      END;                                                              25164000
                                                                        25166000
                                                                        25168000
   << release the sirs >>                                               25170000
   relsir(dirsir,dirsirret);                                            25172000
   relsir(ldtsir,ldtsirret);                                            25174000
   relsir(filesir,filesirret);                                          25176000
                                                                        25178000
   << generate a message to say logging enabled if was before>>         25180000
                                                                        25182000
   IF logging'off THEN                                                  25184000
      BEGIN                                                             25186000
         genmsg(pvmsgset,viwarn80,,,,,,,0);                             25188000
         logging'off:=false;                                            25190000
      END;                                                              25192000
                                                                        25194000
   END;   << cond'disc >>                                               25196000
$PAGE "  PROCEDURE PFRE"                                                25198000
$CONTROL SEGMENT=PVSTATUS                                               25200000
$INCLUDE INCLFREE                                                       25202000
$PAGE "PROCEDURE IS'IT'LINUS"                                  <<03537>>25206000
$CONTROL SEGMENT=LINUS                                         <<03537>>25208000
LOGICAL PROCEDURE Is'It'Linus(Ldev);                           <<03537>>25210000
VALUE   Ldev;                                                  <<03537>>25212000
INTEGER Ldev;                                                  <<03537>>25214000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25216000
                                                               <<03537>>25218000
<< To decide if a given Ldev is a Linus                      >><<03537>>25220000
<< drive based on type and subtype.                          >><<03537>>25222000
                                                               <<03537>>25224000
BEGIN                                                          <<03537>>25226000
   INTEGER Type;                                               <<03537>>25228000
   INTEGER Subtype;                                            <<03537>>25230000
   Is'It'Linus := FALSE;                                       <<03537>>25232000
   Type := Ldevtotype(Ldev);                                   <<03537>>25234000
   IF < THEN RETURN;                                           <<03537>>25236000
                                                               <<03537>>25238000
   Subtype := Ldevtosubtype(Ldev);                             <<03537>>25240000
   IF < THEN RETURN;                                           <<03537>>25242000
                                                               <<03537>>25244000
   Is'It'Linus := Type = cs'80'type LAND                       <<03537>>25246000
                  Subtype = St'9110;                           <<03537>>25248000
END;                                                           <<03537>>25250000
$PAGE "PROCEDURE LOCK"                                         <<03537>>25252000
$CONTROL SEGMENT=LINUS                                         <<03537>>25254000
PROCEDURE Lock(Ldev);                                          <<03537>>25256000
VALUE Ldev;                                                    <<03537>>25258000
INTEGER Ldev;                                                  <<03537>>25260000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25262000
                                                               <<03537>>25264000
<< Intended to Disallow Operator Release request on          >><<03537>>25266000
<< Linus drive. Could be extended for CS'80 discs.           >><<03537>>25268000
<< Calls driver with function code LOCK, defined             >><<03537>>25270000
<< somewhere in an equate.                                   >><<03537>>25272000
                                                               <<03537>>25274000
BEGIN                                                          <<03537>>25276000
   LOGICAL Other'Locking'Device := FALSE;                      <<03537>>25278000
   ARRAY Junk'Buffer (0:Linus'Sector - 1);                     <<03537>>25280000
   INTEGER Qmisc := 0;                                         <<03537>>25282000
   INTEGER Errors := 0;                                        <<03537>>25284000
   EQUATE Lock = 16;                                           <<03537>>25286000
                                                               <<03537>>25288000
   IF Is'It'Linus(Ldev) LOR Other'Locking'Device THEN          <<03537>>25290000
   BEGIN                                                       <<03537>>25292000
      Linusio(Ldev,Qmisc,Junk'buffer,Lock,Linus'Sector,0D,     <<03537>>25294000
              Blocked'IO,NO'SPARING,0,Errors);                 <<03537>>25296000
   END;                                                        <<03537>>25298000
END;                                                           <<03537>>25300000
$PAGE "PROCEDURE UNLOCK"                                       <<03537>>25302000
$CONTROL SEGMENT=LINUS                                         <<03537>>25304000
PROCEDURE Unlock(Ldev);                                        <<03537>>25306000
VALUE Ldev;                                                    <<03537>>25308000
INTEGER Ldev;                                                  <<03537>>25310000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25312000
                                                               <<03537>>25314000
<< Intended to Re-allow Operator Release request on          >><<03537>>25316000
<< Linus drive. Could be extended for CS'80 discs.           >><<03537>>25318000
<< Calls driver with function code UNLOCK, defined           >><<03537>>25320000
<< somewhere in an equate.                                   >><<03537>>25322000
                                                               <<03537>>25324000
BEGIN                                                          <<03537>>25326000
   LOGICAL Other'Locking'Device := FALSE;                      <<03537>>25328000
   ARRAY Junk'Buffer (0:Linus'Sector - 1);                     <<03537>>25330000
   INTEGER Qmisc := 0;                                         <<03537>>25332000
   INTEGER Errors := 0;                                        <<03537>>25334000
   EQUATE Unlock = 17;                                         <<03537>>25336000
                                                               <<03537>>25338000
   IF Is'It'Linus(Ldev) LOR Other'Locking'Device THEN          <<03537>>25340000
   BEGIN                                                       <<03537>>25342000
      Linusio(Ldev,Qmisc,Junk'buffer,Unlock,Linus'Sector,0D,   <<03537>>25344000
              Blocked'IO,NO'SPARING,0,Errors);                 <<03537>>25346000
   END;                                                        <<03537>>25348000
END;                                                           <<03537>>25350000
$PAGE "PROCEDURE ENABLE'BREAK"                                 <<03537>>25352000
$CONTROL SEGMENT=LINUS                                         <<03537>>25354000
PROCEDURE Enable'Break;                                        <<03537>>25356000
BEGIN                                                          <<03537>>25358000
   LOGICAL Dummy;                                              <<03537>>25360000
   EQUATE File'num = 1;  <<someday this should be fixed      >><<03537>>25362000
                         <<by passing a real File'num.       >><<03537>>25364000
   EQUATE En'Break = 15;                                       <<03537>>25366000
   Fcontrol(File'num,En'break,Dummy);                          <<03537>>25368000
END;                                                           <<03537>>25370000
$PAGE "PROCEDURE DISABLE'BREAK"                                <<03537>>25372000
$CONTROL SEGMENT=LINUS                                         <<03537>>25374000
PROCEDURE Disable'Break;                                       <<03537>>25376000
BEGIN                                                          <<03537>>25378000
   LOGICAL Dummy;                                              <<03537>>25380000
   EQUATE File'num = 1;  <<someday this should be fixed      >><<03537>>25382000
                         <<by passing a real File'num.       >><<03537>>25384000
   EQUATE Dis'Break = 14;                                      <<03537>>25386000
   Fcontrol(File'num,Dis'break,Dummy);                         <<03537>>25388000
END;                                                           <<03537>>25390000
$PAGE "PROCEDURE LINUS'NUMBERS"                                <<03537>>25392000
$CONTROL SEGMENT=LINUS                                         <<03537>>25394000
                                                               <<03537>>25396000
LOGICAL PROCEDURE Linus'Numbers(Ldev,Buffer);                  <<03537>>25398000
VALUE Ldev;                                                    <<03537>>25400000
INTEGER Ldev;                                                  <<03537>>25402000
ARRAY Buffer;                                                  <<03537>>25404000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25406000
                                                               <<03537>>25408000
<< This innocent procedure goes out to                       >><<03537>>25410000
<< get the device specific numbers for                       >><<03537>>25412000
<< the Serial Label for Linus Cartridges.                    >><<03537>>25414000
<< The only other device dependent                           >><<03537>>25416000
<< information will written to the                           >><<03537>>25418000
<< label is the Type and Subtype of                          >><<03537>>25420000
<< the device which is done earlier.                         >><<03537>>25422000
<< After this procedure executes, the array                  >><<03537>>25424000
<< Buff in Servol has been overlaid with                     >><<03537>>25426000
<< exactly 7 words of useful data starting                   >><<03537>>25428000
<< with element Buff(Wordspersectr).                         >><<03537>>25430000
<< After this we are ready to write a Serial                 >><<03537>>25432000
<< Label.                                                    >><<03537>>25434000
                                                               <<03537>>25436000
BEGIN                                                          <<03537>>25438000
   INTEGER ARRAY Words'Per'Sector(*)  = Buffer(0);             <<03537>>25440000
   INTEGER ARRAY Sectors'Per'Track(*) = Buffer(1);             <<03537>>25442000
   INTEGER ARRAY BOT(*)               = Buffer(2);             <<03537>>25444000
   DOUBLE ARRAY Tape'Mark(*)          = Buffer(3);             <<03537>>25446000
   DOUBLE ARRAY EOT(*)                = Buffer(5);             <<03537>>25448000
                                                               <<03537>>25450000
   DEFINE BYLER'S'NUMBER = 16D#;                               <<03537>>25452000
   EQUATE Linus'SPT = 1;  << A System Wide Definition        >><<03537>>25454000
   EQUATE Unformatted = 0;                                     <<03537>>25456000
                                                               <<03537>>25458000
<< The following two equates are the only places where       >><<03537>>25460000
<< the load point is defined for the Serial label on         >><<03537>>25462000
<< Linus tape cartridges. The size of Gap Table is           >><<03537>>25464000
<< calculated in Servol based on the numbers returned        >><<03537>>25466000
<< here. If it becomes necessary to make the Gap Table       >><<03537>>25468000
<< bigger than 4 Linus sectors, just change the              >><<03537>>25470000
<< equates here, and the whole system will recognize it.     >><<03537>>25472000
                                                               <<03537>>25474000
   EQUATE Small'Load'Point = 8;  << A System Wide Definition >><<03537>>25476000
   EQUATE Large'Load'Point = 19; << A System Wide Definition >><<04316>>25478000
                                                               <<03537>>25480000
<< Following define is for the last adressable               >><<03537>>25482000
<< sector of data on a small Linus cartridge.                >><<03537>>25484000
<< Remember that sectors address from zero.                  >><<03537>>25486000
                                                               <<03537>>25488000
   DEFINE SMALL'CARTRIDGE'LIMIT = 16351D#;                     <<03537>>25490000
   EQUATE Read'Error'Log = %305;                               <<03537>>25494000
   EQUATE Half'Linus'Sector = 256; << For Double Array       >><<03537>>25500000
   EQUATE Certification'Byte = 23;                             <<03537>>25502000
   <<Above is DB+10 turned into byte address plus offset of 3>><<03537>>25504000
                                                               <<03537>>25506000
   INTEGER Qmisc := 0;                                         <<03537>>25508000
   INTEGER Errors := 0;                                        <<03537>>25510000
   DOUBLE Overrun'Area := BYLER'S'NUMBER;                      <<03537>>25512000
   DOUBLE ARRAY Volume'Limit(0:Half'Linus'Sector - 1);         <<03537>>25514000
   ARRAY Numbers(*) = Volume'Limit;                            <<03537>>25516000
   BYTE ARRAY B'Numbers(*) = Numbers;                          <<03537>>25518000
   DOUBLE Address;                                             <<03537>>25520000
   LOGICAL Message'Qualifier = Address;                        <<03537>>25522000
   LOGICAL Utility'Number    = Address + 1;                    <<03537>>25524000
                                                               <<03537>>25526000
<< The first thing to do is to determine whether             >><<03537>>25528000
<< the media that is mounted has been ever                   >><<03537>>25530000
<< initialized. To determine this is non-trivial             >><<03537>>25532000
<< but the following is the most fool proof way              >><<03537>>25534000
<< we could find.                                            >><<03537>>25536000
<< We use driver function 91 - Initiate Utility              >><<03537>>25538000
<< The parameters passed are as follows:                     >><<03537>>25540000
<< The count only needs to be 20 or so but                   >><<03537>>25542000
<< use 1 Sector for simplicity.                              >><<03537>>25544000
<< P1 is 2 to indicate that information will                 >><<03537>>25546000
<< be returned from the device.                              >><<03537>>25548000
<< P2 is the Utility Number - %305 - Read Error Log          >><<03537>>25550000
<< In the buffer we set up the first 2 words to              >><<03537>>25552000
<< pass parameters to the Utility.                           >><<03537>>25554000
<< Word 0 is a 16 bit quantity indicating how many bytes     >><<03583>>25556000
<< follow.                                                   >><<03583>>25558000
<< Bytes passed as parameters are byte aligned starting      >><<03583>>25560000
<< with the second word.                                     >><<03583>>25562000
<< The parameters used this time are:                        >><<03537>>25564000
<< Word 0 - contains 1 indicating 1 byte to follow           >><<03537>>25566000
<< Byte 2 - contains 0 as a passed parameter.                >><<03583>>25568000
<< The Error Log is returned offset in the                   >><<03537>>25570000
<< same buffer by 10 (decimal) words. The                    >><<03537>>25572000
<< only part we want to see is the Log Header                >><<03537>>25574000
<< which is 4 bytes in length. The last byte (3)             >><<03537>>25576000
<< contains the Type of Certification.                       >><<03537>>25578000
<< If this byte is 0 then the Media hasn't been              >><<03537>>25580000
<< initialized.                                              >><<03537>>25582000
<< Simple, wasn't it ?                                       >><<03537>>25584000
<< If we get a 0 back, the fool                              >><<03537>>25586000
<< hasn't formatted the device yet so we return a            >><<03537>>25588000
<< FALSE and quit. Servol will print an error message        >><<03537>>25590000
<< and return.                                               >><<03537>>25592000
                                                               <<03537>>25594000
   Linus'Numbers := FALSE;                                     <<03537>>25596000
   Numbers := 0;                                               <<03537>>25598000
   MOVE Numbers(1) := Numbers,(Linus'Sector - 1);              <<03537>>25600000
                                                               <<03537>>25602000
   Message'Qualifier := Return'Message;                        <<03537>>25604000
   Utility'Number    := Read'Error'Log;                        <<03537>>25606000
   Numbers(0) := 1;                                            <<03537>>25608000
   B'Numbers(2) := 0;                                          <<03583>>25610000
                                                               <<03537>>25612000
   Linusio(Ldev,Qmisc,Numbers,Initiate'Utility,                <<03537>>25614000
           Linus'Sector,Address,Blocked'IO,                    <<03583>>25616000
           NO'SPARING,Default'Errinfo,Errors);                 <<03537>>25618000
   IF < THEN RETURN;                                           <<03537>>25620000
                                                               <<03537>>25622000
   IF B'Numbers(Certification'Byte) = Unformatted THEN         <<03537>>25624000
   BEGIN                                                       <<03537>>25626000
      Linus'Numbers := FALSE;                                  <<03537>>25628000
      RETURN;                                                  <<03537>>25630000
   END;                                                        <<03537>>25632000
                                                               <<03537>>25634000
<< Otherwise we plod on..                                    >><<03537>>25636000
<< Now we go to the device to see how big                    >><<03537>>25638000
<< it is. We are going to use the Request Volume             >><<03537>>25640000
<< Limit function to get the last sector address             >><<03537>>25642000
<< on the device. RVL is equated somewhere.                  >><<03537>>25644000
<< The RVL function of the driver returns 2 words            >><<03537>>25646000
<< of data in the sector indicating volume limit.            >><<03537>>25648000
<< The driver doesn't set either Count or Tlog so            >><<03537>>25650000
<< we have no idea how many words he is returning.           >><<03537>>25652000
<< We assumed 1 Linus'Sector.                                >><<03537>>25654000
                                                               <<03537>>25656000
   Numbers := 0;                                               <<03537>>25658000
   MOVE Numbers(1) := Numbers,(Linus'Sector - 1);              <<03537>>25660000
                                                               <<03537>>25662000
   Linusio(Ldev,Qmisc,Numbers,Req'Vol'Limit,Linus'Sector,      <<03537>>25664000
           0D,Blocked'IO,NO'SPARING,                           <<03537>>25666000
           Default'Errinfo,Errors);                            <<03537>>25668000
   IF < THEN RETURN;                                           <<03537>>25670000
                                                               <<03537>>25672000
<< Must have been good.                                      >><<03537>>25674000
                                                               <<03537>>25676000
   Words'Per'Sector := Linus'Sector;                           <<03537>>25678000
   Sectors'Per'Track := Linus'SPT;                             <<03537>>25680000
                                                               <<03537>>25682000
   IF Volume'Limit <= SMALL'CARTRIDGE'SIZE THEN                <<03537>>25684000
      BOT := Small'Load'Point                                  <<03537>>25686000
   ELSE                                                        <<03537>>25688000
      BOT := Large'Load'Point;                                 <<03537>>25690000
                                                               <<03537>>25692000
<< Subtract the Overrun'Area to place the Tape'Mark.         >><<03537>>25694000
                                                               <<03537>>25696000
   Tape'Mark := Volume'Limit - Overrun'Area;                   <<03537>>25698000
   EOT := Volume'Limit;                                        <<03537>>25700000
   Linus'Numbers := TRUE;                                      <<03537>>25702000
END;                                                           <<03537>>25704000
$PAGE "PROCEDURE LINUSIO"                                      <<03537>>25706000
$CONTROL SEGMENT=LINUS                                         <<03537>>25708000
INTEGER PROCEDURE Linusio(Ldev,Qmisc,Buf,Funct,Wc,Addr,Flags,  <<03537>>25710000
                  Spare'Mode,Errinfo,Err'Return);              <<03537>>25712000
VALUE Ldev,Funct,Wc,Addr,Flags,Spare'Mode,Errinfo;             <<03537>>25714000
INTEGER Ldev,Qmisc,Funct,Wc,Flags;                             <<03537>>25716000
LOGICAL Spare'Mode,Errinfo,Err'return;                         <<03537>>25718000
DOUBLE Addr;                                                   <<03537>>25720000
ARRAY Buf;                                                     <<03537>>25722000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>25724000
                                                               <<03537>>25726000
<< General Purpose routine for doing I/O to                  >><<03537>>25728000
<< Linus Tape Drive.                                         >><<03537>>25730000
<< Calling Attackio directly from all over                   >><<03537>>25732000
<< the code is not very tasteful, hence                      >><<03537>>25734000
<< Linusio.                                                  >><<03537>>25736000
<< Has been modeled after Discio routine                     >><<03537>>25738000
<< contained elsewhere in this listing, but                  >><<03537>>25740000
<< has been made more general and flexible                   >><<03537>>25742000
<< than Discio. If Discio had been                           >><<03537>>25744000
<< implemented a bit better, this routine                    >><<03537>>25746000
<< would have been unnecessary.                              >><<03537>>25748000
                                                               <<03537>>25750000
<< Variables of interest:                                    >><<03537>>25752000
<< ---------------------                                     >><<03537>>25754000
<< Ldev       - passed directly to Attachio.                 >><<03537>>25756000
<< Qmisc      - Passed straight to Attackio, apparently      >><<03537>>25758000
<<              Hioctap0 uses this.                          >><<03537>>25760000
<< Buf        - Buffer containing data going to/             >><<03537>>25762000
<<              coming from Linus, this has to be            >><<03537>>25764000
<<              at least Linus'sector in size.               >><<03537>>25766000
<<              We do some gymnastics here to pass           >><<03537>>25768000
<<              an address to buffer as an integer.          >><<03537>>25770000
<< Funct      - Driver function, passed to Attackio          >><<03537>>25772000
<< Wc         - The length of the data transfer.             >><<03537>>25774000
<< Addr       - The double sector address.                   >><<03537>>25776000
<<              This is split into P1 and P2 and             >><<03537>>25778000
<<              passed to Attackio.                          >><<03537>>25780000
<< Flags      - Depending on the state of the device's       >><<03537>>25782000
<<              LPDT entry, we may                           >><<03537>>25784000
<<              'OR' in bit #10 so that we never             >><<03537>>25786000
<<              allow Attackio to use Sdiscio,               >><<03537>>25788000
<<              then we pass this directly to                >><<03537>>25790000
<<              Attackio. See note later in code.            >><<03537>>25792000
<< Spare'Mode - Indicates whether we want to                 >><<03537>>25794000
<<              use jump or skip sparing.                    >><<03537>>25796000
<<              This flag is 'OR'ed into Top                 >><<03537>>25798000
<<              bit of P1.                                   >><<03537>>25800000
<<              TRUE implies Skip Sparing                    >><<03537>>25802000
<<              FALSE implies Jump Sparing                   >><<03537>>25804000
<<              This flag only valid during W or WL          >><<03537>>25806000
<<              functions.                                   >><<03537>>25808000
<<              The flag is also required for Fill Sector    >><<03537>>25810000
<<              with Blanks or Fill Sector with Zeroes,      >><<03537>>25812000
<<              but those operations are not used            >><<03537>>25814000
<<              in Vinit presently.                          >><<03537>>25816000
<< Errinfo    - Emulates Input Flags of Errinfo of Discio    >><<03537>>25818000
<<              Values Follow.                               >><<03537>>25820000
<<              (15:1) = 0 - Omit Disc Error Message         >><<03537>>25822000
<<                       1 - Print Disc Error Message.       >><<03537>>25824000
<<              (14:1) = 0 - Don't Return Error Status       >><<03537>>25826000
<<                     = 1 - Return Error To Caller.         >><<03537>>25828000
<<              (13:1) = 0 - Omit Function Abort Message     >><<03537>>25830000
<<                       1 - Print Function Abort Message    >><<03537>>25832000
<< Err'Return - Emulates the information that                >><<03537>>25834000
<<              Discio returned in Errinfo.                  >><<03537>>25836000
                                                               <<03537>>25838000
<< This function returns the Attachio Tlog                   >><<03537>>25840000
<< and sets CCL if it had problems doing I/O.                >><<03537>>25842000
                                                               <<03537>>25844000
BEGIN                                                          <<03537>>25846000
   DOUBLE D'Iostat := 0D;                                      <<03537>>25848000
   LOGICAL Iostat = D'Iostat;                                  <<03537>>25850000
   INTEGER Tlog = D'Iostat+1;  << To pick up the Tlog.       >><<03537>>25852000
   INTEGER P1 = Addr;                                          <<03537>>25854000
   INTEGER P2 = Addr+1;                                        <<03537>>25856000
   LOGICAL L'P1 = P1; << will need this to set spare bit.    >><<03537>>25858000
   INTEGER POINTER Bufp = Buf;                                 <<03537>>25860000
   INTEGER Resulting'P1 := 0;                                  <<03537>>25862000
   LOGICAL L'R'P1 = Resulting'P1;                              <<03537>>25864000
   LOGICAL L'Flags = Flags;                                    <<03537>>25866000
   DEFINE P1'FIELD = (1:15)#; <<remainder of P1.             >><<03537>>25868000
   DEFINE  SKP'SPARING = 1#;        <<Get's 'OR'ed into P1   >><<03537>>25870000
   DEFINE  JMP'SPARING = 0#;                                   <<03537>>25872000
   DEFINE EVADE'SDISCIO = 1#;        << We don't want it.    >><<03537>>25874000
   DEFINE SPECIAL'REQUEST = (10:1)#;                           <<03537>>25876000
   DEFINE SPARING'BIT = (0:1)#;                                <<03537>>25878000
   EQUATE Out'Of'Spares = %16; << Attachio Return            >><<03537>>25880000
   EQUATE Uninitialized = %15; << Attachio Return            >><<03537>>25882000
   EQUATE Initialize'Media = 8;                                <<04670>>25884000
                                                               <<03537>>25886000
   CC := CCE;                                                  <<03537>>25888000
   << Now we fiddle around with the parameters.              >><<03537>>25890000
                                                               <<03537>>25892000
<< Ah, sweet mystery of life department:                     >><<03537>>25894000
                                                               <<03537>>25896000
<< There is this bit that is called the special bit          >><<03537>>25898000
<< which is used to get around normal serial disc            >><<03537>>25900000
<< processing and allow the Vinit user to do real I/O        >><<03537>>25902000
<< directly to the device. This is allowed because           >><<03537>>25904000
<< any operation that would affect the integrity of the      >><<03537>>25906000
<< device requires the user to down the device first.        >><<03537>>25908000
<< It seems I underestimated the complexity of               >><<03537>>25910000
<< how this all works. Anyways there is a delicate           >><<03537>>25912000
<< relationship between some code in Attachio and            >><<03537>>25914000
<< what the second word in the LPDT entry for the            >><<03537>>25916000
<< device contains. If you set the special bit               >><<03537>>25918000
<< incorrectly, you will be rewarded with a                  >><<03537>>25920000
<< Suddendeath 613.                                          >><<03537>>25922000
<< In order to prevent this we take a peek at the            >><<03537>>25924000
<< LPDT entry to correctly set the special bit.              >><<03537>>25926000
<< Fields of interest are                                    >><<03537>>25928000
<< 1/LPDT Word 1.DRSTATE (bits 0 for 2)                      >><<03537>>25930000
<<  This field must be 0 when the device is down,            >><<03537>>25932000
<<  but can be 1 when someone is accessing the               >><<03537>>25934000
<<  device. (Like when you do a Plabel when someone          >><<03537>>25936000
<<  else has the device opened.)                             >><<03537>>25938000
<< 2/LPDT Word 1.FORS (bits 11 for 1)                        >><<03537>>25940000
<<  If this bit is 0 then device is Serial,                  >><<03537>>25942000
<<  else Foreign.                                            >><<03537>>25944000
<<  This bit is manipulated by Vinit, Pvproc and             >><<03537>>25946000
<<  set originally by Initial.                               >><<03537>>25948000
<<  I have found it is hard to predict what this             >><<03537>>25950000
<<  bit will be at any given time.                           >><<03537>>25952000
                                                               <<03537>>25954000
<< Anyways, if the device is allocated and                   >><<03537>>25956000
<< a valid serial disc type, then we want to set the         >><<03537>>25958000
<< special bit on.                                           >><<03537>>25960000
<< Otherwise, we leave it off, and the I/O                   >><<03537>>25962000
<< system gives us the same result anyways.                  >><<03537>>25964000
                                                               <<03537>>25966000
   IF Lpdt1.Drstate = 1 AND                                    <<03537>>25968000
      Lpdt1.Fors = 0 THEN                                      <<03537>>25970000
      L'Flags.SPECIAL'REQUEST := EVADE'SDISCIO;                <<03537>>25972000
                                                               <<03537>>25974000
   IF Funct = W OR Funct = WL THEN                             <<03537>>25976000
                                                               <<03537>>25978000
<< If Linusio is ever called with Fill Sector with           >><<03537>>25980000
<< Blanks or Fill Sector with Zeroes, then the above         >><<03537>>25982000
<< check will need to be expanded.                           >><<03537>>25984000
                                                               <<03537>>25986000
   BEGIN                                                       <<03537>>25988000
      L'R'P1 := P1.P1'FIELD; <<Moves lower 15 bits across    >><<03537>>25990000
      IF Spare'Mode THEN                                       <<03537>>25992000
         L'R'P1.SPARING'BIT := SKP'SPARING                     <<03537>>25994000
      ELSE                                                     <<03537>>25996000
         L'R'P1.SPARING'BIT := JMP'SPARING;                    <<03537>>25998000
   END                                                         <<03537>>26000000
   ELSE                                                        <<03537>>26002000
      Resulting'P1 := P1; << Move all 16 bits                >><<03537>>26004000
        << above is a Kludge to take care of a               >><<03537>>26006000
        << HIOCTAP0 problem.                                 >><<03537>>26008000
                                                               <<03537>>26010000
   D'Iostat := Attachio(Ldev,Qmisc,0,@Bufp,Funct,Wc,           <<03537>>26012000
                        Resulting'P1,P2,Flags);                <<03537>>26014000
                                                               <<03537>>26016000
   IF Iostat.GSTATUS <> SUCCESSFUL THEN  <<Unsucessful I/O   >><<03537>>26018000
   BEGIN                                                       <<03537>>26020000
      CC := CCL;                                               <<03537>>26022000
      IF Iostat.QSTATUS = Out'Of'Spares THEN                   <<03537>>26024000
         Genmsg(Pvmsgset,Vierr91)                              <<03537>>26026000
      ELSE IF Iostat.QSTATUS = Uninitialized THEN              <<03537>>26028000
         IF Funct = Initialize'Media THEN                      <<04670>>26030000
            Genmsg(Pvmsgset,Vierr136)                          <<04670>>26032000
         ELSE                                                  <<04670>>26034000
            Genmsg(Pvmsgset,Vierr92)                           <<04670>>26036000
                                                               <<03537>>26038000
  << Above two messages are the only intelligible            >><<03537>>26040000
  << Status returns that the driver gives.                   >><<03537>>26042000
  << All others are like Unit Failure and don't              >><<03537>>26044000
  << really let us give a good message.                      >><<03537>>26046000
                                                               <<03537>>26048000
           ELSE IF Errinfo.(15:1) THEN                         <<03537>>26050000
              Discerror(Ldev,Funct,Iostat,Addr,                <<03537>>26052000
                        Stat.(8:8),Delp);                      <<03537>>26054000
                                                               <<03537>>26056000
      IF Errinfo.(13:1) THEN Genmsg(Pvmsgset,Vierr0);          <<03537>>26058000
   END;                                                        <<03537>>26060000
   IF Errinfo.(14:1) THEN Err'Return := Iostat;                <<03537>>26062000
   Linusio := Tlog;                                            <<03537>>26064000
END;                                                           <<03537>>26066000
$PAGE "PROCEDURE FORMAT'A'LINUS"                               <<03537>>26068000
$CONTROL SEGMENT=LINUS                                         <<03537>>26070000
PROCEDURE Format'A'Linus(Ldev,Spares,Interleave);              <<03537>>26072000
VALUE Ldev,Spares,Interleave;                                  <<03537>>26074000
INTEGER Ldev,Spares,Interleave;                                <<03537>>26076000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03537>>26078000
                                                               <<03537>>26080000
<< This procedure goes out to format the Linus               >><<03537>>26082000
<< cartridge all by itself. If the diagnostic                >><<03537>>26084000
<< entry point has been used then we allow the               >><<03537>>26086000
<< user to kill field discovered spares.                     >><<03537>>26088000
<< Otherwise all spares are retained and all                 >><<03537>>26090000
<< existing jump spares are converted to skips.              >><<03537>>26092000
<< This routine may take a long long time time,              >><<03537>>26094000
<< depending on how big the cartridge is.                    >><<03537>>26096000
<< Lower down you will see some code to enable               >><<03537>>26098000
<< the break key so that the user can at least               >><<03537>>26100000
<< get some critical commands into the system.               >><<03537>>26102000
<< (If we get it to work.)                                   >><<03537>>26104000
                                                               <<03537>>26106000
BEGIN                                                          <<03537>>26108000
   INTEGER Qmisc := 0;                                         <<03537>>26110000
   INTEGER Errors := 0;                                        <<03537>>26112000
   EQUATE Initialize'Media = 8;                                <<03537>>26114000
   ARRAY Junk'Buffer(0:Linus'Sector - 1); << Not used.       >><<03537>>26116000
   DOUBLE Address := 0D;                                       <<03537>>26118000
   INTEGER P1 = Address;                                       <<03537>>26120000
   INTEGER P2 = Address + 1;                                   <<03537>>26122000
                                                               <<03537>>26124000
   IF Diag'Entry THEN << Must be a CE.                       >><<03537>>26126000
   BEGIN                                                       <<03537>>26128000
      IF Spares = Physical'Format THEN <<Not Allowed.        >><<03537>>26130000
         P1 := Retain'All'Spares                               <<03537>>26132000
      ELSE                                                     <<03537>>26134000
         P1 := Spares;                                         <<03537>>26136000
   END                                                         <<03537>>26138000
   ELSE          << Didn't use the entry point.              >><<03537>>26140000
      P1  := Retain'All'Spares;                                <<03537>>26142000
   P2 := Interleave;                                           <<03537>>26144000
   CC := CCE;                                                  <<03537>>26146000
   Format'Msg(P1);                                             <<03537>>26148000
   Enable'Break;                                               <<03537>>26150000
   Linusio(Ldev,Qmisc,Junk'Buffer,Initialize'Media,            <<03537>>26152000
           Linus'Sector,Address,Blocked'IO,                    <<03537>>26154000
           NO'SPARING,Default'Errinfo,Errors);                 <<03537>>26156000
   IF < THEN                                                   <<03537>>26158000
      CC := CCL;                                               <<03537>>26160000
   Disable'Break;                                              <<03537>>26162000
END;                                                           <<03537>>26164000
$PAGE "FORMAT'MSG"                                             <<03537>>26166000
$CONTROL SEGMENT=LINUS                                         <<03537>>26168000
PROCEDURE Format'Msg(Spares);                                  <<03537>>26170000
VALUE Spares;                                                  <<03537>>26172000
INTEGER Spares;                                                <<03537>>26174000
OPTION PRIVILEGED,UNCALLABLE;                                  <<03537>>26176000
BEGIN                                                          <<03537>>26178000
                                                               <<03537>>26180000
<< Tell the user what we are doing.                          >><<03537>>26182000
<< The meaning of the Spares variable is                     >><<03537>>26184000
<< equated elsewhere.                                        >><<03537>>26186000
                                                               <<03537>>26188000
    INTEGER Len := 0;                                          <<03537>>26190000
    Msgw := 0;                                                 <<03537>>26192000
    MOVE Msgw(1) := Msgw,(35);                                 <<03537>>26194000
    CASE *Spares OF                                            <<03537>>26196000
    BEGIN                                                      <<03537>>26198000
      <<0>>                                                    <<03537>>26200000
        MOVE Msg := "Format Retaining All Spares.",2;          <<03537>>26202000
      <<1>>                                                    <<03537>>26204000
        MOVE Msg :=                                            <<03537>>26206000
           "Format Retaining Factory Spares Only.",2;          <<03537>>26208000
      <<2>>                                                    <<03537>>26210000
        MOVE Msg := "Physical Format.",2;                      <<03537>>26212000
    END;                                                       <<03537>>26214000
    Len := TOS - @Msg;                                         <<03537>>26216000
    Print(Msgw, -Len, 0);                                      <<03537>>26218000
END;                                                           <<03537>>26220000
$PAGE "PROCEDURE PRINT'LINUS'SPARES"                           <<03583>>26222000
$CONTROL SEGMENT=LINUS                                         <<03583>>26224000
PROCEDURE Print'Linus'Spares(Ldev);                            <<03583>>26226000
VALUE Ldev;                                                    <<03583>>26228000
INTEGER Ldev;                                                  <<03583>>26230000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03583>>26232000
                                                               <<03583>>26234000
BEGIN                                                          <<03583>>26236000
   ARRAY Spare'Table(0:Linus'Sector - 1);                      <<03583>>26238000
   BYTE ARRAY B'Spare'Table(*) = Spare'Table;                  <<03583>>26240000
   INTEGER Qmisc := 0;                                         <<03583>>26242000
   INTEGER Err'Info := 0;                                      <<03583>>26244000
   INTEGER Err'result := 0;                                    <<03583>>26246000
   INTEGER I := 0; << Counter Variable - For Loop            >><<03583>>26248000
   DOUBLE Address;                                             <<03583>>26250000
   LOGICAL Message'Qualifier = Address;                        <<03583>>26252000
   LOGICAL Utility'Number = Address + 1;                       <<03583>>26254000
                                                               <<03583>>26256000
   INTEGER Block'Number := 0;                                  <<03583>>26258000
   BYTE ARRAY B'Block'Number(*) = Block'Number;                <<03583>>26260000
   INTEGER Counter := 0; << Used to keep track of where      >><<03583>>26262000
                         << we are in the byte array.        >><<03583>>26264000
                                                               <<03583>>26266000
   EQUATE Spare'Block'Table = 11;                              <<03583>>26268000
   Spare'Table := 0;                                           <<03583>>26270000
   MOVE Spare'Table(1) := Spare'Table,(Linus'Sector - 1);      <<03583>>26272000
                                                               <<03583>>26274000
   Message'Qualifier := Return'Message;                        <<03583>>26276000
   Utility'Number := Read'Drive'Tables;                        <<03583>>26278000
                                                               <<03583>>26280000
   Spare'Table(0) := 1; << 1 Byte to Follow.                 >><<03583>>26282000
                                                               <<03583>>26284000
   << The first word was a 16 bit counter indicating         >><<03583>>26286000
   << how many bytes are going to follow. It gets            >><<03583>>26288000
   << eaten up by the driver. The bytes following            >><<03583>>26290000
   << are byte aligned (not word aligned) starting           >><<03583>>26292000
   << in the left byte of the second word.                   >><<03583>>26294000
                                                               <<03583>>26296000
   << We want to read the Linus Spare Block Table.           >><<03583>>26298000
                                                               <<03583>>26300000
   B'Spare'Table(2) := Spare'Block'Table;                      <<03583>>26302000
                                                               <<03583>>26304000
   Err'Info := 2; << Return error, don't print message.      >><<03583>>26306000
                                                               <<03583>>26308000
   Linusio(Ldev,Qmisc,Spare'Table,Initiate'Utility,            <<03583>>26310000
           Linus'Sector,Address,Blocked'IO,                    <<03583>>26312000
           NO'SPARING,Err'Info,Err'Result);                    <<03583>>26314000
                                                               <<03583>>26316000
   IF < THEN                                                   <<03583>>26318000
   BEGIN                                                       <<03583>>26320000
      Genmsg(Pvmsgset, Viwarn101);                             <<03583>>26322000
      RETURN;                                                  <<03583>>26324000
   END;                                                        <<03583>>26326000
                                                               <<03583>>26328000
   << Have a bit of a problem here. We are going             >><<03583>>26330000
   << to print out the contents of a table that              >><<03583>>26332000
   << must have been defined at Boise. The                   >><<03583>>26334000
   << addressable unit they used is a byte.                  >><<03583>>26336000
   << Clearly they must have done this so we could           >><<03583>>26338000
   << hook this peripheral to a 6800 or a 41-C               >><<03583>>26340000
   << or something like that.                                >><<03583>>26342000
   << The table format is as follows:                        >><<03583>>26344000
   << The header record is one byte which is a counter       >><<03583>>26346000
   << indexed from 1 (I hope) indicating how many            >><<03583>>26348000
   << 3 byte records following are meaningful.               >><<03583>>26350000
   << I don't know what an empty table looks like, but       >><<03583>>26352000
   << I suspect it has a zero in the header record with      >><<03583>>26354000
   << gibberish following.                                   >><<03583>>26356000
   << Anyways, the 3 byte record contains 2 bytes            >><<03583>>26358000
   << containing the physical block number of spared blocks  >><<03583>>26360000
   << and the next byte contains the track number            >><<03583>>26362000
   << of the spared block. Handling 3 byte records is        >><<03583>>26364000
   << real fun in SPL. For more details on what the          >><<03583>>26366000
   << table contains see a Linus or CS'80 family             >><<03583>>26368000
   << ERS.                                                   >><<03583>>26370000
                                                               <<03583>>26372000
   IF ( B'Spare'Table(First'Byte) = 0 ) THEN                   <<03583>>26374000
                                                               <<03583>>26376000
   << The table has no entries (empty)                       >><<03583>>26378000
                                                               <<03583>>26380000
   BEGIN                                                       <<03583>>26382000
      Genmsg(Pvmsgset, Viwarn102);                             <<03583>>26384000
      RETURN;                                                  <<03583>>26386000
   END;                                                        <<03583>>26388000
                                                               <<03583>>26390000
   << Otherwise print out the table.                         >><<03583>>26392000
                                                               <<03583>>26394000
   << Here goes the Header.                                  >><<03583>>26396000
   << Will say number of entries found and to see            >><<03583>>26398000
   << Linus ERS or Boise TSE for interpretation.             >><<03583>>26400000
                                                               <<03583>>26402000
   Genmsg(Pvmsgset, Viwarn103, %010000,                        <<03583>>26404000
          INTEGER(B'Spare'Table(First'Byte)),                  <<03583>>26406000
          <<p2>>,<<p3>>,<<p4>>,<<p5>>,-Outf);                  <<03583>>26408000
                                                               <<03583>>26410000
   Counter := First'Byte + 1;                                  <<03583>>26412000
                                                               <<03583>>26414000
   << To get to the first record in the buffer.              >><<03583>>26416000
                                                               <<03583>>26418000
   FOR I := 0 UNTIL                                            <<03583>>26420000
      (INTEGER(B'Spare'Table(First'Byte)) - 1)                 <<03583>>26422000
   DO BEGIN                                                    <<03583>>26424000
      MOVE B'Block'Number := B'Spare'Table(Counter + 3*I),(2); <<03583>>26426000
                                                               <<03583>>26428000
      << Picking up 3 word entries and printing them.        >><<03583>>26430000
                                                               <<03583>>26432000
      Genmsg(Pvmsgset,Viwarn104,%011000,                       <<03583>>26434000
             Block'Number,                                     <<03583>>26436000
             INTEGER(B'Spare'Table(Counter + 3 * I + 2)),      <<03583>>26438000
             <<p3>>,<<p4>>,<<p5>>,-Outf);                      <<03583>>26440000
   END;                                                        <<03583>>26442000
END;                                                           <<03583>>26444000
$PAGE "PROCEDURE PRINT'CS'80'SPARES"                           <<03583>>26446000
$CONTROL SEGMENT= PVSTATUS                                     <<03583>>26448000
PROCEDURE Print'CS'80'Spares(Ldev);                            <<03583>>26450000
VALUE Ldev;                                                    <<03583>>26452000
INTEGER Ldev;                                                  <<03583>>26454000
OPTION PRIVILEGED, UNCALLABLE;                                 <<03583>>26456000
                                                               <<03583>>26458000
<< The intention of this procedure is to print               >><<03583>>26460000
<< out the spare track and sector table for                  >><<03583>>26462000
<< any  CS'80 disc device. It is only invoked                >><<03583>>26464000
<< when the Vinit user has run Vinit with the                >><<03583>>26466000
<< Diag entry point. The procedure does direct               >><<03583>>26468000
<< its output to the File VINLIST if a file                  >><<03583>>26470000
<< equation has been provided. This procedure                >><<03583>>26472000
<< is called from the procedure PDTRACK.                     >><<03583>>26474000
                                                               <<03583>>26476000
BEGIN                                                          <<03583>>26478000
   EQUATE Buffer'Size = 159;                                   <<03583>>26480000
                                                               <<03583>>26482000
<< Driver can presently return a maximum of 13 Heads         >><<03583>>26484000
<< worth of data times max. of 23 bytes per head.            >><<03583>>26486000
<< But also need 20 bytes of slop area at the front          >><<03583>>26488000
<< of the buffer for the parameters passed to the            >><<03583>>26490000
<< driver. In total 319 bytes = 160 words, or 159            >><<03583>>26492000
<< when indexing from zero. Might need to increase this      >><<03583>>26494000
<< if we get a bigger CS'80 device.                          >><<03583>>26496000
                                                               <<03583>>26498000
   EQUATE Three'Vector'Address = 1;                            <<03583>>26500000
   EQUATE Head'Byte = 2; << Index into buffer returned       >><<03583>>26502000
                         << from Request Volume Limit.       >><<03583>>26504000
   EQUATE Spare'Track'Table = 1;                               <<03583>>26506000
                                                               <<03583>>26508000
   ARRAY Spare'Table(0:Buffer'Size - 1);                       <<03583>>26510000
   BYTE ARRAY B'Spare'Table(*) = Spare'Table;                  <<03583>>26512000
                                                               <<03583>>26514000
   DOUBLE Address := 0D;                                       <<03583>>26516000
   LOGICAL P1 = Address;                                       <<03583>>26518000
   LOGICAL P2 = Address + 1;                                   <<03583>>26520000
                                                               <<03583>>26522000
   LOGICAL Message'Qualifier = Address;                        <<03583>>26524000
   LOGICAL Utility'Number = Address + 1;                       <<03583>>26526000
                                                               <<03583>>26528000
   INTEGER Num'Spare := 0;                                     <<03583>>26530000
   BYTE ARRAY B'Num'Spare(*) = Num'Spare;                      <<03583>>26532000
                                                               <<03583>>26534000
   INTEGER Heads := 0;                                         <<03583>>26536000
   INTEGER I := 0;                                             <<03583>>26538000
   INTEGER J := 0;                                             <<03583>>26540000
   INTEGER Status := 0; << For Discio.                       >><<03583>>26542000
   INTEGER Counter := 0; << Points to Current Buffer Entry.  >><<03583>>26544000
                                                               <<03583>>26546000
   Spare'Table := 0;                                           <<03583>>26548000
   MOVE Spare'Table(1) := Spare'Table,(Buffer'Size - 1);       <<03583>>26550000
                                                               <<03583>>26552000
<< First we want to get the number of heads on the disc.     >><<03583>>26554000
<< This way the procedure is generalized for CS'80           >><<03583>>26556000
<< discs that haven't even been built yet.                   >><<03583>>26558000
<< We use the Request Volume Limit function of the driver    >><<03583>>26560000
<< with P1 set to one. This returns a three-vector           >><<03583>>26562000
<< address of the max. volume limits as follows.             >><<03583>>26564000
                                                               <<03583>>26566000
<<  Word 0 --> | Max Cylinder #            |                 >><<03583>>26568000
<<  Byte 2 --> | Max Head # | Max Sector # | <-- Byte 3      >><<03583>>26570000
                                                               <<03583>>26572000
   Status := 1;   << Let Discerror handle errors.            >><<03583>>26574000
   P1 := Three'Vector'Address;                                 <<03583>>26576000
   P2 := 0;                                                    <<03583>>26578000
   Discio(Ldev,Req'Vol'Limit,Spare'Table,Address,              <<03583>>26580000
          Sector'Size,Status);                                 <<03583>>26582000
   IF < THEN RETURN;                                           <<03583>>26584000
                                                               <<03583>>26586000
   Heads := INTEGER(B'Spare'Table(Head'Byte)) + 1;             <<03583>>26588000
                                                               <<03583>>26590000
<< Above head number is incremented because driver           >><<03583>>26592000
<< returns a zero relative index.                            >><<03583>>26594000
                                                               <<03583>>26596000
                                                               <<03583>>26598000
   Spare'Table := 0;                                           <<03583>>26600000
   MOVE Spare'Table(1) := Spare'Table,(Buffer'Size - 1);       <<03583>>26602000
                                                               <<03583>>26604000
<< Now read the spare table. We do this by using the         >><<03583>>26606000
<< Initiate'Utility function of the driver. If you want      >><<03583>>26608000
<< the details on how to do it, read documentation           >><<03583>>26610000
<< in procedures Print'Linus'Spares and in Linus'Numbers.    >><<03583>>26612000
                                                               <<03583>>26614000
   Message'Qualifier := Return'Message;                        <<03583>>26616000
   Utility'Number := Read'Drive'Tables;                        <<03583>>26618000
                                                               <<03583>>26620000
   Spare'Table(0) := 1; << 1 byte follows.                   >><<03583>>26622000
   B'Spare'Table(2) := Spare'Track'Table;                      <<03583>>26624000
                                                               <<03583>>26626000
   Status := 0;                                                <<03583>>26628000
                                                               <<03583>>26630000
   Discio(Ldev,Initiate'Utility,Spare'Table,Address,           <<03583>>26632000
          Buffer'Size,Status);                                 <<03583>>26634000
   IF < THEN                                                   <<03583>>26636000
   BEGIN                                                       <<03583>>26638000
                                                               <<03583>>26640000
<< Unable to read the Spare Table. Bye-bye.                  >><<03583>>26642000
                                                               <<03583>>26644000
      Genmsg(PVMSGSET,Vierr109);                               <<03583>>26646000
      RETURN;                                                  <<03583>>26648000
   END;                                                        <<03583>>26650000
                                                               <<03583>>26652000
<< Now we should have the Spare Table. Now print it          >><<03583>>26654000
<< and go home for Thanksgiving.                             >><<03583>>26656000
                                                               <<03583>>26658000
<< Print a Header Line. Tell him how many heads we think     >><<03583>>26660000
<< we have.                                                  >><<03583>>26662000
                                                               <<03583>>26664000
   Genmsg(PVMSGSET,Viwarn110,%011000,Heads,Heads - 1,          <<03583>>26666000
          <<p3>>,<<p4>>,<<p5>>,-Outf);                         <<03583>>26668000
                                                               <<03583>>26670000
<< The format of this table is weird. It has                 >><<03583>>26672000
<< one block for each head. Inside each block there          >><<03583>>26674000
<< is a fixed overhead entry and a variable number           >><<03583>>26676000
<< of detail entries. See the BFD ERS (from Boise)           >><<03583>>26678000
<< for details. The reason we are using Num'Spare            >><<03583>>26680000
<< is that they split 16 bit integers over word              >><<03583>>26682000
<< boundaries half of the time.                              >><<03583>>26684000
                                                               <<03583>>26686000
   Counter := First'Byte; << Data starts at Buffer + 10.     >><<03583>>26688000
   FOR I := 1 UNTIL Heads DO                                   <<03583>>26690000
   BEGIN                                                       <<03583>>26692000
                                                               <<03583>>26694000
<< Print an overhead entry for each head.                    >><<03583>>26696000
                                                               <<03583>>26698000
      Move B'Num'Spare := B'Spare'Table(Counter + 1),(2);      <<03583>>26700000
      Genmsg(PVMSGSET,Viwarn111,%011110,                       <<03583>>26702000
             INTEGER(B'Spare'Table(Counter)),                  <<03583>>26704000
             Num'Spare,                                        <<03583>>26706000
             INTEGER(B'Spare'Table(Counter + 3)),              <<03583>>26708000
             INTEGER(B'Spare'Table(Counter + 4)),              <<03583>>26710000
             <<p5>>,-Outf);                                    <<03583>>26712000
      Counter := Counter + 5;                                  <<03583>>26714000
                                                               <<03583>>26716000
<< Now we have the Header done. We look back in our          >><<03583>>26718000
<< Buffer to see if there are any detail entries to          >><<03583>>26720000
<< list out.                                                 >><<03583>>26722000
                                                               <<03583>>26724000
      IF INTEGER(B'Spare'Table(Counter - 1)) > 0 THEN          <<03583>>26726000
      BEGIN                                                    <<03583>>26728000
         FOR J := 1 UNTIL INTEGER(B'Spare'Table(Counter -1)) DO<<03583>>26730000
         BEGIN                                                 <<03583>>26732000
            MOVE B'Num'Spare := B'Spare'Table(Counter),(2);    <<03583>>26734000
                                                               <<03583>>26736000
<< Now we print one of 2 detail lines, one is for            >><<03583>>26738000
<< factory spares, the other is for field discovered spares. >><<03583>>26740000
<< The top bit tells us that it is a factory spare.          >><<03583>>26742000
                                                               <<03583>>26744000
            Genmsg(PVMSGSET,IF B'Spare'Table(Counter+2).(0:1)  <<03583>>26746000
                            = 1 THEN                           <<03583>>26748000
                                   Viwarn112                   <<03583>>26750000
                                ELSE                           <<03583>>26752000
                                   Viwarn113,                  <<03583>>26754000
                   %011000,Num'Spare,                          <<03583>>26756000
                   INTEGER(B'Spare'Table(Counter+2).(1:7)),    <<03583>>26758000
                   <<p3>>,<<p4>>,<<p5>>,-Outf);                <<03583>>26760000
            Counter := Counter + 3;                            <<03583>>26762000
         END;                                                  <<03583>>26764000
      END;                                                     <<03583>>26766000
   END;                                                        <<03583>>26768000
END;                                                           <<03583>>26770000
$PAGE  "   - OUTER BLOCK "                                              26772000
$CONTROL SEGMENT=VINITCI                                                26774000
                              IF (special'entry:=false) THEN   <<03537>>26776000
                                 BEGIN                         <<03537>>26778000
testentry:                          special'entry:=true;       <<03537>>26780000
                                    genmsg(pvmsgset,viwarn76,  <<03537>>26782000
                                           ,,,,,,0);           <<03537>>26784000
                                 END;                          <<03537>>26786000
$IF X3=OFF     << ALLOW USER TRAPS >>                          <<03537>>26788000
                              TRAPS;                                    26790000
$IF                                                            <<03537>>26792000
IF FALSE THEN  << Skip entry point >>                                   26794000
                                                                        26796000
DIAG:  DIAG'ENTRY := TRUE;  << For SE/CE use in FORMAT >>               26798000
                                                                        26800000
                            SETUPSHOP;                                  26802000
                      WHILE MORE DO FUNCTION;                           26804000
                               END.                                     26806000
