$CONTROL MAP,CODE,USLINIT                                               00001000
<<CACHESEG : MODULE 5E>>                                                00002000
$CONTROL PRIVILEGED,SEGMENT=CACHESEG,MAIN=CACHESEG                      00003000
<<*************************>>                                           00004000
<< Set X1=ON for debug, mmstat, and extra error checking >>             00005000
<< For debug ONLY!!!                                     >>             00005100
<<*************************>>                                           00006000
$set x1=OFF                                                             00007000
<< Set X8=on for full INCL file listings >>                             00008000
$set x8=on                                                              00009000
<< Set x7=on for locking code- CURRENTLY NOT SUPPORTED! >>              00009100
$set x7=off                                                             00009200
                                                                        00010000
COMMENT                                                                 00011000
                                                                        00012000
This segment contains the disc cache manipulation procedures required   00013000
by the kernel.  The segment is locked and frozen into memory when       00014000
disc caching is first enabled for a device, and unlocked and unfrozen   00015000
when disc caching is last disabled.                                     00016000
                                                                        00017000
;                                                                       00018000
                                                                        00019000
BEGIN                                                                   00020000
                                                                        00021000
<< ************************************ >>                              00021100
<<cache status returns>>                                                00021170
                                                                        00021171
EQUATE stat'ok = 0,                                                     00021172
       stat'no'dst=1,                                                   00021173
       stat'int'error=2,                                                00021174
       stat'ldev'cached=3,                                              00021175
       stat'cdt'overflow=4,                                             00021176
       stat'dev'not'cachable=5,                                         00021177
       stat'sys'not'cachable=6;                                         00021178
<< Remove this equate for MPEV          >>                              00021200
<< ************************************ >>                              00021300
equate SYSDISCREQTAB = %1031;                                           00021400
                                                                        00021450
equate SYSMON = %1267;     << If MONITOR is enabled on system >>        00021500
$INCLUDE inclstdd                                                       00022000
$INCLUDE inclobj                                                        00023000
$INCLUDE inclreg                                                        00024000
$INCLUDE inclsf                                                         00025000
$INCLUDE inclmmst                                                       00026000
$INCLUDE inclmsg                                                        00026100
$INCLUDE inclpcb                                                        00027000
$INCLUDE inclpcbx                                                       00028000
$INCLUDE inclparm                                                       00029000
$include inclio                                                         00030000
$INCLUDE inclcdef                                                       00031000
$INCLUDE inclldr4                                                       00032000
$INCLUDE inclmeas                                                       00032100
$INCLUDE inclkcim                                                       00033000
$INCLUDE inclkdim                                                       00033100
$INCLUDE inclioim                                                       00034000
                                                                        00034098
intrinsic ASCII,DASCII,PRINT;                                           00034099
                                                                        00034100
$page " Forward Procedure Declarations"                                 00035000
<< Ask KERNEL to find cached domain, if it exists and is not mapped >>  00036000
logical procedure CDT'MAP'CACHED'DOMAIN(CDT'DISC'ENTRY,BASE'ADR,        00037000
                                        LIMIT'ADR,NEW'CDT,              00038000
                                        LDR'ENTRY'INDEX);               00038100
                                                                        00039000
value CDT'DISC'ENTRY,BASE'ADR,LIMIT'ADR,NEW'CDT,LDR'ENTRY'INDEX;        00040000
integer CDT'DISC'ENTRY,NEW'CDT;                                         00041000
logical LDR'ENTRY'INDEX;                                                00041100
double BASE'ADR,LIMIT'ADR;                                              00042000
option forward;                                                         00043000
<<********************************************************************>>00044000
<< This procedure scans the unmapped region list pointed to by disc   >>00045000
<< entry CDT'DISC'ENTRY.  If a region is found which completely con-  >>00046000
<< tains the the disc sector range, then a CDT entry is obtained and  >>00047000
<< formatted to point to that region.  If partial or no overlaps are  >>00048000
<< found, any overlapping region is taken off the list and deleted,   >>00049000
<< and a "0" CDT number is returned to the caller.                    >>00050000
<<                                                                    >>00051000
<< Passed parameters:                                                 >>00052000
<<                                                                    >>00053000
<< CDT'DISC'ENTRY  - The index of the CDT disc entry for this LDEV.   >>00054000
<<                   It contains the list head for all the unmapped   >>00055000
<<                   regions.                                         >>00056000
<<                                                                    >>00057000
<< BASE'ADR        - This is the double word sector address of the    >>00058000
<<                   base sector requested.                           >>00059000
<<                                                                    >>00060000
<< LIMIT'ADR       - This is the upper limit disc address of the range>>00061000
<<                   of sectors required to complete a logical request>>00062000
<<                   The LIMIT'ADR is actually 1 sector greater than  >>00063000
<<                   the highest sector number required (ie sector 1  >>00064000
<<                   for 5 bytes would be BASE'ADR=1 and LIMIT'ADR=2).>>00065000
<<                                                                    >>00066000
<< NEW'CDT         - Only valid on a MAP call, this contains the CDT  >>00066100
<<                   entry number of a mapped domain that is absent   >>00066200
<<                   and has a strategy applied to it.                >>00066300
<< The caller will be PDISABLEd prior to calling this procedure.      >>00067000
<<********************************************************************>>00068000
LOGICAL PROCEDURE CDT'Flush'Cached'Range(devcdtentry,start'addr,        00069000
                                        limit'addr,new'cdt,             00070000
                                        ldr'entry'index);               00070100
VALUE devcdtentry,start'addr,limit'addr,new'cdt,ldr'entry'index;        00071000
INTEGER devcdtentry,new'cdt;                                            00072000
LOGICAL ldr'entry'index;                                                00072100
DOUBLE start'addr,limit'addr;                                           00073000
OPTION FORWARD;                                                         00074000
                                                                        00075000
<<********************************************************************>>00076000
<< This procedure scans the unmapped region list pointed to by        >>00077000
<< CDT'DISC'ENTRY and deletes any region which is partially over-     >>00078000
<< lapping the disc address range specified.                          >>00079000
<<                                                                    >>00080000
<< The parameters are:                                                >>00081000
<<                                                                    >>00082000
<< CDT'DISC'ENTRY  - The index of the CDT disc entry for this LDEV.   >>00083000
<<                   It contains the list head for all the unmapped   >>00084000
<<                   regions.                                         >>00085000
<<                                                                    >>00086000
<< BASE'ADR        - This is the double word sector address of the    >>00087000
<<                   base sector requested.                           >>00088000
<<                                                                    >>00089000
<< LIMIT'ADR       - This is the upper limit disc address of the range>>00090000
<<                   of sectors required to complete a logical request>>00091000
<<                   The LIMIT'ADR is actually 1 sector greater than  >>00092000
<<                   the highest sector number required (ie sector 1  >>00093000
<<                   for 5 bytes would be BASE'ADR=1 and LIMIT'ADR=2).>>00094000
<<                                                                    >>00095000
<< NEW'CDT         - Ignored.                                         >>00095100
<< The caller will be PDISABLEd prior to calling this procedure.      >>00096000
<<********************************************************************>>00097000
                                                                        00098000
procedure CDT'UNMAP'REGION(CDT'DISC'ENTRY,CDT'ENTRY);                   00099000
value CDT'DISC'ENTRY,CDT'ENTRY;                                         00100000
integer CDT'DISC'ENTRY,CDT'ENTRY;                                       00101000
option forward;                                                         00102000
<<********************************************************************>>00103000
<< This procedure takes the memory region pointed to my mapped CDT    >>00104000
<< domain CDT'ENTRY and places it on the unmapped region list for a   >>00105000
<< disc pointed to by CDT'DISC'ENTRY.                                 >>00106000
<<                                                                    >>00107000
<< The parameters are:                                                >>00108000
<< CDT'DISC'ENTRY    - This is the CDT entry index of the disc entry  >>00109000
<<                      for this LDEV.                                >>00110000
<<                                                                    >>00111000
<< CDT'ENTRY         - This is the CDT entry index of the mapped disc >>00112000
<<                     domain.                                        >>00113000
<<                                                                    >>00114000
<< The caller is PDISABLEd prior to calling this procedure.           >>00115000
<<********************************************************************>>00116000
                                                                        00117000
procedure ZAPCACHEDDOMAIN(REGBASE);                                     00117100
value REGBASE;                                                          00117200
double REGBASE;                                                         00117300
option forward;                                                         00117400
$page "PROCEDURE IsSysCachable"                                         00118000
                                                                        00119000
LOGICAL PROCEDURE IsSysCachable;                                        00120000
OPTION PRIVILEGED,UNCALLABLE;                                           00121000
                                                                        00122000
COMMENT                                                                 00123000
                                                                        00124000
CHECKS TO SEE IF THE USER HAS PURCHASED THE RIGHT TO OPERATE            00125000
DISC CACHING FOR THIS MACHINE.                                          00126000
                                                                        00127000
;                                                                       00128000
                                                                        00129000
BEGIN                                                                   00130000
                                                                        00131000
<<FIGURE OUT HOW TO IMPLEMENT THIS>>                                    00132000
                                                                        00133000
IsSysCachable := TRUE;                                                  00134000
                                                                        00135000
END;  <<Procedure IsSysCachable>>                                       00136000
                                                                        00137000
$page "PROCEDURE IsDevCachable"                                         00138000
                                                                        00139000
LOGICAL PROCEDURE IsDevCachable(ldev);                                  00140000
VALUE ldev;                                                             00141000
INTEGER ldev;                                                           00142000
OPTION PRIVILEGED,UNCALLABLE;                                           00143000
                                                                        00144000
COMMENT                                                                 00145000
                                                                        00146000
checks to see if the specified device is cachable.  Currently only      00147000
checks to see if a disc.  should also check serial disc and             00148000
disallow etc... this is yours,al                                        00149000
                                                                        00150000
;                                                                       00151000
                                                                        00152000
BEGIN                                                                   00153000
                                                                        00154000
CHECKLDEV(LDEV);                                                        00155000
IF = AND CARRY THEN IsDevCachable := TRUE                               00156000
ELSE IsDevCachable := FALSE;                                            00157000
                                                                        00158000
END;  <<Procedure IsDevCachable>>                                       00159000
$page "PROCEDURE CDT'GET'ENTRY"                                         00160000
integer procedure CDT'GET'ENTRY;                                        00161000
option privileged,uncallable;                                           00162000
begin                                                                   00163000
                                                                        00164000
<<***********************************************************>>         00165000
<< This procedure obtains a FREE entry in the CDT table and  >>         00166000
<< returns its index.  If no entry is available, a value of  >>         00167000
<< zero is returned to the caller.                           >>         00168000
<<                                                           >>         00169000
<< DB can be set anywhere.                                   >>         00170000
<<***********************************************************>>         00171000
                                                                        00172000
integer CDT'ENTRY=CDT'GET'ENTRY; << Obtained CDT index       >>         00173000
                                                                        00174000
<< Make sure CDT DST exists >>                                          00175000
DISABLE;                                                                00176000
$if x1=on                                                               00177000
if CACHE'DST = 0 then                                                   00178000
  begin                                                                 00179000
  SUDDENDEATH(CDT'NOT'INITIALIZED);                                     00180000
  help; <<just to get an stt>>                                          00181000
  end;                                                                  00182000
$if                                                                     00183000
                                                                        00184000
<< Actually get an entry >>                                             00185000
                                                                        00186000
<< move DB to the CACHE DST >>                                          00187000
tos := CACHE'DST'BANK;                                                  00188000
tos := CACHE'DST'OFST;                                                  00189000
                                                                        00190000
EXCHDB;                                                                 00191000
                                                                        00192000
<< Get head of free list >>                                             00193000
CDT'ENTRY := CDT'ARRAY(CDT'FREE'HEAD); << Get first entry >>            00194000
if <> then                                                              00195000
  begin  << There is an available entry >>                              00196000
                                                                        00197000
  << Check that index passed is valid >>                                00198000
  << DB must be pointing to the CDT and integer CDT'ENTRY is   >>       00199000
  << used to perform a validity check against.                 >>       00200000
$if x1=on                                                               00201000
  if CDT'ARRAY(CDT'ENTRY) <> -1 then                                    00201100
    SUDDENDEATH(CDT'UNASSIGNED);  << Actually, reversed sense >>        00201200
  CDT'ARRAY(CDT'X) := 0;                                                00201300
  CDT'CHECK'INDEX;                                                      00202000
$if                                                                     00203000
                                                                        00204000
  << Place the next CDT pointer into the HEAD pointer >>                00205000
  CDT'ARRAY(CDT'FREE'HEAD) := CDT'ARRAY(CDT'ENTRY+CDT'FREE'HEAD);       00206000
                                                                        00207000
  << If head pointer is zero, this implies that the list is  >>         00208000
  << empty and the tail pointer must also be zeroed.         >>         00209000
  if CDT'ARRAY(CDT'FREE'HEAD) = 0 then                                  00210000
    CDT'ARRAY(CDT'FREE'TAIL) := 0;                                      00211000
                                                                        00212000
  << Increment the MAX in use count if it has been exceeded  >>         00213000
  CDT'ARRAY(CDT'FREE'COUNT) := CDT'ARRAY(CDT'FREE'COUNT) - 1;           00214000
  if (CDT'ARRAY(CDT'ENTRIES) - CDT'ARRAY(CDT'FREE'COUNT)) >             00215000
     CDT'ARRAY(CDT'MAX'USED) then                                       00216000
    CDT'ARRAY(CDT'MAX'USED) := CDT'ARRAY(CDT'ENTRIES) -                 00217000
                                 CDT'ARRAY(CDT'FREE'COUNT);             00218000
                                                                        00219000
  << Zero-out entry just obtained >>                                    00220000
  CDT'ARRAY(CDT'ENTRY) := 0;                                            00221000
  move CDT'ARRAY(CDT'ENTRY+1) := CDT'ARRAY(CDT'ENTRY),                  00222000
                               (CDT'ENTRY'SIZE-1);                      00223000
                                                                        00224000
  << Change index into entry >>                                         00225000
  CDT'GET'ENTRY := CDT'ENTRY / CDT'ENTRY'SIZE;                          00226000
  end                                                                   00227000
                                                                        00228000
else                                                                    00229000
                                                                        00230000
  << We should never run out of CDT entries >>                          00231000
  SUDDENDEATH(CDT'TABLE'EMPTY);                                         00232000
                                                                        00233000
<< Place DB back to caller's DB >>                                      00234000
EXCHDB;                                                                 00235000
                                                                        00236000
<< EXIT will place INTERRUPTs back to caller's state >>                 00237000
$if x1=on                                                               00238000
MMSTAT(MMSTAT'GET'CDT,CDT'ENTRY,1,0);                                   00239000
$if                                                                     00240000
end;  << of procedure GET'CDT'ENTRY >>                                  00241000
$page "CDT'FREE'ENTRY procedure"                                        00242000
procedure CDT'FREE'ENTRY(CDT'ENTRY);                                    00243000
value CDT'ENTRY;                                                        00244000
integer CDT'ENTRY;                                                      00245000
option privileged,uncallable;                                           00246000
begin                                                                   00247000
                                                                        00248000
<<***********************************************************>>         00249000
<< This procedure returns the CDT entry pointed to by        >>         00250000
<< CDT'ENTRY and returns it to the free list.                >>         00251000
<<                                                           >>         00252000
<< CDT'ENTRY   - This is the index into the CDT table of the >>         00253000
<<               entry to be released.                       >>         00254000
<<                                                           >>         00255000
<< DB can point anywhere before calling this procedure.      >>         00256000
<<***********************************************************>>         00257000
                                                                        00258000
<< Re-define entry into index >>                                        00259000
integer CDT'INDEX = CDT'ENTRY;                                          00260000
                                                                        00261000
<< Make sure CACHE DST exists >>                                        00262000
DISABLE;                                                                00263000
$if x1=on                                                               00264000
if CACHE'DST = 0 then                                                   00265000
  SUDDENDEATH(CDT'NOT'INITIALIZED);                                     00266000
                                                                        00267000
MMSTAT(MMSTAT'GET'CDT,CDT'ENTRY,0,0);                                   00268000
$if                                                                     00269000
                                                                        00270000
<< Place DB at the CACHE DST >>                                         00271000
tos := CACHE'DST'BANK;                                                  00272000
tos := CACHE'DST'OFST;                                                  00273000
EXCHDB;                                                                 00274000
                                                                        00275000
$if x1=on                                                               00276000
<< Check that index passed is valid >>                                  00277000
<< DB must be pointing to the CDT and integer CDT'ENTRY is   >>         00278000
<< used to perform a validity check against.                 >>         00279000
CDT'CHECK'ENTRY;                                                        00280000
$if                                                                     00281000
                                                                        00282000
<< Change entry into a index >>                                         00283000
CDT'INDEX := CDT'INDEX * CDT'ENTRY'SIZE;                                00284000
                                                                        00285000
<< Return index to tail of free list >>                                 00286000
if CDT'ARRAY(CDT'FREE'HEAD) = 0 then                                    00287000
  begin  << Free list is completely empty >>                            00288000
  CDT'ARRAY(CDT'FREE'HEAD) := CDT'ARRAY(CDT'FREE'TAIL) := CDT'ENTRY;    00289000
  end                                                                   00290000
                                                                        00291000
else                                                                    00292000
                                                                        00293000
  begin  << There is already something on the free list >>              00294000
                                                                        00295000
  << Put this entry's index into the prior tail's next pointer >>       00296000
  CDT'ARRAY(CDT'ARRAY(CDT'FREE'TAIL)+CDT'FREE'HEAD) := CDT'ENTRY;       00297000
                                                                        00298000
  << Place this entry's index into the new TAIL pointer >>              00299000
  CDT'ARRAY(CDT'FREE'TAIL) := CDT'ENTRY;                                00300000
                                                                        00301000
  end;                                                                  00302000
                                                                        00303000
<< Increment the free count >>                                          00304000
CDT'ARRAY(CDT'FREE'COUNT) := CDT'ARRAY(CDT'FREE'COUNT) + 1;             00305000
                                                                        00306000
<< Zero next pointer in entry just returned >>                          00307000
CDT'ARRAY(CDT'ENTRY) := -1;  << Mark entry available >>                 00307100
CDT'ARRAY(CDT'ENTRY + CDT'FREE'HEAD) := 0;                              00308000
                                                                        00309000
<< Place DB back to caller's DB >>                                      00310000
EXCHDB;                                                                 00311000
                                                                        00312000
<< EXIT will put INTERRUPT state back to caller's state >>              00313000
end;  << of procedure CDT'FREE'ENTRY >>                                 00314000
$page "CDT'SET'BIT CDT'GET'BIT procedure executor"                      00315000
logical procedure CDT'SET'BIT(CDT'ENTRY,BIT'NUMBER,BIT'VALUE);          00316000
value CDT'ENTRY,BIT'NUMBER,BIT'VALUE;                                   00317000
integer CDT'ENTRY,BIT'NUMBER;                                           00318000
logical BIT'VALUE;                                                      00319000
option privileged,uncallable;                                           00320000
begin                                                                   00321000
                                                                        00322000
entry CDT'GET'BIT;      << This entry point only returns the >>         00323000
                        << previous state of the bit, and it >>         00324000
                        << remains unchanged.                >>         00325000
                                                                        00326000
logical MOD'ENTRY;      << Flag if the GET ONLY entry point  >>         00327000
                        << was entered.                      >>         00328000
                                                                        00329000
<<***********************************************************>>         00330000
<< This procedure accepts a bit number, as defined in the    >>         00331000
<< INCLCDT file, and sets the bit in the FLAGS word of the   >>         00332000
<< CDT entry specified.  The old value of the bit is returned>>         00333000
<< as the function return value, bit (15:1).                 >>         00334000
<<                                                           >>         00335000
<< CDT'ENTRY   - The index of the CDT entry to be modified.  >>         00336000
<< BIT'NUMBER  - The relative BIT number in the FLAGS word   >>         00337000
<<               to be set TRUE or on.                       >>         00338000
<< BIT'VALUE   - If this value is TRUE, the bit is turned on,>>         00339000
<<               if false, then the bit is turned off.       >>         00340000
<<                                                           >>         00341000
<< CDT'SET'BIT - The prior value of the specified bit is     >>         00342000
<<               returned in this cell, bit (15:1).          >>         00343000
<<                                                           >>         00344000
<< DB can be set anywhere when calling this procedure.       >>         00345000
<<***********************************************************>>         00346000
                                                                        00347000
<< Re-define entry as index >>                                          00348000
integer CDT'INDEX = CDT'ENTRY;                                          00349000
                                                                        00350000
<< Normal entry point >>                                                00351000
MOD'ENTRY := true;                                                      00352000
go to START;                                                            00353000
                                                                        00354000
CDT'GET'BIT:                                                            00355000
                                                                        00356000
MOD'ENTRY := false;                                                     00357000
                                                                        00358000
START:                                                                  00359000
                                                                        00360000
<< First, we will check if the CDT DST exists.               >>         00361000
DISABLE;                                                                00362000
$if x1=on                                                               00363000
if CACHE'DST = 0 then                                                   00364000
  SUDDENDEATH(CDT'NOT'INITIALIZED);                                     00365000
$if                                                                     00366000
                                                                        00367000
<< Put DB to the CDT DST                                     >>         00368000
tos := CACHE'DST'BANK;                                                  00369000
tos := CACHE'DST'OFST;                                                  00370000
EXCHDB;                                                                 00371000
                                                                        00372000
$if x1=on                                                               00373000
<< Check that index passed is valid >>                                  00374000
<< DB must be pointing to the CDT and integer CDT'ENTRY is   >>         00375000
<< used to perform a validity check against.                 >>         00376000
CDT'CHECK'ENTRY;                                                        00377000
$if                                                                     00378000
                                                                        00379000
<< Change entry into an index >>                                        00380000
CDT'INDEX := CDT'INDEX * CDT'ENTRY'SIZE;                                00381000
                                                                        00382000
<< Turn on the appropriate bit >>                                       00383000
DISABLE;   << Protect from interrupts >>                                00383100
tos := CDT'ARRAY(CDT'ENTRY + CDT'MD'FLAGS);                             00384000
CDT'X := BIT'NUMBER;                                                    00385000
if MOD'ENTRY then                                                       00386000
  begin                                                                 00387000
  if BIT'VALUE then                                                     00388000
    assemble(tsbc 0,X)   << Turn on bit >>                              00389000
  else                                                                  00390000
    assemble(trbc 0,X);  << Turn off bit >>                             00391000
                                                                        00392000
  << If bit was set, turn on return bit >>                              00393000
  if <> then                                                            00394000
    CDT'SET'BIT := 1                                                    00395000
  else                                                                  00396000
    CDT'SET'BIT := 0;                                                   00397000
                                                                        00398000
  << Store back value >>                                                00399000
  CDT'ARRAY(CDT'ENTRY + CDT'MD'FLAGS) := tos;                           00400000
  end                                                                   00401000
                                                                        00402000
else                                                                    00403000
                                                                        00404000
  begin  << Just get existing value >>                                  00405000
                                                                        00406000
  assemble(tbc 0,X);                                                    00407000
  if <> then                                                            00408000
    CDT'SET'BIT := 1                                                    00409000
  else                                                                  00410000
    CDT'SET'BIT := 0;                                                   00411000
                                                                        00412000
  assemble(del);  << Just remove the stacked value (no mod) >>          00413000
  end;                                                                  00414000
                                                                        00415000
<< Put DB back to where caller had it >>                                00416000
EXCHDB;                                                                 00417000
                                                                        00418000
<< EXIT will return INTERRUPTs state >>                                 00419000
end;   << of procedure CDT'SET'BIT >>                                   00420000
$page "Procedure CDT'SET'WORD / CDT'GET'WORD / CDT'ADD'WORD"            00421000
integer procedure CDT'SET'WORD(CDT'ENTRY,WORD'NUMBER,WORD'VALUE);       00422000
value CDT'ENTRY,WORD'NUMBER,WORD'VALUE;                                 00423000
integer CDT'ENTRY,WORD'NUMBER,WORD'VALUE;                               00424000
option privileged,uncallable;                                           00425000
begin                                                                   00426000
                                                                        00427000
entry CDT'GET'WORD,    << This entry is used if the word is  >>         00428000
                       << to be retrieved w/o modification.  >>         00429000
                                                                        00430000
      CDT'ADD'WORD;    << This entry is to be used if the    >>         00431000
                       << value passed is to be 'added' to,  >>         00432000
                       << rather than 'replacing', the orig- >>         00433000
                       << inal value.                        >>         00434000
                                                                        00435000
logical MOD'WORD,      << If true, normal entry point.  If   >>         00436000
                       << false, then don't modify word.     >>         00437000
                                                                        00438000
        ADD'WORD;      << If true, then value is to be added >>         00439000
                       << to current value, rather than      >>         00440000
                       << replacing it.                      >>         00441000
                                                                        00442000
integer OLD'WORD = CDT'SET'WORD; << So we can read old word  >>         00443000
                                                                        00444000
<<***********************************************************>>         00445000
<< This procedure retrieves a word from the CDT entry speci- >>         00446000
<< fied, modifies it to the value provided, and returns the  >>         00447000
<< old value of the word as the function value.              >>         00448000
<<                                                           >>         00449000
<< CDT'ENTRY  - This is the CDT entry to be manipulated.     >>         00450000
<< WORD'NUMBER- This is the CDT offset of the word to be     >>         00451000
<<              modified.  The caller should use the equate  >>         00452000
<<              from the INCLCAC file to insure the proper   >>         00453000
<<              word is retrieved in case the entry values   >>         00454000
<<              are re-arranged in the future.               >>         00455000
<< WORD'VALUE - This is the value that the word is to be set >>         00456000
<<              to.  If CDT'ADD'WORD was called, this value  >>         00457000
<<              is added to the original value.              >>         00458000
<<                                                           >>         00459000
<< CDT'SET'WORD is set to the value of the word prior to     >>         00460000
<<              calling this procedure.  If CDT'ADD'WORD     >>         00461000
<<              was called, this is the NEW value of the     >>         00462000
<<              word.                                        >>         00463000
<<                                                           >>         00464000
<< DB can be anywhere prior to calling this procedure.       >>         00465000
<<***********************************************************>>         00466000
                                                                        00467000
<< Re-define entry as an index >>                                       00468000
integer CDT'INDEX = CDT'ENTRY;                                          00469000
                                                                        00470000
<< Normal entry point >>                                                00471000
MOD'WORD := true;                                                       00472000
ADD'WORD := false;                                                      00473000
go to START;                                                            00474000
                                                                        00475000
CDT'ADD'WORD:                                                           00476000
ADD'WORD := MOD'WORD := true;                                           00477000
go to START;                                                            00478000
                                                                        00479000
CDT'GET'WORD:                                                           00480000
MOD'WORD := false;                                                      00481000
                                                                        00482000
START:                                                                  00483000
                                                                        00484000
<< Make sure CDT table exists >>                                        00485000
DISABLE;                                                                00486000
$if x1=on                                                               00487000
if CACHE'DST = 0 then                                                   00488000
  SUDDENDEATH(CDT'NOT'INITIALIZED);                                     00489000
$if                                                                     00490000
                                                                        00491000
<< Place DB at DST >>                                                   00492000
tos := CACHE'DST'BANK;                                                  00493000
tos := CACHE'DST'OFST;                                                  00494000
EXCHDB;                                                                 00495000
                                                                        00496000
$if x1=on                                                               00497000
<< Check that index passed is valid >>                                  00498000
<< DB must be pointing to the CDT and integer CDT'ENTRY is   >>         00499000
<< used to perform a validity check against.                 >>         00500000
CDT'CHECK'ENTRY;                                                        00501000
$if                                                                     00502000
                                                                        00503000
<< Convert entry into index >>                                          00504000
CDT'INDEX := CDT'INDEX * CDT'ENTRY'SIZE;                                00505000
                                                                        00506000
<< Make sure word offset is valid >>                                    00507000
$if x1=on                                                               00508000
if WORD'NUMBER >= CDT'ENTRY'SIZE then                                   00509000
  SUDDENDEATH(CDT'BAD'WORD'OFST);                                       00510000
$if                                                                     00511000
                                                                        00512000
<< Retrieve word from DST and copy it to return cell >>                 00513000
<< * * DO NOT MODIFY INDEX REGISTER UNTIL NEW VALUE IS STORED >>        00514000
CDT'SET'WORD := CDT'ARRAY(CDT'ENTRY + WORD'NUMBER);                     00515000
                                                                        00516000
<< Place new value in cell >>                                           00517000
if MOD'WORD then                                                        00518000
  if ADD'WORD then                                                      00519000
    begin                                                               00520000
    CDT'ARRAY(CDT'X) := CDT'SET'WORD := WORD'VALUE + OLD'WORD;          00521000
    end                                                                 00522000
  else                                                                  00523000
    CDT'ARRAY(CDT'X) := WORD'VALUE;                                     00524000
                                                                        00525000
<< Place DB back to caller's DB >>                                      00526000
EXCHDB;                                                                 00527000
                                                                        00528000
<< EXIT will return INTERRUPTs to caller's state >>                     00529000
end;  << of procedure CDT'SET'WORD >>                                   00530000
$page "Procedure CDT'SET'DOUBLE / CDT'GET'DOUBLE / CDT'ADD'DOUBLE"      00531000
double procedure CDT'SET'DOUBLE(CDT'ENTRY,WORD'NUMBER,WORD'VALUE);      00532000
value CDT'ENTRY,WORD'NUMBER,WORD'VALUE;                                 00533000
integer CDT'ENTRY,WORD'NUMBER;                                          00534000
double WORD'VALUE;                                                      00535000
option privileged,uncallable;                                           00536000
begin                                                                   00537000
                                                                        00538000
entry CDT'GET'DOUBLE,   << This entry point is used if the   >>         00539000
                        << old value should be returned, but >>         00540000
                        << not modified.                     >>         00541000
                                                                        00542000
      CDT'ADD'DOUBLE;   << This entry point is used if       >>         00543000
                        << WORD'VALUE is to be added, rather >>         00544000
                        << than replace, the double word     >>         00545000
                        << specified by WORD'NUMBER.         >>         00546000
                                                                        00547000
logical MOD'DOUBLE,     << This flag is true if the normal   >>         00548000
                        << procedure entry point is used.    >>         00549000
                                                                        00550000
        ADD'DOUBLE;     << This flag signifies that WORD'VAL->>         00551000
                        << UE should be added to the current >>         00552000
                        << double word.                      >>         00553000
                                                                        00554000
double OLD'DOUBLE = CDT'SET'DOUBLE;  << Re-define return arg >>         00555000
                                                                        00556000
<<***********************************************************>>         00557000
<< This procedure retrieves double from the CDT entry speci- >>         00558000
<< fied, modifies it to the value provided, and returns the  >>         00559000
<< old value of the double word as the function value.       >>         00560000
<<                                                           >>         00561000
<< CDT'ENTRY  - This is the CDT entry to be manipulated.     >>         00562000
<< WORD'NUMBER- This is the CDT offset of the dbl word to be >>         00563000
<<              modified.  The caller should use the equate  >>         00564000
<<              from the INCLCAC file to insure the proper   >>         00565000
<<              word is retrieved in case the entry values   >>         00566000
<<              are re-arranged in the future.               >>         00567000
<< WORD'VALUE - This is the value that the dbl  is to be set >>         00568000
<<              to when CDT'SET'DOUBLE is called.  If CDT'   >>         00569000
<<              ADD'DOUBLE is called, this value is added to >>         00570000
<<              the original double-word value.              >>         00571000
<<                                                           >>         00572000
<< CDT'SET'WORD is set to the value of the dbl word prior to >>         00573000
<<              calling this procedure.  If CDT'ADD'DOUBLE is>>         00574000
<<              called, the value is the new double value of >>         00575000
<<              of the word after adding WORD'VALUE to it.   >>         00576000
<<                                                           >>         00577000
<< DB can be anywhere prior to calling this procedure.       >>         00578000
<<***********************************************************>>         00579000
                                                                        00580000
<< Re-define entry as index >>                                          00581000
integer CDT'INDEX = CDT'ENTRY;                                          00582000
                                                                        00583000
<< Normal entry point >>                                                00584000
MOD'DOUBLE := true;                                                     00585000
ADD'DOUBLE := false;                                                    00586000
go to START;                                                            00587000
                                                                        00588000
CDT'ADD'DOUBLE:                                                         00589000
MOD'DOUBLE := ADD'DOUBLE := true;                                       00590000
go to START;                                                            00591000
                                                                        00592000
CDT'GET'DOUBLE:                                                         00593000
MOD'DOUBLE := false;                                                    00594000
                                                                        00595000
START:                                                                  00596000
                                                                        00597000
<< Make sure CDT table exists >>                                        00598000
DISABLE;                                                                00599000
$if x1=on                                                               00600000
if CACHE'DST = 0 then                                                   00601000
  SUDDENDEATH(CDT'NOT'INITIALIZED);                                     00602000
$if                                                                     00603000
                                                                        00604000
<< Place DB at DST >>                                                   00605000
tos := CACHE'DST'BANK;                                                  00606000
tos := CACHE'DST'OFST;                                                  00607000
EXCHDB;                                                                 00608000
                                                                        00609000
$if x1=on                                                               00610000
<< Check that index passed is valid >>                                  00611000
<< DB must be pointing to the CDT and integer CDT'ENTRY is   >>         00612000
<< used to perform a validity check against.                 >>         00613000
CDT'CHECK'ENTRY;                                                        00614000
$if                                                                     00615000
                                                                        00616000
<< Convert entry into index >>                                          00617000
CDT'INDEX := CDT'INDEX * CDT'ENTRY'SIZE;                                00618000
                                                                        00619000
<< Make sure word offset is valid >>                                    00620000
$if x1=on                                                               00621000
if (WORD'NUMBER+1) >= CDT'ENTRY'SIZE then                               00622000
  SUDDENDEATH(CDT'BAD'WORD'OFST);                                       00623000
$if                                                                     00624000
                                                                        00625000
<< Retrieve word from DST and copy it to return cell >>                 00626000
tos := CDT'ARRAY(CDT'ENTRY + WORD'NUMBER);                              00627000
tos := CDT'ARRAY(CDT'X + 1);  << Second word of double value >>         00628000
<<* * INDEX REGISTER MUST NOT MODIFIED UNTIL NEW VALUE IS    >>         00629000
<<    STORED * *                                             >>         00630000
CDT'SET'DOUBLE := tos;                                                  00631000
                                                                        00632000
<< Place new value in cell >>                                           00633000
if MOD'DOUBLE then                                                      00634000
  begin                                                                 00635000
  if ADD'DOUBLE then                                                    00636000
    begin                                                               00637000
    tos := CDT'SET'DOUBLE := OLD'DOUBLE + WORD'VALUE;                   00638000
    end                                                                 00639000
  else                                                                  00640000
    begin                                                               00641000
    tos := WORD'VALUE;                                                  00642000
    end;                                                                00643000
  CDT'ARRAY(CDT'X) := tos;  << Store second word >>                     00644000
  CDT'ARRAY(CDT'X-1) := tos;<< Store first word  >>                     00645000
  end;                                                                  00646000
                                                                        00647000
<< Place DB back to caller's DB >>                                      00648000
EXCHDB;                                                                 00649000
                                                                        00650000
<< EXIT will return INTERRUPTs to caller's state >>                     00651000
end;  << of procedure CDT'SET'DOUBLE >>                                 00652000
$page "CDT'GET'MD'ENTRY"                                                00653000
integer procedure CDT'GET'MD'ENTRY(LDEV'ENTRY,CD'BASE'SECTOR,           00654000
                                   MD'INDEX);                           00654100
value LDEV'ENTRY,CD'BASE'SECTOR,MD'INDEX;                               00655000
integer LDEV'ENTRY,MD'INDEX;                                            00656000
double CD'BASE'SECTOR;                                                  00657000
option privileged,uncallable,internal;                                  00658000
begin                                                                   00659000
                                                                        00660000
<<********************************************************************>>00661000
<< This procedure obtains a free CDT table entry, places a disc req.  >>00662000
<< entry into it for KERNEL physical requests, and places it in the   >>00663000
<< appropriate place in the LDEV's mapped domain list.                >>00664000
<<                                                                    >>00665000
<< The passed parameters are:                                         >>00666000
<< LDEV'ENTRY        - This is the entry number in the CDT table of   >>00667000
<<                     the LDEV head of this cached disc.             >>00668000
<< CD'BASE'SECTOR    - The double base sector address used to position>>00669000
<<                     this mapped CDT entry into the mapped domain   >>00670000
<<                     list of this LDEV.                             >>00671000
<< MD'INDEX          - If this value is non-neg., it is the mapped    >>00671100
<<                     domain CDT entry number to put the newly-      >>00671200
<<                     obtained mapped CDT ahead of.                  >>00671300
<<                     <-1 - Search & add.                            >>00671307
<<                     =-1 - Add to tail.                             >>00671370
<<                     = 0 - Add to head.                             >>00671440
<<                     > 0 - Add before this CDT entry.               >>00671510
<<                                                                    >>00672000
<< The returned parameter is:                                         >>00673000
<<                                                                    >>00674000
<< CDT'GET'MD'ENTRY - The CDT entry index of the entry obtained.      >>00675000
<<********************************************************************>>00676000
                                                                        00677000
integer CDT'ENTRY  = CDT'GET'MD'ENTRY, << So we can access ptr >>       00678000
        LDREQ,                         << Disc request inx     >>       00679000
        PRIOR'PTR,                     << Previous CDT ptr     >>       00680000
        NEXT'PTR;                      << Next CDT pointer     >>       00681000
                                                                        00682000
logical LOOP'CONTROL;    << Loop exit flag >>                           00683000
                                                                        00684000
equate SYSDISCREQTAB = %1031; << Abs ptr to discreq table >>            00685000
                                                                        00686000
$if x1=off                                                              00686100
DEF'SET'WORD;                                                           00686190
DEF'GET'WORD;                                                           00686280
DEF'ADD'WORD;                                                           00686370
DEF'SET'BIT;                                                            00686460
$if                                                                     00686505
<< First, get an entry from the CDT table >>                            00687000
CDT'ENTRY := CDT'GET'ENTRY;                                             00688000
                                                                        00689000
<< Get a disc request element & place it in the CDT entry >>            00690000
LDREQ := GETDISCREQ(2);  << Pri or secondary, no impede   >>            00691000
if LDREQ = 0 then                                                       00692000
  SUDDENDEATH(CDT'UNAVAIL'DRQ);                                         00693000
CDT'SET'WORD(CDT'ENTRY,CDT'MD'DISCREQ,LDREQ-ABS(SYSDISCREQTAB));        00694000
                                                                        00695000
<< Now place the CDT entry in the proper list position >>               00696000
                                                                        00697000
<<DISABLE;>> <<protect list structure>>                                 00697100
                                                                        00697200
<< If a mapped CDT number was passed, this is a short-cut >>            00697280
NEXT'PTR := MD'INDEX;                                                   00697360
if > then                                                               00697440
  go to SHORT'CUT   << Busch won't like this... >>                      00697520
else if = then                                                          00697530
  go to SHORT'CUT'1                                                     00697531
else if MD'INDEX = -1 then                                              00697560
  begin                                                                 00697600
  PRIOR'PTR := CDT'GET'WORD(LDEV'ENTRY,CDT'DE'MAPD'TAIL,0);             00697640
  go to SHORT'CUT'2;                                                    00697680
  end;                                                                  00697720
                                                                        00697760
<< Get pointer to first entry on list >>                                00698000
NEXT'PTR := CDT'GET'WORD(LDEV'ENTRY,CDT'DE'MAPD'HEAD,0);                00699000
if NEXT'PTR = 0 then                                                    00700000
  begin  << This is the first mapped domain on the list >>              00701000
                                                                        00701100
SHORT'CUT'1:                                                            00701200
                                                                        00701300
  CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'HEAD,CDT'ENTRY);                  00702000
  CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'TAIL,CDT'ENTRY);                  00703000
  << Pointers in obtained CDT should already be zero >>                 00704000
  end                                                                   00705000
else                                                                    00706000
  begin  << We must loop through mapped CDT regions >>                  00707000
  LOOP'CONTROL := true;                                                 00708000
  while LOOP'CONTROL do                                                 00709000
    begin                                                               00710000
    << Check current mapped CDT's base  address against BASE >>         00711000
    if CDT'GET'DOUBLE(NEXT'PTR,CDT'MD'SECTOR,0D) >                      00712000
       CD'BASE'SECTOR then                                              00713000
      begin  << Insert new mapped CDT entry in front of this >>         00714000
                                                                        00714100
SHORT'CUT:                                                              00714200
                                                                        00714300
      <<make this guy next's prior,save his old prior>>                 00715000
      PRIOR'PTR := CDT'SET'WORD(NEXT'PTR,CDT'MD'PREV,CDT'ENTRY);        00718000
      << Fix new CDT's pointers >>                                      00719000
      CDT'SET'WORD(CDT'ENTRY,CDT'MD'NEXT,NEXT'PTR);                     00720000
      CDT'SET'WORD(CDT'ENTRY,CDT'MD'PREV,PRIOR'PTR);                    00721000
      << Fix prev CDT entry's next pointer >>                           00722000
      if PRIOR'PTR = 0 then                                             00723000
        begin  << This new CDT is the newhead entry >>                  00724000
        CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'HEAD,CDT'ENTRY);            00725000
        end                                                             00726000
      else                                                              00727000
        begin  << There is another CDT entry preceding >>               00728000
        CDT'SET'WORD(PRIOR'PTR,CDT'MD'NEXT,CDT'ENTRY);                  00729000
        end;                                                            00730000
      << Stop looping >>                                                00731000
      LOOP'CONTROL := false;                                            00732000
      end  << Of inserting >>                                           00733000
    else if < then                                                      00734000
      begin   << Step to next mapped CDT domain >>                      00735000
      PRIOR'PTR := NEXT'PTR;  << Save current pointer >>                00736000
      NEXT'PTR := CDT'GET'WORD(NEXT'PTR,CDT'MD'NEXT,0);                 00737000
      if NEXT'PTR = 0 then                                              00738000
        begin  << This was the last mapped CDT, so append >>            00739000
                                                                        00739100
SHORT'CUT'2:                                                            00739200
                                                                        00739300
        << Put new CDT in last CDT's NEXT pointer >>                    00740000
        CDT'SET'WORD(PRIOR'PTR,CDT'MD'NEXT,CDT'ENTRY);                  00741000
        << Update tail pointer in LDEV CDT entry >>                     00742000
        CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'TAIL,CDT'ENTRY);            00743000
        << Point new CDT back to old prior >>                           00744000
        CDT'SET'WORD(CDT'ENTRY,CDT'MD'PREV,PRIOR'PTR);                  00745000
        << Stop looping >>                                              00746000
        LOOP'CONTROL := false;                                          00747000
        end;  << of appending to end-of-chain >>                        00748000
      end   << of stepping through next mapped domain >>                00749000
    else                                                                00749100
                                                                        00749200
      << There should NEVER be a match-it means overlap !!! >>          00749300
      SUDDENDEATH(SFKERNCACHEINTBAD);                                   00749400
                                                                        00749450
    end;  <<of WHILE processing >>                                      00750000
  end; << of processing mapped request that is not first >>             00751000
                                                                        00752000
<< Initialize CDT to proper state >>                                    00753000
CDT'SET'BIT(CDT'ENTRY,CDT'ABS'BIT,1);                                   00754000
                                                                        00755000
<< Increment mapped count >>                                            00756000
CDT'ADD'WORD(LDEV'ENTRY,CDT'DE'MAPD'CNT,1);                             00757000
                                                                        00758000
<< Place LDEV in mapped CDT entry >>                                    00759000
CDT'SET'WORD(CDT'ENTRY,CDT'MD'LDEV,                                     00760000
   CDT'GET'WORD(LDEV'ENTRY,CDT'DE'LDEV,0));                             00761000
                                                                        00762000
$if x1=on                                                               00763000
MMSTAT(MMSTAT'GET'CDT,CDT'ENTRY,2,0);                                   00764000
$if                                                                     00765000
end; << of procedure CDT'GET'MD'ENTRY >>                                00766000
$page "CDT'REL'MD'ENTRY"                                                00767000
procedure CDT'REL'MD'ENTRY(LDEV'ENTRY,CDT'ENTRY);                       00768000
value LDEV'ENTRY,CDT'ENTRY;                                             00769000
integer LDEV'ENTRY,CDT'ENTRY;                                           00770000
option privileged,uncallable,internal;                                  00771000
begin                                                                   00772000
                                                                        00773000
<<********************************************************************>>00774000
<< This procedure releases a mapped CDT entry by returning the disc   >>00775000
<< request, delinking the mapped CDT, and returning it to the free    >>00776000
<< list.  The passed parameters are:                                  >>00777000
<<                                                                    >>00778000
<< LDEV'ENTRY     - The CDT device entry index for this mapped CDT.   >>00779000
<< CDT'ENTRY      - The mapped CDT entry to release.                  >>00780000
<<********************************************************************>>00781000
                                                                        00782000
integer PRIOR'PTR,       << Pointer to prior mapped domain >>           00783000
        NEXT'PTR,        << Pointer to next mapped domain >>            00784000
        DISCREQ;         << Disc request entry >>                       00785000
                                                                        00786000
equate SYSDISCREQTAB = %1031; << SYSDB offset to disc req tbl >>        00787000
                                                                        00788000
$if x1=off                                                              00788100
DEF'SET'WORD;                                                           00788200
DEF'ADD'WORD;                                                           00788300
$if                                                                     00788400
$if x1=on                                                               00789000
MMSTAT(MMSTAT'GET'CDT,CDT'ENTRY,3,LDEV'ENTRY);                          00790000
$if                                                                     00791000
                                                                        00792000
  << Release disc request >>                                            00793000
TOS:=CDT'SET'WORD(CDT'ENTRY,CDT'MD'DISCREQ,0) +                         00794000
   ABS(SYSDISCREQTAB);                                                  00795000
RETURNDISCREQ(*);                                                       00796000
                                                                        00797100
<<DISABLE;>> <<protect list structure>>                                 00797190
                                                                        00797200
<< Now, delink the request >>                                           00798000
PRIOR'PTR := CDT'GET'WORD(CDT'ENTRY,CDT'MD'PREV,0);                     00799000
NEXT'PTR := CDT'GET'WORD(CDT'ENTRY,CDT'MD'NEXT,0);                      00800000
                                                                        00801000
<< If next pointer is zero, this is tail on list >>                     00802000
if NEXT'PTR = 0 then                                                    00803000
  begin  << Make prior ptr the new tail pointer >>                      00804000
  CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'TAIL,PRIOR'PTR);                  00805000
  end                                                                   00806000
else                                                                    00807000
  begin  << Link next mapped CDT onto this one's prior CDT >>           00808000
  CDT'SET'WORD(NEXT'PTR,CDT'MD'PREV,PRIOR'PTR);                         00809000
  end;                                                                  00810000
                                                                        00811000
<< If prior pointer is zero, this is first one on list >>               00812000
if PRIOR'PTR = 0 then                                                   00813000
  begin  << This is the first one >>                                    00814000
  CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'HEAD,NEXT'PTR);                   00815000
  end                                                                   00816000
else                                                                    00817000
  begin << Make prior point to NEXT >>                                  00818000
  CDT'SET'WORD(PRIOR'PTR,CDT'MD'NEXT,NEXT'PTR);                         00819000
  end;                                                                  00820000
                                                                        00821000
<< Decrement count of mapped domains >>                                 00822000
CDT'ADD'WORD(LDEV'ENTRY,CDT'DE'MAPD'CNT,-1);                            00823000
                                                                        00824000
<< Tell KERNEL to unmap this region >>                                  00825000
CDT'UNMAP'REGION(LDEV'ENTRY,CDT'ENTRY);                                 00826000
                                                                        00827000
<< Release mapped CDT entry >>                                          00828000
CDT'FREE'ENTRY(CDT'ENTRY);                                              00829000
                                                                        00830000
end;  << of procedure CDT'REL'MD'ENTRY >>                               00831000
$page "CDT'QUEUE'LDR"                                                   00832000
procedure CDT'QUEUE'LDR(CDT'ENTRY,LDR'INDEX,QUEUE);                     00833000
value CDT'ENTRY,LDR'INDEX,QUEUE;                                        00834000
integer CDT'ENTRY,LDR'INDEX,QUEUE;                                      00835000
option privileged,uncallable;                                           00836000
begin                                                                   00837000
                                                                        00838000
<<********************************************************************>>00839000
<< This procedure takes the logical disc request pointed to by        >>00840000
<< LDR'INDEX and queues it to the end of the list pointed to by QUEUE >>00841000
<< on the specified CDT entry.                                        >>00842000
<<                                                                    >>00843000
<< The passed parameters are:                                         >>00844000
<<                                                                    >>00845000
<< CDT'ENTRY     - The entry number in the CDT table to queue this LDR>>00846000
<<                 onto.                                              >>00847000
<< LDR'INDEX     - The index of the logical disc request to queue onto>>00848000
<<                 the CDT entry.                                     >>00849000
<< QUEUE         - An offset (queue pointer) to the queue to place the>>00850000
<<                 request onto in the CDT entry.                     >>00851000
<<********************************************************************>>00852000
                                                                        00853000
logical LDR'ENTRY'INDEX;  << To satisfy INCLLDR req. >>                 00854000
integer LINK'PTR;                                                       00855000
                                                                        00856000
$if x1=off                                                              00856100
DEF'SET'WORD;                                                           00856200
DEF'GET'WORD;                                                           00856300
$if                                                                     00856400
$if x1=on                                                               00857000
MMSTAT(MMSTAT'QUEUE'LDR,CDT'ENTRY,LDR'INDEX,QUEUE);                     00858000
$if                                                                     00859000
                                                                        00860000
<< Load current logical disc request pointer >>                         00861000
LDR'ENTRY'INDEX := LDR'INDEX;                                           00862000
                                                                        00863000
DISABLE;  << To protect link pointers >>                                00863100
<< If queue is empty, place it on the head >>                           00864000
LINK'PTR := CDT'GET'WORD(CDT'ENTRY,QUEUE,0);                            00865000
if LINK'PTR = 0 then                                                    00866000
  begin  << This is first on the list >>                                00867000
  CDT'SET'WORD(CDT'ENTRY,QUEUE,LDR'INDEX);                              00868000
  LDR'PREVQ := LDR'NEXTQ := 0;                                          00869000
  end                                                                   00870000
else                                                                    00871000
  begin   << We must go down the list until a tail is found >>          00872000
  while LINK'PTR <> 0 do                                                00873000
    begin                                                               00874000
    LDR'ENTRY'INDEX := LINK'PTR;                                        00875000
    LINK'PTR := LDR'NEXTQ;                                              00876000
    end;                                                                00877000
                                                                        00878000
  << At this point, we are at the end of the chain >>                   00879000
  << Load new request's pointer into last logical request's next ptr >> 00880000
  LDR'NEXTQ := LDR'INDEX;                                               00881000
                                                                        00882000
  << Save former tail LDR's index >>                                    00883000
  LINK'PTR := LDR'ENTRY'INDEX;                                          00884000
                                                                        00885000
  << Move pointer to new tail and fix its queue pointers >>             00886000
  LDR'ENTRY'INDEX := LDR'INDEX;                                         00887000
  LDR'PREVQ := LINK'PTR;                                                00888000
  LDR'NEXTQ := 0;                                                       00889000
  end;                                                                  00890000
                                                                        00891000
<< If placing LDR on active list, turn on QUEUED bit >>                 00892000
if QUEUE = CDT'MD'LDR'HEAD then                                         00893000
  begin                                                                 00894000
  LDR'CDTQUED := 1;                                                     00895000
  end;                                                                  00896000
                                                                        00897000
end;  << of procedure CDT'QUEUE'REQUEST >>                              00898000
$page "CDT'DEQUEUE'LDR"                                                 00899000
procedure CDT'DEQUEUE'LDR(CDT'ENTRY,LDR'INDEX,QUEUE);                   00900000
value CDT'ENTRY,LDR'INDEX,QUEUE;                                        00901000
integer CDT'ENTRY,LDR'INDEX,QUEUE;                                      00902000
option privileged,uncallable;                                           00903000
begin                                                                   00904000
                                                                        00905000
<<********************************************************************>>00906000
<< This procedure takes the logical disc request pointed to by        >>00907000
<< LDR'INDEX and dequeues it from the list pointed to by QUEUE        >>00908000
<< on the specified CDT entry.                                        >>00909000
<<                                                                    >>00910000
<< The passed parameters are:                                         >>00911000
<<                                                                    >>00912000
<< CDT'ENTRY     - The entry number in the CDT table to dequeue this  >>00913000
<<                 LDR from.                                          >>00914000
<< LDR'INDEX     - The index of the logical disc request to dequeue   >>00915000
<<                 from the CDT entry.                                >>00916000
<< QUEUE         - An offset (queue pointer) to the queue to remove   >>00917000
<<                 the request from on the CDT entry.                 >>00918000
<<********************************************************************>>00919000
                                                                        00920000
logical LDR'ENTRY'INDEX,  << To satisfy INCLLDR req. >>                 00921000
        NOT'FND'FLAG;     << Loop control flag >>                       00922000
                                                                        00923000
integer LINK'PTR,PRIOR'PTR,NEXT'PTR;                                    00924000
                                                                        00925000
$if x1=off                                                              00925100
DEF'GET'WORD;                                                           00925200
DEF'SET'WORD;                                                           00925300
$if                                                                     00925400
$if x1=on                                                               00926000
MMSTAT(MMSTAT'DEQUEUE'LDR,CDT'ENTRY,LDR'INDEX,QUEUE);                   00927000
$if                                                                     00928000
                                                                        00929000
<< Load current logical disc request pointer >>                         00930000
LDR'ENTRY'INDEX := LDR'INDEX;                                           00931000
                                                                        00932000
DISABLE;   << To protect linkage structure >>                           00932100
                                                                        00932200
<< If queue is empty, BAD NEWS! >>                                      00933000
LINK'PTR := CDT'GET'WORD(CDT'ENTRY,QUEUE,0);                            00934000
if LINK'PTR = 0 then                                                    00935000
  SUDDENDEATH(CDT'BAD'LDR'INDEX)                                        00936000
else                                                                    00937000
  begin   << We must go down the list until a tail is found >>          00938000
  << If link pointer is first on the list, take care of it here >>      00939000
  if LINK'PTR = LDR'INDEX then                                          00940000
    begin  << Yes, it is >>                                             00941000
    << Get new list head >>                                             00942000
    LDR'ENTRY'INDEX := LDR'NEXTQ;                                       00943000
    if <> then LDR'PREVQ := 0;                                          00944000
    CDT'SET'WORD(CDT'ENTRY,QUEUE,LDR'ENTRY'INDEX);                      00945000
    end                                                                 00946000
  else                                                                  00947000
    begin  << We must search down the list >>                           00948000
    NOT'FND'FLAG := true;                                               00949000
    while NOT'FND'FLAG do                                               00950000
      begin                                                             00951000
      LDR'ENTRY'INDEX := LINK'PTR;                                      00952000
      LINK'PTR := LDR'NEXTQ;                                            00953000
      if = then  << We didn't find it >>                                00954000
        SUDDENDEATH(CDT'BAD'LDR'INDEX);                                 00955000
      if LINK'PTR = LDR'INDEX then                                      00956000
        begin  << We found it >>                                        00957000
        NOT'FND'FLAG := false;                                          00958000
        PRIOR'PTR := LDR'ENTRY'INDEX;                                   00959000
        LDR'ENTRY'INDEX := LINK'PTR;  << Point to req we're deleting >> 00960000
        NEXT'PTR := LDR'NEXTQ;                                          00961000
        if NEXT'PTR <> 0 then                                           00962000
          begin  << There is a LDR following this one >>                00963000
          LDR'ENTRY'INDEX := NEXT'PTR;                                  00964000
          LDR'PREVQ := PRIOR'PTR;  << Point to the new prior LDR >>     00965000
          end;                                                          00966000
        << Set pointer back to prior LDR >>                             00967000
        LDR'ENTRY'INDEX := PRIOR'PTR;                                   00968000
        << Fix next pointer >>                                          00969000
        LDR'NEXTQ := NEXT'PTR;                                          00970000
        end; << of processing HIT >>                                    00971000
      end;  <<of processing WHILE loop >>                               00972000
    end; << of searching list >>                                        00973000
  end;  << of processing non-zero list >>                               00974000
                                                                        00975000
<< If the LDR was on the active list, turn off QUEUED bit >>            00976000
if QUEUE = CDT'MD'LDR'HEAD then                                         00977000
  begin                                                                 00978000
  LDR'ENTRY'INDEX := LDR'INDEX;                                         00978100
  LDR'CDTQUED := 0;                                                     00979000
  end;                                                                  00980000
                                                                        00981000
end;  << of procedure CDT'DEQUEUE'LDR >>                                00982000
$page "CDT'FIND'DE"                                                     01098000
integer procedure CDT'FIND'DE(LDEV);                                    01099000
value LDEV;                                                             01100000
integer LDEV;                                                           01101000
option privileged,uncallable;                                           01102000
begin                                                                   01103000
                                                                        01104000
<<********************************************************************>>01105000
<< This procedure scans the list of cached LDEVs and returns the entry>>01106000
<< of the CDT entry for this LDEV.  The passed parameter is:          >>01107000
<<                                                                    >>01108000
<< LDEV    - This is the logical device number to find the corres-    >>01109000
<<           ponding CDT disc entry for.                              >>01110000
<<                                                                    >>01111000
<< Returned parameter-                                                >>01112000
<<                                                                    >>01113000
<< CDT'FIND'LDEV - This is the CDT disc entry number of the LDEV.     >>01114000
<<                 Zero is returned if the LDEV is not cached.       >> 01114100
<<********************************************************************>>01115000
                                                                        01116000
integer LDEV'LINK'PTR = CDT'FIND'DE,   << Re-define return parameter  >>01117000
        DE'LDEV,                       << LDEV from CDT disc entry    >>01118000
        CDT'LINK'PTR;                  << Pointer link work variable  >>01119000
                                                                        01120000
$if x1=off                                                              01120100
DEF'GET'WORD;                                                           01120200
$if                                                                     01120300
if CACHE'DST = 0 then  << Caching has been disabled >>                  01120400
  CDT'FIND'DE := 0                                                      01120460
else                                                                    01120520
  begin                                                                 01120580
  << Find LDEV CDT entry >>                                             01121000
  LDEV'LINK'PTR := 0;                                                   01122000
  CDT'LINK'PTR := CDT'GET'WORD(0,CDT'DISC'HEAD,0);                      01123000
                                                                        01124000
  while CDT'LINK'PTR <> 0 do                                            01125000
    begin  << Look for LDEV >>                                          01126000
    DE'LDEV := CDT'GET'WORD(CDT'LINK'PTR,CDT'DE'LDEV,0);                01127000
    if LDEV = DE'LDEV then                                              01128000
      begin  << Found the LDEV >>                                       01129000
      LDEV'LINK'PTR := CDT'LINK'PTR;                                    01130000
      CDT'LINK'PTR := 0;  << To terminate search >>                     01131000
      end                                                               01132000
    else                                                                01133000
      CDT'LINK'PTR:=CDT'GET'WORD(CDT'LINK'PTR,CDT'DE'NEXT'LDEV,0);      01134000
    end;                                                                01135000
  end;                                                                  01135100
                                                                        01136000
$if x1=on                                                               01137000
MMSTAT(MMSTAT'FIND'DE,LDEV,LDEV'LINK'PTR,0);                            01138000
$if                                                                     01142000
                                                                        01143000
end;  << of procedure CDT'FIND'DE >>                                    01144000
$page "CDT'FORCE'LDR'COMPLETION"                                        01145000
procedure CDT'FORCE'LDR'COMPLETION(LDR'INDEX);                          01146000
value LDR'INDEX;                                                        01147000
integer LDR'INDEX;                                                      01148000
option privileged,uncallable;                                           01149000
begin                                                                   01150000
                                                                        01151000
<<***********************************************************>>         01151100
<< This procedure forces any pending I/O requests which are  >>         01152000
<< preventing the completion of the current I/O request, to  >>         01153000
<< be completed.  It is called from locking routines and from>>         01154000
<< WAITFORIO.  The passed parameter is:                      >>         01155000
<<                                                           >>         01156000
<< LDR'INDEX  - Disc request table relative offset to the    >>         01157000
<<              logical disc request.                        >>         01158000
<<                                                           >>         01159000
<< The caller is assumed to be DISABLED prior to calling.    >>         01159100
<< The caller must be able to withstand being "blocked".  No >>         01160000
<< assumption is made as to the location of DB.              >>         01161000
<<***********************************************************>>         01162000
                                                                        01163000
integer CDT'ENTRY,        << CDT entry associated w/LDR      >>         01164000
        CALLERS'PIN,      << PIN of WAITFORIOX caller        >>         01164100
        MY'PIN,           << Caller's PIN number             >>         01164190
        WORK'LDR,         << Current LDR trying to complete  >>         01165000
        SYSDB'LDR'INX,    << SYSDB logical disc req index    >>         01165100
        SAVE'DB,          << For call to SETSYSDB            >>         01165190
        DST,              << DST of LDR trying to complete   >>         01166000
        WORK'CDT,         << CDT entry trying to complete    >>         01168000
        LDEV'ENTRY;       << LDEV CDT entry for this LDR     >>         01169000
                                                                        01170000
logical LDR'ENTRY'INDEX,  << To satisfy LDR equates/defines  >>         01171000
        SAVE'LDR,         << Save old LDR'ENTRY'INDEX        >>         01171010
        INHIBIT'PINSWITCH,<< Don't switch PINS in LDR        >>         01171019
        DONE'FLAG;        << Loop control flag               >>         01171100
                                                                        01171110
entry CDT'FORCE'CDT'COMPLETION;                                         01171120
$page                                                                   01171200
subroutine IMPEDE'ME(IMPEDE'CDT);                                       01171280
value IMPEDE'CDT;                                                       01171360
integer IMPEDE'CDT;                                                     01171440
begin                                                                   01171520
                                                                        01171560
<< This subroutine is used whenever a write of a cached >>              01171600
<< domain is in-progress, the region is in memory, and  >>              01171640
<< the LDR must wait for the write to finish.           >>              01171680
                                                                        01171720
MY'PIN := (ABS(CPCB) - ABS(PCBP)) / PCBSIZE;                            01171721
                                                                        01171722
<< Get in PCB list for this CDT >>                                      01171730
CALLERS'PIN:=CDT'GET'WORD(IMPEDE'CDT,CDT'MD'IMPEDED,0);                 01171731
if CALLERS'PIN = 0 then                                                 01171732
  CDT'SET'WORD(IMPEDE'CDT,CDT'MD'IMPEDED,MY'PIN);                       01171733
STRINGPINATTAIL(CALLERS'PIN,0);                                         01171740
                                                                        01171741
SAVE'LDR := LDR'ENTRY'INDEX;                                            01171742
LDR'ENTRY'INDEX := CDT'GET'WORD(IMPEDE'CDT,                             01171743
                   CDT'MD'DISCREQ,0);                                   01171744
                                                                        01171745
<< Adjust write priority if request is NOT completed >>                 01171746
if not LDR'DONE then                                                    01171747
  BUMPWRITEPRI(LDR'ENTRY'INDEX,PROCESSPRI(MY'PIN));                     01171752
                                                                        01171754
LDR'ENTRY'INDEX := SAVE'LDR;                                            01171755
<< Impede, waiting for WRITE to complete >>                             01171760
IMPEDE(0);                                                              01171790
                                                                        01171800
<< CDT'COMPLETOR checks this list & removes any waitors >>              01171810
end;                                                                    01171820
                                                                        01172000
$page                                                                   01173000
subroutine MAKE'SEGS'PRESENT(LD'REQ);                                   01174000
value LD'REQ;                                                           01175000
integer LD'REQ;                                                         01176000
begin                                                                   01177000
                                                                        01178000
<< Attempt to make this LDR's CDT and DST present >>                    01179000
LDR'ENTRY'INDEX := LD'REQ;  << New index >>                             01180000
DST := LDR'BUFDST;                                                      01181000
if DST < 0      << Stack bit is set >>                                  01182000
then DST.(0:1) := 0;     << Turn off STACK bit >>                       01183000
WORK'CDT := BUILDOBJID(MAPPEDDOMAINOBJECT,LDR'CDT,0);                   01184000
                                                                        01184010
<< Loop until CACHE MOVE is done >>                                     01184020
DONE'FLAG := false;                                                     01184021
while (LDR'MOVE'DONE=0) and (not DONE'FLAG) do                          01184040
  begin <<force in the objects to allow the cache move>>                01184050
  if ISOBJECTABSENT(DST)                                                01184060
  then QUEUEONOBJECT(DST)                                               01184080
  else if ISOBJECTABSENT(WORK'CDT)                                      01184120
  then QUEUEONOBJECT(WORK'CDT)                                          01184140
  else if CDT'GET'BIT(WORK'CDT.OBJIDDSTFIELD,CDT'IMO'BIT,0)             01184141
  then IMPEDE'ME(WORK'CDT.OBJIDDSTFIELD)                                01184142
  else DONE'FLAG := true;  << Both here, so leave >>                    01184162
  end;  << Of expediting cache move completion >>                       01184170
end;                                                                    01191000
$page                                                                   01192000
subroutine SCAN'DEFERRED'QUEUE;                                         01193000
begin                                                                   01194000
                                                                        01195000
<< This procedure scans the disabled disc request queue for >>          01196000
<< a matching CDT and attempts to force its completion.     >>          01197000
                                                                        01197010
<< Load deferred disc req pointer into LDR'ENTRY'INDEX      >>          01197020
LDR'ENTRY'INDEX := 0;    << To point to table header        >>          01197030
SYSDB'LDR'INX   := LDR'PARM1; << Actually, deferred head    >>          01197040
                                                                        01197041
<< If it's zero, we have a logic problem >>                             01197042
if = then                                                               01197043
  SUDDENDEATH(CDT'LOGIC'PROBLEM);                                       01197044
                                                                        01197045
while SYSDB'LDR'INX <> 0 do                                             01197050
  begin  << Scan queue >>                                               01197060
  LDR'ENTRY'INDEX := SYSDB'LDR'INX - ABS(SYSDISCREQTAB);                01197061
  if INTEGER(LDR'CDT) = CDT'ENTRY then                                  01197070
    begin << This is a MATCH, so force it to complete       >>          01197080
    MAKE'SEGS'PRESENT(LDR'ENTRY'INDEX);                                 01197090
    SYSDB'LDR'INX   := 0;  << To terminate looping          >>          01197100
    end                                                                 01197110
  else                                                                  01197120
    begin                                                               01197121
    SYSDB'LDR'INX   := LDR'NEXTQ; << Point to next in list  >>          01197130
                                                                        01197131
    << If the list is exhausted, we have a logic problem    >>          01197132
    if = then                                                           01197133
      SUDDENDEATH(CDT'LOGIC'PROBLEM);                                   01197134
    end;                                                                01197135
  end;                                                                  01197140
                                                                        01197150
<< Restore LDR pointer (index) >>                                       01197160
LDR'ENTRY'INDEX := LDR'INDEX;                                           01197170
                                                                        01197180
end;                                                                    01198000
$page                                                                   01199000
subroutine PROCESS'CDT'QUEUE;                                           01200000
begin                                                                   01201000
                                                                        01202000
<< If this LDR is already on the CDT's active queue, >>                 01202010
<< just let it complete naturally.                   >>                 01202020
do                                                                      01202030
  begin  << We must get things out of the way >>                        01202060
  << Get first active LDR on CDT & force completion >>                  01203000
  WORK'LDR := CDT'GET'WORD(CDT'ENTRY,CDT'MD'LDR'HEAD,0);                01204000
  if WORK'LDR <> 0 then                                                 01205000
    begin   << Force completion >>                                      01206000
    MAKE'SEGS'PRESENT(WORK'LDR);                                        01207000
    end                                                                 01208000
  else                                                                  01209000
    begin  << We must scan deferred disc request queue >>               01210000
    if CDT'GET'BIT(CDT'ENTRY,CDT'WAIT'ON'NOPOST,0) = 0 then             01210100
      SCAN'DEFERRED'QUEUE                                               01211000
    else                                                                01211100
      << Wait for segment write to complete >>                          01211200
      IMPEDE'ME(CDT'ENTRY);                                             01211300
    end;                                                                01212000
  end until (LDR'CDTQUED = 1) or (LDR'MOVE'DONE = 1);                   01212100
end;                                                                    01213000
$page                                                                   01214000
$if x7=on                                                               01214100
subroutine PROCESS'FLUSH'QUEUE;                                         01215000
begin                                                                   01216000
                                                                        01217000
<< Get head CDT in ldev's FLUSH queue >>                                01218000
CDT'ENTRY := CDT'GET'WORD(LDEV'ENTRY,CDT'DE'FLUSH'HD,0);                01219000
if CDT'ENTRY = 0 then                                                   01220000
  SUDDENDEATH(CDT'LOGIC'PROBLEM)                                        01221000
else                                                                    01222000
  PROCESS'CDT'QUEUE;                                                    01223000
                                                                        01224000
end;                                                                    01225000
$if                                                                     01225100
$page                                                                   01226000
                                                                        01226300
INHIBIT'PINSWITCH := false;                                             01226307
go to START;                                                            01226314
                                                                        01226321
CDT'FORCE'CDT'COMPLETION:                                               01226328
INHIBIT'PINSWITCH := true;                                              01226329
                                                                        01226330
START:                                                                  01226331
                                                                        01226332
<< We should be DISABLE'd prior to calling this routine >>              01226370
                                                                        01226440
LDR'ENTRY'INDEX := LDR'INDEX;                                           01227000
                                                                        01228000
<< If this process must stop for cache, count it >>                     01229000
if not LDR'DONE then  << Not marked completed >>                        01230000
  if not INHIBIT'PINSWITCH then << Not a FLUSH call >>                  01230100
    CDT'ADD'DOUBLE(                                                     01230200
      CDT'FIND'DE(LDR'LDEV),   << CDT# of LDEV entry >>                 01230300
      CDT'DE'STOP,             << Inc STOP counter   >>                 01230400
      1D);                                                              01230500
                                                                        01230600
If (LDR'MOVE'DONE = 0) then                                             01231000
  begin  << Move not done on LDR >>                                     01232000
                                                                        01232100
  << Put DB to SYSDB for KERNEL calls >>                                01232200
  SAVE'DB := SETSYSDB;                                                  01232300
                                                                        01233000
  << If the caller's PIN is different than the PIN in >>                01233100
  << the logical disc request, we must fix-up locality>>                01233200
  CALLERS'PIN := (ABS(CPCB)-ABS(PCBP))/PCBSIZE;                         01233300
  if CALLERS'PIN <> integer(LDR'PCB) and                                01233400
     not INHIBIT'PINSWITCH then                                         01233401
    begin  << Adjust localities >>                                      01233450
    << Decrement initiator's prefetch count >>                          01233500
    tos := (integer(LDR'PCB)*PCBSIZE) + ABS(PCBP) - %1000;              01233550
    tos := WORK'CDT := BUILDOBJID(MAPPEDDOMAINOBJECT,                   01233600
                                  LDR'CDT,0);                           01233650
    tos := 0D;                                                          01233700
    tos.decprefetchcntflag := 1;                                        01233725
    ADJUSTLOCALITY(*,*,*,*);                                            01233750
    LDR'PCB := CALLERS'PIN;                                             01233772
                                                                        01233775
    << Now, add domain to caller's locality >>                          01233800
    tos := ABS(ABS(CPCB) + SLLIXWORDNUM);                               01233825
    tos := WORK'CDT;                                                    01233850
    tos := 0;                                                           01233862
    tos.bumpprefetchcntflag := 1;                                       01233874
    ADDTOLOCALITY(*,*,*);                                               01233886
                                                                        01233898
    end;                                                                01233910
                                                                        01233922
  << If LDR is not on CDT's active queue, force it there>>              01233929
  if LDR'CDTQUED = 0 or                                                 01233936
     INHIBIT'PINSWITCH then  << We must assume responsibility >>        01233937
                             << for forcing completion.  WAIT >>        01233938
                             << FORIO was NOT called.         >>        01233939
    begin                                                               01233943
    CDT'ENTRY := LDR'CDT;                                               01234000
    LDEV'ENTRY := CDT'FIND'DE(LDR'LDEV);                                01235000
                                                                        01236000
    PROCESS'CDT'QUEUE;                                                  01241000
    end;                                                                01242000
                                                                        01244000
  RESETDB(SAVE'DB);                                                     01244100
                                                                        01244200
  end;                                                                  01245000
                                                                        01246000
end;  << of procedure CDT'FORCE'LDR'COMPLETION >>                       01247000
$page "CDT'LOCK'RANGE"                                                  01248000
<< Since LOCK code is extremely low-usage and would require >>          01248100
<< exotic mechanisms to implement, it is currently NOT      >>          01248200
<< implemented in disc caching.  Routines, such as FLUSH'   >>          01248300
<< CACHE, CDT'ATTACHIO, and UNCACHE'LDEV would call this    >>          01248400
<< mechanism.  Therefore, all code will disabled via a      >>          01248450
<< compiler switch, S7.  The locking code in CDT'INITIATOR  >>          01248500
<< will not be conditioned, and is an exception.            >>          01248550
$if x7=on                                                               01248595
integer procedure CDT'LOCK'RANGE(LDEV'ENTRY,LDR'ADR,UPPER'LDR'ADR);     01249000
value LDEV'ENTRY,LDR'ADR,UPPER'LDR'ADR;                                 01250000
integer LDEV'ENTRY;                                                     01251000
double LDR'ADR,UPPER'LDR'ADR;                                           01252000
option privileged,uncallable;                                           01253000
begin                                                                   01254000
                                                                        01255000
<<********************************************************************>>01256000
<< This procedure scans the mapped domains for a cached LDEV and locks>>01257000
<< all overlapping and partially overlapping domains.  These domains  >>01258000
<< are marked to be in a "FLUSH" state, and a new mapped CDT is       >>01259000
<< obtained in the "LOCKED" state, which is linked-in the mapped      >>01260000
<< domain list to intercept any subsequent overlapping requests.      >>01261000
<< The lock count is set to 1 + the number of flushing CDTs that had  >>01262000
<< to be moved onto the ldev's flush queue.  The additional lock count>>01263000
<< is to allow the caller to gain control without giving up the lock. >>01264000
<<                                                                    >>01265000
<< The passed parameters are:                                         >>01266000
<<                                                                    >>01267000
<< LDEV'ENTRY   - This is the CDT disc entry for the LDEV whose         01268000
<<                mapped domains are to be locked.                    >>01269000
<< LDR'ADR      - This is the low sector address to lock.             >>01270000
<< UPPER'LDR'ADR- This is the upper sector address of the range to    >>01271000
<<                lock.  This is actually the sector number + 1 of    >>01272000
<<                the highest sector address to lock.                 >>01273000
<<                                                                    >>01274000
<< Returned parameter -                                               >>01275000
<<                                                                    >>01276000
<< CDT'LOCK'RANGE  - The mapped CDT entry of the domain owning the    >>01277000
<<                   lock.                                            >>01278000
<<********************************************************************>>01279000
                                                                        01280000
integer HLD'BEG,         << Ptr to mapd CDT prior to lock range >>      01281000
        HLD'END,         << Ptr to mapd CDT after lock range    >>      01282000
        NEXT'PTR,        << Ptr to last mapd CDT in lock range  >>      01283000
        PRIOR'PTR,       << Ptr to 1st mapd CDT in lock range   >>      01284000
        CDT'FLGS,        << Flags word in CDT entry.            >>      01285000
        CDT'ENTRY;       << New CDT entry obtained              >>      01286000
                                                                        01287000
double CDT'ADR,          << CDT base sector address             >>      01288000
       UPPER'CDT'ADR;    << CDT limit sector address            >>      01289000
                                                                        01290000
DEF'SET'WORD;                                                           01290200
DEF'GET'WORD;                                                           01290300
MMSTAT(MMSTAT'LOCK'RANGE,LDEV'ENTRY,1,0);                               01292000
                                                                        01294000
<< Get pointer to first mapped domain >>                                01295000
PDISABLE;                                                               01295100
NEXT'PTR := CDT'GET'WORD(LDEV'ENTRY,CDT'DE'MAPD'HEAD,0);                01296000
CDT'ENTRY := 0;   << Initialize in case no "hit" >>                     01297000
if NEXT'PTR = 0 then                                                    01298000
  begin  << There are no current mapped domains for this LDEV >>        01299000
  end                                                                   01300000
else                                                                    01301000
  begin  << Find the first overlapping domain >>                        01302000
  while NEXT'PTR <> 0 do                                                01303000
    begin                                                               01304000
    if CDT'GET'DOUBLE(NEXT'PTR,CDT'MD'END'SECTOR,0D) >                  01305000
       LDR'ADR then  << Possible overlap >>                             01306000
      begin                                                             01307000
      if CDT'GET'DOUBLE(NEXT'PTR,CDT'MD'SECTOR,0D) <                    01308000
         UPPER'LDR'ADR then << Definite overlap >>                      01309000
        begin                                                           01310000
        CDT'ENTRY := NEXT'PTR;  << Save CDT index >>                    01311000
        end                                                             01312000
      else                                                              01313000
        begin  << CDT is beyond requested lock range >>                 01314000
        end;                                                            01315000
      NEXT'PTR := 0;                                                    01316000
      end                                                               01317000
    else                                                                01318000
      begin  << We must step to next mapped CDT >>                      01319000
      NEXT'PTR := CDT'GET'WORD(NEXT'PTR,CDT'MD'NEXT,0);                 01320000
      end;                                                              01321000
    end;  << of WHILE looking for first domain in range >>              01322000
  end;  << of looking through mapped CDTs >>                            01323000
                                                                        01324000
<< Delink overlapping mapped domain strings >>                          01325000
<< The current CDT entry being pointed to is where we start >>          01326000
NEXT'PTR := PRIOR'PTR := CDT'ENTRY;                                     01327000
                                                                        01328000
<< Now, find the last overlapping mapped domain >>                      01329000
while CDT'ENTRY <> 0 do                                                 01330000
  begin                                                                 01331000
  << Save current CDT pointer >>                                        01332000
  NEXT'PTR := CDT'ENTRY;                                                01333000
  << Load next pointer >>                                               01334000
  CDT'ENTRY := CDT'GET'WORD(CDT'ENTRY,CDT'MD'NEXT,0);                   01335000
  if CDT'ENTRY = 0 then                                                 01336000
    begin  << This is the end of the scan >>                            01337000
    end  << The next pointer is set >>                                  01338000
  else                                                                  01339000
    begin  << See if this entry partially maps too >>                   01340000
    if CDT'GET'DOUBLE(CDT'ENTRY,CDT'MD'SECTOR,0D) <                     01341000
       UPPER'LDR'ADR  then                                              01342000
      begin  << Continue looping, still overlaps >>                     01343000
      end                                                               01344000
    else                                                                01345000
      begin  << No more overlap, so terminate loop >>                   01346000
      CDT'ENTRY := 0;                                                   01347000
      end;                                                              01348000
    end;                                                                01349000
  end;  << of WHILE looking for partially mapped CDT's >>               01350000
                                                                        01351000
<< Only perform the following if overlapping areas found >>             01352000
if PRIOR'PTR <> 0 then                                                  01353000
  begin                                                                 01354000
                                                                        01355000
  << Now, delink partially mapped domain(s) >>                          01356000
  << Hold pointer to MD prior to string being delinked >>               01357000
  HLD'BEG := CDT'GET'WORD(PRIOR'PTR,CDT'MD'PREV,0);                     01358000
  << Hold pointer to MD after string being delinked >>                  01359000
  HLD'END := CDT'GET'WORD(NEXT'PTR,CDT'MD'NEXT,0);                      01360000
                                                                        01361000
  << Link the MD, minus the string, together >>                         01362000
  if HLD'BEG = 0 then                                                   01363000
    begin  << The end will be the new head pointer >>                   01364000
    CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'HEAD,HLD'END);                  01365000
    if HLD'END <> 0 then                                                01366000
      CDT'SET'WORD(HLD'END,CDT'MD'PREV,0);                              01367000
    end                                                                 01368000
  else                                                                  01369000
    begin  << There is a prior mapped domain >>                         01370000
    CDT'SET'WORD(HLD'BEG,CDT'MD'NEXT,HLD'END);                          01371000
    if HLD'END <> 0 then                                                01372000
      CDT'SET'WORD(HLD'END,CDT'MD'PREV,HLD'BEG);                        01373000
    end;                                                                01374000
                                                                        01375000
  if HLD'END = 0 then                                                   01376000
    begin  << There is a new tail entry >>                              01377000
    CDT'SET'WORD(LDEV'ENTRY,CDT'DE'MAPD'TAIL,HLD'BEG);                  01378000
    end                                                                 01379000
  else                                                                  01380000
    begin  << There is a "next" mapped domain >>                        01381000
    CDT'SET'WORD(HLD'END,CDT'MD'PREV,HLD'BEG);                          01382000
    end;                                                                01383000
  end;  << of processing string >>                                      01384000
                                                                        01385000
<< Now, get a new CDT entry to link-in >>                               01386000
<< Get lowest disc request address for cache >>                         01387000
CDT'ADR := if PRIOR'PTR = 0 then                                        01388000
             LDR'ADR                                                    01389000
           else                                                         01390000
             CDT'GET'DOUBLE(PRIOR'PTR,CDT'MD'SECTOR,0D);                01391000
<< Get highest disc request address for cache >>                        01392000
UPPER'CDT'ADR := if NEXT'PTR = 0 then                                   01393000
                   UPPER'LDR'ADR                                        01394000
                 else                                                   01395000
                   CDT'GET'DOUBLE(NEXT'PTR,CDT'MD'END'SECTOR,0D);       01396000
                                                                        01397000
<< Now we will get a CDT to cover the locked range >>                   01398000
CDT'ENTRY := CDT'GET'MD'ENTRY(LDEV'ENTRY,CDT'ADR,-2);                   01399000
                                                                        01400000
<< Initialize its fields >>                                             01401000
                                                                        01402000
                                                                        01403000
CDT'FLGS := CDT'GET'WORD(CDT'ENTRY,CDT'MD'FLAGS,0);                     01404000
CDT'FLGS.CDT'MD'STATE := CDT'LOCK'STATE;                                01405000
CDT'SET'WORD(CDT'ENTRY,CDT'MD'FLAGS,CDT'FLGS);                          01406000
                                                                        01407000
                                                                        01408000
CDT'SET'WORD(CDT'ENTRY,CDT'MD'LK'CNT,1); << Set lock = 1 >>             01409000
CDT'SET'DOUBLE(CDT'ENTRY,CDT'MD'SECTOR,CDT'ADR);                        01410000
CDT'SET'DOUBLE(CDT'ENTRY,CDT'MD'END'SECTOR,UPPER'CDT'ADR);              01411000
                                                                        01412000
<< If there is a string to "flush", we must now deal with it >>         01413000
if NEXT'PTR <> 0 then                                                   01414000
  begin  << We have to put these mapped CDT's on the "flush" string >>  01415000
                                                                        01416000
  << Force terminator in last mapped CDT >>                             01417000
  CDT'SET'WORD(NEXT'PTR,CDT'MD'NEXT,0);                                 01418000
                                                                        01419000
  << Mark all CDTs in this string "flushing" >>                         01420000
  HLD'BEG := PRIOR'PTR;                                                 01421000
  while HLD'BEG <> 0 do                                                 01422000
    begin                                                               01423000
                                                                        01424000
                                                                        01425000
                                                                        01426000
    CDT'FLGS := CDT'GET'WORD(HLD'BEG,CDT'MD'FLAGS,0);                   01427000
    CDT'FLGS.CDT'MD'STATE := CDT'FLUSH'STATE;                           01428000
    CDT'SET'WORD(HLD'BEG,CDT'MD'FLAGS,CDT'FLGS);                        01429000
                                                                        01430000
                                                                        01431000
    CDT'SET'WORD(HLD'BEG,CDT'MD'LKD'CDT,CDT'ENTRY);                     01432000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'LK'CNT,1);                            01433000
                                                                        01434000
    << Get pointer to next CDT >>                                       01435000
    HLD'BEG := CDT'GET'WORD(HLD'BEG,CDT'MD'NEXT,0);                     01436000
    end;                                                                01437000
                                                                        01438000
  << Append string onto device's FLUSH list >>                          01439000
<<HLD'BEG := CDT'GET'WORD(LDEV'ENTRY,CDT'DE'FLUSH'HD,0);>>              01439100
  if HLD'BEG = 0 then                                                   01440000
    begin  << The flush list is currently empty >>                      01441000
  <<CDT'SET'WORD(LDEV'ENTRY,CDT'DE'FLUSH'HD,PRIOR'PTR);>>               01442000
                                                                        01443000
    CDT'SET'WORD(PRIOR'PTR,CDT'MD'PREV,0);                              01444000
    end                                                                 01445000
  else                                                                  01446000
    begin  << Append string on tail >>                                  01447000
    << Get OLD tail pointer >>                                          01448000
    while HLD'BEG <> 0 do                                               01449000
      begin                                                             01449100
      HLD'END := HLD'BEG;                                               01449200
      HLD'BEG := CDT'GET'WORD(HLD'END,CDT'MD'NEXT,0);                   01449300
      end;                                                              01449400
    << Link old end to new string >>                                    01450000
    CDT'SET'WORD(HLD'END,CDT'MD'NEXT,PRIOR'PTR);                        01451000
    CDT'SET'WORD(PRIOR'PTR,CDT'MD'PREV,HLD'END);                        01452000
    end;                                                                01453000
                                                                        01454000
                                                                        01455000
  end;  << of linking string to FLUSH list >>                           01456000
                                                                        01457000
PENABLE;                                                                01457100
end;  << of procedure CDT'LOCK'RANGE >>                                 01458000
$if                                                                     01458100
$page "Procedure CDT'STRATEGY"                                          01459000
procedure CDT'STRATEGY(CDT'ENTRY,DISCREQ);                              01460000
value CDT'ENTRY,DISCREQ;                                                01461000
integer CDT'ENTRY,DISCREQ;                                              01462000
option privileged,uncallable,internal;                                  01463000
begin                                                                   01464000
                                                                        01465000
<<********************************************************************>>01466000
<< This procedure examines a logical disc request and determines the  >>01467000
<< fetch strategy which is to be applied to a CDT.  The CDT is assumed>>01468000
<< to already be "linked" in the list of mapped-domain CDT's for this >>01469000
<< disc device.  The lower and upper CDT entries are consulted to     >>01470000
<< bound any round-up or round-down decision this procedure makes.    >>01471000
<< The lower and upper disc addresses calculated by this routine are  >>01472000
<< placed in the appropriate cells in the mapped CDT entry.           >>01473000
<<                                                                    >>01474000
<< The passed parameters are:                                         >>01475000
<<                                                                    >>01476000
<< CDT'ENTRY   - The index of the mapped domain CDT entry already     >>01477000
<<               linked into the appropriate position in the list of  >>01478000
<<               mapped CDT domains for this device.                  >>01479000
<< DISCREQ     - A disc request table relative index to the logical   >>01480000
<<               disc request.                                        >>01481000
<<                                                                    >>01482000
<< Returned parameters:                                               >>01483000
<<                                                                    >>01484000
<<               Only the calculated base and limit sector addresses, >>01485000
<<               which have been calculated by this routine, have been>>01486000
<<               placed in the mapped domain CDT entry.               >>01487000
<<********************************************************************>>01488000
                                                                        01489000
<< Re-define DISCREQ to satisfy disc request INCL requirements >>       01490000
logical LDR'ENTRY'INDEX = DISCREQ;                                      01491000
                                                                        01492000
integer COUNT,       << Positive byte count in CDT entry >>             01493000
        CALLER,      << Strategy number to use           >>             01494000
        SECTORS,     << Number of sectors in transfer    >>             01495000
        CDT'PTR,     << Pointer to NEXT/PRIOR CDT entry  >>             01496000
        NEW'SECTORS; << CDT number of sectors to transfer>>             01497000
                                                                        01498000
double LDR'BASE'ADR,    << Base address specified in LDR entry        >>01499000
       LDR'UPPER'ADR,   << Upper address specified in LDR entry       >>01500000
       STRATEGY'BASE,   << Base address calculated by STRATEGY routine>>01501000
       STRATEGY'UPPER,  << Upper address calculated by STRATEGY       >>01502000
       PRIOR'CDT'UPPER, << Prior CDT's upper address                  >>01503000
       NEXT'CDT'BASE,   << Next CDT's base address                    >>01504000
       EXTENT'BASE,     << File system extent base address            >>01505000
       EXTENT'LIMIT;    << File system extent limit address           >>01506000
                                                                        01507000
logical IS'WRITE;   << TRUE if LDR is a write >>                        01507100
                                                                        01507200
<< Re-define LDR'BASE'ADR >>                                            01508000
integer LDR'P1  = LDR'BASE'ADR,                                         01509000
        LDR'P2  = LDR'P1 + 1;                                           01510000
                                                                        01510100
$if x1=off                                                              01510200
DEF'SET'DOUBLE;                                                         01510300
DEF'SET'BIT;                                                            01510400
DEF'GET'DOUBLE;                                                         01510401
DEF'GET'WORD;                                                           01510402
$if                                                                     01510450
$page                                                                   01511000
<< Strategy subroutines >>                                              01512000
subroutine UNKNOWN;                                                     01513000
begin                                                                   01514000
                                                                        01515000
<< We can only use the bounds of the transfer >>                        01516000
STRATEGY'BASE := LDR'BASE'ADR;                                          01517000
STRATEGY'UPPER := LDR'UPPER'ADR;                                        01518000
                                                                        01519000
<< If this is a write, we will set the VIRGIN bit to >>                 01520000
<< eliminate a unrequired read prior to the write.   >>                 01521000
if IS'WRITE then << this is a write >>                                  01522000
  begin                                                                 01522100
  CDT'SET'BIT(CDT'ENTRY,CDT'VIRGIN'BIT,1);                              01523000
                                                                        01523100
  << Force do-post if necessary >>                                      01523200
  if CDT'GET'WORD(0,CDT'FORCE'POST,0) <> 0 then                         01523300
    LDR'DO'POST := 1;                                                   01523400
  end;                                                                  01523450
                                                                        01524000
end;                                                                    01525000
$page                                                                   01526000
subroutine GENMESSAGE;                                                  01526010
begin                                                                   01526020
                                                                        01526030
<< GENMESSAGE always reads one block (record) before the >>             01526040
<< requested address.  This means that a "center" strategy>>            01526050
<< should be used.                                       >>             01526060
                                                                        01526070
if IS'WRITE then                                                        01526071
  UNKNOWN                                                               01526072
else                                                                    01526073
  begin                                                                 01526074
  STRATEGY'BASE := LDR'BASE'ADR - double(SECTORS);                      01526080
  if STRATEGY'BASE < EXTENT'BASE then                                   01526090
    STRATEGY'BASE := EXTENT'BASE;                                       01526100
                                                                        01526110
  NEW'SECTORS:=(CDT'GET'WORD(0,CDT'RND'MINFTCH,0)/SECTORS)              01526120
                * SECTORS;                                              01526125
  STRATEGY'UPPER:=STRATEGY'BASE + double(NEW'SECTORS);                  01526130
                                                                        01526140
  << Bounds check >>                                                    01526150
  if STRATEGY'UPPER < LDR'UPPER'ADR then                                01526160
    begin  << We would have to exceed 32 sector limit >>                01526170
    STRATEGY'BASE := LDR'BASE'ADR;                                      01526180
    STRATEGY'UPPER := LDR'UPPER'ADR;                                    01526190
    end;                                                                01526200
                                                                        01526210
  if STRATEGY'UPPER > EXTENT'LIMIT then                                 01526220
    STRATEGY'UPPER := EXTENT'LIMIT;                                     01526230
  end;  << Of READ/GENMSG strategy >>                                   01526235
                                                                        01526240
end;  << of subroutine GENMESSAGE >>                                    01526250
$page                                                                   01527000
subroutine FS'SEQUENTIAL;                                               01528000
begin                                                                   01529000
                                                                        01530000
if IS'WRITE then                                                        01530100
  UNKNOWN                                                               01530200
else                                                                    01530300
  begin                                                                 01530400
  << Use base address of requested transfer >>                          01531000
  STRATEGY'BASE := LDR'BASE'ADR;                                        01532000
                                                                        01533000
  <<Use upper address of a multiple of block size, <= 8KB>>             01534000
  NEW'SECTORS:=(CDT'GET'WORD(0,CDT'SEQ'MINFTCH,0)/SECTORS)              01535000
               *SECTORS;                                                01535100
  if NEW'SECTORS < SECTORS then <<Less than originally requested>>      01536000
    NEW'SECTORS := SECTORS;   << Round up to 1 block user requested >>  01537000
                                                                        01538000
  << Figure new upper address >>                                        01539000
  STRATEGY'UPPER := STRATEGY'BASE + double(NEW'SECTORS);                01540000
                                                                        01541000
  << If beyond end-of-extent, truncate >>                               01542000
  if STRATEGY'UPPER > EXTENT'LIMIT then                                 01543000
    STRATEGY'UPPER := EXTENT'LIMIT;                                     01544000
  end;  << of READ SEQ strategy >>                                      01544100
                                                                        01545000
<< Turn-on flags bit to indicate sequential access >>                   01545100
CDT'SET'BIT(CDT'ENTRY,CDT'SEQ'BIT,1);                                   01545200
                                                                        01545300
end;  << of FS'SEQUENTIAL strategy >>                                   01546000
$page                                                                   01546010
subroutine FS'DIRECT;                                                   01546020
begin                                                                   01546030
                                                                        01546040
if IS'WRITE then                                                        01546041
  UNKNOWN                                                               01546042
else                                                                    01546043
  begin                                                                 01546044
  << Use base address of requested transfer >>                          01546050
  STRATEGY'BASE := LDR'BASE'ADR;                                        01546060
                                                                        01546070
  << Use upper address of a multiple of block size, <= 8KB >>           01546080
  NEW'SECTORS:=(CDT'GET'WORD(0,CDT'RND'MINFTCH,0)/SECTORS)              01546090
                *SECTORS;                                               01546095
  if NEW'SECTORS < SECTORS then<<Less than originally requested>>       01546100
    NEW'SECTORS := SECTORS; << Round up to 1 block user requested >>    01546110
                                                                        01546120
  << Figure new upper address >>                                        01546130
  STRATEGY'UPPER := STRATEGY'BASE + double(NEW'SECTORS);                01546140
                                                                        01546150
  << If beyond end-of-extent, truncate >>                               01546160
  if STRATEGY'UPPER > EXTENT'LIMIT then                                 01546170
    STRATEGY'UPPER := EXTENT'LIMIT;                                     01546180
                                                                        01546190
  end; << of read/direct strategy >>                                    01546191
end;  << of FS'DIRECT strategy >>                                       01546200
$page                                                                   01547000
subroutine STRATEGY;                                                    01548000
begin                                                                   01549000
                                                                        01550000
case CALLER of                                                          01558000
  begin                                                                 01559000
                                                                        01560000
<<0>> UNKNOWN;            << Unknown caller >>                          01561000
<<1>> UNKNOWN;            << Unknown file system >>                     01562000
<<2>> FS'SEQUENTIAL;      << spooler >>                                 01563000
<<3>> UNKNOWN;            << Directory >>                               01564000
<<4>> UNKNOWN;                                                          01565000
<<5>> UNKNOWN;                                                          01566000
<<6>> UNKNOWN;                                                          01567000
<<7>> UNKNOWN;                                                          01568000
<<8>> GENMESSAGE;         << GENMSG >>                                  01569000
<<9>> UNKNOWN;            << File system, QUIESCE I/O >>                01570000
<<10>> FS'SEQUENTIAL;     << FS, sequential, NOBUF >>                   01571000
<<11>> FS'DIRECT;         << FS, direct, NOBUF >>                       01572000
<<12>> FS'SEQUENTIAL;     << FS, sequential, BUF >>                     01573000
<<13>> FS'DIRECT;         << FS, direct, BUF >>                         01574000
<<14>> FS'DIRECT;         << FS, KSAM >>                                01575000
<<15>> FS'DIRECT;         << FS, IMAGE >>                               01576000
                                                                        01577000
  end;  << of case on CALLER >>                                         01578000
                                                                        01579000
end;  << of subroutine STRATEGY >>                                      01582000
$page                                                                   01583000
<< Procedure mainline >>                                                01584000
                                                                        01585000
$if x1=on                                                               01586000
MMSTAT(MMSTAT'STRATEGY,CDT'ENTRY,DISCREQ,0);                            01587000
$if                                                                     01588000
                                                                        01589000
IS'WRITE := if LDR'FUNC = WRITEREQ then true else false;                01589100
                                                                        01589200
<< Load LDR constants locally >>                                        01590000
tos := LDR'COUNT;                                                       01591000
if < then                                                               01592000
  COUNT := ((-tos)+1) & lsr(1)                                          01593000
else                                                                    01594000
  COUNT := tos;  << Make words >>                                       01595000
SECTORS := (COUNT + 127) & lsr(7); << Divide by 128 >>                  01596000
CALLER := LDR'STRATEGY;  << Caller's code >>                            01597000
<< Load P1,P2 >>                                                        01598000
LDR'P1 := LDR'PARM1;                                                    01599000
LDR'P2 := LDR'PARM2;                                                    01600000
LDR'UPPER'ADR := LDR'BASE'ADR + double(SECTORS);                        01601000
                                                                        01602000
<< Load extent base from Disc Request >>                                01603000
tos := LDR'B'HODA;                                                      01604000
tos := LDR'B'LODA;                                                      01605000
if (EXTENT'BASE := tos) > LDR'BASE'ADR then                             01606000
  EXTENT'BASE := LDR'BASE'ADR;                                          01607000
                                                                        01608000
tos := LDR'L'HODA;                                                      01609000
tos := LDR'L'LODA;                                                      01610000
if (EXTENT'LIMIT := tos) < LDR'UPPER'ADR then                           01611000
  EXTENT'LIMIT := LDR'UPPER'ADR;                                        01612000
                                                                        01613000
<< Get prior CDT's UPPER disc address >>                                01614000
CDT'PTR := CDT'GET'WORD(CDT'ENTRY,CDT'MD'PREV,0);                       01615000
if CDT'PTR = 0 then                                                     01616000
  begin  << There is no previous, so assume 0 >>                        01617000
  PRIOR'CDT'UPPER := 0D;                                                01618000
  end                                                                   01619000
else                                                                    01620000
  begin  << Get prior CDT's upper address >>                            01621000
  PRIOR'CDT'UPPER := CDT'GET'DOUBLE(CDT'PTR,CDT'MD'END'SECTOR,0D);      01622000
  end;                                                                  01623000
                                                                        01624000
<< Get next CDT's base disc address >>                                  01625000
CDT'PTR := CDT'GET'WORD(CDT'ENTRY,CDT'MD'NEXT,0);                       01626000
if CDT'PTR = 0 then                                                     01627000
  begin << There is no next CDT, so assume highest disc address >>      01628000
  NEXT'CDT'BASE := %17777777777 D;  << Highest possible address >>      01629000
  end                                                                   01630000
else                                                                    01631000
  begin  << Get next CDT's base address >>                              01632000
  NEXT'CDT'BASE := CDT'GET'DOUBLE(CDT'PTR,CDT'MD'SECTOR,0D);            01633000
  end;                                                                  01634000
                                                                        01635000
STRATEGY;                                                               01636000
                                                                        01637000
<< Bounds check strategy applied >>                                     01638000
if STRATEGY'BASE < PRIOR'CDT'UPPER then  << Must adjust >>              01639000
  STRATEGY'BASE := PRIOR'CDT'UPPER;                                     01640000
if STRATEGY'UPPER > NEXT'CDT'BASE then                                  01641000
  STRATEGY'UPPER := NEXT'CDT'BASE;                                      01642000
                                                                        01643000
<< Place disc domain in CDT entry >>                                    01644000
CDT'SET'DOUBLE(CDT'ENTRY,CDT'MD'SECTOR,STRATEGY'BASE);                  01645000
CDT'SET'DOUBLE(CDT'ENTRY,CDT'MD'END'SECTOR,STRATEGY'UPPER);             01646000
                                                                        01647000
end;  << of procedure CDT'STRATEGY >>                                   01653000
$page "CDT'INITIATOR / CDT'COMPLETOR procedure"                         01654000
procedure CDT'INITIATOR(CDT'ENTRY,DISC'REQ);                            01655000
value CDT'ENTRY,DISC'REQ;                                               01656000
integer CDT'ENTRY,DISC'REQ;                                             01657000
option privileged,uncallable,internal;                                  01658000
begin                                                                   01659000
                                                                        01660000
<<********************************************************************>>01661000
<< This procedure processes requests to "queue" disc requests to an   >>01662000
<< existing CDT entry for a new request, and to "dequeue" disc re-    >>01663000
<< quests when the 'move' has been satisfied by the cache completor   >>01664000
<< code.  On initiation, it is assumed that we are running in the     >>01665000
<< caller's process environment.  A call to "PREFETCH" is made which  >>01666000
<< might add this CDT entry to the processes locality.  On completion,>>01667000
<< this routine will perform housekeeping to determine if deferred    >>01668000
<< requests can be released for processing.                           >>01669000
<<                                                                    >>01670000
<< The parameters passed to this procedure are:                       >>01671000
<<                                                                    >>01672000
<< CDT'ENTRY    - This is the index of the CDT entry to be manipulated>>01673000
<< DISC'REQ     - This is the index of the disc request to be attached>>01674000
<<                or released from this procedure.  When the initiator>>01675000
<<                is called, this LDR entry is attached to either the >>01676000
<<                "active" or "deferred" queue on this CDT.  When the >>01677000
<<                "completor" is called, this entry MUST be the head  >>01678000
<<                entry on this CDT's active list.                    >>01679000
<<                                                                    >>01680000
<< It is assumed that we are already PDISABLEd when entering this     >>01681000
<< routine.  Also, there is no assumption made of where DB is sitting.>>01682000
<<********************************************************************>>01683000
                                                                        01684000
entry CDT'COMPLETOR;   << This is called to "complete" a LDR attached >>01685000
                       << to a CDT.                                   >>01686000
                                                                        01687000
<< Variable to satisfy the LDR's include file >>                        01688000
integer LDR'ENTRY'INDEX;                                                01689000
                                                                        01690000
integer NEXT'POINTER,  << Used to chase down linked LDR's >>            01691000
        SAVE'LDR,      << Cell to save passed DISC'REQ value >>         01692000
        STATE,         << CDT state (saved locally)       >>            01693000
        CDT'FLGS,      << FLAGS word in CDT entry         >>            01694000
        LKD'CDT,       << CDT entry of locked CDT         >>            01695000
        DEV'ENTRY,     << Device entry number             >>            01696000
        SENDMSGFLAGS,  << flags parameter to send msg     >>            01696100
        CURRENTPIN,    << pin of currently executing process>>          01696200
        IMPEDED'PIN,   << Head pin waiting on write compl'n >>          01696280
        NEXT'PIN,      << Next pin waiting on write compl'n >>          01696360
        OBJECT'ID,     << Object ID of cache domain         >>          01696424
        FUNCTION;      << I/O function from disc request  >>            01697000
                                                                        01698000
logical CONTINUE'LOOP, << Loop control flag >>                          01699000
        FIRST'TIME;    << Loop control flag >>                          01700000
                                                                        01701000
double REGION'ADDRESS;   << CDT memory address >>                       01701100
                                                                        01701200
equate SYSDISCREQTAB = %1031;  << SYSDB ptr to disc request tbl >>      01702000
                                                                        01702100
$if x1=off                                                              01702200
DEF'GET'BIT;                                                            01702300
DEF'ADD'WORD;                                                           01702400
DEF'GET'WORD;                                                           01702450
DEF'SET'WORD;                                                           01702500
$if                                                                     01702550
$page                                                                   01703000
subroutine RELEASE'CDT;                                                 01704000
begin                                                                   01705000
                                                                        01706000
<< If in-motion out bit is set, we MUST hold on to the CDT entry >>     01707000
if logical(CDT'GET'BIT(CDT'ENTRY,CDT'IMO'BIT,0)) then                   01708000
  begin     << Deferred posting is still in progress >>                 01709000
  end                                                                   01710000
                                                                        01711000
else                                                                    01712000
                                                                        01713000
  begin                                                                 01714000
                                                                        01715000
$if x7=on                                                               01715100
  << If there was a locked CDT, decrement its lock cnt >>               01716000
  LKD'CDT := CDT'GET'WORD(CDT'ENTRY,CDT'MD'LKD'CDT,0);                  01717000
  if LKD'CDT <> 0 then                                                  01718000
    begin                                                               01719000
    if CDT'ADD'WORD(LKD'CDT,CDT'MD'LK'CNT,-1) <= 1 then                 01720000
      CDT'COMPLETOR(LKD'CDT,0); << Awaken locked entry >>               01721000
    end;                                                                01722000
$if                                                                     01722100
                                                                        01723000
  << Get LDEV CDT entry index >>                                        01724000
  DEV'ENTRY := CDT'FIND'DE(CDT'GET'WORD(CDT'ENTRY,CDT'MD'LDEV,0));      01725000
                                                                        01726000
  << If this was a sequential access and the last block >>              01726100
  << of the memory region was touched, delete the memory>>              01726200
  << region from main memory.                           >>              01726300
  if CDT'GET'BIT(CDT'ENTRY,CDT'SEQ'BIT,0) then                          01726400
    begin                                                               01726450
    LDR'ENTRY'INDEX := DISC'REQ;                                        01726500
    if <> then                                                          01726550
      begin                                                             01726600
      << Place LDR logical disc address on tos >>                       01726601
      tos := LDR'PARM1;                                                 01726602
      tos := LDR(CDT'X:=CDT'X + 1);                                     01726603
      tos := 0;   << Add sector offset to it >>                         01726604
      tos := LDR'COUNT;                                                 01726605
      if < then tos := ((-tos)+1) & lsr(1);  << Make words>>            01726606
      tos := (tos+127) & lsr(7); << Make sectors >>                     01726607
      ASMB(DADD);   << Form end sector address >>                       01726608
      if tos =                                                          01726609
         CDT'GET'DOUBLE(CDT'ENTRY,CDT'MD'END'SECTOR,0D) then            01726650
         REGION'ADDRESS:=CDT'GET'DOUBLE(CDT'ENTRY,                      01726700
                         CDT'MD'MEM'ADDR,0D)                            01726730
      else                                                              01726731
         REGION'ADDRESS:=0D;                                            01726732
      end                                                               01726757
    else                                                                01726784
      << If no LDR, this is NO'POST write >>                            01726811
      REGION'ADDRESS:=CDT'GET'DOUBLE(CDT'ENTRY,CDT'MD'MEM'ADDR,         01726838
                      0D);                                              01726851
    <<If non-zero REGION'ADDRESS, we must purge memory region>>         01726866
    if REGION'ADDRESS <> 0D then                                        01726867
      begin                                                             01726868
      << Convert to standard segment ID >>                              01726869
      OBJECT'ID := BUILDOBJID(MAPPEDDOMAINOBJECT,                       01726870
                              CDT'ENTRY,0);                             01726871
      << If not absent, make it an OC >>                                01726872
      if not ISOBJECTABSENT(OBJECT'ID) then                             01726873
        MakeOC(0,                                                       01726900
               OBJECT'ID,                                               01726910
               0,  << Request size >>                                   01726920
               REGION'ADDRESS);                                         01726930
                                                                        01726940
      end;                                                              01726946
    end;  << of processing sequential I/O special case >>               01726951
                                                                        01726956
  << Release CDT entry >>                                               01727000
  CDT'REL'MD'ENTRY(DEV'ENTRY,CDT'ENTRY);                                01728000
                                                                        01728550
  end;                                                                  01729000
                                                                        01730000
end;                                                                    01731000
$page                                                                   01731100
subroutine UNIMPEDE'WAITORS;                                            01731190
begin                                                                   01731280
                                                                        01731370
<< Any processes waiting for writes to complete will be >>              01731460
<< awaked here.  Originally, they were impeded in proc. >>              01731505
<< CDT'FORCE'LDR'COMPLETION.                            >>              01731550
                                                                        01731595
<< Get pin of any waitor & unimpede them                >>              01731640
IMPEDED'PIN:=CDT'SET'WORD(CDT'ENTRY,CDT'MD'IMPEDED,0);                  01731685
while IMPEDED'PIN <> 0 do                                               01731730
  begin                                                                 01731752
                                                                        01731774
  << Take off PCB list >>                                               01731775
  NEXT'PIN := UNSTRINGHEADPIN(IMPEDED'PIN);                             01731776
                                                                        01731777
  << AWAKEn process >>                                                  01731778
  UNIMPEDE(IMPEDED'PIN * PCBSIZE);                                      01731779
                                                                        01731780
  IMPEDED'PIN := NEXT'PIN;                                              01731787
                                                                        01731788
  end;                                                                  01731789
                                                                        01731790
end;  << of subroutine UNIMPEDE'WAITORS >>                              01731791
$page                                                                   01732000
subroutine MOVE'QUEUE;                                                  01733000
begin                                                                   01734000
                                                                        01735000
<< This subroutine moves disc requests from the 'impeded' to>>          01736000
<< the 'available' queue.  The first element is always moved>>          01737000
<< and afterwards will continue until the first 'write' is  >>          01738000
<< encountered.                                             >>          01739000
                                                                        01740000
CONTINUE'LOOP := FIRST'TIME := true;  << Loop control >>                01741000
                                                                        01742000
while CONTINUE'LOOP do                                                  01743000
  begin                                                                 01744000
  LDR'ENTRY'INDEX := CDT'GET'WORD(CDT'ENTRY,CDT'MD'IMPED'HD,0);         01745000
  if LDR'ENTRY'INDEX = 0 then                                           01746000
    CONTINUE'LOOP := false                                              01747000
  else                                                                  01748000
    begin  << Try to move over to active list >>                        01749000
    << If this is a write, we must be careful >>                        01750000
    if LDR'FUNC = WRITEREQ then                                         01751000
      begin                                                             01752000
      if FIRST'TIME then                                                01754000
        begin  << we can move only this "write" >>                      01755000
        CDT'DEQUEUE'LDR(CDT'ENTRY,LDR'ENTRY'INDEX,CDT'MD'IMPED'HD);     01756000
        CDT'QUEUE'LDR(CDT'ENTRY,LDR'ENTRY'INDEX,CDT'MD'LDR'HEAD);       01757000
        FIRST'TIME := false;                                            01757100
        end                                                             01758000
      else                                                              01758100
        CONTINUE'LOOP := false;                                         01758200
      end                                                               01759000
    else                                                                01760000
      begin  << This is a read, so just move it >>                      01761000
      CDT'DEQUEUE'LDR(CDT'ENTRY,LDR'ENTRY'INDEX,CDT'MD'IMPED'HD);       01762000
      CDT'QUEUE'LDR(CDT'ENTRY,LDR'ENTRY'INDEX,CDT'MD'LDR'HEAD);         01763000
      end;                                                              01765000
    end;                                                                01766000
  end;  << of looping through WHILE stmt >>                             01767000
                                                                        01768000
<< Inform CDT processor routine that NEW requests exist >>              01768100
                                                                        01768110
LDR'ENTRY'INDEX:=CDT'GET'WORD(CDT'ENTRY,CDT'MD'LDR'HEAD,0);             01768120
if LDR'ENTRY'INDEX <> 0 then                                            01768121
   BEGIN                                                                01768130
   tos := CDT'ENTRY;                                                    01768200
   tos := IOSTATUSOK;                                                   01768300
   tos := CACHEMOVEREADYCODE;                                           01768400
   SENDMSGFLAGS:=0;                                                     01768401
   if (CURRENTPIN := ((abs(CPCB)-abs(PCBP))/PCBSIZE)) <> 0              01768402
   and PROCESSPRI(LDR'PCB) >= PROCESSPRI(CURRENTPIN)                    01768403
   then SENDMSGFLAGS.MSGDON'TPREEMPTFLAG := 1;                          01768404
   SENDMSG(SCHEDPIN,CACHEMOVEPORT,3,SENDMSGFLAGS);                      01768450
                                                                        01768451
  << Unimpede anybody waiting on write completions >>                   01768500
  UNIMPEDE'WAITORS;                                                     01768550
                                                                        01768600
  end;                                                                  01768650
<< Restore current disc request pointer >>                              01769000
LDR'ENTRY'INDEX := DISC'REQ;                                            01770000
                                                                        01771000
end;                                                                    01772000
$page                                                                   01773000
subroutine WAKE'LDR;                                                    01774000
begin                                                                   01775000
                                                                        01776000
if  DISC'REQ <> 0 then                                                  01777000
  begin                                                                 01778000
                                                                        01779000
  << Figure SYSDB request address >>                                    01780000
  tos := DISC'REQ + ABS(SYSDISCREQTAB);                                 01781000
                                                                        01782000
  << Now, have MPE I/O system attempt to waken process if required >>   01783000
  SIODM'REQUEST'DONE(*);                                                01784000
                                                                        01785000
  end;                                                                  01786000
                                                                        01787000
end;                                                                    01788000
$page                                                                   01789000
subroutine SETSTATE(STATE'TYPE);                                        01790000
value STATE'TYPE;                                                       01791000
integer STATE'TYPE;                                                     01792000
begin                                                                   01793000
                                                                        01794000
DISABLE;                                                                01795000
CDT'FLGS := CDT'GET'WORD(CDT'ENTRY,CDT'MD'FLAGS,0);                     01796000
CDT'FLGS.CDT'MD'STATE := STATE'TYPE;                                    01797000
CDT'SET'WORD(CDT'ENTRY,CDT'MD'FLAGS,CDT'FLGS);                          01798000
ENABLE;                                                                 01799000
                                                                        01800000
end;                                                                    01801000
$page                                                                   01802000
subroutine DO'PREFETCH;                                                 01803000
begin                                                                   01804000
                                                                        01805000
PREFETCHOBJECT(LDR'PCB,    << PIN of requestor >>                       01806000
              BUILDOBJID(MAPPEDDOMAINOBJECT,                            01807000
                         CDT'ENTRY,                                     01808000
                         0 <<Pin>>)); << CDT object number >>           01809000
                                                                        01810000
end;                                                                    01811000
$page                                                                   01812000
subroutine INIT;                                                        01813000
begin                                                                   01814000
                                                                        01815000
<< This routine initializes variables for either entry point >>         01816000
LDR'ENTRY'INDEX := DISC'REQ;  << Point to passed LDR >>                 01817000
                                                                        01818000
<< If there is a disc request, place CDT# in it >>                      01819000
if <> then                                                              01820000
  begin                                                                 01821000
  LDR'CDT := CDT'ENTRY;                                                 01822000
  FUNCTION := LDR'FUNC;                                                 01823000
  end                                                                   01824000
else                                                                    01825000
  FUNCTION := -1;                                                       01826000
                                                                        01827000
STATE := CDT'GET'WORD(CDT'ENTRY,CDT'MD'FLAGS,0).CDT'MD'STATE;           01828000
                                                                        01829000
end;                                                                    01830000
$page                                                                   01831000
<< This is the procedure INITIATOR point >>                             01832000
$if x1=on                                                               01833000
MMSTAT(MMSTAT'INITIATOR,CDT'ENTRY,DISC'REQ,0);                          01834000
$if                                                                     01835000
                                                                        01836000
INIT;                                                                   01837000
                                                                        01838000
case STATE of                                                           01839000
  begin                                                                 01840000
                                                                        01841000
  <<0>> << CDT is available, on FREE list >>                            01842000
  begin                                                                 01843000
  if FUNCTION = READREQ then                                            01844000
    begin << It's a read >>                                             01845000
    SETSTATE(CDT'READ'STATE);                                           01846000
    CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);                  01847000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'READ'CNT,1);                          01848000
    DO'PREFETCH;                                                        01849000
    end                                                                 01850000
  else                                                                  01851000
    begin << It's a write >>                                            01852000
    SETSTATE(CDT'WRITE'STATE);                                          01853000
    CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);                  01854000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'WRITE'CNT,1);                         01855000
    DO'PREFETCH;                                                        01856000
    end;                                                                01857000
  end;                                                                  01858000
                                                                        01859000
  <<1>> << CDT is in a read state >>                                    01860000
  begin                                                                 01861000
  if FUNCTION = READREQ then                                            01862000
    begin << It's a read >>                                             01863000
    CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);                  01864000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'READ'CNT,1);                          01865000
    DO'PREFETCH;                                                        01866000
    end                                                                 01867000
  else                                                                  01868000
    begin << It's a write >>                                            01869000
    SETSTATE(CDT'WRITE'STATE);                                          01870000
    CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'IMPED'HD);                  01871000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'WRITE'CNT,1);                         01872000
    DO'PREFETCH;                                                        01873000
    end;                                                                01874000
  end;                                                                  01875000
                                                                        01876000
  <<2>> << CDT is in a write state >>                                   01877000
  begin                                                                 01878000
  if FUNCTION = READREQ then                                            01879000
    begin << It's a read >>                                             01880000
                                                                        01880100
    << If there is only one writer, we can allow other >>               01880200
    << readers to access domain.                       >>               01880300
    if CDT'GET'WORD(CDT'ENTRY,CDT'MD'WRITE'CNT,0) <= 1 then             01880400
      CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD)                 01880450
    else                                                                01880500
      CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'IMPED'HD);                01881000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'READ'CNT,1);                          01882000
    DO'PREFETCH;                                                        01883000
    end                                                                 01884000
  else                                                                  01885000
    begin << It's a write >>                                            01886000
    CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'IMPED'HD);                  01887000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'WRITE'CNT,1);                         01888000
    DO'PREFETCH;                                                        01889000
    end;                                                                01890000
  end;                                                                  01891000
                                                                        01892000
  <<3>> << CDT is being flushed and should not receive requests >>      01893000
  SUDDENDEATH(CDT'INVALID'STATE);                                       01894000
                                                                        01895000
  <<4>> << CDT is LOCKED, awaiting other CDT's to "flush" >>            01896000
  begin                                                                 01897000
  CDT'QUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'IMPED'HD);                    01898000
  end;                                                                  01899000
                                                                        01900000
  end;  << of case on STATE >>                                          01901000
                                                                        01902000
go to Leave'routine;  << Perform EXIT housekeeping >>                   01903000
$page                                                                   01904000
<< COMPLETOR entry point into procedure >>                              01905000
CDT'COMPLETOR:                                                          01906000
                                                                        01907000
$if x1=on                                                               01908000
MMSTAT(MMSTAT'INITIATOR,CDT'ENTRY,DISC'REQ,1);                          01909000
$if                                                                     01910000
                                                                        01911000
INIT;  << Initialize variables >>                                       01912000
                                                                        01913000
case STATE of                                                           01914000
  begin                                                                 01915000
                                                                        01916000
  <<0>> << The CDT should have no requests pending (AVAIL).  This case>>01917000
        << may be used by KERNEL to finish a WRITE which has been     >>01918000
        << already reported as "completed" to the user.               >>01919000
  begin                                                                 01920000
  RELEASE'CDT;                                                          01921000
  end;                                                                  01922000
                                                                        01923000
  <<1>> << Read state >>                                                01924000
  begin                                                                 01925000
  if FUNCTION = READREQ then                                            01926000
    begin << It's a read >>                                             01927000
    CDT'DEQUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);                01928000
    if CDT'ADD'WORD(CDT'ENTRY,CDT'MD'READ'CNT,-1) = 0 then              01929000
      begin << Read count is zero, remove this CDT entry >>             01930000
      SETSTATE(CDT'AVAIL'STATE);                                        01931000
      RELEASE'CDT;                                                      01932000
      end;                                                              01933000
    end                                                                 01934000
  else                                                                  01935000
    begin << It's a write >>                                            01936000
    SUDDENDEATH(CDT'INVALID'STATE);                                     01937000
    end;                                                                01938000
                                                                        01939000
  << Waken request >>                                                   01940000
  WAKE'LDR;                                                             01941000
  end;                                                                  01942000
                                                                        01943000
  <<2>> << Write state >>                                               01944000
  begin                                                                 01945000
  if FUNCTION = READREQ then                                            01946000
    begin << It's a read >>                                             01947000
    CDT'DEQUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);                01948000
    CDT'ADD'WORD(CDT'ENTRY,CDT'MD'READ'CNT,-1);                         01949000
                                                                        01949100
    << If the CDT's active queue is empty, move requests >>             01949200
    << over from the pending queue.                      >>             01949300
    if CDT'GET'WORD(CDT'ENTRY,CDT'MD'LDR'HEAD,0) = 0 then               01949400
      MOVE'QUEUE;                                                       01949450
    end                                                                 01950000
  else                                                                  01951000
    begin << It's a write >>                                            01952000
    if DISC'REQ = 0 then                                                01952100
      begin  << This must be a NOPOST I/O completion >>                 01952200
      if CDT'SET'BIT(CDT'ENTRY,CDT'WAIT'ON'NOPOST,0) = 0 then           01952300
        SUDDENDEATH(CDT'LOGIC'PROBLEM);<< We got problems...>>          01952400
      end                                                               01952450
    else                                                                01952500
      begin << See if this is a NOPOST move completion >>               01952550
      if not LDR'DO'POST then                                           01952600
        begin  << Yes, so don't decrement write count yet >>            01952650
        if CDT'SET'BIT(CDT'ENTRY,CDT'WAIT'ON'NOPOST,1)=1                01952725
          then SUDDENDEATH(CDT'LOGIC'PROBLEM);                          01952726
        end;                                                            01952750
      CDT'DEQUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);              01952760
      end;                                                              01952775
                                                                        01953000
    << If we aren't waiting on a no-post completion, continue>>         01953500
    if CDT'GET'BIT(CDT'ENTRY,CDT'WAIT'ON'NOPOST,0) = 0 then             01953550
      begin                                                             01953600
      if CDT'ADD'WORD(CDT'ENTRY,CDT'MD'WRITE'CNT,-1) = 0 then           01954000
        begin  << All writes have completed >>                          01955000
        if CDT'GET'WORD(CDT'ENTRY,CDT'MD'READ'CNT,0) = 0 then           01956000
          begin << All activity to this CDT has completed >>            01957000
          SETSTATE(CDT'AVAIL'STATE);                                    01958000
          RELEASE'CDT;                                                  01959000
          end                                                           01960000
        else                                                            01961000
          begin  << There is other pending "read" activity >>           01962000
          MOVE'QUEUE; << Move all deferred to active queue >>           01963000
          SETSTATE(CDT'READ'STATE);                                     01964000
          end;                                                          01965000
        end                                                             01966000
      else                                                              01967000
        begin  << There are still writes remaining. >>                  01968000
        if CDT'GET'WORD(CDT'ENTRY,CDT'MD'LDR'HEAD,0) = 0 then           01968100
          MOVE'QUEUE; << Move up to the next WRITE >>                   01969000
        end;                                                            01970000
      end;                                                              01971000
    end;                                                                01971100
                                                                        01972000
  << Waken caller >>                                                    01973000
  WAKE'LDR;                                                             01974000
  end;                                                                  01975000
                                                                        01976000
  <<3>> << Flush requests >>                                            01977000
  begin                                                                 01978000
  if FUNCTION = READREQ then                                            01979000
    begin << It's a read >>                                             01980000
    CDT'DEQUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);                01981000
    if CDT'ADD'WORD(CDT'ENTRY,CDT'MD'READ'CNT,-1) = 0 then              01982000
      begin                                                             01983000
      if CDT'GET'WORD(CDT'ENTRY,CDT'MD'WRITE'CNT,0) = 0 then            01984000
        begin << We're all done with this CDT >>                        01985000
        SETSTATE(CDT'AVAIL'STATE);                                      01986000
        RELEASE'CDT;                                                    01987000
        end                                                             01988000
      else                                                              01989000
        begin  << reads=0, writes>0 >>                                  01990000
        end;                                                            01991000
      end                                                               01992000
    else                                                                01993000
      begin  << reads>0, writes=? >>                                    01994000
      end;                                                              01995000
    end                                                                 01996000
  else                                                                  01997000
    begin << It's a write >>                                            01998000
    CDT'DEQUEUE'LDR(CDT'ENTRY,DISC'REQ,CDT'MD'LDR'HEAD);                01999000
    if CDT'ADD'WORD(CDT'ENTRY,CDT'MD'WRITE'CNT,-1) = 0 then             02000000
      begin                                                             02001000
      if CDT'GET'WORD(CDT'ENTRY,CDT'MD'READ'CNT,0) = 0 then             02002000
        begin  << We're all done with this CDT >>                       02003000
        STATE := CDT'AVAIL'STATE;                                       02004000
        RELEASE'CDT;                                                    02005000
        end                                                             02006000
      else                                                              02007000
        begin << writes=0, reads>0 >>                                   02008000
        MOVE'QUEUE;                                                     02009000
        end;                                                            02010000
      end                                                               02011000
    else                                                                02012000
      begin << writes>0, reads=? >>                                     02013000
      MOVE'QUEUE;                                                       02014000
      end;                                                              02015000
    end;                                                                02016000
                                                                        02017000
  << Waken caller >>                                                    02018000
  WAKE'LDR;                                                             02019000
  end;                                                                  02020000
                                                                        02021000
  <<4>> << LOCKED CDT entry >>                                          02022000
  begin                                                                 02023000
  << Lock code should NEVER execute completor >>                        02024000
  SUDDENDEATH(CDT'INVALID'STATE);                                       02025000
  end;                                                                  02026000
                                                                        02027000
  end;  << of case on STATE >>                                          02028000
                                                                        02029000
<< We will now leave this procedure >>                                  02030000
Leave'routine:                                                          02031000
                                                                        02032000
end;  << of procedure CDT'INITIATOR and CDT'COMPLETOR >>                02033000
$page "Procedure REQUEST'CACHE"                                         02034000
logical procedure REQUEST'CACHE(DISCREQ);                               02035000
value DISCREQ;                                                          02036000
integer DISCREQ;                                                        02037000
option privileged,uncallable,internal;                                  02038000
begin                                                                   02039000
                                                                        02040000
<<********************************************************************>>02041000
<< This procedure is called from ATTACHIO after determining that the  >>02042000
<< I/O to be performed is against DISC, and this DISC is currently    >>02043000
<< CACHED as specified by the FLAGS word of the disc's DIT.  If the   >>02044000
<< function requested against this disc is not of concern to CACHING, >>02045000
<< a return of FALSE to ATTACHIO indicates that ATTACHIO should issue >>02046000
<< the request through P'ATTACHIO.  If this is a data-transfer func-  >>02047000
<< tion, this procedure will return TRUE to ATTACHIO, indicating that >>02048000
<< CACHING will take responsibility for performing the I/O operation. >>02049000
<<                                                                    >>02050000
<< At this point, the CDT and memory regions for this disc are ex-    >>02051000
<< amined to determine if the requested data exists in main memory.   >>02052000
<< The cache service routines are then called to get everything going >>02053000
<< for this request.                                                  >>02054000
<<                                                                    >>02055000
<< The passed parameter to this procedure is:                         >>02056000
<<                                                                    >>02057000
<< LDR    - A DISCREQ relative index to the disc request entry asso-  >>02058000
<<          ciated with this request.  ATTACHIO is responsible for    >>02059000
<<          filling-in the request with the proper data.              >>02060000
<<                                                                    >>02061000
<< The returned parameter is:                                         >>02062000
<<                                                                    >>02063000
<< REQUEST'CACHE - TRUE indicates (to ATTACHIO) that caching has ac-  >>02064000
<<                 cepted the request and takes the responsibility for>>02065000
<<                 processing it.                                     >>02066000
<<                 FALSE indicates that the request has been ignored  >>02067000
<<                 by caching, and must be handled by ATTACHIO.       >>02068000
<<                                                                    >>02069000
<< DB is assumed to be at SYSDB in this procedure.  It is guaranteed  >>02070000
<< that the caller will not be blocked if so specified in the FLAGS   >>02071000
<< word of the LDR.                                                   >>02072000
<<********************************************************************>>02073000
                                                                        02074000
integer LDEV'LINK'PTR,           << Pointer to next LDEV CDT entry    >>02075000
        LDEV,                    << The LDEV number of the current CDT>>02076000
        FUNCTN,                  << LDR's function                    >>02076100
        CDT'LINK'PTR,            << Pointer to next cache CDT entry   >>02077000
        RETURN'CODE,             << Return code from scan subroutine  >>02078000
        CDT'ENTRY,               << CDT'ENTRY found on scan           >>02079000
        MISS'ENTRY,              << CDT'ENTRY just past where CDT shd >>02079100
                                 << have been on MISS, or points to   >>02079200
                                 << first partially-mapped domain.    >>02079300
        COUNT;                   << Number of positive bytes in xfer  >>02080000
                                                                        02081000
logical LDR'ENTRY'INDEX=DISCREQ, << Satisfies LDR defines requirements>>02082000
        IS'READ;                 << TRUE if I/O request was a read    >>02082100
                                                                        02083000
double  LDR'ADR,                 << Base disc address in LDR entry    >>02084000
        CDT'ADR;                 << Base disc address in CDT entry    >>02085000
                                                                        02086000
integer LDR'P1    = LDR'ADR,                                            02087000
        LDR'P2    = LDR'P1 + 1;                                         02088000
                                                                        02089000
double  UPPER'CDT'ADR,             << High CDT disc address           >>02090000
        UPPER'LDR'ADR;             << High LDR disc address required  >>02091000
double STARTCACHETIME;                                                  02091010
                                                                        02091100
$if x1=off                                                              02091200
DEF'GET'WORD;                                                           02091300
DEF'GET'DOUBLE;                                                         02091400
DEF'ADD'DOUBLE;                                                         02091450
$if                                                                     02091500
$page                                                                   02091510
subroutine RESET'TOTALS;                                                02091520
begin                                                                   02091530
                                                                        02091540
<< This subroutine is called when an accumulator overflows >>           02091550
CDT'SET'DOUBLE(LDEV'LINK'PTR,CDT'DE'RHIT,0D);                           02091560
CDT'SET'DOUBLE(LDEV'LINK'PTR,CDT'DE'WHIT,0D);                           02091561
CDT'SET'DOUBLE(LDEV'LINK'PTR,CDT'DE'RMISS,0D);                          02091570
CDT'SET'DOUBLE(LDEV'LINK'PTR,CDT'DE'WMISS,0D);                          02091580
CDT'SET'DOUBLE(LDEV'LINK'PTR,CDT'DE'STOP,0D);                           02091581
                                                                        02091590
end;  << of subroutine RESET'TOTALS >>                                  02091600
$page                                                                   02092000
logical subroutine CACHE'THIS'FUNCTION;                                 02093000
begin                                                                   02094000
                                                                        02095000
<< This subroutine examines the function specified in the LDR for this>>02096000
<< request and returns TRUE if this function is to be managed by the  >>02097000
<< cache routines.                                                    >>02098000
                                                                        02099000
if COUNT = 0 then                                                       02100000
  CACHE'THIS'FUNCTION := false                                          02101000
else                                                                    02102000
  begin                                                                 02102010
  if (LDEV'LINK'PTR := CDT'FIND'DE(LDR'LDEV)) = 0 then                  02102020
    CACHE'THIS'FUNCTION := false << Caching shut-off >>                 02102028
  ELSE                                                                  02102036
    BEGIN                                                               02102044
    if (FUNCTN := LDR'FUNC) = READREQ then                              02102100
      begin                                                             02102200
      IS'READ := CACHE'THIS'FUNCTION := true;                           02102220
      end                                                               02102230
    else if FUNCTN = WRITEREQ then                                      02102300
      begin                                                             02102307
      IS'READ := false;                                                 02102370
      CACHE'THIS'FUNCTION := true;                                      02102447
      end                                                               02102510
    else                                                                02103000
      CACHE'THIS'FUNCTION := false;                                     02103100
    end;                                                                02104000
  end;                                                                  02106000
end; << of  subroutine CACHE'THIS'FUNCTION >>                           02107000
$page                                                                   02108000
subroutine SCAN'CDTS'FOR'HIT;                                           02109000
begin                                                                   02110000
<<********************************************************************>>02111000
<< This subroutine scans the cached CDT entries for a "hit" on this   >>02112000
<< disc domain.                                                       >>02113000
<<                                                                    >>02114000
<< Input parameters:  not examined.                                   >>02115000
<<                                                                    >>02116000
<< Return parameters:                                                 >>02117000
<<                                                                    >>02118000
<<      CDT'ENTRY     - Cached CDT entry of 'hit' on disc address.    >>02119000
<<                      Valid only if RETURN'CODE is 0.               >>02120000
<<      MISS'ENTRY    - Mapped CDT following desired domain, or first >>02120100
<<                      domain that is partially mapped.  Valid if    >>02120200
<<                      RETURN'CODE is 1 or 2.  Set to 0 if beginning,>>02120300
<<                      or -1 if tail.                                >>02120400
<<      RETURN'CODE   - Indicates the results of the scan, which are: >>02121000
<<                      0 - CDT entry found that satisfies entire     >>02122000
<<                          requested disc domain.                    >>02123000
<<                      1 - CDT entry found that partially covers     >>02124000
<<                          requested disc domain.                    >>02125000
<<                      2 - No CDT entry found which corresponds to   >>02126000
<<                          this disc domain.                         >>02127000
<<********************************************************************>>02128000
                                                                        02129000
<< Find actual cache CDT entry, if it exists >>                         02136000
<< Load low LDR address >>                                              02137000
LDR'P1 := LDR'PARM1;                                                    02138000
LDR'P2 := LDR(CDT'X:=CDT'X+1);   << LDR'ADR is now loaded >>            02139000
                                                                        02140000
<< Figure high LDR disc address >>                                      02141000
UPPER'LDR'ADR := double((COUNT+127)&lsr(7))+LDR'ADR;                    02146000
                                                                        02147000
<< Get pointer to first mapped domain >>                                02147100
if (CDT'LINK'PTR:=CDT'GET'WORD(LDEV'LINK'PTR,CDT'DE'MAPD'HEAD,          02147200
    0)) = 0 then                                                        02147210
  begin  << This is a miss, and CDT must be added to head >>            02147220
  RETURN'CODE := 2;                                                     02147230
  MISS'ENTRY := 0;                                                      02147240
  end                                                                   02147245
else                                                                    02147250
  << We must loop >>                                                    02147255
  begin                                                                 02147300
  << Wizz through mapped CDT domains >>                                 02148000
  while CDT'LINK'PTR <> 0 do                                            02149000
    begin                                                               02150000
    UPPER'CDT'ADR:=CDT'GET'DOUBLE(CDT'LINK'PTR,CDT'MD'END'SECTOR,0D);   02151000
                                                                        02152000
    << if cache addr is higher than disc address, skip checking >>      02153000
    if UPPER'CDT'ADR > LDR'ADR then                                     02154000
      begin  << We have a hit, check if it's partial, full, or miss >>  02155000
                                                                        02156000
      << Get lower CDT address >>                                       02157000
      CDT'ADR := CDT'GET'DOUBLE(CDT'LINK'PTR,CDT'MD'SECTOR,0D);         02158000
                                                                        02159000
      <<If low address is beyond high LDR address, then it's a miss>>   02160000
      if CDT'ADR >= UPPER'LDR'ADR then                                  02162000
        begin  << yep, it's a miss >>                                   02163000
        MISS'ENTRY := CDT'LINK'PTR;                                     02163100
        RETURN'CODE := 2;                                               02164000
        return;                                                         02165000
        end;                                                            02166000
                                                                        02167000
      <<We know we have at least a partial hit.  We will now range >>   02168000
      <<check to see if we can satisfy the LDR with this CDT.  >>       02169000
      if CDT'ADR <= LDR'ADR and                                         02170000
         UPPER'CDT'ADR >= UPPER'LDR'ADR then                            02171000
        begin  << WE HAVE A TOTAL HIT! >>                               02172000
        CDT'ENTRY := CDT'LINK'PTR;                                      02172100
        RETURN'CODE := 0;                                               02173000
        end                                                             02174000
      else                                                              02175000
        begin << We have a partial hit >>                               02176000
        MISS'ENTRY := CDT'LINK'PTR;                                     02176100
        RETURN'CODE := 1;                                               02177000
        end;                                                            02178000
      return;   << to caller >>                                         02179000
      end;  << of processing a 'hit' >>                                 02180000
                                                                        02181000
    << Increment to next CDT entry >>                                   02182000
    CDT'LINK'PTR := CDT'GET'WORD(CDT'LINK'PTR,CDT'MD'NEXT,0);           02183000
                                                                        02184000
    end; << of 'while' stmt wizzing through CDT entries >>              02185000
                                                                        02186000
  << At this point, we know that the disc address being      >>         02187000
  << requested is beyond any currently mapped domains.  Mark it >>      02188000
  << as a 'miss' at this point.                                       >>02189000
  MISS'ENTRY := -1;  << At end-of-chain >>                              02189100
  RETURN'CODE := 2;                                                     02190000
  end;                                                                  02190100
                                                                        02191000
end;  << of subroutine SCAN'CDTS'FOR'HIT >>                             02192000
$page                                                                   02193000
subroutine HIT'ON'CACHE;                                                02194000
begin                                                                   02195000
                                                                        02196000
if CDT'ADD'DOUBLE(LDEV'LINK'PTR,if IS'READ then CDT'DE'RHIT             02197000
                  else CDT'DE'WHIT,1D) <= 0D then                       02197001
  RESET'TOTALS;                                                         02197002
if CLASS0STATSENABLED then                                              02197010
   if FUPDATESTATISTICS(MEASCLASS0,MEASSUBCLASS0,MEASENTRY1,            02197019
                       if IS'READ then C'CACHEREADHITS                  02197100
                       else C'CACHEWRITEHITS,                           02197190
                       NOTNEWVALUE,1D,NOTDOUBLE)                        02197191
   <> 0 then SUDDENDEATH(SFKERNCACHEINTBAD);                            02197280
                                                                        02198000
<< Go ahead and link this LDR to the CDT entry >>                       02199000
CDT'INITIATOR(CDT'ENTRY,DISCREQ);                                       02200000
                                                                        02201000
end;                                                                    02202000
$page                                                                   02203000
$if x7=on                                                               02203100
subroutine PARTIAL'HIT;                                                 02204000
begin                                                                   02205000
                                                                        02206000
<<******************************************************>>              02207000
<< Patial's are NOT supported yet...                    >>              02208000
assemble(halt 7);                                                       02209000
<<******************************************************>>              02210000
                                                                        02211000
<< Count this as a MISS >>                                              02212000
if CDT'ADD'DOUBLE(LDEV'LINK'PTR,if IS'READ then CDT'DE'RMISS            02213000
                  else CDT'DE'WMISS,1D) <= 0D then                      02213010
  RESET'TOTALS;                                                         02213100
                                                                        02214000
<< Lock range >>                                                        02215000
CDT'ENTRY := CDT'LOCK'RANGE(LDEV'LINK'PTR,LDR'ADR,UPPER'LDR'ADR);       02216000
                                                                        02217000
<< Queue this request to the locked CDT entry >>                        02218000
CDT'INITIATOR(CDT'ENTRY,DISCREQ);                                       02219000
                                                                        02220000
end;                                                                    02221000
$if                                                                     02221100
$page                                                                   02222000
subroutine MISS'ON'CDT;                                                 02223000
begin                                                                   02224000
                                                                        02224010
<< Get CDT entry and put in list >>                                     02224020
CDT'ENTRY:=CDT'GET'MD'ENTRY(LDEV'LINK'PTR,LDR'ADR,MISS'ENTRY);          02224030
                                                                        02225000
<< Now, we will see if unmapped region exists >>                        02226000
if CDT'MAP'CACHED'DOMAIN(LDEV'LINK'PTR,LDR'ADR,UPPER'LDR'ADR,           02227000
                         CDT'ENTRY,DISCREQ) THEN                        02227100
  begin  << We found a HIT >>                                           02229000
  if CDT'ADD'DOUBLE(LDEV'LINK'PTR,if IS'READ then CDT'DE'RHIT           02230000
                    else CDT'DE'WHIT,1D) <= 0D then                     02230001
    RESET'TOTALS;                                                       02230010
                                                                        02230100
  if CLASS0STATSENABLED then                                            02230190
     if FUPDATESTATISTICS(MEASCLASS0,MEASSUBCLASS0,MEASENTRY1,          02230270
                                                                        02230280
                         if IS'READ then C'CACHEREADHITS                02230289
                         else C'CACHEWRITEHITS,                         02230370
                         NOTNEWVALUE,1D,NOTDOUBLE)                      02230379
     <> 0 then SUDDENDEATH(SFKERNCACHEINTBAD);                          02230460
                                                                        02230505
  end                                                                   02233000
else                                                                    02234000
  begin  << We had a total miss, so get a CDT and fill it in >>         02235000
                                                                        02235100
  if CDT'ADD'DOUBLE(LDEV'LINK'PTR,if IS'READ then CDT'DE'RMISS          02236000
                    else CDT'DE'WMISS,1D) <= 0D then                    02236100
    RESET'TOTALS;                                                       02237000
                                                                        02243000
  << Mark CDT entry as "MISS" >>                                        02243100
  CDT'SET'BIT(CDT'ENTRY,CDT'MISS'BIT,1);                                02243200
                                                                        02243300
  << If MONITOR is enabled, report strategy applied >>                  02244000
  if ABS(SYSMON) then                                                   02244250
    begin                                                               02244500
    MMSTAT(-133,COUNT,LDR'P1,LDR'P2);                                   02244750
    MMSTAT(-134,CDT'GET'WORD(CDT'ENTRY,CDT'MD'SECTOR,0),                02245000
           CDT'GET'WORD(CDT'ENTRY,CDT'MD'SECTOR+1,0),                   02245250
           LDR'FLAGS);                                                  02245500
    MMSTAT(-135,CDT'GET'WORD(CDT'ENTRY,CDT'MD'END'SECTOR,0),            02245625
           CDT'GET'WORD(CDT'ENTRY,CDT'MD'END'SECTOR+1,0),               02245750
           LDR'FUNC);                                                   02245875
    MMSTAT(-136,LDR'B'HODA,LDR'B'LODA,LDR'L'LODA);                      02245887
    end;                                                                02246000
  end;                                                                  02247000
                                                                        02247010
<< Link LDR to newly obtained CDT >>                                    02247020
CDT'INITIATOR(CDT'ENTRY,DISCREQ);                                       02247030
                                                                        02247550
end;                                                                    02248000
$page                                                                   02249000
<< Begin procedure mainline >>                                          02250000
                                                                        02251000
$if x1=on                                                               02252000
MMSTAT(MMSTAT'REQ'CACHE,DISCREQ,0,0);                                   02253000
$if                                                                     02254000
                                                                        02255000
<< Initialize return code >>                                            02256000
REQUEST'CACHE := false;                                                 02257000
                                                                        02257100
tos := LDR'COUNT;                                                       02258000
if < then                                                               02258250
  tos := ((-tos)+1) & lsr(1); << Make words >>                          02258500
COUNT := tos;                                                           02258750
                                                                        02258875
if CACHE'THIS'FUNCTION then                                             02260000
   BEGIN <<function is cachable>>                                       02261000
                                                                        02262000
   if CLASS0STATSENABLED then                                           02262100
      begin <<update meas instrumentation>>                             02262190
      startcachetime := TIMER;                                          02262280
      if FUPDATESTATISTICS(MEASCLASS0,MEASSUBCLASS0,MEASENTRY1,         02262360
                          IF IS'READ THEN C'CACHEREADS                  02262370
                          ELSE C'CACHEWRITES,                           02262460
                          NOTNEWVALUE,1D,NOTDOUBLE)                     02262461
      <> 0 then SUDDENDEATH(SFKERNCACHEINTBAD);                         02262505
      end;                                                              02262550
                                                                        02262595
   <<Look thru CDT's for this dev for mapped domains>>                  02263000
Loopkludge:                                                             02264000
   SCAN'CDTS'FOR'HIT;                                                   02265000
                                                                        02266000
   case RETURN'CODE of                                                  02267000
      begin                                                             02268000
                                                                        02269000
      <<0>> HIT'ON'CACHE;     << CDT fully satisfies request >>         02270000
                                                                        02271000
      <<1>> <<PARTIAL'HIT;>>  << CDT partially satisfies request >>     02272000
            << This code should be eliminated if the LOCK code   >>     02272010
            << is ever implemented.  Since the occurance of this >>     02272020
            << section of code is extremely low, it may never be >>     02272030
            << done.  (AJK)                                      >>     02272040
            begin  << Kludge until code is done >>                      02272100
                                                                        02272110
            << Measure cache STOP event >>                              02272120
            if CDT'ADD'DOUBLE(LDEV'LINK'PTR,CDT'DE'STOP,1D)             02272130
              <= 0D then RESET'TOTALS;                                  02272140
            tos := 100D;  << 100 ms >>                                  02272200
            PENABLE;                                                    02272300
            DELAY(*);                                                   02272400
            PDISABLE;                                                   02272450
            go to Loopkludge;                                           02272500
            end;                                                        02272550
                                                                        02273000
      <<2>> MISS'ON'CDT;      << No overlapping CDT entry found >>      02274000
                                                                        02275000
      end;                                                              02276000
                                                                        02277000
   <<Inform ATTACHIO that caching will be responsible for the I/O >>    02278000
                                                                        02278100
   REQUEST'CACHE := true;                                               02279000
                                                                        02279100
   if CLASS0STATSENABLED then                                           02279190
      if FUPDATESTATISTICS(MEASCLASS0,MEASSUBCLASS0,MEASENTRY1,         02279279
                          C'CACHEONPROCESS,NOTNEWVALUE,                 02279280
                          TIMER-STARTCACHETIME,DOUBLEVALUE)             02279370
      <> 0 then SUDDENDEATH(SFKERNCACHEINTBAD);                         02279460
                                                                        02279505
   end;                                                                 02280000
end;  << of procedure REQUEST'CACHE >>                                  02281000
$page "Procedure FLUSH'CACHE"                                           02282000
<<**************************************************>>                  02283000
<< Change to perform attachio or LOCK'RANGE         >>                  02284000
<<**************************************************>>                  02285000
integer procedure FLUSH'CACHE(LDEV,START'ADDR,LIMIT'ADDR);              02286000
value LDEV,START'ADDR,LIMIT'ADDR;                                       02287000
integer LDEV;                                                           02288000
double START'ADDR,LIMIT'ADDR;                                           02289000
option uncallable, privileged;                                          02290000
begin                                                                   02291000
                                                                        02292000
<<********************************************************************>>02293000
<< Upon return from this procedure, the caller is guaranteed of having>>02294000
<< the range of sectors specified posted to disc and removed          >>02295000
<< from main memory.                                                  >>02296000
<<                                                                    >>02297000
<< The passed arguments are:                                          >>02298000
<<                                                                    >>02299000
<< LDEV         - The MPE logical device number of the disc device.   >>02300000
<< START'ADDR   - The logical disc address from which the data is to  >>02301000
<<                be flushed.                                         >>02302000
<< LIMIT'ADDR   - The logical disc address to which the data is to    >>02303000
<<                be flushed (up to, but not including sector         >>02304000
<<                LIMIT'ADDR).                                        >>02305000
<<                                                                    >>02305100
<< The returned value is:                                             >>02306000
<<                                                                    >>02307000
<< FLUSH'CACHE  - Return parameter from the procedure.  The values are>>02308000
<<                0 - disc range successfully flushed.                >>02309000
<<                1 - LDEV specified is not a disc or not cached.     >>02310000
<<                                                                    >>02311000
<< DB can be pointing anywhere when calling this procedure.  The      >>02312000
<< must be able to be "blocked" when calling this procedure.          >>02313000
<<********************************************************************>>02314000
                                                                        02315000
double HOLD'ADDR;      << Hold logical disc address >>                  02316000
                                                                        02316250
logical LDR'ENTRY'INDEX;  << Logical disc req index >>                  02316500
                                                                        02316625
integer R'FLUSH'CACHE = FLUSH'CACHE, << Access return var >>            02318000
        LDEV'ENTRY,      << CDT index of LDEV's entry >>                02319000
        CDT'ENTRY,       << Mapped-domain CDT entry   >>                02319100
        OLDCRIT,         << Critical state before entering this proc >> 02320000
        OLDDB;           << DB location prior to calling this proc >>   02321000
$page                                                                   02321010
subroutine CHECK'FOR'LAZY'LDR;                                          02321020
begin                                                                   02321030
<<****************************************************>>                02321040
<< This subroutine tries to force a LDR which is      >>                02321050
<< holding-up a FLUSH, to complete.                   >>                02321060
<<****************************************************>>                02321070
                                                                        02321080
CDT'ENTRY := CDT'GET'WORD(LDEV'ENTRY,CDT'DE'MAPD'HEAD,0);               02321090
while CDT'ENTRY <> 0 do                                                 02321100
   begin                                                                02321110
   HOLD'ADDR := CDT'GET'DOUBLE(CDT'ENTRY,CDT'MD'SECTOR,0D);             02321120
   if HOLD'ADDR >= START'ADDR and                                       02321130
      HOLD'ADDR < LIMIT'ADDR then << They overlap >>                    02321140
      begin                                                             02321150
                                                                        02321160
      << See if there is a LDR we can get out of the way >>             02321170
      LDR'ENTRY'INDEX := CDT'GET'WORD(CDT'ENTRY,                        02321180
                         CDT'MD'LDR'HEAD,0);                            02321190
      if LDR'ENTRY'INDEX <> 0 then                                      02321200
         CDT'FORCE'CDT'COMPLETION(LDR'ENTRY'INDEX)                      02321210
      else                                                              02321220
         begin                                                          02321230
         LDR'ENTRY'INDEX := CDT'GET'WORD(CDT'ENTRY,                     02321240
                            CDT'MD'IMPED'HD,0);                         02321250
         if LDR'ENTRY'INDEX <> 0 then                                   02321260
            CDT'FORCE'CDT'COMPLETION(LDR'ENTRY'INDEX);                  02321270
         end;                                                           02321280
      << Terminate looping >>                                           02321290
      CDT'ENTRY := 0;                                                   02321300
      end                                                               02321310
   else                                                                 02321320
      begin                                                             02321330
      << If address is beyond, terminate looping >>                     02321340
      if HOLD'ADDR >= LIMIT'ADDR then                                   02321350
         CDT'ENTRY := 0                                                 02321360
      else                                                              02321370
         CDT'ENTRY := CDT'GET'WORD(CDT'ENTRY,CDT'MD'NEXT,0);            02321380
      end;                                                              02321390
   end;                                                                 02321400
end;  << of subroutine >>                                               02321410
$page                                                                   02322000
<< First, set this process CRITICAL because we're getting system >>     02323000
<< resources.                                                    >>     02324000
TURNOFFTRAPS;                                                           02324100
OLDCRIT := SETCRITICAL;                                                 02325000
                                                                        02326000
<< Set DB to SYSDB to access I/O system tables. >>                      02327000
OLDDB := SETSYSDB;                                                      02328000
                                                                        02329000
PDISABLE;                                                               02330250
                                                                        02330500
<< Loop until there are NO overlapping mapped domains >>                02330625
FLUSH'CACHE := -1;   << Loop control >>                                 02330637
while R'FLUSH'CACHE = -1 do                                             02330649
   begin                                                                02330661
   if CACHE'DST = 0 then                                                02330673
      FLUSH'CACHE := 1                                                  02330685
   else if (LDEV'ENTRY:=CDT'FIND'DE(LDEV)) = 0 then                     02330691
      FLUSH'CACHE := 1                                                  02330697
   else                                                                 02330703
      begin                                                             02330709
      if CDT'FLUSH'CACHED'RANGE(                                        02331000
         LDEV'ENTRY,   << LDEV entry in CDT >>                          02331125
         START'ADDR,   << Start sector address >>                       02331250
         LIMIT'ADDR,   << Limit sector address >>                       02331312
         0,0) then                                                      02331374
         FLUSH'CACHE := 0                                               02331436
      else                                                              02331448
         begin  << We must wait for I/O to quiesce >>                   02331460
         DISABLE;                                                       02331470
         PENABLE;                                                       02331560
         tos := 300D;   << 300 ms >>                                    02331622
         DELAY(*);                                                      02331684
         CHECK'FOR'LAZY'LDR;                                            02331685
         PDISABLE;                                                      02331715
         ENABLE;                                                        02331716
         end;                                                           02331746
      end;                                                              02331747
   end;                                                                 02331748
PENABLE;                                                                02331777
RESETDB(OLDDB);                                                         02331799
RESETCRITICAL(OLDCRIT);                                                 02331821
                                                                        02332000
end;   << of procedure FLUSH'CACHE >>                                   02336000
$page "CDT'ATTACHIO"                                                    02337000
DOUBLE PROCEDURE CDT'ATTACHIO(LDEV,QMISC,DSTX,ADDR,FNCT,                02338000
                              CNT,P1,P2,FLAGS,                          02339000
                              EXTBASE,EXTSIZE);                         02340000
                                                                        02341000
VALUE                       LDEV, QMISC, DSTX, ADDR, FNCT,              02342000
                            EXTBASE, EXTSIZE,                           02343000
                            CNT, P1, P2, FLAGS;                         02344000
                                                                        02345000
INTEGER                     LDEV, QMISC, DSTX, ADDR, FNCT,              02346000
                            CNT, P1, P2, FLAGS;                         02347000
                                                                        02348000
DOUBLE                      EXTBASE;                                    02349000
                                                                        02350000
LOGICAL                     EXTSIZE;                                    02351000
                                                                        02352000
OPTION PRIVILEGED,UNCALLABLE;                                           02353000
  BEGIN                                                                 02354000
comment                                                                 02355000
<<*****************************************************>>               02356000
LDEV   - Logical device number                                          02357000
QMISC  - Misc parameter specified for device                            02358000
DSTX   - DST number of data segment.  If zero, then                     02359000
         specifies that ADDR is DB relative to the caller's             02360000
         stack.  Must be zero if system buffers is specified.           02361000
ADDR   - Depending on FLAGS.(14:1) and DSTX, this may be:               02362000
         1)Offset to data in DST.                                       02363000
         2)Offset to data from DB in callers stack.                     02364000
         3)Index to a system buffer.                                    02365000
FUNC   - Function code.  Device defined, but usually:                   02366000
         0 - Read.                                                      02367000
         1 - Write.                                                     02368000
         2 - Open file.                                                 02369000
         3 - Close file.                                                02370000
         4 - Close device.                                              02371000
CNT    - Data transfer count, + words or - bytes.                       02372000
P1     - Parameter 1.  High-order disc sector address (HODA).           02373000
P2     - Parameter 2.  Low-order disc sector address (LODA).            02374000
FLAGS  - Control and specification flags.                               02375000
         (0:4) - Caller is unknown(0), file system(1), or               02376000
                 spooler(2).                                            02377000
         (4:1) - Force posting of writes prior to                       02377200
                 completion notification.                               02377300
         (5:1) - Serialize write request                                02377400
         (6:1) - Available                                              02378000
         (7:2) - Premption flags, soft(1) or hard(2).                   02379000
         (9:1) - 0.                                                     02380000
         (10:1)- Special request, device defined.  Usually              02381000
                 memory management.                                     02382000
         (11:1)- If set, this is a diagnostic request.                  02383000
         (12:1)- System buffer flag.  If set, ADDR is an index          02384000
                 relative to the SBUF table.  For devices               02385000
                 that support chaining, the data is trans-              02386000
                 ferred to and from a set of chained buffers,           02387000
                 up to a maximum of 1024 words.                         02388000
         (13:3)- Request type:                                          02389000
                 0)Unblocked, no wake.  Impede if no IOQ.               02390000
                 1)Blocked (caller is waited until done).               02391000
                 2)Unblocked, wake caller, impede if no IOQ.            02392000
                 3)Unblocked & no PIN is to be associated               02393000
                   with this I/O.  Impede if no IOQ.                    02394000
                 4)Unblocked, no wake, no impede if no IOQ.             02395000
                 5)Reserved.                                            02396000
                 6)Unblocked, wake, no impede if no IOQ.                02397000
                 7)Same as 3 but no impede & get secondary              02398000
                   IOQ if necessary.                                    02399000
                                                                        02400000
RETURN:                                                                 02401000
                                                                        02402000
Blocked-                                                                02403000
                                                                        02404000
S-1    - (0:8) - PCB number.                                            02405000
         (8:5) - Qualifying status.                                     02406000
         (13:3)- General status.                                        02407000
S-0    - Transmission log (+words or -bytes).                           02408000
                                                                        02409000
Unblocked-                                                              02410000
                                                                        02411000
S-1    - IOQ index of request  (1 if no PCB I/O)                        02412000
S-0    - 0                                                              02413000
                                                                        02414000
<<************************************************************>         02415000
;                                                                       02416000
    INTEGER PCBNUM=Q+1;                                                 02417000
    INTEGER DBSAVE = PCBNUM + 1;                                        02418000
    INTEGER ARRAY DITP(@) = DBSAVE + 1;                                 02419000
    LOGICAL POINTER DITPL = DITP;                                       02420000
    INTEGER SAVECRIT = DITP + 1;                                        02421000
<<>>                                                                    02422000
                                                                        02424000
equate DTYPE      = 5;     << Device type word in DLT    >>             02425000
                                                                        02426000
define DDTYPE     = (8:8)#;<< Device type field in DLT   >>             02427000
                                                                        02428000
    INTEGER ARRAY DLTP(@)=SAVECRIT + 1;                                 02429000
    INTEGER POINTER IOQP  = DLTP + 1;                                   02430000
    LOGICAL POINTER IOQPL = IOQP;                                       02431000
    DOUBLE  POINTER IOQPD = IOQP;                                       02432000
    logical LDR'ENTRY'INDEX = IOQP,  <<Satisfies equates>>              02433000
            LDSTX           = DSTX;  <<Redefine DSTX passed>>           02434000
                                                                        02435000
    integer HEAD'PIN = IOQP+1;<< Head pin of impeded queue >>           02436000
                                                                        02437000
    INTEGER STACKDST = HEAD'PIN+1; << Holds DST if a stack >>           02438000
                                                                        02439000
    LOGICAL LFLAGS = FLAGS;                                             02440000
                                                                        02441000
<<**********************************************>>                      02442000
<< Defines and equates from HARDRES >>                                  02443000
                                                                        02444000
integer X = X;   << Index register >>                                   02445000
                                                                        02446000
equate DDLTP       = 4, << DLT entry offset in DIT >>                   02447000
       PCB3        = 3, << Word 3 of PCB entry >>                       02448000
       PCBB        = 3, << Absolute PCB base ptr cell >>                02449000
       SYSDISCREQTAB = %1031, << Abs ptr to Disc req tabl >>            02450000
       DBXDSINFOWORDNUM = 2, << Process' XDS number >>                  02451000
       SLLIXWORDNUM = 1;                                                02452000
                                                                        02453000
define NOTIMPEDABLE     = (13:1)#,                                      02454000
       DSTFIELD         = (1:10)#,                                      02455000
       RTYPE            = (14:2)#,                                      02456000
       REFERENCEDFLAG   = (2:1)#,                                       02457000
       SYSBUFRS         = (12:1)#, << Req uses sysbuffers >>            02458000
       STACKFLAG        = (0:1)#,  << Req is stack-relative >>          02459000
       BLOCKED          = (5:1)#,                                       02460000
       IOWAKE           = (4:1)#;                                       02461000
                                                                        02462000
integer array DST(*)    = DB + 2;                                       02463000
double pointer DSTD     = DST;                                          02464000
double START'ADDR       = P1;   << Double disc address >>               02464100
                                                                        02465000
$if x1=off                                                              02465100
DEF'GET'WORD;                                                           02465200
$if                                                                     02465300
                                                                        02466000
$if x1=on                                                               02467000
MMSTAT(MMSTAT'CDT'ATT,LDEV,FNCT,FLAGS);                                 02468000
<< If we are disabled prior to calling ATTACHIO, HALT >>                02468100
PUSH(STATUS);                                                           02468200
if tos.(1:1) = 0 then                                                   02468300
   if absolute(%1355).(13:1) = 1 then                                   02468400
      begin                                                             02468450
      ASMB(halt 3);                                                     02468500
      HELP;                                                             02468550
      end;                                                              02468600
$if                                                                     02469000
                                                                        02470000
<< TRAPSOFF; >>                                                         02471000
<< FORCE STACK OVERFLOWS, LEAVE 2 WORDS OF LOCAL DATA >>                02472000
ASMB(adds 255);                                                         02473000
ASMB(subs 253);                                                         02474000
PUSH(DB);   IF TOS=%1000 D THEN ASMB(DEL,ZERO) ELSE                     02475000
ASMB( PCAL SETSYSDB );  << SET DBSAVE >>                                02476000
TOS := S'LPDT(LDEV & asl(1));  << SET DITP >>                           02477000
                                                                        02478000
TOS := 0;    << Set SAVECRIT >>                                         02479000
                                                                        02480000
X := DBSAVE;   << TEST IF I/O SYSTEM CALL >>                            02481000
IF <> THEN ASMB(PCAL SETCRITICAL);  << SET SAVECRIT >>                  02482000
                                                                        02483000
TOS := DITP(DDLTP);    <<SET UP DLT>>                                   02484000
TOS:=GETDISCREQ(FLAGS.NOTIMPEDABLE);                                    02485000
ASMB(TEST,DZRO);   << FOR STACKDST AND PFLAG >>                         02486000
IF = THEN GOTO OUT;   << NO IOQ'S AVAILABLE >>                          02487000
                                                                        02488000
<< Make IOQP table-relative >>                                          02489000
@IOQP := @IOQP - ABS(SYSDISCREQTAB);                                    02490000
                                                                        02491000
IF LFLAGS.SYSBUFRS THEN             << DST # OF SYS BUFS >>             02492000
  begin                                                                 02492100
  DSTX := 8;  << System buffers >>                                      02492200
  if CNT <> 0 then  << CACHING does not support chained sysbufs>>       02492300
    if > then                                                           02492400
      begin                                                             02492450
      if CNT > 128 then                                                 02492500
        SUDDENDEATH(SFKERNCACHEINTBAD);                                 02492550
      end                                                               02492600
    else                                                                02492650
      if CNT < -256 then                                                02492700
        SUDDENDEATH(SFKERNCACHEINTBAD);                                 02492725
  end;                                                                  02492750
                                                                        02493000
X := DSTX;                                                              02494000
IF = THEN   << A STACK RELATIVE ADDRESS >>                              02495000
  BEGIN                                                                 02496000
  STACKDST := ABS(ABS(CPCB)+PCB3).DSTFIELD;                             02497000
  TOS := STACKDST;  TOS.STACKFLAG := 1;  DSTX := TOS;                   02498000
  END;                                                                  02499000
                                                                        02500000
<< Load parameters into LDR entry >>                                    02501000
LDR'LDEV := LDEV;                                                       02502000
LDR'CDT := 0;                                                           02503000
LDR'BUFDST := DSTX;                                                     02504000
LDR'BUFADR := ADDR;                                                     02505000
LDR'FUNC := FNCT;                                                       02506000
LDR'COUNT := CNT;                                                       02507000
LDR'PARM1 :=P1;                                                         02508000
LDR'PARM2 := P2;                                                        02509000
tos := EXTBASE;                                                         02510000
LDR'B'LODA := tos;                                                      02511000
LDR'B'HODA := tos;                                                      02512000
tos := EXTBASE + double(EXTSIZE);                                       02513000
LDR'L'LODA := tos;                                                      02514000
LDR'L'HODA := tos;                                                      02515000
LDR'STRATEGY := LFLAGS.(0:4);  << Save strategy >>                      02515100
                                                                        02516000
<<TOS := 0;   TOS.(1:3) := FLAGS.(10:3);>><<SPEC,DIAG,SYSBUF>>          02517000
TOS := (LFLAGS land %006000)&lsr(3); << DO'POST, SEQ'POST >>            02518000
TOS := TOS lor %2;  << Turn on logical disc request bit >>              02519000
                                                                        02520000
X := FLAGS.RTYPE;   << SWITCH ON REQUEST TYPE >>                        02521000
ASMB( BR *+1,X ;                                                        02522000
      br RT0;  br RT1;  br RT2;  br RT3 );                              02523000
                                                                        02524000
<< If this is NO PCB I/O, it cannot be sysbuf I/O >>                    02524100
RT3:  << No-PCB I/O >>                                                  02524200
if LFLAGS.SYSBUFRS and CNT <> 0 then                                    02524300
  SUDDENDEATH(SFKERNCACHEINTBAD);                                       02524400
go to RT0;    << We MUST cram a PCB number in here! >>                  02524450
                                                                        02524500
RT1:  << Blocked I/O - must clear WWS bit in PCB >>                     02525000
<<tos.BLOCKED := 1;>><< Turn on blocked bit in FLAGS >>                 02526000
DISABLE;                                                                02527000
CLEARWWS;                                                               02528000
                                                                        02529000
RT2:                                                                    02530000
<<TOS.IOWAKE := 1;>>                                                    02531000
                                                                        02532000
RT0:                                                                    02533000
LDR'PCB := PCBNUM := ((ABS(CPCB)-ABS(PCBB))/PCBSIZE);                   02534000
                                                                        02535000
LDR'FLAGS := TOS; << Save FLAGS word  + LDR bit >>                      02539000
                                                                        02540000
<< If caching is in the process of terminating, hold-off all >>         02540100
<< user disc requests.                                       >>         02540200
DISABLE;                                                                02540210
while CDT'GET'WORD(0,CDT'STOP'PND,0) <> 0 do                            02540300
  begin  << Impede me, and wait for stopcache executor >>               02540400
  << Get in PIN list >>                                                 02540450
  if (HEAD'PIN := CDT'GET'WORD(0,CDT'STOP'QUEUE,0))=0 then              02540500
    CDT'SET'WORD(0,CDT'STOP'QUEUE,PCBNUM);                              02540550
  STRINGPINATTAIL(HEAD'PIN,0);                                          02540595
                                                                        02540640
  << Impede, waiting for stop cache to work >>                          02540685
  IMPEDE(0);                                                            02540730
  end;                                                                  02540752
                                                                        02540900
<< Now, perform unblocked cache processing >>                           02541000
PDISABLE;                                                               02542000
ENABLE;                                                                 02543000
                                                                        02544000
tos := REQUEST'CACHE(@IOQP);                                            02545000
                                                                        02546000
PENABLE;                                                                02547000
                                                                        02548000
if not tos then                                                         02549000
  begin  << Cache did not accept, perform physical attachio >>          02550000
                                                                        02551000
  << Return disc request element >>                                     02552000
  TOS :=@IOQP + ABS(SYSDISCREQTAB);                                     02553000
  RETURNDISCREQ(*);                                                     02554000
                                                                        02555000
  << If this is a STACK DST, zero DSTX word >>                          02556000
  if LDSTX.STACKFLAG then                                               02557000
    DSTX := 0;                                                          02558000
                                                                        02559000
  << If this is a data transfer function, we must force     >>          02560000
  << any overlapping areas in memory OUT.                   >>          02560010
  if FNCT > 4 and CNT <> 0 then <<not r/w/fopen/fclose/dclose>>         02560100
    if (5 <= FNCT <= 6) or  <<zero/blank fill>>                         02560200
      FNCT = 11 then       << write sector zero >>                      02560300
      FLUSH'CACHE(LDEV,                                                 02560400
        START'ADDR,                                                     02560460
        START'ADDR+(((if CNT < 0 then                                   02560520
                        double((1-CNT)&asr(1))                          02560580
                      else                                              02560640
                        double(CNT)) + 127D)&dasr(7)));                 02560670
                                                                        02561000
  CDT'ATTACHIO := P'ATTACHIO(LDEV,QMISC,DSTX,ADDR,FNCT,CNT,             02562000
                             P1,P2,FLAGS,EXTBASE,EXTSIZE);              02563000
  end                                                                   02564000
                                                                        02565000
else                                                                    02566000
                                                                        02567000
  begin  << Cache accepted responsibility, so proceed >>                02568000
                                                                        02573000
  IF FLAGS.RTYPE=1 THEN   << BLOCKED I/O >>                             02574000
    BEGIN                                                               02575000
                                                                        02576000
    CDT'ATTACHIO := WAITFORIO(logical(@IOQP) lor %040000);              02577000
                                                                        02578000
    END                                                                 02579000
                                                                        02580000
  ELSE                                                                  02581000
                                                                        02582000
    BEGIN << UNBLOCKED REQUEST, RETURN IOQ INDEX >>                     02583000
    tos := logical(@IOQP) lor %040000;                                  02584000
                                                                        02585000
OUT:                                                                    02586000
                                                                        02587000
    TOS := 0;  << FOR P'ATTACHIO RETURN >>                              02588000
    CDT'ATTACHIO := TOS;                                                02589000
    END;                                                                02590000
                                                                        02591000
  END;                                                                  02592000
                                                                        02593000
TOS := DBSAVE;    IF = THEN RETURN;  << NOT SET HERE >>                 02594000
RESETCRITICAL(SAVECRIT);                                                02595000
RESETDB( * );                                                           02596000
                                                                        02597000
END;      <<  CDT'ATTACHIO >>                                           02598000
                                                                        02599000
$page "Cached Disc Domain List Management : Overview"                   02600000
                                                                        02601000
COMMENT                                                                 02602000
                                                                        02603000
All disc domains that have main memory allocated to them (ie cached     02604000
disc domains) are linked into cached disc domain lists.  A separate     02605000
cached disc domain list is maintained for the disc domains belonging    02606000
to common device.  The cached disc domains belonging to a common device 02607000
are linked together through the main memory region headers of  the      02608000
cached domains.  They are linked according to increasing sector offset  02609000
and the head and tail region addresses of the cached dommain lists      02610000
are kept in the CDT entry for the corresponding disc.  (the list is     02611000
ordered for fast searching using the LLSH instruction).                 02612000
                                                                        02613000
Cached regions are kept in the list even if the disc domain is not      02614000
mapped in and not present.  In particular, any cached disc domain that  02615000
is present, in motion in, or a recoverable overlay candidate is kept    02616000
in the appropraite list of cached disc domains.                         02617000
                                                                        02618000
The cached disc domain lists are managed by the procedures LinkCached   02619000
Domain and UnlinkCachedDomain.  LinkCachedDomain is invoked b6y Fetch   02620000
Object when the main memory region is first allocated for the cacahed   02621000
disc domain.  UnlinkCachedDomain is invoked when the cached region is   02622000
being wiped out of main memory (from CleanRegion or FlushDiscRange).    02623000
                                                                        02624000
;                                                                       02625000
                                                                        02626000
$page "Cached Region Management Procedures : Link Cached Region"        02627000
                                                                        02628000
PROCEDURE LinkCachedRegion ( regionbase );                              02629000
VALUE regionbase;                                                       02630000
DOUBLE regionbase;                                                      02631000
OPTION PRIVILEGED,UNCALLABLE;                                           02632000
                                                                        02633000
COMMENT                                                                 02634000
                                                                        02635000
LinkCachedDomain places a main memory region into the list of           02636000
cached disc domains.                                                    02637000
                                                                        02638000
LinkCachedDomain is called from FetchObject when space is first         02639000
allocated for the object.                                               02640000
                                                                        02641000
;                                                                       02642000
                                                                        02643000
BEGIN                                                                   02644000
                                                                        02645000
INTEGER ldev,                                                           02646000
        cdtentrynum,                                                    02646100
        pages,                                                          02646200
        cdcount,                                                        02647000
        remlinkcount,                                                   02648000
        devcdtentry;                                                    02649000
                                                                        02650000
DOUBLE sectoroffset,                                                    02651000
       cdhead,                                                          02652000
       prevlink,                                                        02654000
       nextlink;                                                        02655000
                                                                        02656000
INTEGER HODA=SECTOROFFSET,                                              02657000
        LODA=HODA+1;                                                    02658000
                                                                        02659000
DOUBLE OLDLISTHEAD,                                                     02660000
       nextlinktocheck,                                                 02661000
       scanpt,              << Index to last scan point >>              02661100
       targetda,                                                        02662000
       thisregndptraddr,                                                02663000
       OLDLISTTAIL;                                                     02664000
                                                                        02665000
LOGICAL not'smaller;                                                    02666000
                                                                        02667000
$if x1=off                                                              02667100
DEF'SET'DOUBLE;                                                         02667200
DEF'ADD'WORD;                                                           02667300
DEF'GET'DOUBLE;                                                         02667400
$if                                                                     02667500
subroutine FIX'DA(FIX'REGION,IS'TAIL);                                  02667550
value FIX'REGION,IS'TAIL;                                               02667600
double FIX'REGION;                                                      02667601
logical IS'TAIL;                                                        02667650
begin                                                                   02667700
                                                                        02667725
<< Fix disc address in region header >>                                 02667750
if IS'TAIL then                                                         02667775
   begin                                                                02667800
   TOS := FIX'REGION;                                                   02667825
   TOS := TOS + NDtoCACDAdisp;                                          02667826
   TOS := -1;   << Terminator >>                                        02667850
   ASMB(SSEA;DDEL);                                                     02667851
   end                                                                  02667852
else                                                                    02667862
   begin                                                                02667874
   TOS := FIX'REGION;                                                   02667886
   TOS := TOS + NDtoHODAdisp;                                           02667898
   ASMB(LDEA);                                                          02667910
   CDT'SHIFT'DA;                                                        02667922
   ASMB(DEL);  << Remove LODA >>                                        02667934
   S1 := S1 + HODAtoCACDAdisp;                                          02667935
   ASMB(SSEA;DDEL);                                                     02667936
   end;                                                                 02667940
                                                                        02667946
end;   << of subroutine FIX'DA >>                                       02667958
SUBROUTINE PLACEATHEAD;                                                 02668000
                                                                        02669000
BEGIN                                                                   02670000
oldlisthead := cdhead;                                                  02671000
TOS := regionbase;                                                      02672000
TOS := TOS + RBTONDDISP;                                                02673000
thisregndptraddr := TOS;                                                02674000
                                                                        02674100
<< Update scan point to this region >>                                  02674200
CDT'SET'DOUBLE(devcdtentry,cdt'de'scanpt,thisregndptraddr);             02674300
                                                                        02674400
CDT'SET'DOUBLE(devcdtentry,cdt'de'reg'hd,thisregndptraddr);             02675000
TOS := regionbase;                                                      02676000
TOS := TOS+RBTOPDDISP;                                                  02677000
TOS := 0D;                                                              02678000
ASMB(SDEA);      << zero out prev link >>                               02679000
TOS := TOS+PDTONDDISP;                                                  02680000
TOS := OLDLISTHEAD;                                                     02681000
ASMB(SDEA;DDEL);                                                        02682000
IF > THEN   << Load of old head was NOT zero >>                         02683000
   BEGIN       << must update prevlink of old head. >>                  02684000
   TOS := OLDLISTHEAD;                                                  02685000
   TOS := TOS+NDTOPDDISP;                                               02686000
   TOS := regionbase;                                                   02687000
   TOS := TOS + RBTOPDDISP;                                             02688000
   ASMB(SDEA;DDEL);                                                     02689000
   END;                                                                 02690000
FIX'DA(thisregndptraddr,FALSE);                                         02690100
END;     << subroutine PLACEATHEAD >>                                   02691000
                                                                        02692000
SUBROUTINE PLACEATTAIL;                                                 02693000
                                                                        02694000
BEGIN                                                                   02695000
                                                                        02696000
TOS := regionbase;                                                      02698000
TOS := TOS + RBTONDDISP;                                                02699000
TOS := 0D;                                                              02699100
ASMB(SDEA);    << Zero next region pointer >>                           02699200
thisregndptraddr:=TOS;                                                  02700000
OLDLISTTAIL := CDT'SET'DOUBLE(devcdtentry,cdt'de'reg'tl,                02701000
                              thisregndptraddr);                        02701100
                                                                        02702000
<< Fill in prev and next links of this hole. >>                         02703000
                                                                        02704000
IF OLDLISTTAIL <> 0D THEN                                               02709000
   BEGIN                                                                02710000
   TOS := thisregndptraddr;                                             02710100
   TOS := TOS+NDTOPDDISP;                                               02711000
   TOS := OLDLISTTAIL;                                                  02712000
   TOS := TOS + NDTOPDDISP;                                             02713000
   ASMB(SDEA;DDEL);    << update Prev in list ptr >>                    02714000
                                                                        02717000
   << Update old tail's Next link >>                                    02718000
   TOS := OLDLISTTAIL;                                                  02720000
   TOS := thisregndptraddr;                                             02723000
   ASMB(SDEA;DDEL);                                                     02725000
                                                                        02725100
   << Update scan point >>                                              02725200
   CDT'SET'DOUBLE(devcdtentry,cdt'de'scanpt,oldlisttail);               02725300
                                                                        02725400
   FIX'DA(oldlisttail,FALSE);                                           02725460
   END                                                                  02726000
ELSE                                                                    02726010
   << Update scan point >>                                              02726020
   CDT'SET'DOUBLE(devcdtentry,cdt'de'scanpt,thisregndptraddr);          02726030
                                                                        02726100
FIX'DA(thisregndptraddr,TRUE);                                          02726280
END;      << subroutine PLACEATTHEAD >>                                 02727000
                                                                        02728000
                                                                        02729000
$if x1=on                                                               02729100
tos := mmstat'link'region;                                              02729200
tos := 0;                 << 0-link, 1-unlink >>                        02729300
tos := REGIONBASE;                                                      02729400
MMSTAT(*,*,*,*);                                                        02729450
$if                                                                     02729500
<<look up device # and sector offset  of region , fill in               02730000
  corresponding local variables>>                                       02731000
                                                                        02732000
TOS:=regionbase;                                                        02733000
TOS := TOS + rbtoobjidentdisp;                                          02733100
ASMB(LSEA);                                                             02733190
tos := cdtentrynum := tos.objiddstfield;                                02733199
                                                                        02733280
<< If the CDT is mapped-in, get length from CDT >>                      02733370
IF tos <> 0 then                                                        02733460
   BEGIN                                                                02733505
   pages := integer(                                                    02733554
     CDT'GET'DOUBLE(cdtentrynum,cdt'md'end'sector,0D) -                 02733603
     CDT'GET'DOUBLE(cdtentrynum,cdt'md'sector,0D)) +                    02733652
     1  << Overhead >>;                                                 02733701
   END                                                                  02733750
ELSE                                                                    02733774
   BEGIN                                                                02733798
   TOS := TOS + objidenttossdisp;                                       02733846
   ASMB(LSEA);                                                          02733870
   pages := TOS;                                                        02733882
   END;                                                                 02733906
                                                                        02733915
TOS := regionbase;                                                      02733924
TOS := TOS + rbtohodadisp;                                              02734000
ASMB(LDEA);                                                             02735000
ASMB(DDUP);                                                             02736000
targetda := TOS;                                                        02737000
loda := TOS;                                                            02738000
ldev:=s0.regldevfield;                                                  02739000
hoda:=TOS.reghodafield;                                                 02740000
                                                                        02741000
<<find out head, tail, prev and next for the list of cached             02742000
  disc domains for this device>>                                        02743000
                                                                        02744000
if (devcdtentry := CDT'FIND'DE(ldev)) = 0 then                          02745000
   SUDDENDEATH(SFKernCacheIntBad);                                      02745100
                                                                        02746000
cdhead  := CDT'GET'DOUBLE(devcdtentry,                                  02747000
                          cdt'de'reg'hd,                                02748000
                          0d);                                          02749000
                                                                        02750000
cdcount := CDT'ADD'WORD(devcdtentry,                                    02755000
                        cdt'de'regions,                                 02756000
                        1)-1; <<bumps current by 1>>                    02757000
                                                                        02758000
                                                                        02759000
CDT'ADD'WORD(devcdtentry,cdt'de'mapd'pages,pages);                      02759450
                                                                        02759500
IF cdhead = 0D THEN                                                     02760000
   BEGIN       << List of cached regions is empty >>                    02761000
   PlaceAtHead;                                                         02762000
   PlaceAtTail;                                                         02763000
   END                                                                  02764000
ELSE                                                                    02765000
   BEGIN     << Must merge into list >>                                 02766000
                                                                        02767000
   << Locate position in the hole list for this hole. >>                02768000
                                                                        02769000
   << Locate proper hoda position (since llsh only masks 1 word)>>      02770000
                                                                        02771000
   TOS := NDtoCACDAdisp;<< offset from Link to target for LLSH >>       02772000
   TOS := TARGETDA; <<test word>>                                       02773000
   CDT'SHIFT'DA;      << Put into search form >>                        02774000
   ASMB(DEL);         << Remove LODA          >>                        02774100
                                                                        02775000
   << Determine whether to use scan point or CDHEAD >>                  02775100
   IF (SCANPT:=CDT'GET'DOUBLE(devcdtentry,cdt'de'scanpt,0D))            02775200
      <> 0D THEN                                                        02775300
      BEGIN                                                             02775400
      TOS := SCANPT;                                                    02775450
      TOS := TOS + NDtoHODAdisp;                                        02775500
      ASMB(LDEA;DXCH,DDEL);                                             02775550
      IF TOS <= targetda THEN                                           02775600
         TOS := SCANPT                                                  02775650
      ELSE                                                              02775700
         TOS := CDHEAD;                                                 02775725
      END                                                               02775750
   ELSE                                                                 02775775
      TOS := CDHEAD;                                                    02775800
                                                                        02775825
   X := cdcount;                                                        02776000
   ASMB(LLSH);  << chase through the list to get to right place >>      02777000
   IF < THEN PLACEATTAIL  ELSE                                          02779000
      BEGIN    << got some regions with the same or larger hoda>>       02780000
      ASMB(DDUP);                                                       02780100
      nextlinktocheck:=TOS;                                             02781000
      remlinkcount := X;                                                02782000
      not'smaller := FALSE;                                             02783000
      do                                                                02786000
         BEGIN <<locate location within hoda>>                          02787000
         ASMB(DDUP);                                                    02789000
         TOS := TOS + NDtoHODAdisp;                                     02790000
         ASMB(LDEA;DXCH,DDEL);                                          02791000
         TOS := targetda;                                               02792000
         ASMB(DCMP);                                                    02793000
         IF < THEN                      <<GO TO NEXT>>                  02794000
            BEGIN                                                       02794100
            ASMB(LDEA);                                                 02794190
            IF <= THEN  << We are at end-of-list >>                     02794280
               X := 1; << Terminate scan >>                             02794370
            ASMB(DXCH,DDEL);                                            02794379
            END                                                         02794460
         ELSE IF > THEN NOT'SMALLER := TRUE                             02795000
         ELSE SuddenDeath(SFKernCacheIntBad);                           02796000
         END                                                            02797000
      UNTIL NOT'SMALLER OR DXBZ;                                        02797100
                                                                        02798000
      IF X = 0 THEN PlaceAtTail ELSE                                    02799000
         BEGIN    << stopped in middle of list >>                       02800000
                                                                        02801000
         << Put in front of link on TOS >>                              02802000
                                                                        02803000
         TOS := TOS+NDTOPDDISP;                                         02804000
         ASMB(LDEA);                                                    02805000
         PREVLINK := TOS;                                               02806000
                                                                        02807000
         << Now link in behind previous region base. >>                 02808000
                                                                        02809000
         TOS := PREVLINK;                                               02810000
         IF <= THEN PLACEATHEAD ELSE                                    02811000
            BEGIN                                                       02812000
            TOS := TOS+PDTONDDISP;                                      02813000
            ASMB(LDEA);                                                 02814000
            NEXTLINK := TOS;                                            02815000
                                                                        02815100
            TOS := regionbase;                                          02816000
            TOS := TOS+RBTONDDISP;                                      02817000
            ASMB(SDEA);  << put new next link in prev in list >>        02818000
                                                                        02819000
            ASMB(DDUP);                                                 02819100
            SCANPT := TOS;                                              02819200
            << Update scan point >>                                     02819300
            CDT'SET'DOUBLE(devcdtentry,cdt'de'scanpt,scanpt);           02819370
                                                                        02819440
            TOS := NEXTLINK;                                            02820000
            IF <= THEN SUDDENDEATH(SFKernCacheIntBad);                  02821000
            TOS := TOS+NDTOPDDISP;                                      02822000
            TOS := regionbase;                                          02823000
            TOS := TOS + RBTOPDDISP;                                    02824000
            ASMB(SDEA);  << put new prev ptr in next in list >>         02825000
                                                                        02826000
            TOS := regionbase;                                          02827000
            TOS := TOS+RBTONDDISP;                                      02828000
                                                                        02828100
            << Fix LLSH disc address >>                                 02828200
            ASMB(DDUP);                                                 02828300
            SCANPT := TOS;                                              02828400
            FIX'DA(scanpt,FALSE);                                       02828450
                                                                        02828500
            TOS := NEXTLINK;                                            02829000
            ASMB(SDEA);   << put next link into this region >>          02830000
            TOS := TOS+NDTOPDDISP;                                      02831000
            TOS := PREVLINK;                                            02832000
            ASMB(SDEA);   << put Prev region ptr into this region >>    02833000
            END;                                                        02834000
         END;                                                           02835000
      END;                                                              02836000
   END;                                                                 02837000
                                                                        02837100
END; <<LinkCachedDomain>>                                               02838000
                                                                        02839000
$page "Cached Region Management Procedures : Unlink Cached Region"      02840000
                                                                        02841000
PROCEDURE UnlinkCachedRegion ( regionbase );                            02842000
VALUE regionbase;                                                       02843000
DOUBLE regionbase;                                                      02844000
OPTION PRIVILEGED,UNCALLABLE;                                           02845000
                                                                        02846000
COMMENT                                                                 02847000
                                                                        02848000
UnlinkCachedDomain takes a main memory region off the list of           02849000
cached disc domains.                                                    02850000
                                                                        02851000
This routine is called form CleanRegion when a cached domain is         02852000
being wiped out of main memory and by ZapCachedDomain when releasing    02853000
cached regions form memory due to partial overlaps, dismounts, or       02854000
cache bypasses.                                                         02855000
                                                                        02856000
;                                                                       02857000
                                                                        02858000
BEGIN                                                                   02859000
                                                                        02860000
INTEGER ldev,                                                           02861000
        regsize,                                                        02862000
        devcdtentry;                                                    02863000
                                                                        02864000
DOUBLE sectoroffset,                                                    02865000
       holdnextptr,                                                     02866000
       cdtail,                                                          02867000
       prevlink,                                                        02868000
       nextlink;                                                        02869000
                                                                        02870000
                                                                        02871000
INTEGER hoda=sectoroffset,                                              02872000
        loda=sectoroffset+1;                                            02873000
                                                                        02874000
$if x1=off                                                              02874100
DEF'ADD'WORD;                                                           02874200
DEF'SET'DOUBLE;                                                         02874300
$if                                                                     02874400
$if x1=on                                                               02874500
tos := mmstat'link'region;                                              02874550
tos := 1;       << 0-link, 1-unlink >>                                  02874600
tos := REGIONBASE;                                                      02874650
MMSTAT(*,*,*,*);                                                        02874700
$if                                                                     02874725
<<look up device # and sector address of region , fill in               02875000
  corresponding local variables>>                                       02876000
                                                                        02877000
TOS:=regionbase;                                                        02878000
TOS:=TOS+rbtohodadisp;                                                  02879000
ASSEMBLE(ldea);                                                         02880000
loda := TOS;                                                            02881000
ldev:=s0.regldevfield;                                                  02882000
hoda:=TOS.reghodafield;                                                 02883000
                                                                        02884000
<<find out head, tail, prev and next for the list of cached             02885000
  disc domains for this device>>                                        02886000
                                                                        02887000
if (devcdtentry := CDT'FIND'DE(ldev)) = 0 then                          02888000
   SUDDENDEATH(SFKernCacheIntBad);                                      02888100
                                                                        02889000
<< Decrement current region count by 1.  If < 0, SF >>                  02897100
if CDT'ADD'WORD(devcdtentry,                                            02898000
                cdt'de'regions,                                         02899000
                -1) < 0 then                                            02900000
  SuddenDeath(sfkerncacheintbad);                                       02902000
                                                                        02903000
<< Decrement number of main memory pages consumed by device >>          02903100
TOS := regionbase;                                                      02903200
TOS := TOS + RBTOSSDISP;                                                02903300
ASMB(LSEA);                                                             02903400
REGSIZE := -TOS;                                                        02903450
CDT'ADD'WORD(devcdtentry,cdt'de'mapd'pages,regsize);                    02903500
                                                                        02903550
<< Look up addresses of prev hole and next link from header >>          02904000
                                                                        02905000
TOS := regionbase;                                                      02906000
TOS := TOS+RBTOPDDISP;                                                  02907000
ASMB(LDEA);                                                             02908000
if < then                                                               02908100
   SUDDENDEATH(SFKernCacheIntBad);  << Already unlinked >>              02908200
PREVLINK := TOS;                                                        02909000
TOS := -1D;                                                             02909100
ASMB(SDEA);                                                             02909200
TOS := TOS+PDTONDDISP;                                                  02910000
ASMB(LDEA);                                                             02911000
if < then                                                               02911100
   SUDDENDEATH(SFKernCacheIntBad);  << Already unlinked >>              02911200
NEXTLINK := TOS;                                                        02912000
TOS := -1D;                                                             02912100
ASMB(SDEA);                                                             02912200
ASMB(DDEL);                                                             02913000
                                                                        02914000
<< Take the region off the list >>                                      02915000
                                                                        02916000
IF PREVLINK <> 0D THEN                                                  02917000
   BEGIN   << Region is not the first in the list. >>                   02918000
                                                                        02919000
   << Place next link into previous cd's next link >>                   02920000
                                                                        02921000
   TOS := PREVLINK;                                                     02922000
   TOS := TOS+PDTONDDISP;                                               02923000
                                                                        02923100
   << Update scan point >>                                              02923200
   ASMB(DDUP);                                                          02923300
   holdnextptr := TOS;                                                  02923400
   CDT'SET'DOUBLE(devcdtentry,cdt'de'scanpt,holdnextptr);               02923450
                                                                        02923500
   TOS := NEXTLINK;                                                     02924000
   ASMB(SDEA;DDEL);                                                     02925000
                                                                        02926000
   << Place Previnlist into next cd's Previous pointer >>               02927000
                                                                        02928000
   IF NEXTLINK=0D THEN                                                  02929000
      BEGIN   << That was the last cd in the list. >>                   02930000
                                                                        02931000
      << Update hole list tail and max avail region size >>             02932000
                                                                        02933000
      TOS := PREVLINK;                                                  02934000
      TOS := TOS + PDTONDDISP;                                          02935000
      ASMB(DDUP);                                                       02935300
      cdtail := TOS;                                                    02936000
                                                                        02936100
      << Put terminator (LLSH) in new last region >>                    02936200
      TOS := TOS + NDtoCACDAdisp;                                       02936300
      TOS := -1;                                                        02936400
      ASMB(SSEA;DDEL);                                                  02936450
                                                                        02936500
      CDT'SET'DOUBLE(devcdtentry,cdt'de'reg'tl,cdtail);                 02937000
      END                                                               02938000
   ELSE                                                                 02939000
      BEGIN    << Not the last cd in the list >>                        02940000
      TOS := NEXTLINK;                                                  02941000
      TOS := TOS+NDTOPDDISP;                                            02942000
      TOS := PREVLINK;                                                  02943000
      ASMB(SDEA;DDEL);   << new Prev link for next in list >>           02944000
      END;                                                              02945000
   END                                                                  02946000
ELSE                                                                    02947000
   BEGIN        << Removing first in list >>                            02948000
                                                                        02948100
   << Update scan point.  Since there isn't a prior, point >>           02948200
   << to CDHEAD.                                           >>           02948300
   CDT'SET'DOUBLE(devcdtentry,cdt'de'scanpt,0D);                        02948400
                                                                        02948450
   IF NEXTLINK = 0D THEN                                                02949000
      BEGIN  <<last entry in list>>                                     02950000
      CDT'SET'DOUBLE(devcdtentry,cdt'de'reg'hd,0d);                     02951000
      CDT'SET'DOUBLE(devcdtentry,cdt'de'reg'tl,0d);                     02952000
      END                                                               02953000
   ELSE                                                                 02954000
      BEGIN    << There's a cd after this one >>                        02955000
                                                                        02956000
      << Make next cd the new head. >>                                  02957000
                                                                        02958000
      CDT'SET'DOUBLE(devcdtentry,cdt'de'reg'hd,nextlink);               02959000
      TOS := NEXTLINK;                                                  02960000
      TOS := TOS+NDTOPDDISP;                                            02961000
      TOS := 0D;                                                        02962000
      ASMB(SDEA;DDEL);   << erase previous link >>                      02963000
      END;                                                              02964000
   END;                                                                 02965000
END;  <<UnlinkCachedDomain>>                                            02966000
$page "Cache Management Utilities : Zap Cached Domain"                  02967000
                                                                        02968000
PROCEDURE ZapCachedDomain(regionbase);                                  02969000
VALUE regionbase;                                                       02970000
DOUBLE regionbase;                                                      02971000
OPTION PRIVILEGED,UNCALLABLE;                                           02972000
                                                                        02973000
COMMENT                                                                 02974000
                                                                        02975000
removes the cached disc domain pointed to by regionbase from the list   02976000
of cached domains attached to the device's CDT entry, wipes out the     02977000
indications in the region header that a cached domain was sitting       02978000
there, and releases the main memory region.                             02979000
                                                                        02980000
Assumes caller is pdisabled, and DB is placed at SYSDB.                 02981000
                                                                        02983000
Returned condition codes are:                                           02983100
                                                                        02983300
   CCE - Domain was successfully removed                                02983370
   CCG - Domain was NOT remove because it was still mapped              02983440
;                                                                       02984000
                                                                        02985000
BEGIN                                                                   02986000
                                                                        02987000
LOGICAL objid,                                                          02988000
        subregflags,                                                    02989000
        rstat = q-1;     << Caller's status register >>                 02989100
                                                                        02989200
DEFINE rstatus = rstat.(6:2)#;                                          02989300
                                                                        02990000
TOS:=regionbase;                                                        02991000
TOS := TOS+rbtoobjidentdisp;                                            02992000
ASMB(LSEA);                                                             02993000
objid := TOS;                                                           02994000
IF (objid.objidtypefield <> objiddatatype)                              02995000
OR (NOT objid.objidcdflag) then                                         02996000
   SUDDENDEATH(SFKernCacheIntBad);                                      02996100
                                                                        02996200
<< If it is still mapped into a CDT entry, we cannot release >>         02996400
<< it from main memory.                                      >>         02996460
if (objid.objidcdtfield <> 0 ) then                                     02997000
   RSTATUS := CCG                                                       02998000
else                                                                    02998100
   begin                                                                02998200
   TOS:=0;                                                              02999000
   ASMB(SSEA);                                                          03000000
   UnlinkCachedRegion(regionbase);                                      03001000
                                                                        03002000
   TOS := regionbase;                                                   03003000
   TOS:=TOS+rbtosasdisp;                                                03004000
   ASMB(LSEA);                                                          03005000
   subregflags := TOS;                                                  03006000
   IF NOT subregflags.regcachedflag THEN                                03007000
      SUDDENDEATH(SFKernCacheIntBad);                                   03007100
   TOS:=subregflags;                                                    03008000
   TOS.regcachedflag:=0;                                                03009000
   TOS.regrocflag:=0;                                                   03010000
   ASMB(SSEA);                                                          03011000
                                                                        03012000
   <<if reg assigned, release it>>                                      03013000
                                                                        03014000
   TOS:=TOS+sastorasdisp;                                               03015000
   ASMB(LSEA);                                                          03016000
   IF LS0.regreservedflag THEN SuddenDeath(SFKernCacheIntBad);          03017000
   IF LS0.regassignedflag THEN                                          03018000
      BEGIN                                                             03019000
      ReleaseRegion(regionbase,0);                                      03022000
      END;                                                              03024000
                                                                        03024100
   << Return good status back to caller >>                              03024200
   RSTATUS := CCE;                                                      03024300
   end;                                                                 03024400
END;  <<ZapCachedDomain>>                                               03025000
                                                                        03026000
                                                                        03027000
$page "Cache Utilities : CDT'MAP'CACHED'DOMAIN"                         03028000
                                                                        03029000
LOGICAL PROCEDURE CDT'MAP'CACHED'DOMAIN(devcdtentry,start'addr,         03030000
                                        limit'addr,new'cdt,             03031000
                                        ldr'entry'index);               03031100
VALUE devcdtentry,start'addr,limit'addr,new'cdt,ldr'entry'index;        03032000
INTEGER devcdtentry,new'cdt;                                            03033000
LOGICAL ldr'entry'index;                                                03033100
DOUBLE start'addr,limit'addr;                                           03034000
OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                                  03035000
                                                                        03036000
                                                                        03037000
COMMENT                                                                 03038000
                                                                        03039000
Input parameters are:                                                   03039100
                                                                        03039200
devcdtentry  - this is the CDT entry no. of the device.                 03039300
                                                                        03039400
start'addr   - this is the starting sector number of the                03039450
               requested domain(s) to flush, or the start               03039500
               address of logical disc request issued to                03039550
               satisfy a map request.                                   03039600
                                                                        03039650
limit'adr    - this is the limit sector number of the requested         03039700
               domain(s) to be flushed, or the end address of           03039725
               the logical disc request.                                03039750
                                                                        03039775
new'cdt      - only valid on a map request, this is the newly           03039800
               obtained mapped-domain CDT entry which has NOT had a     03039825
               strategy applied to it.  In case of a miss on the        03039850
               disc range specified by start'addr and limit'addr,       03039862
               the disc address range specified in the CDT is           03039874
               flushed because it has a strategy applied to it          03039886
               which might be larger than the disc address range        03039898
               necessary to satisfy the actual logical disc req.        03039910
                                                                        03039922
ldr'entry'                                                              03039923
index        - only valid on a map request, this is the                 03039924
               logical disc request which is trying to be               03039925
               statisfied.  Its only reason for being passed            03039926
               is to use it as a parameter to the STRATEGY              03039927
               routine on a MISS.                                       03039928
                                                                        03039929
Return parameter is:                                                    03039934
                                                                        03039935
cdt'map'cached'domain -                                                 03039936
               On a map request, false is returned                      03039937
               on a miss and true is returned if there is a             03039938
               hit.                                                     03039939
                                                                        03039940
cdt'flush'cached'range -                                                03039946
               On a flush request, TRUE is returned if the entire       03039952
               range was successfully flushed, and FALSE is returned    03039958
               if there was a MAPPED domain in the range specified      03039964
               to be flushed.                                           03039965
                                                                        03039966
This procedure scans the list of cached regions pointed to by the       03040000
devcdtentry passed as a parameter to locate the disc region             03041000
delimited by the start'addr and limit'addr parameters.  If a cached     03042000
region is found which completely contains the specified disc range,     03043000
a CDT entry is obtained and formatted to map the cached region and      03044000
the cdt entry number is returned.  Anyt partial overlaps are zapped     03045000
out from memory.  If the specified disc range is not on the list        03046000
of cached disc domains, a zero is returned.                             03047000
                                                                        03048000
caller expected to be pdisabled, DB must be at SYSDB.                   03049000
                                                                        03050000
                                                                        03051000
;                                                                       03052000
                                                                        03053000
BEGIN                                                                   03054000
                                                                        03055000
ENTRY CDT'Flush'Cached'Range;                                           03056000
                                                                        03057000
EQUATE hodatopddisp    = rbtopddisp - rbtohodadisp,                     03057100
       hodatorbdisp    = -rbtohodadisp;                                 03057200
                                                                        03057300
INTEGER limithoda=limit'addr,                                           03058000
        limitloda=limithoda+1;                                          03059000
                                                                        03060000
DOUBLE cdhead,                                                          03061000
       cdtail,                                                          03062000
       targetda,                                                        03064000
       nextdiscaddr,                                                    03065000
       limitda,                                                         03066000
       da'less'ldev,                                                    03066100
       nextlinktocheck,                                                 03067000
       checkregionbase,                                                 03068000
       save'overlap'regbase,   << For flush on "miss" map req >>        03068100
       targetda'hit,           << DA for HIT on map request   >>        03068200
       limitda'hit,            << Limit DA for HIT on map req.>>        03068280
       scanpt,                 << Scan point (to save time)   >>        03068352
       checkregionsectors,                                              03069000
       checkregionlimit,                                                03070000
       checkregionstart;                                                03071000
                                                                        03072000
INTEGER domainsize,                                                     03073000
        cdcount,                                                        03076000
        remlinkcount,                                                   03077000
        ldev,                                                           03078000
        flags,                                                          03079000
        starthoda=start'addr,                                           03081000
        startloda=start'addr+1;                                         03082000
                                                                        03083000
LOGICAL flush,                                                          03084000
        objident,                                                       03085000
        smaller,                                                        03086000
        roc,                                                            03087000
        zapfailed:=FALSE,<<T if zap of mapped domain attempted >>       03087100
        gotahit := FALSE;                                               03088000
                                                                        03089000
$if x1=off                                                              03089100
DEF'SET'DOUBLE;                                                         03089200
DEF'SET'BIT;                                                            03089300
DEF'GET'DOUBLE;                                                         03089400
DEF'GET'WORD;                                                           03089450
$if                                                                     03089500
$page                                                                   03089550
SUBROUTINE CheckCheckRegion;                                            03090000
                                                                        03091000
COMMENT                                                                 03092000
                                                                        03093000
checks the region pointed to by the checkregionbase variable to see     03094000
if this disc domain is contained in that region or overlaps that        03095000
region.  If contained, that region is mapped in.  If partial            03096000
overlapped, that region is zapped.                                      03097000
                                                                        03098000
The entry point CDT'Flush'CachedRange causes any overlapping domains    03099000
to be zapped even if they are complete hits.                            03100000
                                                                        03101000
;                                                                       03102000
                                                                        03103000
BEGIN                                                                   03104000
                                                                        03105000
<<check check reg for overlap>>                                         03106000
                                                                        03107000
TOS := checkregionbase;                                                 03108000
TOS := TOS + rbtohodadisp;                                              03109000
ASMB(LDEA);                                                             03110000
checkregionstart:=TOS;                                                  03111000
                                                                        03114100
<< If this domain is absent, but assigned a reserved region, >>         03114200
<< the SS is not correct yet.  We must figure length from    >>         03114300
<< mapped CDT entry.                                         >>         03114400
tos := tos + hodatoobjidentdisp;                                        03114450
ASMB(LSEA);                                                             03114500
if (S0.objidtypefield = objiddatatype) and                              03114550
   (S0.objidcdflag = 1) then                                            03114600
   begin  << This is a cached domain, check if assigned >>              03114650
   objident := S0;                                                      03114651
   if tos.objidcdtfield <> 0 then                                       03114700
     begin << Get length from CDT entry >>                              03114725
     checkregionsectors:=                                               03114775
      CDT'GET'DOUBLE(objident.objidcdtfield,cdt'md'end'sector,0D)       03114800
     -CDT'GET'DOUBLE(objident.objidcdtfield,cdt'md'sector,0D);          03114825
     end                                                                03114850
   else                                                                 03114862
     begin  << normal path >>                                           03114874
     tos := tos + objidenttossdisp;                                     03114875
     ASMB(LSEA;DECA,ZERO;XCH);  << Put double pgs-1 on tos >>           03114876
     tos := tos * sectorspermainmempage;                                03114877
     checkregionsectors := tos;  << Save # of sectors >>                03114878
     end;                                                               03114879
   end                                                                  03114886
else                                                                    03114898
   SUDDENDEATH(SFKernCacheIntBad);  << Not a cached domain >>           03114910
                                                                        03114922
ASMB(DDEL); <<get rid of region address>>                               03118000
TOS:=checkregionlimit:=checkregionstart+checkregionsectors;             03119000
                                                                        03120000
IF TOS > TARGETDA'HIT THEN                                              03121000
   BEGIN <<checkregion is beyond>>                                      03122000
   IF checkregionstart < limitda'hit THEN                               03123000
      BEGIN  <<check region not below ==> they overlap>>                03124000
      IF flush THEN                                                     03125000
         BEGIN                                                          03125100
         ZapCachedDomain(checkregionbase);                              03125200
         IF > THEN                                                      03125300
            zapfailed := TRUE;                                          03125400
         END                                                            03125450
      ELSE                                                              03125500
         BEGIN  <<not flush so check for hit>>                          03126000
                                                                        03126100
         << At this point, we have determined that an overlap >>        03126200
         << exists with, at least, the strategy determined on >>        03126300
         << this request.  Save the first region number over- >>        03126400
         << lapping in case we need to flush on an overlap.   >>        03126450
         IF save'overlap'regbase = 0D THEN                              03126500
            save'overlap'regbase := checkregionbase;                    03126550
                                                                        03126600
         << Now, use actual request disc address to determine >>        03126650
         << whether we have a total 'hit'.                    >>        03126700
         IF (checkregionstart <= targetda'hit)                          03127000
         AND (checkregionlimit >= limitda'hit) THEN                     03128000
            BEGIN  <<its contained entirely in the check region>>       03129000
            gotahit := TRUE;                                            03130000
                                                                        03131000
            <<if region not assigned, recover it>>                      03132000
                                                                        03133000
            TOS:=checkregionbase;                                       03134000
            TOS:=TOS+rbtosasdisp;                                       03135000
            ASMB(LSEA);                                                 03136000
            IF NOT LS0.regcachedflag                                    03137000
            THEN SuddenDeath(SFkernCacheIntBad);                        03138000
            IF LS0.regrocflag THEN                                      03139000
               BEGIN <<RECOVER IT>>                                     03140000
               RecoverOC(BuildObjId(mappeddomainobject,0,0),            03144000
                         0,checkregionbase);                            03145000
               roc := TRUE;                                             03148000
               END                                                      03149000
            ELSE                                                        03150000
               roc := FALSE;                                            03151000
                                                                        03151100
            ASMB(DEL,DDEL);                                             03152000
                                                                        03153000
            <<map in check region>>                                     03154000
                                                                        03155000
            << Strip ldev >>                                            03155100
            tos := checkregionstart;                                    03155200
            s1.(0:8) := 0;                                              03155300
            da'less'ldev := tos;                                        03155400
                                                                        03156100
            CDT'SET'DOUBLE(new'cdt,cdt'md'sector,                       03157000
                           da'less'ldev);                               03158000
            tos := checkregionlimit;                                    03158100
            s1.(0:8) := 0;                                              03158200
            da'less'ldev := tos;                                        03158300
            CDT'SET'DOUBLE(new'cdt,cdt'md'end'sector,                   03159000
                           da'less'ldev);                               03160000
            CDT'SET'DOUBLE(new'cdt,cdt'md'mem'addr,checkregionbase);    03173000
                                                                        03173010
            << Update scan point >>                                     03173020
            CDT'SET'DOUBLE(devcdtentry,cdt'de'scanpt,                   03173030
                           checkregionbase+DOUBLE(RBtoNDdisp));         03173040
                                                                        03173045
            CDT'SET'BIT(new'cdt,CDT'ABS'BIT,0);<<mark pres>>            03173100
            CDT'SET'BIT(new'cdt,CDT'VIRGIN'BIT,0);<<Not virgin>>        03173200
            <<fix up objident in region header>>                        03174000
            TOS:=checkregionbase;                                       03175000
            TOS:=TOS+rbtoobjidentdisp;                                  03176000
            TOS := objident;                                            03177000
            IF S0.objidcdtfield <> 0 THEN                               03181000
               SuddenDeath(SFKernCacheIntBad);                          03182000
            TOS.objidcdtfield:=new'cdt;                                 03183000
            ASMB(SSEA;DDEL);                                            03184000
            END;                                                        03185000
         END;                                                           03187000
      END;                                                              03188000
   END;                                                                 03189000
END;  <<SUBROUTINE CheckCheckRegion>>                                   03190000
$page                                                                   03191000
SUBROUTINE LOOP'THRU'LIST;                                              03191010
BEGIN                                                                   03191020
                                                                        03191030
<< Called when pointing to overlapping part of list >>                  03191040
TOS := nextlinktocheck;                                                 03191050
TOS := TOS + ndtohodadisp;                                              03191060
ASMB(LDEA;DXCH,DDEL);                                                   03191070
nextdiscaddr := TOS;                                                    03191080
WHILE (nextlinktocheck > 0D)                                            03191090
AND (limitda'hit > nextdiscaddr)                                        03191100
AND NOT gotahit                                                         03191101
DO                                                                      03191110
   BEGIN <<check next link for overlap>>                                03191120
   TOS := nextlinktocheck;                                              03191130
   ASMB(LDEA);                                                          03191140
   nextlinktocheck := TOS;                                              03191150
   TOS := TOS + ndtorbdisp;                                             03191160
   checkregionbase := TOS;                                              03191170
   CheckCheckRegion;                                                    03191180
   TOS := nextlinktocheck;                                              03191190
   TOS := TOS + ndtohodadisp;                                           03191200
   ASMB(LDEA);                                                          03191210
   nextdiscaddr := TOS;                                                 03191220
   ASMB(DDEL);    << Clean up stack >>                                  03191230
   END;                                                                 03191240
END;                                                                    03191250
$page                                                                   03191260
SUBROUTINE PROCESS'MISS;                                                03191270
BEGIN                                                                   03191280
<< Process a MISS on a MAP request >>                                   03191290
<< First, apply a STRATEGY to the request >>                            03191300
CDT'STRATEGY(NEW'CDT,LDR'ENTRY'INDEX);                                  03191310
                                                                        03191320
<< Obtain disc limits from strategy >>                                  03191330
TOS := CDT'GET'DOUBLE(NEW'CDT,CDT'MD'SECTOR,0D);                        03191340
S1.regldevfield := ldev;                                                03191350
targetda := TOS;                                                        03191360
TOS := CDT'GET'DOUBLE(NEW'CDT,CDT'MD'END'SECTOR,0D);                    03191370
S1.regldevfield := ldev;                                                03191380
limitda := TOS;                                                         03191390
                                                                        03191400
<< Determine region address to back-up to to start flush >>             03191410
if SAVE'OVERLAP'REGBASE = 0D then                                       03191420
   if (SAVE'OVERLAP'REGBASE:=CHECKREGIONBASE) = 0D then                 03191430
      if CDTAIL <> 0D then                                              03191440
         SAVE'OVERLAP'REGBASE:=CDTAIL+double(NDtoRBdisp);               03191441
                                                                        03191450
tos := SAVE'OVERLAP'REGBASE;                                            03191460
if <> then                                                              03191470
   begin  << Start backing-up regions until no overlap >>               03191480
   SMALLER := false;                                                    03191490
   do                                                                   03191500
      begin                                                             03191510
      tos := tos + RBTOHODADISP;                                        03191520
      ASMB(LDEA);                                                       03191530
      if tos > TARGETDA then  << We must go-back a region >>            03191540
         begin                                                          03191550
         tos := tos + HODATOPDDISP;                                     03191560
         ASMB(LDEA);                                                    03191570
         if = then << We're at beginning-of-list >>                     03191580
            begin << Terminate scan >>                                  03191590
            ASMB(DDEL);  << Remove zeros >>                             03191600
            tos := tos + PDTORBDISP;  << Point back to RB >>            03191610
            SMALLER := true;                                            03191620
            end                                                         03191630
         else                                                           03191640
            << Make TOS a RB to previous region >>                      03191650
            begin                                                       03191660
            tos := tos + PDTORBDISP;                                    03191670
            ASMB(DXCH,DDEL);                                            03191680
            end;                                                        03191690
         end                                                            03191700
      else                                                              03191710
         << We have backed-up far-enough >>                             03191720
         begin                                                          03191730
         tos := tos + HODATORBDISP;                                     03191740
         SMALLER := true;                                               03191750
         end;                                                           03191760
      end until SMALLER;  << of DO backing-up regions >>                03191770
                                                                        03191780
   << Region base should be on TOS here >>                              03191790
   tos := tos + RBTONDDISP;                                             03191800
   NEXTLINKTOCHECK := tos;                                              03191810
   FLUSH := true;                                                       03191820
   LIMITDA'HIT := LIMITDA;                                              03191830
   TARGETDA'HIT := TARGETDA;                                            03191840
   LOOP'THRU'LIST;                                                      03191850
   end                                                                  03191860
else                                                                    03191870
   ASMB(DDEL);  << Remove stacked regionbase of zeros >>                03191880
end;  << of subroutine PROCESS'MISS >>                                  03191890
$page                                                                   03191990
flush := FALSE;                                                         03192000
GO START;                                                               03193000
                                                                        03194000
CDT'FLUSH'CACHED'REGION : flush := TRUE;                                03195000
                                                                        03196000
START:                                                                  03197000
                                                                        03198000
cdhead  := CDT'GET'DOUBLE(devcdtentry,                                  03199000
                          cdt'de'reg'hd,                                03200000
                          0d);                                          03201000
                                                                        03202000
cdtail := CDT'GET'DOUBLE(devcdtentry,                                   03203000
                         cdt'de'reg'tl,                                 03204000
                         0d);                                           03205000
                                                                        03206000
ldev := CDT'GET'WORD(devcdtentry,cdt'de'ldev,0);                        03207000
                                                                        03208000
checkregionbase :=                                                      03209050
save'overlap'regbase := 0D;  << Init to no overlap >>                   03209500
                                                                        03210000
IF (cdcount := CDT'GET'WORD(devcdtentry,cdt'de'regions,0))              03211000
    <> 0 THEN                                                           03211100
   BEGIN     << Device has some cached domains >>                       03212000
                                                                        03213000
   << Use disc address from CDT if this is a map request >>             03214000
   TOS := limit'addr;                                                   03217000
   S1.regldevfield := ldev;  << Overlay LDEV >>                         03218000
   limitda'hit := TOS;                                                  03219000
   TOS := start'addr;                                                   03220000
   S1.regldevfield := ldev;  << Overlay LDEV >>                         03220010
   targetda'hit := TOS;                                                 03220020
                                                                        03220280
   TOS := NDtoCACDAdisp;<< offset from Link to target for LLSH >>       03221000
   TOS := targetda'hit;  << Search double word >>                       03222000
   CDT'SHIFT'DA;  << Shift disc address for search >>                   03227000
   ASMB(DEL);     << Remove LODA portion of DA     >>                   03227100
                                                                        03228000
   << Determine whether to use scan point or CDHEAD >>                  03228100
   IF (SCANPT:=CDT'GET'DOUBLE(devcdtentry,cdt'de'scanpt,0D))            03228200
      <> 0D THEN                                                        03228300
      BEGIN                                                             03228400
      TOS := SCANPT;                                                    03228450
      TOS := TOS + NDtoHODAdisp;                                        03228500
      ASMB(LDEA;DXCH,DDEL);                                             03228550
      IF TOS <= targetda'hit THEN                                       03228600
         TOS := SCANPT                                                  03228650
      ELSE                                                              03228700
         TOS := CDHEAD;                                                 03228725
      END                                                               03228750
   ELSE                                                                 03228775
      TOS := CDHEAD;                                                    03228800
                                                                        03228825
   X := cdcount;         << link count >>                               03229000
   ASMB(LLSH);  << chase through the list to get to right place >>      03230000
   IF < THEN                                                            03232000
      BEGIN <<hit end-check the tail of the list>>                      03233000
      checkregionbase := cdtail + double(ndtorbdisp);                   03234000
      CheckCheckRegion;                                                 03235000
      END                                                               03236000
   ELSE                                                                 03237000
      BEGIN    << got some regions with the same or larger hoda>>       03238000
      << Check prior REGION (if any) for overlap >>                     03239000
      TOS := TOS + NDtoPDdisp;                                          03240000
      ASMB(LDEA);  << Load prior link pointer >>                        03241000
      IF = THEN    << There was no prior link >>                        03242000
         ASMB(DDEL)                                                     03243000
      ELSE                                                              03244000
         BEGIN  << There was, so adjust count, etc >>                   03245000
         X := X + 1;  << New count of remaining regions >>              03246000
         ASMB(DXCH,DDEL); << Remove old link pointer >>                 03247000
         END;                                                           03248000
      TOS := TOS + PDtoNDdisp;  << Change ptr to next ptr >>            03249000
      << Save parameters for posterity >>                               03250000
      TOS := nextlinktocheck := TOS;                                    03251000
      REMLINKCOUNT := X;                                                03252000
      << Start looking for overlapping domains >>                       03253000
      smaller := TRUE;                                                  03254000
      DO                                                                03256000
         BEGIN <<chase thru list for a ms or so>>                       03257000
         ASMB(DDUP);                                                    03259000
         TOS := TOS + NDtoHODAdisp;                                     03260000
         ASMB(LDEA;DXCH,DDEL);                                          03261000
         TOS := targetda'hit;                                           03262000
         ASMB(DCMP);                                                    03263000
         IF <= THEN                                                     03264000
            BEGIN <<targetda > regionda so continue>>                   03265000
            ASMB(LDEA);  <<addr of next region's link>>                 03266000
            IF <= THEN                                                  03266100
               X := 1;  << Terminate scan >>                            03266190
            ASMB(DXCH,DDEL);  << Remove address >>                      03266271
            END                                                         03267000
         ELSE                                                           03268000
            BEGIN                                                       03269000
            smaller := FALSE;                                           03270000
            END                                                         03271000
         END                                                            03272000
      UNTIL (NOT smaller) OR DXBZ;                                      03272100
                                                                        03273000
      IF smaller THEN                                                   03274000
         BEGIN <<got to end of list>>                                   03275000
         checkregionbase := cdtail + double(ndtorbdisp);                03276000
         CheckCheckRegion;                                              03277000
         END                                                            03278000
      ELSE                                                              03279000
         BEGIN    << stopped in middle of list >>                       03280000
         <<prev region may have overlapped so check it>>                03282000
         TOS := nextlinktocheck := TOS;                                 03283000
         TOS := TOS +ndtopddisp;                                        03284000
         ASMB(LDEA);                                                    03285000
         IF > THEN                                                      03286000
            BEGIN <<check prev region>>                                 03287000
            TOS := TOS+pdtorbdisp;                                      03288000
            checkregionbase := TOS;                                     03289000
            CheckCheckRegion;                                           03290000
            END;                                                        03291000
         IF NOT gotahit THEN                                            03292000
            LOOP'THRU'LIST;                                             03293000
                                                                        03294000
         END;                                                           03314000
      END;                                                              03315000
   END;                                                                 03316000
                                                                        03317500
IF flush THEN                                                           03318000
   BEGIN                                                                03318001
   IF zapfailed THEN                                                    03318002
      << There were mapped domains in the way >>                        03318003
      CDT'MAP'CACHED'DOMAIN := FALSE                                    03318004
   ELSE                                                                 03318005
      CDT'MAP'CACHED'DOMAIN := TRUE; << Full range zapped >>            03318010
   END                                                                  03318011
ELSE                                                                    03318020
  IF gotahit THEN                                                       03318030
     CDT'Map'Cached'Domain := TRUE                                      03318040
  ELSE                                                                  03318050
     BEGIN  << We must FLUSH any overlapping domains >>                 03318060
     << Process MISS on cache >>                                        03318070
     PROCESS'MISS;                                                      03318080
     CDT'Map'Cached'Domain := FALSE;  << MISS >>                        03318180
     END;                                                               03318190
                                                                        03320000
$if x1=on                                                               03321000
MMSTAT(MMSTAT'MAP'DOMAIN,new'cdt,RETURNED'CDT,0);                       03322000
$if                                                                     03323000
                                                                        03324000
END;  <<Map'Cached'Domain>>                                             03325000
$page "Cache Management Utilities : CDT'Unmap'Region"                   03326000
                                                                        03327000
                                                                        03328000
PROCEDURE CDT'Unmap'Region(devcdtentry,regcdtentry);                    03329000
VALUE devcdtentry,regcdtentry;                                          03330000
INTEGER devcdtentry,regcdtentry;                                        03331000
OPTION PRIVILEGED,UNCALLABLE,INTERNAL;                                  03332000
                                                                        03333000
COMMENT                                                                 03334000
                                                                        03335000
invoked when the cdt entry for a mapped disc domain is released.  The   03336000
region is still to be cached, but not mapped, so any semblence to a     03337000
mapped disc domain must be eliminated.                                  03338000
                                                                        03339000
caller is assumed to be pdisabled.                                      03340000
                                                                        03341000
                                                                        03342000
;                                                                       03343000
                                                                        03344000
BEGIN                                                                   03345000
                                                                        03346000
LOGICAL objident,                                                       03347000
        flags;                                                          03348000
                                                                        03349000
$if x1=off                                                              03349100
DEF'GET'WORD;                                                           03349200
DEF'SET'WORD;                                                           03349300
$if                                                                     03349400
                                                                        03350000
SUBROUTINE FixObjident;                                                 03351000
                                                                        03352000
BEGIN <<  mapped domain is present >>                                   03353000
TOS := CDT'SET'DOUBLE(regcdtentry,cdt'md'mem'addr,0d);                  03354000
TOS := TOS+rbtoobjidentdisp;                                            03355000
ASMB(LSEA);                                                             03356000
objident := TOS;                                                        03357000
IF (objident.objidtypefield <> objiddatatype)                           03358000
OR (NOT objident.objidcdflag)                                           03359000
OR (INTEGER(objident).objidcdtfield <> regcdtentry)                     03360000
THEN SuddenDeath(SFKernCacheIntBad);                                    03361000
TOS := objident;                                                        03362000
TOS.objidcdtfield := 0;                                                 03363000
ASMB(SSEA;DDEL);                                                        03364000
END;                                                                    03365000
                                                                        03366000
$if x1=on                                                               03367000
MMSTAT(MMSTAT'UNMAP'REGION,DEVCDTENTRY,REGCDTENTRY,0);                  03368000
$if                                                                     03369000
                                                                        03370000
DISABLE;                                                                03371000
                                                                        03372000
flags :=  CDT'GET'WORD(regcdtentry,cdt'md'flags,0);                     03373000
                                                                        03374000
IF (flags.cdt'imi) OR (flags.cdt'fwip) OR (flags.cdt'imo)               03375000
THEN SuddenDeath(SFKernCacheSyncBad);                                   03376000
                                                                        03377000
IF (NOT flags.cdt'absent) OR (flags.cdt'roc) THEN                       03378000
   BEGIN <<mapped domain has a memory region corresponding>>            03379000
   FixObjident;                                                         03380000
   flags.cdt'absent:=1;                                                 03381000
   flags.cdt'roc := 0;                                                  03382000
   CDT'Set'Word(regcdtentry,cdt'md'flags,flags);                        03383000
   END;                                                                 03384000
END;  <<PROCEDURE CDT'Unmap'Region>>                                    03385000
                                                                        03386000
$Page "Cache/Mem Mgr Interfaces : Cache Transfer Completor"             03387000
                                                                        03388000
PROCEDURE CacheXferComp(ldr'entry'index,iostatus);                      03389000
VALUE ldr'entry'index,iostatus;                                         03390000
INTEGER ldr'entry'index,iostatus;                                       03391000
OPTION PRIVILEGED, UNCALLABLE, INTERNAL;                                03392000
                                                                        03393000
COMMENT                                                                 03394000
                                                                        03395000
CachexferComp is called when a requested transfer against a mapped      03396000
domain is completed.  For a read, this occurs right after the move      03397000
from the mapped domain to the target segment completes.  For a write,   03398000
the completion occurs either after the move to cache has completed      03399000
(in case nowait for post was specified) or (if wait till post was spec  03400000
ified) the xfer completor is not invoked until the physical I/O backin  03401000
up the disc copy of the mapped domain completes. For reads and nowait-  03402000
for-post writes, the CacheXferComp routine is called by ProcessCDTQueu  03403000
when the cache move is performed.  For writes in which wait till post   03404000
was set, the logical transfer completor is called by the segment write  03405000
completor for the physical write updating the disc.  CacheXferComp      03406000
invokes the cache management completor to allow it to clean up the CDT  03407000
requesting the transfer if the wakeup bit has been set (ie if process   03408000
entry, get the next things going, awaken the process if wakeup set,     03409000
etc..                                                                   03410000
                                                                        03411000
;                                                                       03412000
                                                                        03413000
BEGIN                                                                   03414000
                                                                        03415000
<<record transfer status into logical request element>>                 03416000
                                                                        03417000
<< The high-order byte of the FUNCT  word in the LDR entry >>           03417100
<< contains the "strategy" information required for this   >>           03417200
<< request.  Unfortunately, the MPE I/O system places this >>           03417300
<< byte in the high-order byte of the status returned to   >>           03417400
<< the caller.  MPE File System compares this entire word  >>           03417450
<< to a "1", which fails if the strategy is kept in FUNCT. >>           03417500
ldr'strategy := 0;                                                      03417550
ldr'stat := iostatus;                                                   03418000
                                                                        03419000
<<If bad status, zap the xfer count>>                                   03420000
                                                                        03421000
IF iostatus <> iostatusok                                               03422000
THEN ldr'count := 0;                                                    03423000
                                                                        03424000
<<adjust locality if not db or stk, adj loc on cdt entry in sll         03425000
to offset add in attchio for blocked, waitforio for unbl>>              03426000
                                                                        03427000
IF (NOT ldr'dbrel) LAND ((ldr'blocked=1) LOR (ldr'iowake=1)) THEN       03428000
   BEGIN<<must offset addtolocality of seg if not dbseg>>               03429000
<< IF ABS(ldr'pcb*pcbsize+dbxdsinfowordnum+ABS(pcbp)) >>                03430000
<<         .xdsdstfield <> ldr'bufdst.(1:15)  THEN    >>                03431000
      BEGIN  <<not his db seg so do it>>                                03432000
      TOS := ABS(pcbp)+ldr'pcb*pcbsize-%1000;<<pcbsysbaseinx>>          03433000
      TOS:=ldr'bufdst.(1:15);  <<segid>>                                03434000
      TOS:=0;<<reqsize>>                                                03435000
      TOS:=0;                                                           03436000
      TOS.cleardiscsegflag:=1;                                          03437000
      AdjustLocality(*,*,*,*);                                          03438000
      END;                                                              03439000
   END;                                                                 03440000
                                                                        03441000
<<invoke the cache management xfer completor>>                          03442000
                                                                        03443000
CDT'COMPLETOR(ldr'cdt,ldr'entry'index);                                 03444000
                                                                        03445000
END;  <<Procedure CacheXferComp>>                                       03446000
                                                                        03447000
$PAGE "Cache Write Completor"                                           03448000
                                                                        03449000
PROCEDURE CacheWriteComp(CDTEntryNumber,XferStatus);                    03450000
VALUE CDTEntryNumber,XferStatus;                                        03451000
INTEGER CDTENTRYNumber,XferStatus;                                      03452000
OPTION PRIVILEGED,UNCALLABLE;                                           03453000
                                                                        03454000
COMMENT                                                                 03455000
                                                                        03456000
The Cache Write Completor is invoked by the object write completor      03457000
from the ICS in response to the interrupt signalling the completion     03458000
of a physical write to the disc of a mapped disc domain.                03459000
                                                                        03460000
The CDT entry number of the mapped domain and the status of the disc    03461000
request transfer are sent as incoming parameters.                       03462000
                                                                        03463000
The cache write completor stuffs the status of the write update into    03464000
the CDT entry of the mapped domain and invokes the transfer completor   03465000
for the logical disc req which is related to this write update.         03466000
                                                                        03467000
;                                                                       03468000
                                                                        03469000
BEGIN                                                                   03470000
                                                                        03471000
INTEGER ldr'entry'index;                                                03472000
                                                                        03473000
$if x1=off                                                              03473100
DEF'GET'WORD;                                                           03473200
$if                                                                     03473300
ldr'entry'index:=CDT'Get'Word(cdtentrynumber,cdt'md'ldr'head,0);        03474000
IF ldr'entry'index <> 0 THEN                                            03475000
   BEGIN  <<somebody waiting>>                                          03476000
   if LDR'FUNC = WRITEREQ then  << This is a non-NOPOST >>              03476100
     CacheXferComp(ldr'entry'index,xferstatus)                          03477000
   else                                                                 03477100
     CDT'COMPLETOR(cdtentrynumber,0);                                   03477200
   END                                                                  03478000
ELSE CDT'COMPLETOR(cdtentrynumber,0);                                   03479000
                                                                        03480000
END;  <<CacheWriteComp>>                                                03481000
$PAGE "Process CDT Disc Request Queue"                                  03482000
PROCEDURE ProcessCDTLogReqQueue (cdtentrynum, iostatus, xfercnt);       03483000
VALUE cdtentrynum,iostatus,xfercnt;                                     03484000
INTEGER cdtentrynum, iostatus,xfercnt;                                  03485000
OPTION PRIVILEGED,UNCALLABLE;                                           03486000
                                                                        03487000
COMMENT                                                                 03488000
                                                                        03489000
ProcessCDTDiscQueue is invoked by the dispatcher when processing        03490000
a message related to the arrival of a mapped disc domain into           03491000
main memory, and by PrefecthObject,RecoverOC, and FetchObject when      03492000
a cached mapped disc domain is requested and found to be in memory.     03493000
                                                                        03494000
ProcessCDTDiscQueue chases through the queue of pending logical         03495000
disc requests attached to the CDT entry passed as parameter.  For       03496000
each logical disc request in the CDT entry's pending queue :            03497000
                                                                        03498000
   if the segment involved in the transfer request is absent,           03499000
   the process requesting the logical transfer is flagged absent        03500000
   and the disc request element is moved to the hung logical request    03501000
   queue.                                                               03502000
                                                                        03503000
   if the mapped domain is absent, the process requesting the transfer  03504000
   is flagged absent.                                                   03505000
                                                                        03506000
   if both the segment and the mapped domain are present, a             03507000
   move effecting the desired transfer is performed.  The prefetch      03508000
   count of the sll entry of the mapped domain is decremented, and      03509000
   the ongoingio flag of the sllentry of the segment is                 03510000
   cleared.  If the transfer involved a write, the virginflag of the    03511000
   CDT entry is cleared and a physical write update of the cached       03512000
   domain is initiated through attachio.  If the transfer is for a      03513000
   read, the transfer completor is invoked.                             03514000
                                                                        03515000
After a transfer is performed, the reference bit of the cached disc     03516000
domain is set, the prefetch count of the mapped domain is cleared       03517000
in the process' sll, and the ongoing disc io count of the related       03518000
buffer is decrementd in the process' sll if not a stack, db not         03519000
pointing at it, and blocked or the iowake bit set.                      03520000
                                                                        03521000
It is assumed that the caller is pdisabled, and that DB is set at       03522000
sysdb.                                                                  03523000
                                                                        03524000
;                                                                       03525000
                                                                        03526000
BEGIN                                                                   03527000
                                                                        03528000
LOGICAL domainabsent,                                                   03529000
        segabsent,                                                      03530000
        odd'byte,    << True if transfer is odd-byte >>                 03530100
        is'write,    << True if this is a write function >>             03530190
        dbrel;                                                          03531000
                                                                        03532000
INTEGER processid,                                                      03533000
        flagprocflags,                                                  03533100
        urgency,                                                        03534000
        ldr'entry'index,                                                03535000
        mdobjident,                                                     03536000
        nextxferreqindex,                                               03537000
        xfercount,                                                      03538000
        residual,     << residual count >>                              03538100
        segoffset,                                                      03539000
        mdoffset,                                                       03540000
        mdhoda,                                                         03541000
        mdloda,                                                         03542000
        xferhoda,                                                       03543000
        xferloda,                                                       03544000
        discreqoffset,                                                  03544100
        segid;                                                          03545000
                                                                        03546000
DOUBLE mdregionbase,                                                    03547000
       segregionbase,                                                   03548000
       mddiscaddr=mdhoda,                                               03549000
       xferdiscaddr=xferhoda,                                           03550000
       segxferstartaddr,                                                03553000
       mdxferstartaddr,                                                 03554000
       startcachetime,                                                  03556100
       segaddress;                                                      03557000
                                                                        03557010
INTEGER discreqsysbase; <<ditto>>                                       03557021
                                                                        03557022
<< This define must always be because we check for an >>                03557023
<< unassigned entry.                                  >>                03557024
                                                                        03557030
DEF'GET'WORD;                                                           03557031
$if x1=OFF                                                              03557037
DEF'GET'DOUBLE;                                                         03557044
DEF'SET'BIT;                                                            03557051
$if                                                                     03557058
                                                                        03557100
<< Only process if this entry is currently assigned >>                  03557110
if CDT'GET'WORD(cdtentrynum,0,0) >= 0 THEN                              03557120
BEGIN                                                                   03557130
                                                                        03557140
IF CLASS0STATSENABLED AND ABS(CPCB) = 0                                 03557200
THEN STARTCACHETIME:=TIMER; <<FOR MEAS SUPPORT>>                        03558200
                                                                        03558325
mdobjident := BuildObjID(mappeddomainobject,cdtentrynum,0);             03559000
                                                                        03560000
nextxferreqindex := CDT'GET'WORD(cdtentrynum,cdt'md'ldr'head,0);        03561000
                                                                        03562000
WHILE nextxferreqindex <> 0 DO                                          03563000
   BEGIN  <<try to perform this move>>                                  03564000
   DISABLE;                                                             03565000
   ldr'entry'index := nextxferreqindex;                                 03566000
   nextxferreqindex := LDR'NEXTQ;                                       03567000
   IF NOT LDR'MOVE'DONE THEN                                            03567500
   BEGIN  << Cache move has NOT been performed yet >>                   03567550
                                                                        03567600
   TOS := LDR'BUFDST;                                                   03567640
   IF < THEN  << Bit 0 indicates that xfer is DB-RELATIVE>>             03568000
      BEGIN  <<xfer is rel to db>>                                      03569000
      dbrel := TRUE;                                                    03570000
      TOS.(0:1) := 0;                                                   03572000
      segid := TOS;                                                     03573000
      END                                                               03574000
   ELSE                                                                 03575000
      BEGIN <<not db rel>>                                              03576000
      dbrel := FALSE;                                                   03577000
      segid:=TOS;                                                       03578000
      END;                                                              03579000
                                                                        03580000
   IF INTEGER(LDR'CDT)<> cdtentrynum                                    03581000
   THEN SuddenDeath(SFKernCacheIntBad);                                 03582000
                                                                        03583000
   processid:=LDR'PCB;                                                  03584000
                                                                        03585000
   <<handle case of absent mapped domain>>                              03586000
                                                                        03587000
   IF IsObjectAbsent(mdobjident) THEN                                   03588000
      BEGIN  <<mapped domain is out, so flag process absent>>           03589000
      domainabsent:=TRUE;                                               03590000
      flagprocflags:=0;                                                 03590100
      flagprocflags.causefullswap:=1;                                   03590200
      FlagProcAbsent (processid,0,flagprocflags);                       03591000
$if x1=on                                                               03591100
      MMSTAT(139,0,processid,mdobjident);                               03591200
$if                                                                     03591300
      END                                                               03592000
   ELSE domainabsent := FALSE;                                          03593000
                                                                        03594000
   << handle case of absent data segment>>                              03595000
                                                                        03596000
   IF IsObjectAbsent(segid) THEN                                        03597000
      BEGIN                                                             03598000
      segabsent := TRUE;                                                03599000
      flagprocflags:=0;                                                 03599100
      flagprocflags.causefullswap:=1;                                   03599190
      FlagProcAbsent (processid,0,flagprocflags);                       03599280
$if x1=on                                                               03599362
      MMSTAT(139,ldr'entry'index,processid,segid);                      03599444
$if                                                                     03599526
      discreqsysbase := ABS(sysdiscreqtab)+ldr'entry'index;             03600100
      DequeueDiscReq(discreqsysbase,cdtreqq,cdtentrynum);               03601000
      QueueDiscReq(discreqsysbase,deferredreqq,0);                      03602000
      END                                                               03603000
   ELSE segabsent := FALSE;                                             03604000
                                                                        03605000
   <<handle case of seg and mapped domain present>>                     03606000
                                                                        03607000
   IF (NOT segabsent) AND (NOT domainabsent) THEN                       03608000
      BEGIN                                                             03609000
                                                                        03610000
      ENABLE;                                                           03611000
                                                                        03612000
      << lookup mdregionbase, seg region base>>                         03613000
                                                                        03614000
      mdregionbase := CDT'GET'DOUBLE(cdtentrynum,                       03615000
                                     cdt'md'mem'addr,0d);               03616000
      TOS:=0;                                                           03617000
      TOS := ABS(dstp)+segid&lsl(2)+2;                                  03618000
      ASMB(LDEA); <<base and bank from dst entry>>                      03619000
      segregionbase := TOS;                                             03620000
                                                                        03621000
      <<figure out transfer count>>                                     03622000
                                                                        03623000
      xfercount := ldr'count;                                           03624000
      IF < THEN                                                         03625000
         BEGIN  << Make count positive words >>                         03626000
         IF LOGICAL(xfercount) THEN  << Round count down 1 byte >>      03627000
            odd'byte := TRUE                                            03628000
         ELSE                                                           03628100
            odd'byte := FALSE;                                          03628200
         xfercount := (-xfercount) & ASR(1); << Make words >>           03629000
         END                                                            03630000
      ELSE                                                              03630100
         odd'byte := FALSE;                                             03630200
                                                                        03631000
      <<figure out offsets for transfer from base of seg, md>>          03632000
                                                                        03633000
      segoffset := ldr'bufadr;                                          03634000
      IF dbrel THEN                                                     03635000
         BEGIN <<must add db offset of stack to offset>>                03636000
         TOS := segregionbase;                                          03637000
         TOS := TOS+sbtostkreldbdisp;                                   03638000
         ASMB(LSEA);                                                    03639000
         segoffset := segoffset+TOS;                                    03640000
         END;                                                           03641000
      TOS:=0;                                                           03642000
      TOS:=segoffset;                                                   03643000
      segxferstartaddr := TOS + segregionbase;                          03645000
                                                                        03646000
                                                                        03647000
      TOS:=mdregionbase;                                                03648000
      TOS:=TOS+rbtohodadisp;                                            03649000
      ASMB(LDEA);                                                       03650000
      mdloda:=TOS;                                                      03651000
      mdhoda:=TOS.reghodafield;                                         03652000
      xferhoda := ldr'parm1;                                            03653000
      xferloda := ldr(cdt'x:=cdt'x+1);                                  03654000
      TOS:=xferdiscaddr-mddiscaddr;                                     03655000
      mdoffset := TOS*sectorsizeinwords;                                03656000
      IF < THEN SuddenDeath(SFKernCacheIntBad);                         03657000
                                                                        03657100
      << Check transfer count >>                                        03657200
      TOS := mdregionbase;                                              03657300
      TOS := TOS + RBtoRSdisp;                                          03657310
      ASMB(LSEA;DELB,DELB);  << Region size on TOS >>                   03657400
      if (tos * mmpagesize) <= (mdoffset + xfercount) then              03657450
        Suddendeath(SFKernCacheIntBad);                                 03657500
                                                                        03657550
      TOS:=0;                                                           03658000
      TOS:=mdoffset;                                                    03659000
      mdxferstartaddr:=TOS + mdregionbase;                              03661000
                                                                        03662000
      IF ldr'func = readreq THEN                                        03663000
         BEGIN                                                          03664000
         is'write := false;                                             03664100
         TOS := segxferstartaddr;                                       03666000
         TOS := mdxferstartaddr;                                        03666500
         END                                                            03667000
      ELSE                                                              03668000
         BEGIN                                                          03669000
         is'write := true;                                              03669100
         TOS := mdxferstartaddr;                                        03671000
         TOS := segxferstartaddr;                                       03671500
         END;                                                           03672000
                                                                        03674000
      << At this point, absolute TARGET and SOURCE addresses >>         03674100
      << for MABS instruction are stacked.                   >>         03674200
      <<perform the move effecting the transfer>>                       03675000
                                                                        03676000
      IF iostatus = iostatusok THEN                                     03680000
         BEGIN  << Perform move of data >>                              03680100
         TOS:=xfercount;                                                03680103
         ASMB(MABS 1);                                                  03680110
         IF odd'byte THEN                                               03680120
            BEGIN  << Take care of residual data byte >>                03680130
            ASMB(LSEA;DELB,DELB); << Load next word of source >>        03680140
            CDT'X    := TOS;      << Save it >>                         03680150
            ASMB(LSEA);           << Load next target word    >>        03680160
            TOS.(0:8) := CDT'X.(0:8); << Overlay byte      >>           03680170
            ASMB(SSEA);      << Store modified byte      >>             03680180
            END                                                         03680190
         ELSE                                                           03680200
            ASMB(DDEL);   << Remove stacked source addr  >>             03680210
         << At this point, move TARGET abs addr is on TOS >>            03680211
         if IS'WRITE then                                               03680212
         if (residual:=INTEGER((128-(LOGICAL(XFERCOUNT) land %177)      03680213
            ) land %177)) <> 0 or ODD'BYTE then begin                   03680214
            if ODD'BYTE then                                            03680215
               begin                                                    03680216
               ASMB(LSEA); << Load word w/hobyte modified >>            03680217
               tos := tos & lsr(8); << Shift off unneeded byte>>        03680218
               ASMB(DUP);  << Duplicate word >>                         03680219
               tos := tos & lsl(8); << Put byte in upper half >>        03680220
               tos := tos lor tos;  << Make new word >>                 03680227
               ASMB(SSEA);  << Store back in main memory >>             03680234
               << If residual is zero, 1 byte was moved >>              03680235
               if residual = 0 then                                     03680236
                  residual := 128;   << Actually, 1 sector >>           03680237
               end                                                      03680241
            else                                                        03680248
               begin  << Copy last BYTE, like the CS80 controller>>     03680249
               ASMB(DECA;LSEA);  << Load last valid word >>             03680250
               tos := tos & lsl(8); << Shift-off crap >>                03680251
               ASMB(DUP); << DUP word >>                                03680252
               tos := tos & lsr(8); << Put byte in low order >>         03680253
               tos := tos lor tos;  << Byte appears in both >>          03680254
               ASMB(INCB);  << Increment destination address >>         03680255
               ASMB(SSEA);  << Store next word back >>                  03680256
               end;                                                     03680257
            << Perform overlapping move >>                              03680262
            ASMB(INCA,DDUP;DECA);<< Copy target to source, sub 1 >>     03680263
            tos := residual-1;                                          03680264
            ASMB(MABS 5);                                               03680265
            end                                                         03680266
         else                                                           03680267
            ASMB(DDEL);  << Remove stacked target address >>            03680268
         end                                                            03680269
      ELSE                                                              03680298
         ASMB(DDEL,DDEL);  << Remove stacked parameters >>              03680376
                                                                        03681000
      <<set ref bit in region header of cached domain>>                 03682000
                                                                        03683000
      TOS := mdregionbase;                                              03684000
      TOS := TOS+rbtosasdisp;                                           03685000
      ASMB(LSEA);                                                       03686000
      IF NOT LS0.regcachedflag THEN SuddenDeath(SFKernCacheIntBad);     03687000
      TOS.regrefflag := 1;                                              03688000
      ASMB(SSEA;DDEL);                                                  03689000
                                                                        03690000
      <<update measurement instrumentation if statistics enabled>>      03690010
                                                                        03690020
      if CLASS0STATSENABLED then                                        03690100
         if FUPDATESTATISTICS(MEASCLASS0,MEASSUBCLASS0,MEASENTRY1,      03690369
                             C'CACHEDATAMOVES,NOTNEWVALUE,1D,NOTDOUBLE) 03690370
         <> 0 then SUDDENDEATH(SFKERNCACHEINTBAD);                      03690505
                                                                        03690595
      <<adjust locality to offset prefetch on mapped domain>>           03691000
                                                                        03692000
      TOS := ABS(pcbp)+processid*pcbsize-%1000;<<pcbsysbase>>           03693000
      TOS:=mdobjident;                                                  03694000
      TOS:=0;<<reqsize>>                                                03695000
      TOS:=0;                                                           03696000
      TOS.decprefetchcntflag := 1;                                      03697000
      AdjustLocality(*,*,*,*);                                          03698000
                                                                        03698100
      << Record fact that move has taken place >>                       03698200
      LDR'MOVE'DONE := 1;                                               03698300
                                                                        03699000
      MMSTAT(mmstatcachemove,segid,cdtentrynum,xfercount);              03700000
                                                                        03701000
      DISABLE;                                                          03702000
                                                                        03703000
      <<nextxferreqindex := LDR'NEXTQ;>><<may have changed>>            03704000
                                                                        03705000
      <<start disc update for write requests>>                          03706000
                                                                        03707000
      IF is'write THEN                                                  03708000
         BEGIN                                                          03709000
                                                                        03710000
         << Clear mapped CDT VIRGIN bit, if set >>                      03711000
         CDT'SET'BIT(cdtentrynum,cdt'virgin'bit,0);                     03712000
                                                                        03713000
         discreqoffset := CDT'GET'WORD(cdtentrynum,cdt'md'discreq,0);   03713100
         IF = THEN SuddenDeath(SFKernCacheIntBad);                      03713190
         IF not LDR'DO'POST THEN urgency := bkgrndpri                   03714000
         ELSE urgency := ProcessPri(processid);                         03715000
         StartObjWrite(mdobjident,urgency,mdregionbase,                 03716000
                       ldr'entry'index,discreqoffset);                  03717000
         END;                                                           03719000
                                                                        03720000
      <<finish off request for read, no-wait-for-post write requests>>  03721000
                                                                        03722000
      IF (not is'write) OR (not ldr'do'post) THEN                       03723000
         BEGIN <<complete it now>>                                      03724000
         CacheXferComp(ldr'entry'index,iostatus);                       03725000
         END;                                                           03726000
                                                                        03727000
      END;                                                              03728000
                                                                        03729000
   END;  << of IF testing if move has been performed >>                 03729100
                                                                        03729200
   END;  <<While Loop>>                                                 03730000
                                                                        03731000
IF CLASS0STATSENABLED AND ABS(CPCB) = 0 THEN                            03731190
   IF FUPDATESTATISTICS(MEASCLASS0,MEASSUBCLASS0,MEASENTRY1,            03731279
                       C'CACHEONICS,NOTNEWVALUE,                        03731280
                       TIMER-STARTCACHETIME,DOUBLEVALUE)                03731370
   <> 0 THEN SUDDENDEATH(SFKERNCACHEINTBAD);                            03731460
                                                                        03731505
                                                                        03731554
END;  << of processing VALID cdt entry >>                               03731603
                                                                        03731652
END;  <<Procedure  ProcessCDTReqQ>>                                     03732000
                                                                        03733000
                                                                        03734000
                                                                        03735000
                                                                        03736000
$PAGE "DISC CACHE ENABLE / DISABLE CONTROL : CACHE'LDEV  "              03793000
procedure CACHE'LDEV(LDEV,STAT);                                        03795000
value LDEV;                                                             03797000
integer LDEV,STAT  ;                                                    03799000
option privileged,uncallable;                                           03801000
begin                                                                   03803000
                                                                        03805000
<< CACHE'LDEV is the executor for the STARTCACHE command.        >>     03807000
                                                                        03809000
<< This procedure accepts LDEV as input, and manipulates various >>     03811000
<< I/O and CACHE tables to enable global caching on that disc.   >>     03813000
<< If this is the first time a disc has been enabled, it will    >>     03815000
<< obtain a CACHE DST, initialize it, and set up the environment >>     03817000
<< to allow any disc to have caching enabled.                    >>     03819000
                                                                        03821000
<<***************************************************************>>     03823000
<< INPUT - LDEV.  This logical device number is assumed to be a  >>     03825000
<<         valid disc logical device configured into the system. >>     03827000
<<                                                               >>     03829000
<< OUTPUT- STAT  . This integer is returned to the caller to     >>     03831000
<<         indicate the status of the call.  The values returned >>     03833000
<<         are:                                                  >>     03835000
<<         0 - call completed successfully.                      >>     03837000
<<         1 - the cache DST could not be obtained.              >>     03839000
<<         2 - an internal CACHE software error occurred.        >>     03841000
<<         3 - the LDEV specified is already cached.             >>     03843000
<<         4 - the CDT would be too large due to too many disc req>>    03845000
<<         5 - the device specified is not cachable              >>     03847000
<<         6 - this system is not permitted to use disc caching  >>     03849000
<<***************************************************************>>     03851000
                                                                        03853000
<<******************* Caller environment ************************>>     03855000
<< The caller of this procedure should have DB pointing to the   >>     03857000
<< stack and be able to be "BLOCKED", as an absence trap might   >>     03859000
<< occur during the CACHE DST initialization.                     >>    03861000
<<                                                               >>     03863000
<< This routine may PDISABLE/PENABLE at various times to handle  >>     03865000
<< syncronization problems.  It also needs to be privileged to   >>     03867000
<< access various system tables.                                 >>     03869000
<<***************************************************************>>     03871000
                                                                        03873000
<<**************** MPE Tables Accessed **************************>>     03875000
<< CACHE'DST    - This SYSGLOB cell is read and modified.        >>     03877000
<< LPDT         - This table is read only to obtain disc DIT info>>     03879000
<<                and determine the highest LDEV configured.     >>     03881000
<< DIT          - DIT word 0 (Flags) is accessed to set/reset bit4>>    03883000
<<                which is the DIT'CACHE'ENABLED bit for this disc>>    03885000
<<***************************************************************>>     03887000
$page                                                                   03889000
integer HIGHEST'LDEV,          << Highest LDEV config'd in MPE>>        03891000
        NUM'OF'DISCS,          << Number of DISCS config'd    >>        03893000
        CTR,                   << Indexing variable           >>        03895000
        NUM'OF'DISCREQ,        << Number of DISCREQ entries   >>        03897000
        NUM'OF'ENTRIES,        << Number of Entries in CDT    >>        03899000
        XDS'SIZE,              << CACHING DST size            >>        03901000
        OLD'CRITICAL,          << Return from SETCRITICAL     >>        03903000
        OLD'SIR,               << Return from GetSir          >>        03905000
        X = x,                 << Index register              >>        03907000
        OBJECT'IDENT,          << MPE standard object ident   >>        03909000
        DST'NUMBER;            << DST number obtained for CACH>>        03911000
$page                                                                   03913000
subroutine FORMAT'CDT;                                                  03915000
begin                                                                   03917000
                                                                        03919000
<< This procedure formats the CACHE DST.  At this point, the DST >>     03921000
<< is already LOCKED and FROZEN in memory.  We will move DB to   >>     03923000
<< the DST to facilitate ease of formatting.                     >>     03925000
                                                                        03927000
EXCHANGEDB(DST'NUMBER);                                                 03929000
                                                                        03931000
<< Zero out DST.  >>                                                    03933000
CDT'ARRAY := 0;                                                         03935000
move CDT'ARRAY(1) := CDT'ARRAY,(XDS'SIZE-1);                            03937000
                                                                        03939000
<< Perform specific initialization >>                                   03941000
                                                                        03943000
<< Initialize table header >>                                           03945000
CDT'ARRAY(CDT'ENTRIES) := NUM'OF'ENTRIES;                               03947000
CDT'ARRAY(CDT'SIZE) := CDT'ENTRY'SIZE;                                  03949000
CDT'ARRAY(CDT'FREE'COUNT) := NUM'OF'ENTRIES - 1;                        03951000
<< CDT'FREE'HEAD already 0 >>                                           03953000
<< CDT'FREE'TAIL already 0 >>                                           03955000
CDT'ARRAY(CDT'MAX'USED) := 1;                                           03957000
<< CDT'NUM'LDEVS already 0 >>                                           03959000
<< CDT'DISC'HEAD already 0 >>                                           03961000
CDT'ARRAY(CDT'DST'WORDS) := XDS'SIZE;  << Words CDT is in length >>     03963000
<< CDT'STOP'PND already false >>                                        03965000
CDT'ARRAY(CDT'SEQ'MINFTCH) := CACHE'SEQUENTIAL;                         03967000
CDT'ARRAY(CDT'RND'MINFTCH) := CACHE'RANDOM;                             03969000
<< CDT'FORCE'POST already false >>                                      03971000
                                                                        03973000
<< Initialize FREE entry list >>                                        03975000
CDT'ARRAY(CDT'FREE'HEAD) := CDT'ENTRY'SIZE;                             03977000
CTR := CDT'ENTRY'SIZE;                                                  03979000
while CTR < XDS'SIZE do                                                 03981000
  begin                                                                 03983000
  CDT'ARRAY(CTR) := -1;  << Mark as unassigned >>                       03985000
  CDT'ARRAY(CTR+CDT'FREE'HEAD) := CTR + CDT'ENTRY'SIZE;                 03987000
  CTR := CTR + CDT'ENTRY'SIZE;                                          03989000
  end;                                                                  03991000
<< Back-up to last entry >>                                             03993000
CTR := CTR - CDT'ENTRY'SIZE;                                            03995000
CDT'ARRAY(CTR + CDT'FREE'HEAD) := 0;                                    03997000
CDT'ARRAY(CDT'FREE'TAIL) := CTR;  << Fix tail pointer in header rec >>  03999000
                                                                        04001000
<< Put DB back to the caller's stack >>                                 04003000
EXCHANGEDB(0);                                                          04005000
                                                                        04007000
end; <<of subroutine FORMAT'CDT>>                                       04009000
$page                                                                   04011000
subroutine INIT'DITS;                                                   04013000
begin                                                                   04015000
                                                                        04017000
<< This subroutine turns off the DIT'CACHE'ENABLED bit in all    >>     04019000
<< DISC DITS "FLAGS" word.                                   >>         04021000
                                                                        04023000
CTR := 0;     << Sweep through all the LDEV's >>                        04025000
while (CTR:=CTR+1) <= HIGHEST'LDEV do                                   04027000
  begin                                                                 04029000
  IF IsDevCachable(CTR) THEN                                            04031000
    begin <<this dev is cachable>>                                      04033000
    DISABLE;                                                            04035000
    S'DITP(S'LPDT(CTR*2)).DIT'CACHE'ENABLED := 0;  << Bit off >>        04037000
    ENABLE;                                                             04039000
    end;                                                                04041000
  end;                                                                  04043000
                                                                        04045000
end;  << of subroutine INIT'DITS >>                                     04047000
$page                                                                   04049000
subroutine BUILD'CDT;                                                   04051000
begin                                                                   04053000
                                                                        04055000
<< This subroutine is called the first time a DISC is requested >>      04057000
<< to have CACHING enabled.  The SYSGLOB cell containing the DST>>      04059000
<< number will be zero until the first disc is requested to have>>      04061000
<< CACHING enabled against it.                                  >>      04063000
                                                                        04065000
<< Determine the number of discs configured on this system.     >>      04067000
HIGHEST'LDEV := S'LPDT(0).(0:8);<< Max ldev configured on system.>>     04069000
NUM'OF'DISCS := 0;                                                      04071000
CTR := 0;   << LDEV index >>                                            04073000
                                                                        04075000
<< Step through the LDEV's >>                                           04077000
while (CTR:=CTR+1) <= HIGHEST'LDEV do                                   04079000
  begin                                                                 04081000
  IF IsDevCachable(CTR) THEN NUM'OF'DISCS:=NUM'OF'DISCS+1;              04083000
  end;                                                                  04085000
                                                                        04087000
<< Determine the number of DISC REQUEST elements configured >>          04089000
NUM'OF'DISCREQ := S'DISCREQ(0).conf'disc'req'cnt;                       04091000
                                                                        04093000
<< Calculate the DST size and obtain CACHING DST >>                     04095000
NUM'OF'ENTRIES := NUM'OF'DISCS +   << One entry for every disc >>       04097000
                  NUM'OF'DISCREQ + << One for each Disc Request>>       04099000
                  1;               << One entry for table head >>       04101000
                                                                        04103000
<< Over-configure table to handle table roundoff & init routines >>     04105000
XDS'SIZE := CDT'ENTRY'SIZE * NUM'OF'ENTRIES;                            04107000
                                                                        04109000
<< If overflow, its too big >>                                          04111000
if carry or overflow then                                               04113000
  begin  << System manager must make LDR table smaller >>               04115000
  STAT := stat'cdt'overflow;                                            04117000
  end                                                                   04119000
else                                                                    04121000
  begin <<can procede - get the xds for the CDT>>                       04123000
  DST'NUMBER := GETDATASEG(XDS'SIZE,XDS'SIZE);                          04125000
  if DST'NUMBER <= 0 then                                               04127000
     begin  << Could not obtain DST >>                                  04129000
     STAT   := stat'no'dst;                                             04131000
     end                                                                04133000
  else                                                                  04135000
     begin <<got the xds for the cdt, now lock,freeze, format>>         04137000
     << Lock and freeze the DST in main memory >>                       04139000
     OBJECT'IDENT := BUILDOBJID(DATAOBJECT,DST'NUMBER,0);               04141000
     LOCKSEG'(OBJECT'IDENT,true);  << Place it in a good location >>    04143000
     FREEZESEG'(OBJECT'IDENT,0);   << Don't allow it to move.     >>    04145000
                                                                        04147000
     << Format the data segment into the CDT >>                         04149000
     FORMAT'CDT;                                                        04151000
                                                                        04153000
     << Build object identifier for the cacheseg>>                      04155000
     OBJECT'IDENT := BUILDOBJID(SLOBJECT,                               04157000
                          logical(@CDT'GET'ENTRY) land %377,0);         04159000
                                                                        04161000
     << Lock and freeze the cacheseg into main memory >>                04163000
     LOCKSEG'(OBJECT'IDENT,true);                                       04165000
     FREEZESEG'(OBJECT'IDENT,0);                                        04167000
                                                                        04169000
     DISABLE;                                                           04171000
                                                                        04173000
     << Turn off the CACHED bit in all disc DITS >>                     04175000
     INIT'DITS;                                                         04177000
                                                                        04179000
     <<stuff away CDT dst num & address into sysglob>>                  04181000
     CACHE'DST := DST'NUMBER;                                           04183000
     CACHE'DST'BANK := S'DST((DST'NUMBER*4)+2).(8:8); << Bank >>        04185000
     CACHE'DST'OFST := S'DST((DST'NUMBER*4)+3); << Offset >>            04187000
                                                                        04189000
     ENABLE;                                                            04191000
                                                                        04193000
     end;                                                               04195000
  end;                                                                  04197000
end;  << of subroutine BUILD'CDT>>                                      04199000
$page                                                                   04201000
subroutine ENABLE'CACHE;                                                04203000
begin                                                                   04205000
                                                                        04207000
<< This routine checks whether CACHING is already enabled against >>    04209000
<< the specified LDEV, and if not, proceeds to enable CACHING on  >>    04211000
<< it.  The CACHE transition flag is set to block any further req->>    04213000
<< uests until all the physical I/O's have completed on this LDEV.>>    04215000
                                                                        04217000
DISABLE;     << Protect possible concurrent access >>                   04219000
                                                                        04221000
<< See if LDEV is already CACHED >>                                     04223000
X := S'LPDT(LDEV * 2);   << DIT pointer is placed in INDEX register >>  04225000
if S'DITP(X).DIT'CACHE'ENABLED = 1 then                                 04227000
  begin  << Cache is already enabled on this LDEV >>                    04229000
  STAT := stat'ldev'cached;  << Return error code >>                    04231000
  end                                                                   04233000
else                                                                    04235000
   begin <<caching not yet enabled - go ahead>>                         04237000
   << Get a table entry for this new LDEV >>                            04239000
   CTR := CDT'GET'ENTRY;                                                04241000
   if CTR = 0 then                                                      04243000
     begin  << We could not get an entry >>                             04245000
     STAT := stat'int'error;  << Indicate software error >>             04247000
     end                                                                04249000
   else                                                                 04251000
     begin  <<got a cdt entry for this device>>                         04253000
     << Increment number of LDEVs cached >>                             04255000
     CDT'ADD'WORD(0 << header >>,CDT'NUM'LDEVS,1);                      04257000
                                                                        04259000
     << Format this new entry >>                                        04261000
     CDT'SET'WORD(CTR,CDT'DE'LDEV,LDEV);                                04263000
                                                                        04265000
     << Fix pointers >>                                                 04267000
     if CDT'GET'WORD(0,CDT'DISC'HEAD,0) = 0 then                        04269000
        begin   << This is the first disc on the list >>                04271000
        CDT'SET'WORD(0,CDT'DISC'HEAD,CTR);                              04273000
        CDT'ARRAY(CTR + CDT'DE'PREV'LDEV) := 0;                         04275000
        end                                                             04277000
                                                                        04279000
     else                                                               04281000
                                                                        04283000
        begin  << Someone else is on the list >>                        04285000
        << Use DST'NUMBER as index >>                                   04287000
        DST'NUMBER := CDT'GET'WORD(0,CDT'DISC'HEAD,0);                  04289000
        while CDT'GET'WORD(DST'NUMBER,CDT'DE'NEXT'LDEV,0) <> 0          04291000
        do DST'NUMBER := CDT'GET'WORD(DST'NUMBER,CDT'DE'NEXT'LDEV,0);   04293000
        << At this point, we should be at last entry in chain >>        04295000
        << Put new LDEV in this LDEV's NEXT pointer >>                  04297000
        CDT'SET'WORD(DST'NUMBER,CDT'DE'NEXT'LDEV,CTR);                  04299000
        << Point new LDEV entry back to prior LDEV entry >>             04301000
        CDT'SET'WORD(CTR,CDT'DE'PREV'LDEV,DST'NUMBER);                  04303000
        end;                                                            04305000
                                                                        04307000
      << Finally, turn on the DIT'CACHE'ENABLED bit in the DIT >>       04309000
      X := S'LPDT(LDEV * 2);  << SYSDB DITP in index register >>        04311000
      S'DITP(X).DIT'CACHE'ENABLED := 1; << Turn on bit >>               04313000
                                                                        04315000
      ENABLE;   << Let the system RIP >>                                04317000
                                                                        04319000
      end;                                                              04321000
   end;                                                                 04323000
end;  << of subroutine ENABLE'CACHE >>                                  04325000
$page                                                                   04327000
<<turn off arithmetic traps, set critical to prevent midway abort>>     04329000
                                                                        04331000
TurnOffTraps;                                                           04333000
old'critical := SetCritical;                                            04335000
                                                                        04337000
<<serialize cache control thru sir acquisition>>                        04339000
                                                                        04341000
old'sir := GetSir(cache'control'sir);                                   04343000
                                                                        04345000
<<if caching is permitted on this system and on the specified           04347000
  device, enable caching for the device>>                               04349000
                                                                        04351000
IF NOT IsSysCachable THEN stat := stat'sys'not'cachable ELSE            04353000
   BEGIN  <<system is allowed to have disc caching enabled>>            04355000
   IF NOT IsDevCachable(ldev)  THEN stat := stat'dev'not'cachable ELSE  04357000
      BEGIN  <<device is a cachable device>>                            04359000
      stat := stat'ok;  <<initialize to successful completion>>         04361000
      IF cache'dst = 0 THEN Build'CDT; << first enable-build CDT >>     04363000
      IF stat = stat'ok THEN Enable'Cache;                              04365000
      END;                                                              04367000
   END;                                                                 04369000
                                                                        04371000
<< release sir and reset critical state >>                              04373000
                                                                        04375000
RelSir(cache'control'sir,old'sir);                                      04377000
ResetCritical(old'critical);                                            04379000
                                                                        04381000
END;  << of procedure CACHE'LDEV >>                                     04383000
$PAGE "DISC CACHE ENABLE / DISABLE CONTROL : UNCACHE'LDEV  "            04385000
procedure UNCACHE'LDEV(LDEV,STATR);                                     04387000
value LDEV;                                                             04389000
integer LDEV,STATR ;                                                    04391000
option privileged,uncallable;                                           04393000
begin                                                                   04395000
                                                                        04397000
<< UNCACHE'LDEV is the executor for the STOPCACHE command.       >>     04399000
                                                                        04401000
<< This procedure accepts LDEV as input, and manipulates various >>     04403000
<< I/O and CACHE tables to disable global caching from that disc.>>     04405000
<< If this is the last disc to have caching disabled against it, >>     04407000
<< the cache data segment will be unfrozen, unlocked and released>>     04409000
<< and the cache segment CACHESEG will be unfrozen nad unlocked. >>     04411000
                                                                        04413000
<<***************************************************************>>     04415000
<< INPUT - LDEV.  This logical device number is assumed to be a  >>     04417000
<<         valid disc logical device configured into the system. >>     04419000
<<                                                               >>     04421000
<< OUTPUT- STATR . This integer is returned to the caller to     >>     04423000
<<         indicate the status of the call.  The values returned >>     04425000
<<         are:                                                  >>     04427000
<<         0 - call completed successfully.                      >>     04429000
<<         1 - caching was not enabled for any devices           >>     04431000
<<         2 - an internal CACHE software error occurred.        >>     04433000
<<         3 - the LDEV specified did not have caching enabled   >>     04435000
<<         5 - the device cannot support caching                 >>     04437000
<<         6 - this system is not permitted to use disc caching  >>     04439000
<<***************************************************************>>     04441000
                                                                        04443000
<<******************* Caller environment ************************>>     04445000
<< The caller of this procedure should have DB pointing to the   >>     04447000
<< stack and be able to be "BLOCKED", as an absence trap might   >>     04449000
<< occur during the CACHE DST initialization.                     >>    04451000
<<                                                               >>     04453000
<< This routine may PDISABLE/PENABLE at various times to handle  >>     04455000
<< syncronization problems.  It also needs to be privileged to   >>     04457000
<< access various system tables.                                 >>     04459000
<<***************************************************************>>     04461000
                                                                        04463000
<<**************** MPE Tables Accessed **************************>>     04465000
<< CACHE'DST    - This SYSGLOB cell is read and modified.        >>     04467000
<< LPDT         - This table is read only to obtain disc DIT info>>     04469000
<<                and determine the highest LDEV configured.     >>     04471000
<< DIT          - DIT word 0 (Flags) is accessed to set/reset bit4>>    04473000
<<                which is the DIT'CACHE'ENABLED bit for this disc>>    04475000
<<***************************************************************>>     04477000
                                                                        04479000
integer OLD'SIR,       << Return from GETSIR              >>            04481000
        OLD'CRITICAL,  << Return from SETCRITICAL         >>            04483000
        DBSAVE,        << Return from SETSYSDB            >>            04485000
        STAT,          << return status from procedure    >>            04487000
        LDEV'INDEX,    << CDT entry of LDEV to be uncached>>            04489000
        CDT'ENTRY,     << CDT entry of mapped domain      >>            04491000
        OBJECT'IDENT,  << Object identifier               >>            04493000
        PRIOR'PTR,     << Prior mapped CDT entry          >>            04495000
        NEXT'PTR,      << Next mapped CDT entry           >>            04497000
        IMPEDED'PIN,   << Head impeded pin                >>            04499000
        NEXT'PIN;      << Next pin to be unimpeded        >>            04501000
                                                                        04503000
$page                                                                   04505000
subroutine DEALLOCATE'RESOURCES;                                        04507000
begin                                                                   04509000
                                                                        04511000
<< This subroutine cleans-up all code and data structures >>            04513000
<< associated with disc caching.                          >>            04515000
                                                                        04517000
<< Unlock/unfreeze cache DST >>                                         04519000
OBJECT'IDENT := BUILDOBJID(SLOBJECT,logical(@CDT'GET'ENTRY)             04521000
                land %377,0);                                           04523000
UNFREEZESEG'(OBJECT'IDENT);                                             04525000
UNLOCKSEG'(OBJECT'IDENT);                                               04527000
                                                                        04529000
OBJECT'IDENT := BUILDOBJID(DATAOBJECT,CACHE'DST,0);                     04531000
UNFREEZESEG'(OBJECT'IDENT);                                             04533000
UNLOCKSEG'(OBJECT'IDENT);                                               04535000
                                                                        04537000
<< Release the cache XDS >>                                             04539000
RELDATASEG(CACHE'DST);                                                  04541000
                                                                        04543000
<< Clean-up sysglob cells >>                                            04545000
CACHE'DST := CACHE'DST'BANK := CACHE'DST'OFST := 0;                     04547000
                                                                        04549000
end;                                                                    04551000
$page                                                                   04553000
TURNOFFTRAPS;                                                           04555000
DBSAVE := SETSYSDB;                                                     04557000
OLD'CRITICAL := SETCRITICAL;                                            04559000
OLD'SIR := GETSIR(CACHE'CONTROL'SIR);                                   04561000
                                                                        04563000
<< Perform error checking >>                                            04565000
if not ISSYSCACHABLE then                                               04567000
   STAT := 6 << Caching not permitted >>                                04569000
else if CACHE'DST = 0 then                                              04571000
   STAT := 1 << Caching not enabled >>                                  04573000
else if not ISDEVCACHABLE(LDEV) then                                    04575000
   STAT := 5     << Not a cachable device >>                            04577000
else if (LDEV'INDEX:=CDT'FIND'DE(LDEV)) = 0 then                        04579000
   STAT := 3     << Device is NOT cached >>                             04581000
else                                                                    04583000
   begin  << Turn it off... >>                                          04585000
   STAT := STAT'OK;                                                     04587000
                                                                        04589000
   << Lock the entire CDT >>                                            04591000
   CDT'SET'WORD(0,CDT'STOP'PND,-1);                                     04593000
                                                                        04595000
   << Flush all domains for this device >>                              04597000
   while (CDT'ENTRY:=CDT'GET'WORD(LDEV'INDEX,CDT'DE'MAPD'HEAD,          04599000
          0)) <> 0 or                                                   04601000
         (CDT'GET'WORD(LDEV'INDEX,CDT'DE'REGIONS,0) <> 0) do            04603000
      FLUSH'CACHE(LDEV,0D,%17777777777 D);                              04605000
                                                                        04607000
   << Turn off CACHED flag in the DIT >>                                04609000
   PDISABLE;                                                            04611000
   DISABLE;                                                             04613000
   S'DITP(S'LPDT(LDEV*2)).DIT'CACHE'ENABLED := 0;                       04615000
   ENABLE;                                                              04617000
                                                                        04619000
   << Delink the entry >>                                               04621000
   PRIOR'PTR := CDT'SET'WORD(LDEV'INDEX,CDT'DE'PREV'LDEV,0);            04623000
   NEXT'PTR  := CDT'SET'WORD(LDEV'INDEX,CDT'DE'NEXT'LDEV,0);            04625000
   if PRIOR'PTR <> 0 then                                               04627000
      CDT'SET'WORD(PRIOR'PTR,CDT'DE'NEXT'LDEV,NEXT'PTR)                 04629000
   else                                                                 04631000
      CDT'SET'WORD(0,CDT'DISC'HEAD,NEXT'PTR);                           04633000
                                                                        04635000
   if NEXT'PTR <> 0 then                                                04637000
      CDT'SET'WORD(NEXT'PTR,CDT'DE'PREV'LDEV,PRIOR'PTR);                04639000
                                                                        04641000
   << Release the entry >>                                              04643000
   CDT'FREE'ENTRY(LDEV'INDEX);                                          04645000
                                                                        04647000
   << Decrement count of cached devices >>                              04649000
   CDT'ADD'WORD(0,CDT'NUM'LDEVS,-1);                                    04651000
                                                                        04653000
   << Unlock/unimpede waiting processes >>                              04655000
   CDT'SET'WORD(0,CDT'STOP'PND,0);                                      04657000
   IMPEDED'PIN := CDT'SET'WORD(0,CDT'STOP'QUEUE,0);                     04659000
   while IMPEDED'PIN <> 0 do                                            04661000
      begin                                                             04663000
      NEXT'PIN := UNSTRINGHEADPIN(IMPEDED'PIN);                         04665000
      UNIMPEDE(IMPEDED'PIN * PCBSIZE);                                  04667000
      IMPEDED'PIN := NEXT'PIN;                                          04669000
      end;                                                              04671000
                                                                        04673000
   << If there are no more devices, deallocate resources >>             04675000
   PENABLE;                                                             04677000
   if CDT'GET'WORD(0,CDT'DISC'HEAD,0) = 0 then                          04679000
      DEALLOCATE'RESOURCES;                                             04681000
                                                                        04683000
   end;                                                                 04685000
                                                                        04687000
<< Clean-up >>                                                          04689000
RELSIR(CACHE'CONTROL'SIR,OLD'SIR);                                      04691000
RESETCRITICAL(OLD'CRITICAL);                                            04693000
RESETDB(DBSAVE);                                                        04695000
STATR := STAT;                                                          04697000
end;   << of procedure UNCACHE'LDEV >>                                  04699000
$page "CDT'DISPLAY'LDEVS"                                               04701000
procedure CDT'DISPLAY'LDEVS(RESET'TTLS,RSTAT);                          04703000
value RESET'TTLS;                                                       04705000
logical RESET'TTLS;                                                     04707000
integer RSTAT;                                                          04709000
option privileged,uncallable;                                           04711000
begin                                                                   04713000
                                                                        04715000
<<CDT'DISPLAY'LDEVS IS THE EXECUTOR FOR THE SHOWCACHE CMD.  >>          04717000
<< This procedure displays basic caching statistics for all >>          04719000
<< cached discs on the system.  The returned value(s) are:  >>          04721000
<<                                                          >>          04723000
<< RSTAT    - Returned status, where:                       >>          04725000
<<            0 - Successful                                >>          04727000
<<            1 - Caching is not enabled on this system.    >>          04729000
<<                                                          >>          04731000
<< Passed parameter is:                                     >>          04733000
<< RESET'TTLS - Set to TRUE if caller wishes to reset       >>          04735000
<<              cache HIT and REQUEST counters.             >>          04737000
<< DB is assumed to be at the caller's stack.               >>          04739000
<<**********************************************************>>          04741000
                                                                        04743000
array BUF(0:39);                                                        04745000
byte array B'BUF(*) = BUF;                                              04747000
                                                                        04749000
integer LENGTH,    << For printing >>                                   04751000
        LDEV,      << Number of LDEV being displayed >>                 04753000
        OLD'SIR,   << Return value from GETSIR >>                       04755000
        OLD'CRIT,  << Old value from SETCRITICAL>>                      04757000
        LDEV'LINK, << Pointer to device entry  >>                       04759000
        WORK,      << Temp variable            >>                       04761000
        OHEAD,     << Number of words in CDT   >>                       04763000
        PCNT'MEM,  << Percent of main memory   >>                       04765000
        PCNT'READ, << % of reads to all reqs.  >>                       04767000
        RPERCENT,  << Read hit ratio on disc   >>                       04769000
        WPERCENT;  << Write hit ratio on disc  >>                       04771000
                                                                        04773000
double RHIT,      << Number of read cache HITS >>                       04775000
       WHIT,      << Number of write cache HITS>>                       04777000
       RMISS,    << Number of cache read misses on this LDEV >>         04779000
       WMISS,    << Number of cache write misses on this LDEV>>         04781000
       WRITES,     << Number of cache write requests      >>            04783000
       TWRITES,    << Total # of cache write requests     >>            04785000
       TRHIT,     << Total # read hits for all ldev's         >>        04787000
       TWHIT,     << Total # write hits for all ldev's        >>        04789000
       TRMISS,   << Total # of read misses for all ldev's    >>         04791000
       TWMISS,   << Total # of write misses for all ldev's   >>         04793000
       STOPS,      << Number of process stops on this ldev     >>       04795000
       TSTOPS,     << Total # of process stops on this ldev    >>       04797000
       PAGES,      << Number of pages consumed by this dev>>            04799000
       TPAGES,     << Total # of pages by all devices     >>            04801000
       REGIONS,    << Number of cached domains for disc   >>            04803000
       TREGIONS,   << Total # of cached domains for all   >>            04805000
       TMEMORY,    << Total bytes of main memory          >>            04807000
       REQUESTS;   << Total number of cache requests on this LDEV>>     04809000
                                                                        04811000
logical OVRFLOW;           << An arithmetic overflow occurred >>        04813000
                                                                        04815000
equate NBANKSINX = %1047;  << SYSGLOB cell indicating # banks>>         04817000
                                                                        04819000
<< We can't abort here... >>                                            04821000
OLD'CRIT := SETCRITICAL;                                                04823000
                                                                        04825000
<< Obtain SIR to protect integrity >>                                   04827000
OLD'SIR := GETSIR(CACHE'CONTROL'SIR);                                   04829000
                                                                        04831000
<< Check if caching is enabled >>                                       04833000
if CACHE'DST = 0 then                                                   04835000
  begin  << Caching is NOT enabled >>                                   04837000
  RSTAT := 1;                                                           04839000
  end                                                                   04841000
else                                                                    04843000
  begin                                                                 04845000
                                                                        04847000
  TURNOFFTRAPS;                                                         04849000
                                                                        04851000
  << Loop through all cached discs >>                                   04853000
  PRINT(BUF,0,0);   << One line space >>                                04855000
  TRHIT := TWHIT := TRMISS := TWMISS :=                                 04857000
  TWRITES := TREGIONS := TPAGES := TSTOPS := 0D;                        04859000
  OVRFLOW := false;                                                     04861000
                                                                        04863000
  move BUF :=                                                           04865000
"DISC   CACHE    READ WRITE        PROCESS               % OF    CACHE" 04867000
,2;                                                                     04869000
  LENGTH := TOS - @BUF;                                                 04871000
  PRINT(BUF,LENGTH,0);                                                  04873000
                                                                        04875000
  move BUF :=                                                           04877000
"LDEV  REQUESTS  HIT%  HIT%  READ%  STOPS      K-BYTES  MEMORY  DOMAINS"04879000
,2;                                                                     04881000
  LENGTH := TOS - @BUF;                                                 04883000
  PRINT(BUF,LENGTH,0);                                                  04885000
                                                                        04887000
  BUF := "--";                                                          04889000
  move BUF(1) := BUF,(LENGTH-1);                                        04891000
  PRINT(BUF,LENGTH,0);                                                  04893000
  PRINT(BUF,0,0);  << Space >>                                          04895000
                                                                        04897000
  << Get main memory size in bytes >>                                   04899000
  TMEMORY := double(absolute(NBANKSINX)) * 131072D;                     04901000
                                                                        04903000
  << Get cache data segment words >>                                    04905000
  OHEAD := CDT'GET'WORD(0<<hdr>>,CDT'DST'WORDS,0);                      04907000
                                                                        04909000
  LDEV'LINK := CDT'GET'WORD(0<<hdr>>,CDT'DISC'HEAD,0);                  04911000
  while LDEV'LINK <> 0 do                                               04913000
    begin                                                               04915000
    << Get statistics >>                                                04917000
    PDISABLE;                                                           04919000
    if RESET'TTLS then                                                  04921000
      begin                                                             04923000
      RHIT:=CDT'SET'DOUBLE(LDEV'LINK,CDT'DE'RHIT,0D);                   04925000
      WHIT:=CDT'SET'DOUBLE(LDEV'LINK,CDT'DE'WHIT,0D);                   04927000
      RMISS:=CDT'SET'DOUBLE(LDEV'LINK,CDT'DE'RMISS,0D);                 04929000
      WMISS:=CDT'SET'DOUBLE(LDEV'LINK,CDT'DE'WMISS,0D);                 04931000
      STOPS := CDT'SET'DOUBLE(LDEV'LINK,CDT'DE'STOP,0D);                04933000
      end                                                               04935000
    else                                                                04937000
      begin                                                             04939000
      RHIT := CDT'GET'DOUBLE(LDEV'LINK,CDT'DE'RHIT,0D);                 04941000
      WHIT := CDT'GET'DOUBLE(LDEV'LINK,CDT'DE'WHIT,0D);                 04943000
      RMISS := CDT'GET'DOUBLE(LDEV'LINK,CDT'DE'RMISS,0D);               04945000
      WMISS := CDT'GET'DOUBLE(LDEV'LINK,CDT'DE'WMISS,0D);               04947000
      STOPS := CDT'GET'DOUBLE(LDEV'LINK,CDT'DE'STOP,0D);                04949000
      end;                                                              04951000
                                                                        04953000
    WORK := CDT'GET'WORD(LDEV'LINK,CDT'DE'MAPD'PAGES,0);                04955000
    PAGES := double(WORK);                                              04957000
    WORK := CDT'GET'WORD(LDEV'LINK,CDT'DE'REGIONS,0);                   04959000
    REGIONS := double(WORK);                                            04961000
    PENABLE;                                                            04963000
                                                                        04965000
    << Since there is 1 page overhead per mapped domain, >>             04967000
    << mask it off.                                      >>             04969000
    PAGES := PAGES - REGIONS;                                           04971000
                                                                        04973000
    LDEV := CDT'GET'WORD(LDEV'LINK,CDT'DE'LDEV,0);                      04975000
    REQUESTS := RHIT + RMISS + WHIT + WMISS;                            04977000
    if overflow then REQUESTS := 0D;                                    04979000
    if REQUESTS = 0D then   << No hits/misses >>                        04981000
      begin                                                             04983000
      PCNT'READ := 0;                                                   04985000
      RPERCENT  := WPERCENT := 0;                                       04987000
      end                                                               04989000
    else                                                                04991000
      begin                                                             04993000
      PCNT'READ:=integer(                                               04995000
                 (REQUESTS-WHIT-WMISS)*100D / REQUESTS                  04997000
                 );                                                     04999000
      RPERCENT := integer((RHIT*100D)/(RHIT+RMISS));                    05001000
      WPERCENT := integer((WHIT*100D)/(WHIT+WMISS));                    05003000
      end;                                                              05005000
                                                                        05007000
    TRHIT := TRHIT + RHIT;                                              05009000
    if overflow then OVRFLOW := true;                                   05011000
    TWHIT := TWHIT + WHIT;                                              05013000
    if overflow then OVRFLOW := true;                                   05015000
    TRMISS := TRMISS + RMISS;                                           05017000
    if overflow then OVRFLOW := true;                                   05019000
    TWMISS := TWMISS + WMISS;                                           05021000
    if overflow then OVRFLOW := true;                                   05023000
    TPAGES := TPAGES + PAGES;                                           05025000
    if overflow then OVRFLOW := true;                                   05027000
    TREGIONS := TREGIONS + REGIONS;                                     05029000
    if overflow then OVRFLOW := true;                                   05031000
    TSTOPS := TSTOPS + STOPS;                                           05033000
    if overflow then OVRFLOW := true;                                   05035000
                                                                        05037000
    << Perform interum calculations >>                                  05039000
    PAGES := PAGES * 256D;   << Number of bytes >>                      05041000
    PCNT'MEM := integer((PAGES*100D)/TMEMORY);                          05043000
    PAGES := (PAGES+512D)/1024D;  << Number of K-BYTES >>               05045000
                                                                        05047000
    BUF := "  ";                                                        05049000
    move BUF(1) := BUF,(39);                                            05051000
    ASCII(LDEV,10,B'BUF);                                               05053000
    DASCII(REQUESTS,10,B'BUF(6));                                       05055000
    ASCII(RPERCENT,10,B'BUF(17));                                       05057000
    ASCII(WPERCENT,10,B'BUF(23));                                       05059000
    ASCII(PCNT'READ,10,B'BUF(29));                                      05061000
    DASCII(STOPS,10,B'BUF(34));                                         05063000
    DASCII(PAGES,10,B'BUF(46));                                         05065000
    ASCII(PCNT'MEM,10,B'BUF(58));                                       05067000
    LENGTH := DASCII(REGIONS,10,B'BUF(64));                             05069000
    LENGTH := LENGTH + 64;                                              05071000
    PRINT(BUF,-LENGTH,0);                                               05073000
                                                                        05075000
    LDEV'LINK:=CDT'GET'WORD(LDEV'LINK,CDT'DE'NEXT'LDEV,0);              05077000
    end;  << of WHILE >>                                                05079000
                                                                        05081000
  << Print final results >>                                             05083000
  PRINT(BUF,0,0);                                                       05085000
  BUF := "  ";                                                          05087000
  move BUF(1) := BUF,(39);                                              05089000
                                                                        05091000
  move BUF := "Total";                                                  05093000
  if OVRFLOW then                                                       05095000
    begin                                                               05097000
    move B'BUF(6) := "* * Arithmetic overflow * *",2;                   05099000
    LENGTH := tos - @B'BUF;                                             05101000
    PRINT(BUF,-LENGTH,0);                                               05103000
    end                                                                 05105000
  else                                                                  05107000
    begin                                                               05109000
    REQUESTS := TRHIT + TRMISS + TWHIT + TWMISS;                        05111000
    if overflow then REQUESTS := 0D;                                    05113000
    if REQUESTS = 0D then                                               05115000
      begin                                                             05117000
      PCNT'READ := 0;                                                   05119000
      RPERCENT := 0;                                                    05121000
      WPERCENT := 0;                                                    05123000
      end                                                               05125000
    else                                                                05127000
      begin                                                             05129000
      if ((TRHIT+TRMISS)=0D) then                                       05131000
        begin                                                           05133000
        RPERCENT := 0;                                                  05135000
        end                                                             05137000
      else                                                              05139000
        begin                                                           05141000
        RPERCENT := integer((TRHIT*100D)/(TRHIT + TRMISS));             05143000
        end;                                                            05145000
                                                                        05147000
      PCNT'READ := integer((REQUESTS-TWHIT-TWMISS)*100D/REQUESTS);      05149000
                                                                        05151000
      if ((TWHIT+TWMISS)=0D) then                                       05153000
        begin                                                           05155000
        WPERCENT := 0;                                                  05157000
        end                                                             05159000
      else                                                              05161000
        begin                                                           05163000
        WPERCENT := integer((TWHIT*100D)/(TWHIT + TWMISS));             05165000
        end;                                                            05167000
      end;                                                              05169000
                                                                        05171000
    DASCII(REQUESTS,10,B'BUF(6));                                       05173000
    ASCII(RPERCENT,10,B'BUF(17));                                       05175000
    ASCII(WPERCENT,10,B'BUF(23));                                       05177000
    ASCII(PCNT'READ,10,B'BUF(29));                                      05179000
    DASCII(TSTOPS,10,B'BUF(34));                                        05181000
    TPAGES := TPAGES * 256D;                                            05183000
    if overflow then TPAGES := 0D;                                      05185000
    PCNT'MEM := integer((TPAGES*100D)/TMEMORY);                         05187000
    TPAGES := (TPAGES + 512D) / 1024D;                                  05189000
    DASCII(TPAGES,10,B'BUF(46));                                        05191000
    ASCII(PCNT'MEM,10,B'BUF(58));                                       05193000
    LENGTH := DASCII(TREGIONS,10,B'BUF(64));                            05195000
    LENGTH := LENGTH + 64;                                              05197000
    PRINT(BUF,-LENGTH,0);                                               05199000
                                                                        05201000
    << Print cache overhead number >>                                   05203000
    PRINT(BUF,0,0);                                                     05205000
    move B'BUF := "Data overhead is ",2;                                05207000
    LENGTH := tos - @B'BUF;                                             05209000
    LENGTH := LENGTH + DASCII(((TREGIONS*256D)+double(OHEAD))/1024D,    05211000
              10,B'BUF(LENGTH));                                        05213000
    move B'BUF(LENGTH) := "K bytes.",2;                                 05215000
    LENGTH := tos - @B'BUF;                                             05217000
    PRINT(BUF,-LENGTH,0);                                               05219000
                                                                        05221000
    move B'BUF:="Sequential fetch quantum is ",2;                       05223000
    LENGTH := tos - @B'BUF;                                             05225000
    LENGTH := LENGTH + ASCII(CDT'GET'WORD(0,                            05227000
                             CDT'SEQ'MINFTCH,0),10,                     05229000
                             B'BUF(LENGTH));                            05231000
    move B'BUF(LENGTH):=" sectors.",2;                                  05233000
    LENGTH := tos - @B'BUF;                                             05235000
    PRINT(BUF,-LENGTH,0);                                               05237000
                                                                        05239000
    move B'BUF:="Random fetch quantum is ",2;                           05241000
    LENGTH := tos - @B'BUF;                                             05243000
    LENGTH := LENGTH + ASCII(CDT'GET'WORD(0,                            05245000
                             CDT'RND'MINFTCH,0),10,                     05247000
                             B'BUF(LENGTH));                            05249000
    move B'BUF(LENGTH):=" sectors.",2;                                  05251000
    LENGTH := tos - @B'BUF;                                             05253000
    PRINT(BUF,-LENGTH,0);                                               05255000
    if CDT'GET'WORD(0,CDT'FORCE'POST,0) <> 0 then                       05257000
      begin                                                             05259000
      move B'BUF :=                                                     05261000
"Write notification ONLY on physical completion.",2;                    05263000
      LENGTH := tos - @B'BUF;                                           05265000
      PRINT(BUF,-LENGTH,0);                                             05267000
      end;                                                              05269000
    end;                                                                05271000
                                                                        05273000
  PRINT(BUF,0,0);                                                       05275000
  RSTAT := 0;                                                           05277000
  end;                                                                  05279000
                                                                        05281000
RELSIR(CACHE'CONTROL'SIR,OLD'SIR);                                      05283000
RESETCRITICAL(OLD'CRIT);                                                05285000
                                                                        05287000
end;  << of procedure CDT'DISPLAY'DISCS >>                              05289000
$page "CDT'SET'SEQ / CDT'SET'RND / CDT'SET'POST procedure"              05291000
procedure CDT'SET'SEQ(PARM,RSTAT);                                      05293000
value PARM;                                                             05295000
integer PARM,RSTAT;                                                     05297000
option privileged,uncallable;                                           05299000
begin                                                                   05301000
                                                                        05303000
<<CDT'SET'SEQ is one of the executors for the CACHECONTROL cmd >>       05305000
                                                                        05307000
<< This procedure sets basic caching strategy and policy    >>          05309000
<< parameters for all discs.    The returned value(s) are:  >>          05311000
<<                                                          >>          05313000
<< RSTAT    - Returned status, where:                       >>          05315000
<<            0 - Successful                                >>          05317000
<<            1 - Caching is not enabled on this system.    >>          05319000
<<                                                          >>          05321000
<< Passed parameter is:                                     >>          05323000
<< PARM       - Set to 1 to 96 to indicate the fetch        >>          05325000
<<              quantum on CDT'SET'SEQ and CDT'SET'RND (in  >>          05327000
<<              sectors).  In CDT'SET'POST, a non-zero value>>          05329000
<<              indicates that caching should only notify   >>          05331000
<<              the user of a write completion when the     >>          05333000
<<              actual physical write has completed.        >>          05335000
<<                                                          >>          05337000
<< DB is assumed to be at the caller's stack.               >>          05339000
<<**********************************************************>>          05341000
                                                                        05343000
integer OLD'SIR,   << Return value from GETSIR >>                       05345000
        OLD'CRIT,  << Old value from SETCRITICAL>>                      05347000
        ENTRY'INDEX; << Index to which entry point was called >>        05349000
                                                                        05351000
entry CDT'SET'RND, CDT'SET'POST;                                        05353000
                                                                        05355000
ENTRY'INDEX := 0;    << SET'SEQ >>                                      05357000
go to START;                                                            05359000
                                                                        05361000
CDT'SET'RND:                                                            05363000
ENTRY'INDEX := 1;    << SET'RND >>                                      05365000
go to START;                                                            05367000
                                                                        05369000
CDT'SET'POST:                                                           05371000
ENTRY'INDEX := 2;                                                       05373000
go to START;                                                            05375000
                                                                        05377000
START:                                                                  05379000
                                                                        05381000
<< We can't abort here... >>                                            05383000
OLD'CRIT := SETCRITICAL;                                                05385000
                                                                        05387000
<< Obtain SIR to protect integrity >>                                   05389000
OLD'SIR := GETSIR(CACHE'CONTROL'SIR);                                   05391000
                                                                        05393000
<< See if caching is enabled >>                                         05395000
if CACHE'DST = 0 then                                                   05397000
  RSTAT := 1                                                            05399000
else                                                                    05401000
  begin                                                                 05403000
                                                                        05405000
  << Set the appropriate parameter >>                                   05407000
  case ENTRY'INDEX of                                                   05409000
    begin                                                               05411000
                                                                        05413000
<<0 - SEQ >>                                                            05415000
    begin                                                               05417000
    if not (1 <= PARM <= 96) then                                       05419000
      PARM := CACHE'SEQUENTIAL;                                         05421000
    CDT'SET'WORD(0,CDT'SEQ'MINFTCH,PARM);                               05423000
    end;                                                                05425000
                                                                        05427000
<<1 - RND >>                                                            05429000
    begin                                                               05431000
    if not (1 <= PARM <= 96) then                                       05433000
      PARM := CACHE'RANDOM;                                             05435000
    CDT'SET'WORD(0,CDT'RND'MINFTCH,PARM);                               05437000
    end;                                                                05439000
                                                                        05441000
<<2- Post notification >>                                               05443000
    begin                                                               05445000
    CDT'SET'WORD(0,CDT'FORCE'POST,if(PARM=0)then 0 else -1);            05447000
    end;                                                                05449000
                                                                        05451000
    end;  << of CASE on ENTRY'INDEX >>                                  05453000
                                                                        05455000
  RSTAT := 0;   << Return a good status >>                              05457000
  end;                                                                  05459000
                                                                        05461000
RELSIR(CACHE'CONTROL'SIR,OLD'SIR);                                      05463000
RESETCRITICAL(OLD'CRIT);                                                05465000
end;                                                                    05467000
$CONTROL SEGMENT=MAIN                                                   05469000
end.                                                                    05471000
