<< LINES .001/.009 ARE RESERVED FOR SYSTEMS INTEGRATION>>               00005000
$control map,code,uslinit                                               00010000
<<cacheseg : module 5e>>                                       <<06858>>00015000
$control privileged,segment=cacheseg,main=cacheseg                      00020000
<<*************************>>                                           00025000
<< set x1=on for debug, mmstat, and extra error checking >>             00030000
<< for debug only!!!                                     >>    <<06858>>00035000
<<*************************>>                                           00040000
$set x1=off                                                    <<*7723>>00045000
<< set x8=on for full incl file listings >>                             00050000
$set x8=on                                                              00055000
<< set x7=on for locking code- currently not supported! >>     <<06858>>00060000
$set x7=off                                                    <<06858>>00065000
<< x6 must always be on for full inclldr defines >>            <<*7724>>00070000
$set x6=on                                                     <<*7724>>00075000
                                                                        00080000
comment                                                                 00085000
                                                                        00090000
this segment contains the disc cache manipulation procedures required   00095000
by the kernel.  the segment is locked and frozen into memory when       00100000
disc caching is first enabled for a device, and unlocked and unfrozen   00105000
when disc caching is last disabled.                                     00110000
                                                                        00115000
;                                                                       00120000
                                                                        00125000
begin                                                                   00130000
                                                                        00135000
$page "Cache Control Specific Defines"                         <<06858>>00140000
                                                               <<06858>>00145000
                                                               <<06858>>00150000
<<cache status returns>>                                       <<06858>>00155000
                                                               <<06858>>00160000
equate stat'ok = 0,                                            <<06858>>00165000
       stat'no'dst=1,                                          <<06858>>00170000
       stat'int'error=2,                                       <<06858>>00175000
       stat'ldev'cached=3,                                     <<06858>>00180000
       stat'cdt'overflow=4,                                    <<06858>>00185000
       stat'dev'not'cachable=5,                                <<06858>>00190000
       stat'sys'not'cachable=6;                                <<06858>>00195000
                                                               <<06858>>00200000
                                                               <<06858>>00205000
                                                               <<06858>>00210000
                                                                        00215000
                                                               <<*7724>>00220000
                                                               <<*7551>>00225000
$if x6 = on                                                    <<*7724>>00230000
logical pointer lpdt  = %10;                                   <<*7724>>00235000
$if                                                            <<*7724>>00240000
                                                               <<*7724>>00245000
$include inclstdd                                                       00250000
                                                               <<h8580>>00255000
integer pointer                                                <<h8580>>00260000
   dst  = dstp,                                                <<h8580>>00265000
   pcb  = pcbp;                                                <<h8580>>00270000
                                                               <<h8580>>00275000
$include inclst                                                <<h8580>>00280000
$include incldrq                                               <<06858>>00285000
$include incldqh                                               <<07308>>00290000
$include inclobj                                                        00295000
$include inclreg                                                        00300000
$include inclsf                                                         00305000
$include inclmmst                                                       00310000
$include inclmsg                                                        00315000
$include inclpcb5                                              <<06858>>00320000
$include inclpcbx                                                       00325000
$include inclparm                                                       00330000
$include inclknio                                              <<06856>>00335000
$include incllpdt                                              <<06856>>00340000
$include inclcdef                                                       00345000
$include inclldr                                               <<06859>>00350000
$include inclmeas                                                       00355000
$include inclmift                                              <<*7551>>00360000
$include inclkcim                                                       00365000
$include inclkdim                                                       00370000
$include inclioim                                                       00375000
                                                               <<*7727>>00380000
                                                               <<*7727>>00385000
procedure returnsysbuf(index);                                 <<*7727>>00390000
value index;                                                   <<*7727>>00395000
integer index;                                                 <<*7727>>00400000
option external;                                               <<*7727>>00405000
                                                               <<*7727>>00410000
                                                               <<*7727>>00415000
                                                               <<06858>>00420000
intrinsic ascii,dascii,print;                                  <<06858>>00425000
intrinsic freedseg,getdseg,dmovin,dmovout;                     <<*7553>>00430000
                                                               <<06858>>00435000
                                                               <<06858>>00440000
                                                               <<06858>>00445000
                                                               <<06858>>00450000
$page " Forward Procedure Declarations"                                 00455000
<< ask kernel to find cached domain, if it exists and is not mapped >>  00460000
logical procedure cdt'map'cached'domain(cdt'disc'entry,base'adr,        00465000
                                        limit'adr,new'cdt,     <<07308>>00470000
                                        ldr'entry'index);      <<07308>>00475000
                                                                        00480000
value cdt'disc'entry,base'adr,limit'adr,new'cdt,               <<07308>>00485000
      ldr'entry'index;                                                  00490000
integer cdt'disc'entry,new'cdt;                                         00495000
logical ldr'entry'index;                                       <<07308>>00500000
double base'adr,limit'adr;                                              00505000
option forward;                                                         00510000
<<********************************************************************>>00515000
<< this procedure scans the unmapped region list pointed to by disc   >>00520000
<< entry cdt'disc'entry.  if a region is found which completely con-  >>00525000
<< tains the the disc sector range, then a cdt entry is obtained and  >>00530000
<< formatted to point to that region.  if partial or no overlaps are  >>00535000
<< found, any overlapping region is taken off the list and deleted,   >>00540000
<< and a "0" cdt number is returned to the caller.                    >>00545000
<<                                                                    >>00550000
<< passed parameters:                                                 >>00555000
<<                                                                    >>00560000
<< cdt'disc'entry  - the index of the cdt disc entry for this ldev.   >>00565000
<<                   it contains the list head for all the unmapped   >>00570000
<<                   regions.                                         >>00575000
<<                                                                    >>00580000
<< base'adr        - this is the double word sector address of the    >>00585000
<<                   base sector requested.                           >>00590000
<<                                                                    >>00595000
<< limit'adr       - this is the upper limit disc address of the range>>00600000
<<                   of sectors required to complete a logical request>>00605000
<<                   the limit'adr is actually 1 sector greater than  >>00610000
<<                   the highest sector number required (ie sector 1  >>00615000
<<                   for 5 bytes would be base'adr=1 and limit'adr=2).>>00620000
<<                                                                    >>00625000
<< new'cdt         - only valid on a map call, this contains the cdt  >>00630000
<<                   entry number of a mapped domain that is absent   >>00635000
<<                   and has a strategy applied to it.                >>00640000
<< the caller will be pdisabled prior to calling this procedure.      >>00645000
<<********************************************************************>>00650000
logical procedure cdt'flush'cached'range(devcdtentry,start'addr,        00655000
                                        limit'addr,new'cdt,    <<07308>>00660000
                                        ldr'entry'index);      <<07308>>00665000
value devcdtentry,start'addr,limit'addr,new'cdt,               <<07308>>00670000
      ldr'entry'index;                                                  00675000
integer devcdtentry,new'cdt;                                            00680000
logical ldr'entry'index;                                       <<07308>>00685000
double start'addr,limit'addr;                                           00690000
option forward;                                                         00695000
                                                                        00700000
<<********************************************************************>>00705000
<< this procedure scans the unmapped region list pointed to by        >>00710000
<< cdt'disc'entry and deletes any region which is partially over-     >>00715000
<< lapping the disc address range specified.                          >>00720000
<<                                                                    >>00725000
<< the parameters are:                                                >>00730000
<<                                                                    >>00735000
<< cdt'disc'entry  - the index of the cdt disc entry for this ldev.   >>00740000
<<                   it contains the list head for all the unmapped   >>00745000
<<                   regions.                                         >>00750000
<<                                                                    >>00755000
<< base'adr        - this is the double word sector address of the    >>00760000
<<                   base sector requested.                           >>00765000
<<                                                                    >>00770000
<< limit'adr       - this is the upper limit disc address of the range>>00775000
<<                   of sectors required to complete a logical request>>00780000
<<                   the limit'adr is actually 1 sector greater than  >>00785000
<<                   the highest sector number required (ie sector 1  >>00790000
<<                   for 5 bytes would be base'adr=1 and limit'adr=2).>>00795000
<<                                                                    >>00800000
<< new'cdt         - ignored.                                         >>00805000
<< the caller will be pdisabled prior to calling this procedure.      >>00810000
<<********************************************************************>>00815000
                                                                        00820000
procedure cdt'unmap'region(cdt'disc'entry,cdt'entry);                   00825000
value cdt'disc'entry,cdt'entry;                                         00830000
integer cdt'disc'entry,cdt'entry;                                       00835000
option forward;                                                         00840000
<<********************************************************************>>00845000
<< this procedure takes the memory region pointed to my mapped cdt    >>00850000
<< domain cdt'entry and places it on the unmapped region list for a   >>00855000
<< disc pointed to by cdt'disc'entry.                                 >>00860000
<<                                                                    >>00865000
<< the parameters are:                                                >>00870000
<< cdt'disc'entry    - this is the cdt entry index of the disc entry  >>00875000
<<                      for this ldev.                                >>00880000
<<                                                                    >>00885000
<< cdt'entry         - this is the cdt entry index of the mapped disc >>00890000
<<                     domain.                                        >>00895000
<<                                                                    >>00900000
<< the caller is pdisabled prior to calling this procedure.           >>00905000
<<********************************************************************>>00910000
                                                                        00915000
procedure zapcacheddomain(regbase);                            <<06858>>00920000
value regbase;                                                 <<06858>>00925000
double regbase;                                                <<06858>>00930000
option forward;                                                <<06858>>00935000
$page "PROCEDURE IsSysCachable"                                         00940000
                                                                        00945000
logical procedure issyscachable;                                        00950000
option privileged,uncallable;                                           00955000
                                                                        00960000
comment                                                                 00965000
                                                                        00970000
if the customer purchases disc caching, then this procedure    <<07311>>00975000
and the full complement of procedures in this module will be   <<07311>>00980000
installed into sl.pub.sys. however, if they did not purchase   <<07311>>00985000
disc caching, this procedure would always return false and     <<07311>>00990000
this module would be "stubbed" out.                            <<07311>>00995000
                                                                        01000000
;                                                                       01005000
                                                                        01010000
begin                                                                   01015000
                                                                        01020000
                                                               <<07311>>01025000
                                                                        01030000
issyscachable := true;                                                  01035000
                                                                        01040000
end;  <<procedure issyscachable>>                                       01045000
                                                                        01050000
$page "PROCEDURE IsDevCachable"                                         01055000
                                                                        01060000
logical procedure isdevcachable(ldev);                                  01065000
value ldev;                                                             01070000
integer ldev;                                                           01075000
option privileged,uncallable;                                           01080000
                                                                        01085000
comment                                                                 01090000
                                                                        01095000
checks to see if the specified device is cachable. (currently  <<07311>>01100000
checks to see if a disc.  should also check serial disc and             01105000
only disallow etc... this is yours,al)                         <<07311>>01110000
                                                                        01115000
;                                                                       01120000
                                                                        01125000
begin                                                                   01130000
                                                               <<07311>>01135000
define                                                         <<07311>>01140000
   lpdt'index = ldev * size'of'lpdt'entry#;                    <<07311>>01145000
                                                               <<07311>>01150000
                                                                        01155000
checkldev(ldev);                                                        01160000
if = and carry << and not lpdt'rdy'ser'frn'disc >>             <<07311>>01165000
   then isdevcachable := true                                  <<07311>>01170000
else isdevcachable := false;                                            01175000
                                                                        01180000
end;  <<procedure isdevcachable>>                                       01185000
$page "PROCEDURE CDT'GET'ENTRY"                                         01190000
integer procedure cdt'get'entry;                                        01195000
option privileged,uncallable;                                           01200000
begin                                                                   01205000
                                                                        01210000
<<***********************************************************>>         01215000
<< this procedure obtains a free entry in the cdt table and  >>         01220000
<< returns its index.  if no entry is available, a value of  >>         01225000
<< zero is returned to the caller.                           >>         01230000
<<                                                           >>         01235000
<< db can be set anywhere.                                   >>         01240000
<<***********************************************************>>         01245000
                                                                        01250000
integer cdt'entry=cdt'get'entry; << obtained cdt index       >>         01255000
                                                                        01260000
<< make sure cdt dst exists >>                                          01265000
disable;                                                                01270000
$if x1=on                                                               01275000
if cache'dst = 0 then                                                   01280000
  begin                                                                 01285000
  suddendeath(cdt'not'initialized);                                     01290000
  help; <<just to get an stt>>                                          01295000
  end;                                                                  01300000
$if                                                                     01305000
                                                                        01310000
<< actually get an entry >>                                             01315000
                                                                        01320000
<< move db to the cache dst >>                                          01325000
cdt'abs'on'tos;                                                <<*7724>>01330000
                                                               <<*7724>>01335000
                                                                        01340000
exchdb;                                                                 01345000
                                                                        01350000
<< get head of free list >>                                             01355000
cdt'entry := cdt'array(cdt'free'head); << get first entry >>            01360000
if <> then                                                              01365000
  begin  << there is an available entry >>                              01370000
                                                                        01375000
  << check that index passed is valid >>                                01380000
  << db must be pointing to the cdt and integer cdt'entry is   >>       01385000
  << used to perform a validity check against.                 >>       01390000
$if x1=on                                                               01395000
  if cdt'array(cdt'entry) <> -1 then                                    01400000
    suddendeath(cdt'unassigned);  << actually, reversed sense >>        01405000
  cdt'array(cdt'x) := 0;                                                01410000
  cdt'check'index;                                                      01415000
$if                                                                     01420000
                                                                        01425000
  << place the next cdt pointer into the head pointer >>                01430000
  cdt'array(cdt'free'head) := cdt'array(cdt'entry+cdt'free'head);       01435000
                                                                        01440000
  << if head pointer is zero, this implies that the list is  >>         01445000
  << empty and the tail pointer must also be zeroed.         >>         01450000
  if cdt'array(cdt'free'head) = 0 then                                  01455000
    cdt'array(cdt'free'tail) := 0;                                      01460000
                                                                        01465000
  << increment the max in use count if it has been exceeded  >>         01470000
  cdt'array(cdt'free'count) := cdt'array(cdt'free'count) - 1;           01475000
  if (cdt'array(cdt'entries) - cdt'array(cdt'free'count)) >             01480000
     cdt'array(cdt'max'used) then                                       01485000
    cdt'array(cdt'max'used) := cdt'array(cdt'entries) -                 01490000
                                 cdt'array(cdt'free'count);             01495000
                                                                        01500000
  << zero-out entry just obtained >>                                    01505000
  cdt'array(cdt'entry) := 0;                                            01510000
  move cdt'array(cdt'entry+1) := cdt'array(cdt'entry),                  01515000
                               (cdt'entry'size-1);                      01520000
                                                                        01525000
  << change index into entry >>                                         01530000
  cdt'get'entry := cdt'entry / cdt'entry'size;                          01535000
  end                                                                   01540000
                                                                        01545000
else                                                                    01550000
                                                                        01555000
  << we should never run out of cdt entries >>                          01560000
  suddendeath(cdt'table'empty);                                         01565000
                                                                        01570000
<< place db back to caller's db >>                                      01575000
exchdb;                                                                 01580000
                                                                        01585000
<< exit will place interrupts back to caller's state >>                 01590000
$if x1=on                                                               01595000
mmstat'(mmstat'get'cdt,cdt'entry,1,0,0,0,0);                   <<06859>>01600000
$if                                                                     01605000
end;  << of procedure get'cdt'entry >>                                  01610000
$page "CDT'FREE'ENTRY procedure"                                        01615000
procedure cdt'free'entry(cdt'entry);                                    01620000
value cdt'entry;                                                        01625000
integer cdt'entry;                                                      01630000
option privileged,uncallable;                                           01635000
begin                                                                   01640000
                                                                        01645000
<<***********************************************************>>         01650000
<< this procedure returns the cdt entry pointed to by        >>         01655000
<< cdt'entry and returns it to the free list.                >>         01660000
<<                                                           >>         01665000
<< cdt'entry   - this is the index into the cdt table of the >>         01670000
<<               entry to be released.                       >>         01675000
<<                                                           >>         01680000
<< db can point anywhere before calling this procedure.      >>         01685000
<<***********************************************************>>         01690000
                                                                        01695000
<< re-define entry into index >>                                        01700000
integer cdt'index = cdt'entry;                                          01705000
                                                                        01710000
<< make sure cache dst exists >>                                        01715000
disable;                                                                01720000
$if x1=on                                                               01725000
if cache'dst = 0 then                                                   01730000
  suddendeath(cdt'not'initialized);                                     01735000
                                                                        01740000
mmstat'(mmstat'get'cdt,cdt'entry,0,0,0,0,0);                   <<06859>>01745000
$if                                                                     01750000
                                                                        01755000
<< place db at the cache dst >>                                         01760000
cdt'abs'on'tos;                                                <<*7724>>01765000
                                                               <<*7724>>01770000
exchdb;                                                                 01775000
                                                                        01780000
$if x1=on                                                               01785000
<< check that index passed is valid >>                                  01790000
<< db must be pointing to the cdt and integer cdt'entry is   >>         01795000
<< used to perform a validity check against.                 >>         01800000
cdt'check'entry;                                                        01805000
$if                                                                     01810000
                                                                        01815000
<< change entry into a index >>                                         01820000
cdt'index := cdt'index * cdt'entry'size;                                01825000
                                                                        01830000
<< return index to tail of free list >>                                 01835000
if cdt'array(cdt'free'head) = 0 then                                    01840000
  begin  << free list is completely empty >>                            01845000
  cdt'array(cdt'free'head) := cdt'array(cdt'free'tail) := cdt'entry;    01850000
  end                                                                   01855000
                                                                        01860000
else                                                                    01865000
                                                                        01870000
  begin  << there is already something on the free list >>              01875000
                                                                        01880000
  << put this entry's index into the prior tail's next pointer >>       01885000
  cdt'array(cdt'array(cdt'free'tail)+cdt'free'head) := cdt'entry;       01890000
                                                                        01895000
  << place this entry's index into the new tail pointer >>              01900000
  cdt'array(cdt'free'tail) := cdt'entry;                                01905000
                                                                        01910000
  end;                                                                  01915000
                                                                        01920000
<< increment the free count >>                                          01925000
cdt'array(cdt'free'count) := cdt'array(cdt'free'count) + 1;             01930000
                                                                        01935000
<< zero next pointer in entry just returned >>                          01940000
cdt'array(cdt'entry) := -1;  << mark entry available >>                 01945000
cdt'array(cdt'entry + cdt'free'head) := 0;                              01950000
                                                                        01955000
<< place db back to caller's db >>                                      01960000
exchdb;                                                                 01965000
                                                                        01970000
<< exit will put interrupt state back to caller's state >>              01975000
end;  << of procedure cdt'free'entry >>                                 01980000
$page "CDT'SET'BIT CDT'GET'BIT procedure executor"                      01985000
logical procedure cdt'set'bit(cdt'entry,bit'number,bit'value);          01990000
value cdt'entry,bit'number,bit'value;                                   01995000
integer cdt'entry,bit'number;                                           02000000
logical bit'value;                                                      02005000
option privileged,uncallable;                                           02010000
begin                                                                   02015000
                                                                        02020000
entry cdt'get'bit;      << this entry point only returns the >>         02025000
                        << previous state of the bit, and it >>         02030000
                        << remains unchanged.                >>         02035000
                                                                        02040000
logical mod'entry;      << flag if the get only entry point  >>         02045000
                        << was entered.                      >>         02050000
                                                                        02055000
<<***********************************************************>>         02060000
<< this procedure accepts a bit number, as defined in the    >>         02065000
<< inclcdt file, and sets the bit in the flags word of the   >>         02070000
<< cdt entry specified.  the old value of the bit is returned>>         02075000
<< as the function return value, bit (15:1).                 >>         02080000
<<                                                           >>         02085000
<< cdt'entry   - the index of the cdt entry to be modified.  >>         02090000
<< bit'number  - the relative bit number in the flags word   >>         02095000
<<               to be set true or on.                       >>         02100000
<< bit'value   - if this value is true, the bit is turned on,>>         02105000
<<               if false, then the bit is turned off.       >>         02110000
<<                                                           >>         02115000
<< cdt'set'bit - the prior value of the specified bit is     >>         02120000
<<               returned in this cell, bit (15:1).          >>         02125000
<<                                                           >>         02130000
<< db can be set anywhere when calling this procedure.       >>         02135000
<<***********************************************************>>         02140000
                                                                        02145000
<< re-define entry as index >>                                          02150000
integer cdt'index = cdt'entry;                                          02155000
                                                                        02160000
<< normal entry point >>                                                02165000
mod'entry := true;                                                      02170000
go to start;                                                            02175000
                                                                        02180000
cdt'get'bit:                                                            02185000
                                                                        02190000
mod'entry := false;                                                     02195000
                                                                        02200000
start:                                                                  02205000
                                                                        02210000
<< first, we will check if the cdt dst exists.               >>         02215000
disable;                                                                02220000
$if x1=on                                                               02225000
if cache'dst = 0 then                                                   02230000
  suddendeath(cdt'not'initialized);                                     02235000
$if                                                                     02240000
                                                                        02245000
<< put db to the cdt dst                                     >>         02250000
tos := cache'dst'bank;                                                  02255000
tos := cache'dst'ofst;                                                  02260000
exchdb;                                                                 02265000
                                                                        02270000
$if x1=on                                                               02275000
<< check that index passed is valid >>                                  02280000
<< db must be pointing to the cdt and integer cdt'entry is   >>         02285000
<< used to perform a validity check against.                 >>         02290000
cdt'check'entry;                                                        02295000
$if                                                                     02300000
                                                                        02305000
<< change entry into an index >>                                        02310000
cdt'index := cdt'index * cdt'entry'size;                                02315000
                                                                        02320000
<< turn on the appropriate bit >>                                       02325000
disable;   << protect from interrupts >>                       <<06858>>02330000
tos := cdt'array(cdt'entry + cdt'md'flags);                             02335000
cdt'x := bit'number;                                                    02340000
if mod'entry then                                                       02345000
  begin                                                                 02350000
  if bit'value then                                                     02355000
    assemble(tsbc 0,x)   << turn on bit >>                              02360000
  else                                                                  02365000
    assemble(trbc 0,x);  << turn off bit >>                             02370000
                                                                        02375000
  << if bit was set, turn on return bit >>                              02380000
  if <> then                                                            02385000
    cdt'set'bit := 1                                                    02390000
  else                                                                  02395000
    cdt'set'bit := 0;                                                   02400000
                                                                        02405000
  << store back value >>                                                02410000
  cdt'array(cdt'entry + cdt'md'flags) := tos;                           02415000
  end                                                                   02420000
                                                                        02425000
else                                                                    02430000
                                                                        02435000
  begin  << just get existing value >>                                  02440000
                                                                        02445000
  assemble(tbc 0,x);                                                    02450000
  if <> then                                                            02455000
    cdt'set'bit := 1                                                    02460000
  else                                                                  02465000
    cdt'set'bit := 0;                                                   02470000
                                                                        02475000
  assemble(del);  << just remove the stacked value (no mod) >>          02480000
  end;                                                                  02485000
                                                                        02490000
<< put db back to where caller had it >>                                02495000
exchdb;                                                                 02500000
                                                                        02505000
<< exit will return interrupts state >>                                 02510000
end;   << of procedure cdt'set'bit >>                                   02515000
$page "Procedure CDT'SET'WORD / CDT'GET'WORD / CDT'ADD'WORD"            02520000
integer procedure cdt'set'word(cdt'entry,word'number,word'value);       02525000
value cdt'entry,word'number,word'value;                                 02530000
integer cdt'entry,word'number,word'value;                               02535000
option privileged,uncallable;                                           02540000
begin                                                                   02545000
                                                                        02550000
entry cdt'get'word,    << this entry is used if the word is  >>         02555000
                       << to be retrieved w/o modification.  >>         02560000
                                                                        02565000
      cdt'add'word;    << this entry is to be used if the    >>         02570000
                       << value passed is to be 'added' to,  >>         02575000
                       << rather than 'replacing', the orig- >>         02580000
                       << inal value.                        >>         02585000
                                                                        02590000
logical mod'word,      << if true, normal entry point.  if   >>         02595000
                       << false, then don't modify word.     >>         02600000
                                                                        02605000
        add'word;      << if true, then value is to be added >>         02610000
                       << to current value, rather than      >>         02615000
                       << replacing it.                      >>         02620000
                                                                        02625000
integer old'word = cdt'set'word; << so we can read old word  >>         02630000
                                                                        02635000
<<***********************************************************>>         02640000
<< this procedure retrieves a word from the cdt entry speci- >>         02645000
<< fied, modifies it to the value provided, and returns the  >>         02650000
<< old value of the word as the function value.              >>         02655000
<<                                                           >>         02660000
<< cdt'entry  - this is the cdt entry to be manipulated.     >>         02665000
<< word'number- this is the cdt offset of the word to be     >>         02670000
<<              modified.  the caller should use the equate  >>         02675000
<<              from the inclcac file to insure the proper   >>         02680000
<<              word is retrieved in case the entry values   >>         02685000
<<              are re-arranged in the future.               >>         02690000
<< word'value - this is the value that the word is to be set >>         02695000
<<              to.  if cdt'add'word was called, this value  >>         02700000
<<              is added to the original value.              >>         02705000
<<                                                           >>         02710000
<< cdt'set'word is set to the value of the word prior to     >>         02715000
<<              calling this procedure.  if cdt'add'word     >>         02720000
<<              was called, this is the new value of the     >>         02725000
<<              word.                                        >>         02730000
<<                                                           >>         02735000
<< db can be anywhere prior to calling this procedure.       >>         02740000
<<***********************************************************>>         02745000
                                                                        02750000
<< re-define entry as an index >>                                       02755000
integer cdt'index = cdt'entry;                                          02760000
                                                                        02765000
<< normal entry point >>                                                02770000
mod'word := true;                                                       02775000
add'word := false;                                                      02780000
go to start;                                                            02785000
                                                                        02790000
cdt'add'word:                                                           02795000
add'word := mod'word := true;                                           02800000
go to start;                                                            02805000
                                                                        02810000
cdt'get'word:                                                           02815000
mod'word := false;                                                      02820000
                                                                        02825000
start:                                                                  02830000
                                                                        02835000
<< make sure cdt table exists >>                                        02840000
disable;                                                                02845000
$if x1=on                                                               02850000
if cache'dst = 0 then                                                   02855000
  suddendeath(cdt'not'initialized);                                     02860000
$if                                                                     02865000
                                                                        02870000
<< place db at dst >>                                                   02875000
tos := cache'dst'bank;                                                  02880000
tos := cache'dst'ofst;                                                  02885000
exchdb;                                                                 02890000
                                                                        02895000
$if x1=on                                                               02900000
<< check that index passed is valid >>                                  02905000
<< db must be pointing to the cdt and integer cdt'entry is   >>         02910000
<< used to perform a validity check against.                 >>         02915000
cdt'check'entry;                                                        02920000
$if                                                                     02925000
                                                                        02930000
<< convert entry into index >>                                          02935000
cdt'index := cdt'index * cdt'entry'size;                                02940000
                                                                        02945000
<< make sure word offset is valid >>                                    02950000
$if x1=on                                                               02955000
if word'number >= cdt'entry'size then                                   02960000
  suddendeath(cdt'bad'word'ofst);                                       02965000
$if                                                                     02970000
                                                                        02975000
<< retrieve word from dst and copy it to return cell >>                 02980000
<< * * do not modify index register until new value is stored >>        02985000
cdt'set'word := cdt'array(cdt'entry + word'number);                     02990000
                                                                        02995000
<< place new value in cell >>                                           03000000
if mod'word then                                                        03005000
  if add'word then                                                      03010000
    begin                                                               03015000
    cdt'array(cdt'x) := cdt'set'word := word'value + old'word;          03020000
    end                                                                 03025000
  else                                                                  03030000
    cdt'array(cdt'x) := word'value;                                     03035000
                                                                        03040000
<< place db back to caller's db >>                                      03045000
exchdb;                                                                 03050000
                                                                        03055000
<< exit will return interrupts to caller's state >>                     03060000
end;  << of procedure cdt'set'word >>                                   03065000
$page "Procedure CDT'SET'DOUBLE / CDT'GET'DOUBLE / CDT'ADD'DOUBLE"      03070000
double procedure cdt'set'double(cdt'entry,word'number,word'value);      03075000
value cdt'entry,word'number,word'value;                                 03080000
integer cdt'entry,word'number;                                          03085000
double word'value;                                                      03090000
option privileged,uncallable;                                           03095000
begin                                                                   03100000
                                                                        03105000
entry cdt'get'double,   << this entry point is used if the   >>         03110000
                        << old value should be returned, but >>         03115000
                        << not modified.                     >>         03120000
                                                                        03125000
      cdt'add'double;   << this entry point is used if       >>         03130000
                        << word'value is to be added, rather >>         03135000
                        << than replace, the double word     >>         03140000
                        << specified by word'number.         >>         03145000
                                                                        03150000
logical mod'double,     << this flag is true if the normal   >>         03155000
                        << procedure entry point is used.    >>         03160000
                                                                        03165000
        add'double;     << this flag signifies that word'val->>         03170000
                        << ue should be added to the current >>         03175000
                        << double word.                      >>         03180000
                                                                        03185000
double old'double = cdt'set'double;  << re-define return arg >>         03190000
                                                                        03195000
<<***********************************************************>>         03200000
<< this procedure retrieves double from the cdt entry speci- >>         03205000
<< fied, modifies it to the value provided, and returns the  >>         03210000
<< old value of the double word as the function value.       >>         03215000
<<                                                           >>         03220000
<< cdt'entry  - this is the cdt entry to be manipulated.     >>         03225000
<< word'number- this is the cdt offset of the dbl word to be >>         03230000
<<              modified.  the caller should use the equate  >>         03235000
<<              from the inclcac file to insure the proper   >>         03240000
<<              word is retrieved in case the entry values   >>         03245000
<<              are re-arranged in the future.               >>         03250000
<< word'value - this is the value that the dbl  is to be set >>         03255000
<<              to when cdt'set'double is called.  if cdt'   >>         03260000
<<              add'double is called, this value is added to >>         03265000
<<              the original double-word value.              >>         03270000
<<                                                           >>         03275000
<< cdt'set'word is set to the value of the dbl word prior to >>         03280000
<<              calling this procedure.  if cdt'add'double is>>         03285000
<<              called, the value is the new double value of >>         03290000
<<              of the word after adding word'value to it.   >>         03295000
<<                                                           >>         03300000
<< db can be anywhere prior to calling this procedure.       >>         03305000
<<***********************************************************>>         03310000
                                                                        03315000
<< re-define entry as index >>                                          03320000
integer cdt'index = cdt'entry;                                          03325000
                                                                        03330000
<< normal entry point >>                                                03335000
mod'double := true;                                                     03340000
add'double := false;                                                    03345000
go to start;                                                            03350000
                                                                        03355000
cdt'add'double:                                                         03360000
mod'double := add'double := true;                                       03365000
go to start;                                                            03370000
                                                                        03375000
cdt'get'double:                                                         03380000
mod'double := false;                                                    03385000
                                                                        03390000
start:                                                                  03395000
                                                                        03400000
<< make sure cdt table exists >>                                        03405000
disable;                                                                03410000
$if x1=on                                                               03415000
if cache'dst = 0 then                                                   03420000
  suddendeath(cdt'not'initialized);                                     03425000
$if                                                                     03430000
                                                                        03435000
<< place db at dst >>                                                   03440000
tos := cache'dst'bank;                                                  03445000
tos := cache'dst'ofst;                                                  03450000
exchdb;                                                                 03455000
                                                                        03460000
$if x1=on                                                               03465000
<< check that index passed is valid >>                                  03470000
<< db must be pointing to the cdt and integer cdt'entry is   >>         03475000
<< used to perform a validity check against.                 >>         03480000
cdt'check'entry;                                                        03485000
$if                                                                     03490000
                                                                        03495000
<< convert entry into index >>                                          03500000
cdt'index := cdt'index * cdt'entry'size;                                03505000
                                                                        03510000
<< make sure word offset is valid >>                                    03515000
$if x1=on                                                               03520000
if (word'number+1) >= cdt'entry'size then                               03525000
  suddendeath(cdt'bad'word'ofst);                                       03530000
$if                                                                     03535000
                                                                        03540000
<< retrieve word from dst and copy it to return cell >>                 03545000
tos := cdt'darray((cdt'entry + word'number)&asr(1));           <<*7724>>03550000
                                                               <<*7724>>03555000
<<* * index register must not modified until new value is    >>         03560000
<<    stored * *                                             >>         03565000
cdt'set'double := tos;                                                  03570000
                                                                        03575000
<< place new value in cell >>                                           03580000
if mod'double then                                                      03585000
  begin                                                                 03590000
  if add'double then                                                    03595000
    begin                                                               03600000
    tos := cdt'set'double := old'double + word'value;                   03605000
    end                                                                 03610000
  else                                                                  03615000
    begin                                                               03620000
    tos := word'value;                                                  03625000
    end;                                                                03630000
  cdt'darray(cdt'x) := tos;  << store double word >>           <<*7724>>03635000
                                                               <<*7724>>03640000
  end;                                                                  03645000
                                                                        03650000
<< place db back to caller's db >>                                      03655000
exchdb;                                                                 03660000
                                                                        03665000
<< exit will return interrupts to caller's state >>                     03670000
end;  << of procedure cdt'set'double >>                                 03675000
$page "CDT'GET'MD'ENTRY"                                                03680000
integer procedure cdt'get'md'entry(ldev'entry,cd'base'sector,           03685000
                                   md'index);                           03690000
value ldev'entry,cd'base'sector,md'index;                               03695000
integer ldev'entry,md'index;                                            03700000
double cd'base'sector;                                                  03705000
option privileged,uncallable,internal;                         <<06858>>03710000
begin                                                                   03715000
                                                                        03720000
<<********************************************************************>>03725000
<< this procedure obtains a free cdt table entry, places a disc req.  >>03730000
<< entry into it for kernel physical requests, and places it in the   >>03735000
<< appropriate place in the ldev's mapped domain list.                >>03740000
<<                                                                    >>03745000
<< the passed parameters are:                                         >>03750000
<< ldev'entry        - this is the entry number in the cdt table of   >>03755000
<<                     the ldev head of this cached disc.             >>03760000
<< cd'base'sector    - the double base sector address used to position>>03765000
<<                     this mapped cdt entry into the mapped domain   >>03770000
<<                     list of this ldev.                             >>03775000
<< md'index          - if this value is non-neg., it is the mapped    >>03780000
<<                     domain cdt entry number to put the newly-      >>03785000
<<                     obtained mapped cdt ahead of.                  >>03790000
<<                     <-1 - search & add.                            >>03795000
<<                     =-1 - add to tail.                             >>03800000
<<                     = 0 - add to head.                             >>03805000
<<                     > 0 - add before this cdt entry.               >>03810000
<<                                                                    >>03815000
<< the returned parameter is:                                         >>03820000
<<                                                                    >>03825000
<< cdt'get'md'entry - the cdt entry index of the entry obtained.      >>03830000
<<********************************************************************>>03835000
                                                                        03840000
integer cdt'entry  = cdt'get'md'entry, << so we can access ptr >>       03845000
        ldreq,                         << disc request inx     >>       03850000
        prior'ptr,                     << previous cdt ptr     >>       03855000
        next'ptr;                      << next cdt pointer     >>       03860000
                                                                        03865000
<< variables for fast cdt access >>                            <<*7724>>03870000
double save'db;                                                <<*7724>>03875000
                                                               <<*7724>>03880000
integer mapd'offset,                                           <<*7724>>03885000
        next'mapd'offset,                                      <<*7724>>03890000
        ldev'offset;                                           <<*7724>>03895000
                                                               <<*7724>>03900000
logical loop'control;    << loop exit flag >>                           03905000
                                                                        03910000
                                                                        03915000
                                                               <<*7724>>03920000
                                                               <<*7724>>03925000
                                                               <<*7724>>03930000
                                                               <<*7724>>03935000
                                                               <<*7724>>03940000
                                                               <<*7724>>03945000
<< put db at cdt >>                                            <<*7724>>03950000
cdt'abs'on'tos;                                                <<*7724>>03955000
exchdb;                                                        <<*7724>>03960000
save'db := tos;                                                <<*7724>>03965000
                                                               <<*7724>>03970000
<< first, get an entry from the cdt table >>                            03975000
cdt'entry := cdt'get'entry;                                             03980000
                                                               <<*7724>>03985000
ldev'offset := ldev'entry * cdt'entry'size;                    <<*7724>>03990000
mapd'offset := cdt'entry * cdt'entry'size;                     <<*7724>>03995000
next'mapd'offset := md'index * cdt'entry'size;                 <<*7724>>04000000
                                                                        04005000
<< get a disc request element & place it in the cdt entry >>            04010000
tos := %1000 d;                                                <<*7724>>04015000
exchdb;                                                        <<*7724>>04020000
ldreq := getdiscreq(2);  << pri or secondary, no impede   >>            04025000
if ldreq = 0 then                                                       04030000
  suddendeath(cdt'unavail'drq);                                         04035000
exchdb;  << back to cdt >>                                     <<*7724>>04040000
asmb(ddel);                                                    <<*7724>>04045000
                                                               <<*7724>>04050000
$if x1=on                                                      <<*7724>>04055000
cdt'set'word(cdt'entry,cdt'md'discreq,ldreq);                  <<06856>>04060000
$if x1=off                                                     <<*7724>>04065000
cdt'array(mapd'offset+cdt'md'discreq) := ldreq;                <<*7724>>04070000
$if                                                            <<*7724>>04075000
                                                                        04080000
<< now place the cdt entry in the proper list position >>               04085000
                                                                        04090000
<<disable;>> <<protect list structure>>                        <<06858>>04095000
                                                                        04100000
<< if a mapped cdt number was passed, this is a short-cut >>            04105000
next'ptr := md'index;                                                   04110000
if > then                                                               04115000
  go to short'cut   << busch won't like this... >>                      04120000
else if = then                                                          04125000
  go to short'cut'1                                                     04130000
else if md'index = -1 then                                              04135000
  begin                                                                 04140000
  prior'ptr := cdt'array(ldev'offset+cdt'de'mapd'tail);        <<*7724>>04145000
  go to short'cut'2;                                                    04150000
  end;                                                                  04155000
                                                                        04160000
<< get pointer to first entry on list >>                                04165000
tos := next'ptr := cdt'array(ldev'offset+cdt'de'mapd'head);    <<*7724>>04170000
if tos <<next'ptr>> = 0 then                                   <<*7724>>04175000
  begin  << this is the first mapped domain on the list >>              04180000
                                                                        04185000
short'cut'1:                                                            04190000
                                                                        04195000
  cdt'array(ldev'offset+cdt'de'mapd'head):=cdt'entry;          <<*7724>>04200000
  cdt'array(ldev'offset+cdt'de'mapd'tail):=cdt'entry;          <<*7724>>04205000
  << pointers in obtained cdt should already be zero >>                 04210000
  end                                                                   04215000
else                                                                    04220000
  begin  << we must loop through mapped cdt regions >>                  04225000
  loop'control := false;                                       <<*7724>>04230000
  do                                                           <<*7724>>04235000
    begin                                                               04240000
    next'mapd'offset := next'ptr * cdt'entry'size;             <<*7724>>04245000
    << check current mapped cdt's base  address against base >>         04250000
    tos := cdt'darray((next'mapd'offset+cdt'md'sector)&asr(1));<<*7724>>04255000
                                                               <<*7724>>04260000
    if tos > cd'base'sector then                               <<*7724>>04265000
      begin  << insert new mapped cdt entry in front of this >>         04270000
                                                                        04275000
short'cut:                                                              04280000
                                                                        04285000
      <<make this guy next's prior,save his old prior>>                 04290000
      prior'ptr := cdt'array(next'mapd'offset+cdt'md'prev);    <<*7724>>04295000
      cdt'array(cdt'x) := cdt'entry;                           <<*7724>>04300000
      << fix new cdt's pointers >>                                      04305000
      cdt'array(mapd'offset+cdt'md'next):=next'ptr;            <<*7724>>04310000
      cdt'array(mapd'offset+cdt'md'prev):=prior'ptr;           <<*7724>>04315000
      << fix prev cdt entry's next pointer >>                           04320000
      if prior'ptr = 0 then                                             04325000
        begin  << this new cdt is the newhead entry >>                  04330000
        cdt'array(ldev'offset+cdt'de'mapd'head):=cdt'entry;    <<*7724>>04335000
        end                                                             04340000
      else                                                              04345000
        begin  << there is another cdt entry preceding >>               04350000
        cdt'array((prior'ptr*cdt'entry'size)+cdt'md'next)      <<*7724>>04355000
                  := cdt'entry;                                <<*7724>>04360000
        end;                                                            04365000
      << stop looping >>                                                04370000
      loop'control := true;                                    <<*7724>>04375000
      end  << of inserting >>                                           04380000
    else if < then                                                      04385000
      begin   << step to next mapped cdt domain >>                      04390000
      prior'ptr := next'ptr;  << save current pointer >>                04395000
      next'ptr := cdt'array(next'mapd'offset+cdt'md'next);     <<*7724>>04400000
      if next'ptr = 0 then                                              04405000
        begin  << this was the last mapped cdt, so append >>            04410000
                                                                        04415000
short'cut'2:                                                            04420000
                                                                        04425000
        << put new cdt in last cdt's next pointer >>                    04430000
        cdt'array((prior'ptr*cdt'entry'size)+cdt'md'next) :=   <<*7724>>04435000
                  cdt'entry;                                   <<*7724>>04440000
        << update tail pointer in ldev cdt entry >>                     04445000
        cdt'array(ldev'offset+cdt'de'mapd'tail):=cdt'entry;    <<*7724>>04450000
        << point new cdt back to old prior >>                           04455000
        cdt'array(mapd'offset+cdt'md'prev):=prior'ptr;         <<*7724>>04460000
        << stop looping >>                                              04465000
        loop'control := true;                                  <<*7724>>04470000
        end;  << of appending to end-of-chain >>                        04475000
      end   << of stepping through next mapped domain >>                04480000
    else                                                                04485000
                                                                        04490000
      << there should never be a match-it means overlap !!! >>          04495000
      suddendeath(sfkerncacheintbad);                                   04500000
                                                                        04505000
    end until loop'control;  <<of do processing >>             <<*7724>>04510000
  end; << of processing mapped request that is not first >>             04515000
                                                                        04520000
<< initialize cdt to proper state >>                                    04525000
cdt'array(mapd'offset+cdt'md'flags).(cdt'abs'bit:1):=1;        <<*7724>>04530000
                                                                        04535000
<< increment mapped count >>                                            04540000
cdt'x := ldev'offset + cdt'de'mapd'cnt;                        <<*7724>>04545000
cdt'array(cdt'x) := cdt'array(cdt'x) + 1;                      <<*7724>>04550000
                                                                        04555000
<< place ldev in mapped cdt entry >>                                    04560000
cdt'array(mapd'offset+cdt'md'ldev) :=                          <<*7724>>04565000
   cdt'array(ldev'offset+cdt'de'ldev);                         <<*7724>>04570000
                                                                        04575000
<< place device's entry index in md entry >>                   <<d7726>>04580000
cdt'array(mapd'offset+cdt'md'de) := ldev'entry;                <<d7726>>04585000
                                                               <<d7726>>04590000
$if x1=on                                                               04595000
mmstat'(mmstat'get'cdt,cdt'entry,2,0,0,0,0);                   <<06859>>04600000
$if                                                                     04605000
end; << of procedure cdt'get'md'entry >>                                04610000
$page "CDT'REL'MD'ENTRY"                                                04615000
procedure cdt'rel'md'entry(ldev'entry,cdt'entry);                       04620000
value ldev'entry,cdt'entry;                                             04625000
integer ldev'entry,cdt'entry;                                           04630000
option privileged,uncallable,internal;                         <<06858>>04635000
begin                                                                   04640000
                                                                        04645000
<<********************************************************************>>04650000
<< this procedure releases a mapped cdt entry by returning the disc   >>04655000
<< request, delinking the mapped cdt, and returning it to the free    >>04660000
<< list.  the passed parameters are:                                  >>04665000
<<                                                                    >>04670000
<< ldev'entry     - the cdt device entry index for this mapped cdt.   >>04675000
<< cdt'entry      - the mapped cdt entry to release.                  >>04680000
<<********************************************************************>>04685000
                                                                        04690000
integer prior'ptr,       << pointer to prior mapped domain >>           04695000
        next'ptr,        << pointer to next mapped domain >>            04700000
        discreq;         << disc request entry >>                       04705000
                                                                        04710000
<< variables for fast cdt access >>                            <<*7724>>04715000
double save'db;                                                <<*7724>>04720000
                                                               <<*7724>>04725000
integer mapd'offset,                                           <<*7724>>04730000
        ldev'offset;                                           <<*7724>>04735000
                                                               <<*7724>>04740000
                                                                        04745000
                                                               <<*7724>>04750000
                                                               <<*7724>>04755000
                                                               <<*7724>>04760000
                                                               <<*7724>>04765000
$if x1=on                                                               04770000
mmstat'(mmstat'get'cdt,cdt'entry,3,ldev'entry,0,0,0);          <<06859>>04775000
$if                                                                     04780000
                                                                        04785000
<< make sure we're at cdt >>                                   <<*7724>>04790000
cdt'abs'on'tos;                                                <<*7724>>04795000
exchdb;                                                        <<*7724>>04800000
save'db := tos;                                                <<*7724>>04805000
                                                               <<*7724>>04810000
mapd'offset := cdt'entry * cdt'entry'size;                     <<*7724>>04815000
ldev'offset := ldev'entry * cdt'entry'size;                    <<*7724>>04820000
  << release disc request >>                                            04825000
$if x1=on                                                      <<*7724>>04830000
tos:=cdt'set'word(cdt'entry,cdt'md'discreq,0);                 <<06856>>04835000
$if x1=off                                                     <<*7724>>04840000
tos := cdt'array(mapd'offset+cdt'md'discreq);                  <<*7724>>04845000
cdt'array(cdt'x) := 0;                                         <<*7724>>04850000
$if                                                            <<*7724>>04855000
<< go to sysdb >>                                              <<*7724>>04860000
tos := %1000 d;                                                <<*7724>>04865000
exchdb;                                                        <<*7724>>04870000
asmb(ddel);                                                    <<*7724>>04875000
returndiscreq(*);                                                       04880000
<< go back to cdt >>                                           <<*7724>>04885000
cdt'abs'on'tos;                                                <<*7724>>04890000
exchdb;                                                        <<*7724>>04895000
asmb(ddel);                                                    <<*7724>>04900000
                                                                        04905000
<<disable;>> <<protect list structure>>                        <<06858>>04910000
                                                                        04915000
<< now, delink the request >>                                           04920000
prior'ptr := cdt'array(mapd'offset+cdt'md'prev);               <<*7724>>04925000
next'ptr := cdt'array(mapd'offset+cdt'md'next);                <<*7724>>04930000
                                                                        04935000
<< if next pointer is zero, this is tail on list >>                     04940000
if next'ptr = 0 then                                                    04945000
  begin  << make prior ptr the new tail pointer >>                      04950000
  cdt'array(ldev'offset+cdt'de'mapd'tail):=prior'ptr;          <<*7724>>04955000
  end                                                                   04960000
else                                                                    04965000
  begin  << link next mapped cdt onto this one's prior cdt >>           04970000
  cdt'array((next'ptr*cdt'entry'size)+cdt'md'prev):=prior'ptr; <<*7724>>04975000
  end;                                                                  04980000
                                                                        04985000
<< if prior pointer is zero, this is first one on list >>               04990000
if prior'ptr = 0 then                                                   04995000
  begin  << this is the first one >>                                    05000000
  cdt'array(ldev'offset+cdt'de'mapd'head):=next'ptr;           <<*7724>>05005000
  end                                                                   05010000
else                                                                    05015000
  begin << make prior point to next >>                                  05020000
  cdt'array((prior'ptr*cdt'entry'size)+cdt'md'next):=next'ptr; <<*7724>>05025000
  end;                                                                  05030000
                                                                        05035000
<< decrement count of mapped domains >>                                 05040000
cdt'x := ldev'offset + cdt'de'mapd'cnt;                        <<*7724>>05045000
cdt'array(cdt'x) := cdt'array(cdt'x) - 1;                      <<*7724>>05050000
                                                                        05055000
<< tell kernel to unmap this region >>                                  05060000
<< go to sysdb >>                                              <<*7724>>05065000
tos := %1000 d;                                                <<*7724>>05070000
exchdb;                                                        <<*7724>>05075000
cdt'unmap'region(ldev'entry,cdt'entry);                                 05080000
                                                                        05085000
<< release mapped cdt entry >>                                          05090000
cdt'free'entry(cdt'entry);                                              05095000
                                                                        05100000
<< go to caller's db >>                                        <<*7724>>05105000
tos := save'db;                                                <<*7724>>05110000
exchdb;                                                        <<*7724>>05115000
                                                               <<*7724>>05120000
end;  << of procedure cdt'rel'md'entry >>                               05125000
$page "CDT'QUEUE'LDR"                                                   05130000
procedure cdt'queue'ldr(cdt'entry,ldr'index,queue);                     05135000
value cdt'entry,ldr'index,queue;                                        05140000
integer cdt'entry,ldr'index,queue;                                      05145000
option privileged,uncallable;                                           05150000
begin                                                                   05155000
                                                                        05160000
<<********************************************************************>>05165000
<< this procedure takes the logical disc request pointed to by        >>05170000
<< ldr'index and queues it to the end of the list pointed to by queue >>05175000
<< on the specified cdt entry.                                        >>05180000
<<                                                                    >>05185000
<< the passed parameters are:                                         >>05190000
<<                                                                    >>05195000
<< cdt'entry     - the entry number in the cdt table to queue this ldr>>05200000
<<                 onto.                                              >>05205000
<< ldr'index     - the index of the logical disc request to queue onto>>05210000
<<                 the cdt entry.                                     >>05215000
<< queue         - an offset (queue pointer) to the queue to place the>>05220000
<<                 request onto in the cdt entry.                     >>05225000
<<********************************************************************>>05230000
                                                                        05235000
logical ldr'entry'index;  << to satisfy inclldr req. >>                 05240000
integer link'ptr;                                                       05245000
                                                               <<*7724>>05250000
<< variables for quick cdt access >>                           <<*7724>>05255000
double save'db;                                                <<*7724>>05260000
                                                               <<*7724>>05265000
integer mapd'offset;                                           <<*7724>>05270000
                                                                        05275000
                                                               <<*7724>>05280000
                                                               <<*7724>>05285000
                                                               <<*7724>>05290000
                                                               <<*7724>>05295000
$if x1=on                                                               05300000
mmstat'(mmstat'queue'ldr,cdt'entry,ldr'index,queue,0,0,0);     <<06859>>05305000
$if                                                                     05310000
                                                                        05315000
<< put db at cdt >>                                            <<*7724>>05320000
cdt'abs'on'tos;                                                <<*7724>>05325000
exchdb;                                                        <<*7724>>05330000
save'db := tos;                                                <<*7724>>05335000
                                                               <<*7724>>05340000
mapd'offset := cdt'entry * cdt'entry'size;                     <<*7724>>05345000
                                                               <<*7724>>05350000
<< load current logical disc request pointer >>                         05355000
ldr'entry'index := ldr'index;                                           05360000
                                                                        05365000
disable;      << to protect link pointers >>                   <<07309>>05370000
<< if queue is empty, place it on the head >>                           05375000
$if x1=on                                                      <<*7724>>05380000
tos := link'ptr := cdt'get'word(cdt'entry,queue,0);            <<*7724>>05385000
$if x1=off                                                     <<*7724>>05390000
tos := link'ptr := cdt'array(mapd'offset+queue);               <<*7724>>05395000
$if                                                            <<*7724>>05400000
if tos <<link'ptr>> = 0 then                                   <<*7724>>05405000
  begin  << this is first on the list >>                                05410000
  cdt'array(mapd'offset+queue) := ldr'index;                   <<*7724>>05415000
  ldr'prevq := ldr'nextq := 0;                                          05420000
  end                                                                   05425000
else                                                                    05430000
  begin   << we must go down the list until a tail is found >>          05435000
  while link'ptr <> 0 do                                                05440000
    begin                                                               05445000
    ldr'entry'index := link'ptr;                                        05450000
    link'ptr := ldr'nextq;                                              05455000
    end;                                                                05460000
                                                                        05465000
  << at this point, we are at the end of the chain >>                   05470000
  << load new request's pointer into last logical request's next ptr >> 05475000
  ldr'nextq := ldr'index;                                               05480000
                                                                        05485000
  << save former tail ldr's index >>                                    05490000
  link'ptr := ldr'entry'index;                                          05495000
                                                                        05500000
  << move pointer to new tail and fix its queue pointers >>             05505000
  ldr'entry'index := ldr'index;                                         05510000
  ldr'prevq := link'ptr;                                                05515000
  ldr'nextq := 0;                                                       05520000
  end;                                                                  05525000
                                                                        05530000
<< if placing ldr on active list, turn on queued bit >>                 05535000
if queue = cdt'md'ldr'head then                                         05540000
  begin                                                                 05545000
  ldr'cdtqued := 1;                                                     05550000
  end;                                                                  05555000
                                                                        05560000
tos := save'db;                                                <<*7724>>05565000
exchdb;                                                        <<*7724>>05570000
end;  << of procedure cdt'queue'request >>                              05575000
$page "CDT'DEQUEUE'LDR"                                                 05580000
procedure cdt'dequeue'ldr(cdt'entry,ldr'index,queue);                   05585000
value cdt'entry,ldr'index,queue;                                        05590000
integer cdt'entry,ldr'index,queue;                                      05595000
option privileged,uncallable;                                           05600000
begin                                                                   05605000
                                                                        05610000
<<********************************************************************>>05615000
<< this procedure takes the logical disc request pointed to by        >>05620000
<< ldr'index and dequeues it from the list pointed to by queue        >>05625000
<< on the specified cdt entry.                                        >>05630000
<<                                                                    >>05635000
<< the passed parameters are:                                         >>05640000
<<                                                                    >>05645000
<< cdt'entry     - the entry number in the cdt table to dequeue this  >>05650000
<<                 ldr from.                                          >>05655000
<< ldr'index     - the index of the logical disc request to dequeue   >>05660000
<<                 from the cdt entry.                                >>05665000
<< queue         - an offset (queue pointer) to the queue to remove   >>05670000
<<                 the request from on the cdt entry.                 >>05675000
<<********************************************************************>>05680000
                                                                        05685000
logical ldr'entry'index,  << to satisfy inclldr req. >>                 05690000
        not'fnd'flag;     << loop control flag >>                       05695000
                                                                        05700000
<< variables for fast cdt access >>                            <<*7724>>05705000
double save'db;                                                <<*7724>>05710000
                                                               <<*7724>>05715000
integer mapd'offset;                                           <<*7724>>05720000
                                                               <<*7724>>05725000
integer link'ptr,prior'ptr,next'ptr;                                    05730000
                                                                        05735000
                                                               <<*7724>>05740000
                                                               <<*7724>>05745000
                                                               <<*7724>>05750000
                                                               <<*7724>>05755000
$if x1=on                                                               05760000
mmstat'(mmstat'dequeue'ldr,cdt'entry,ldr'index,queue,0,0,0);   <<06859>>05765000
$if                                                                     05770000
                                                                        05775000
<< put db at cdt >>                                            <<*7724>>05780000
cdt'abs'on'tos;                                                <<*7724>>05785000
exchdb;                                                        <<*7724>>05790000
save'db := tos;                                                <<*7724>>05795000
mapd'offset := cdt'entry * cdt'entry'size;                     <<*7724>>05800000
                                                               <<*7724>>05805000
<< load current logical disc request pointer >>                         05810000
ldr'entry'index := ldr'index;                                           05815000
                                                                        05820000
disable;       << to protect linkage structure >>              <<07309>>05825000
                                                                        05830000
<< if queue is empty, bad news! >>                                      05835000
$if x1=on                                                      <<*7724>>05840000
link'ptr := cdt'get'word(cdt'entry,queue,0);                            05845000
$if x1=off                                                     <<*7724>>05850000
link'ptr := cdt'array(mapd'offset+queue);                      <<*7724>>05855000
$if                                                            <<*7724>>05860000
if link'ptr = 0 then                                                    05865000
  suddendeath(cdt'bad'ldr'index)                                        05870000
else                                                                    05875000
  begin   << we must go down the list until a tail is found >>          05880000
  << if link pointer is first on the list, take care of it here >>      05885000
  if link'ptr = ldr'index then                                          05890000
    begin  << yes, it is >>                                             05895000
    << get new list head >>                                             05900000
    ldr'entry'index := ldr'nextq;                                       05905000
    if <> then ldr'prevq := 0;                                 <<07311>>05910000
    cdt'set'word(cdt'entry,queue,ldr'entry'index);                      05915000
    cdt'array(mapd'offset+queue) := ldr'entry'index;           <<*7724>>05920000
    end                                                                 05925000
  else                                                                  05930000
    begin  << we must search down the list >>                           05935000
    not'fnd'flag := true;                                               05940000
    while not'fnd'flag do                                               05945000
      begin                                                             05950000
      ldr'entry'index := link'ptr;                                      05955000
      link'ptr := ldr'nextq;                                            05960000
      if = then  << we didn't find it >>                                05965000
        suddendeath(cdt'bad'ldr'index);                                 05970000
      if link'ptr = ldr'index then                                      05975000
        begin  << we found it >>                                        05980000
        not'fnd'flag := false;                                          05985000
        prior'ptr := ldr'entry'index;                                   05990000
        ldr'entry'index := link'ptr;  << point to req we're deleting >> 05995000
        next'ptr := ldr'nextq;                                          06000000
        if next'ptr <> 0 then                                           06005000
          begin  << there is a ldr following this one >>                06010000
          ldr'entry'index := next'ptr;                                  06015000
          ldr'prevq := prior'ptr;  << point to the new prior ldr >>     06020000
          end;                                                          06025000
        << set pointer back to prior ldr >>                             06030000
        ldr'entry'index := prior'ptr;                                   06035000
        << fix next pointer >>                                          06040000
        ldr'nextq := next'ptr;                                          06045000
        end; << of processing hit >>                                    06050000
      end;  <<of processing while loop >>                               06055000
    end; << of searching list >>                                        06060000
  end;  << of processing non-zero list >>                               06065000
                                                                        06070000
<< if the ldr was on the active list, turn off queued bit >>            06075000
if queue = cdt'md'ldr'head then                                         06080000
  begin                                                                 06085000
  ldr'entry'index := ldr'index;                                         06090000
  ldr'cdtqued := 0;                                                     06095000
  end;                                                                  06100000
                                                                        06105000
<< put db back to caller's db >>                               <<*7724>>06110000
tos := save'db;                                                <<*7724>>06115000
exchdb;                                                        <<*7724>>06120000
                                                               <<*7724>>06125000
end;  << of procedure cdt'dequeue'ldr >>                                06130000
$page "CDT'FIND'DE"                                                     06135000
integer procedure cdt'find'de(ldev);                                    06140000
value ldev;                                                             06145000
integer ldev;                                                           06150000
option privileged,uncallable;                                           06155000
begin                                                                   06160000
                                                                        06165000
<<********************************************************************>>06170000
<< this procedure scans the list of cached ldevs and returns the entry>>06175000
<< of the cdt entry for this ldev.  the passed parameter is:          >>06180000
<<                                                                    >>06185000
<< ldev    - this is the logical device number to find the corres-    >>06190000
<<           ponding cdt disc entry for.                              >>06195000
<<                                                                    >>06200000
<< returned parameter-                                                >>06205000
<<                                                                    >>06210000
<< cdt'find'ldev - this is the cdt disc entry number of the ldev.     >>06215000
<<                 zero is returned if the ldev is not cached. <<06858>>06220000
<<********************************************************************>>06225000
                                                                        06230000
integer ldev'link'ptr = cdt'find'de,   << re-define return parameter  >>06235000
        de'ldev,                       << ldev from cdt disc entry    >>06240000
        cdt'link'ptr;                  << pointer link work variable  >>06245000
<< variable for fast cdt access >>                             <<*7724>>06250000
integer ldev'offset;                                           <<*7724>>06255000
                                                                        06260000
                                                               <<*7724>>06265000
                                                               <<*7724>>06270000
                                                               <<*7724>>06275000
if cache'dst = 0 then  << caching has been disabled >>         <<06858>>06280000
  cdt'find'de := 0                                             <<06858>>06285000
else                                                           <<06858>>06290000
  begin                                                        <<06858>>06295000
  << put db to cdt >>                                          <<*7724>>06300000
  cdt'abs'on'tos;                                              <<*7724>>06305000
  exchdb;                                                      <<*7724>>06310000
                                                               <<*7724>>06315000
  << find ldev cdt entry >>                                    <<06858>>06320000
  ldev'link'ptr := 0;                                          <<06858>>06325000
  cdt'link'ptr := cdt'array(cdt'disc'head);                    <<*7724>>06330000
                                                                        06335000
  while cdt'link'ptr <> 0 do                                   <<06858>>06340000
    begin  << look for ldev >>                                 <<06858>>06345000
    ldev'offset := cdt'link'ptr * cdt'entry'size;              <<*7724>>06350000
    de'ldev := cdt'array(ldev'offset+cdt'de'ldev);             <<*7724>>06355000
    if ldev = de'ldev then                                     <<06858>>06360000
      begin  << found the ldev >>                              <<06858>>06365000
      ldev'link'ptr := cdt'link'ptr;                           <<06858>>06370000
      cdt'link'ptr := 0;  << to terminate search >>            <<06858>>06375000
      end                                                      <<06858>>06380000
    else                                                       <<06858>>06385000
      cdt'link'ptr:=cdt'array(ldev'offset+cdt'de'next'ldev);   <<*7724>>06390000
    end;                                                       <<06858>>06395000
                                                               <<*7724>>06400000
  << put db back to caller's db >>                             <<*7724>>06405000
  exchdb;                                                      <<*7724>>06410000
  asmb(ddel);                                                  <<*7724>>06415000
  end;                                                         <<06858>>06420000
                                                                        06425000
$if x1=on                                                               06430000
mmstat'(mmstat'find'de,ldev,ldev'link'ptr,0,0,0,0);            <<06859>>06435000
                                                               <<06858>>06440000
                                                               <<06858>>06445000
                                                               <<06858>>06450000
$if                                                                     06455000
                                                                        06460000
end;  << of procedure cdt'find'de >>                                    06465000
$page "CDT'FORCE'LDR'COMPLETION"                                        06470000
procedure cdt'force'ldr'completion(ldr'index);                          06475000
value ldr'index;                                                        06480000
integer ldr'index;                                                      06485000
option privileged,uncallable;                                           06490000
begin                                                                   06495000
                                                                        06500000
<<***********************************************************>><<06858>>06505000
<< this procedure forces any pending i/o requests which are  >>         06510000
<< preventing the completion of the current i/o request, to  >>         06515000
<< be completed.  it is called from locking routines and from>>         06520000
<< waitforio.  the passed parameter is:                      >>         06525000
<<                                                           >>         06530000
<< ldr'index  - disc request table relative offset to the    >>         06535000
<<              logical disc request.                        >>         06540000
<<                                                           >>         06545000
<< the caller is assumed to be disabled prior to calling.    >><<06858>>06550000
<< the caller must be able to withstand being "blocked".  no >>         06555000
<< assumption is made as to the location of db.              >>         06560000
<<***********************************************************>>         06565000
                                                                        06570000
integer cdt'entry,        << cdt entry associated w/ldr      >>         06575000
        callers'pin,      << pin of waitforiox caller        >>         06580000
        my'pin,           << caller's pin number             >><<06858>>06585000
        work'ldr,         << current ldr trying to complete  >>         06590000
        ldr'inx,          << logical disc req index          >><<07311>>06595000
        save'db,          << for call to setsysdb            >>         06600000
        dst,              << dst of ldr trying to complete   >>         06605000
                                                               <<06858>>06610000
        ldev'entry;       << ldev cdt entry for this ldr     >>         06615000
<< this is a new measurement interface global counter. >>      <<*8735>>06620000
<< it should be added to the measurement interface include  >> <<*8735>>06625000
<< file as soon as possible.  >>                               <<*8735>>06630000
equate  c'impedecache = 74 ;                                   <<*8735>>06635000
                                                               <<*8735>>06640000
                                                                        06645000
double work'cdt;          << cdt entry trying to complete    >><<06855>>06650000
logical array wrk'cdt(*)=work'cdt;                             <<06855>>06655000
logical ldr'entry'index,  << to satisfy ldr equates/defines  >>         06660000
        save'ldr,         << save old ldr'entry'index        >><<06858>>06665000
        inhibit'pinswitch,<< don't switch pins in ldr        >><<06858>>06670000
        done'flag;        << loop control flag               >>         06675000
                                                               <<06858>>06680000
entry cdt'force'cdt'completion;                                <<06858>>06685000
$page                                                                   06690000
subroutine impede'me(impede'cdt);                                       06695000
value impede'cdt;                                                       06700000
integer impede'cdt;                                                     06705000
begin                                                                   06710000
                                                                        06715000
<< this subroutine is used whenever a write of a cached >>              06720000
<< domain is in-progress, the region is in memory, and  >>              06725000
<< the ldr must wait for the write to finish.           >>              06730000
                                                                        06735000
my'pin := curprc / pcbsize;                                    <<06858>>06740000
                                                               <<06858>>06745000
<< get in pcb list for this cdt >>                                      06750000
callers'pin:=cdt'get'word(impede'cdt,cdt'md'impeded,0);                 06755000
if callers'pin = 0 then                                                 06760000
  cdt'set'word(impede'cdt,cdt'md'impeded,my'pin);              <<06858>>06765000
                                                               <<06858>>06770000
stringpinattail(callers'pin,0);                                         06775000
                                                               <<06858>>06780000
save'ldr := ldr'entry'index;                                   <<06858>>06785000
ldr'entry'index := cdt'get'word(impede'cdt,                    <<06858>>06790000
                   cdt'md'discreq,0);                          <<06858>>06795000
                                                               <<06858>>06800000
<< adjust write priority if request is not completed >>        <<06858>>06805000
if not ldr'done then                                           <<06858>>06810000
                                                               <<06858>>06815000
  bumpwritepri(ldr'entry'index,processpri(my'pin));            <<06858>>06820000
                                                               <<06858>>06825000
ldr'entry'index := save'ldr;                                   <<06858>>06830000
<< impede, waiting for write to complete >>                             06835000
<< count impedes due to disc caching.  this is a double count>><<*8735>>06840000
<< since it is also counted in procedure impede.             >><<*8735>>06845000
                                                               <<*8735>>06850000
if class0statsenabled then                                     <<*8735>>06855000
  if fupdatestatistics(measclass0,meassubclass0,measentry1,    <<*8735>>06860000
           c'impedecache,notnewvalue,1d,notdouble)             <<*8735>>06865000
   <> 0 then suddendeath(sfkerncacheintbad) ;                  <<*8735>>06870000
                                                               <<*8735>>06875000
<< there is no room for additional process level counters. >>  <<*8735>>06880000
<< this uses the old counter cp'segcontract to count impedes >><<*8735>>06885000
<< due to caching.  the old counters for cp'segcontract have >><<*8735>>06890000
<< been removed from kerneld.  this counter should be renamed>><<*8735>>06895000
<< cp'impedecache in the measurement include file asap!!!!!!!>><<*8735>>06900000
if gclassenabledmask.class15 then                              <<*8735>>06905000
   begin                                                       <<*8735>>06910000
   tos:=measprocxdsbank;                                       <<*8735>>06915000
   tos:=measprocxdsbase;                                       <<*8735>>06920000
   tos:=tos + curprc / pcbsize * class15'sub0size +            <<*8735>>06925000
        cp'segcontract ;                                       <<*8735>>06930000
   asmb(lsea);                                                 <<*8735>>06935000
   tos:=tos+1;                                                 <<*8735>>06940000
   asmb(ssea;ddel);                                            <<*8735>>06945000
   end;                                                        <<*8735>>06950000
impede(0);                                                              06955000
                                                                        06960000
<< cdt'completor checks this list & removes any waitors >>              06965000
end;                                                                    06970000
                                                                        06975000
$page                                                                   06980000
subroutine make'segs'present(ld'req);                                   06985000
value ld'req;                                                           06990000
integer ld'req;                                                         06995000
begin                                                                   07000000
                                                                        07005000
<< attempt to make this ldr's cdt and dst present >>                    07010000
ldr'entry'index := ld'req;  << new index >>                             07015000
dst := ldr'buf'dstn;                                           <<07311>>07020000
work'cdt := buildobjid(mappeddomainobject,ldr'cdt,0);                   07025000
                                                                        07030000
<< loop until cache move is done >>                                     07035000
done'flag := false;                                                     07040000
while (ldr'move'done=0) and (not done'flag) do                          07045000
  begin <<force in the objects to allow the cache move>>                07050000
  if isobjectabsent(double(dst))                               <<06855>>07055000
  then queueonobject(double(dst))                              <<06855>>07060000
  else if isobjectabsent(work'cdt) and                         <<*8003>>07065000
          not isobjectimi(work'cdt)                            <<*8003>>07070000
  then queueonobject(work'cdt)                                          07075000
  else if cdt'get'bit(wrk'cdt(objidnumfield),cdt'imo'bit,0)    <<06855>>07080000
  then impede'me(wrk'cdt(objidnumfield))                       <<06855>>07085000
  else done'flag := true;  << both here, so leave >>                    07090000
  end;  << of expediting cache move completion >>                       07095000
end;                                                                    07100000
$page                                                                   07105000
subroutine scan'deferred'queue;                                         07110000
begin                                                                   07115000
                                                                        07120000
<< this procedure scans the disabled disc request queue for >>          07125000
<< a matching cdt and attempts to force its completion.     >>          07130000
                                                                        07135000
<< load deferred disc req pointer into ldr'entry'index      >>          07140000
                                                               <<07311>>07145000
ldr'inx   := dqh'disahead;              << deferred head    >> <<07311>>07150000
                                                                        07155000
<< if it's zero, we have a logic problem >>                             07160000
if = then                                                               07165000
  suddendeath(cdt'logic'problem);                                       07170000
                                                                        07175000
while ldr'inx <> 0 do                                          <<07311>>07180000
  begin  << scan queue >>                                               07185000
  ldr'entry'index := ldr'inx;                                  <<07311>>07190000
  if integer(ldr'cdt) = cdt'entry then                                  07195000
    begin << this is a match, so force it to complete       >>          07200000
    make'segs'present(ldr'entry'index);                                 07205000
    ldr'inx   := 0;        << to terminate looping          >> <<07311>>07210000
    end                                                                 07215000
  else                                                                  07220000
    begin                                                               07225000
    ldr'inx   := ldr'nextq;       << point to next in list  >> <<07311>>07230000
                                                                        07235000
    << if the list is exhausted, we have a logic problem    >>          07240000
    if = then                                                           07245000
      suddendeath(cdt'logic'problem);                                   07250000
    end;                                                                07255000
  end;                                                                  07260000
                                                                        07265000
<< restore ldr pointer (index) >>                                       07270000
ldr'entry'index := ldr'index;                                           07275000
                                                                        07280000
end;                                                                    07285000
$page                                                                   07290000
subroutine process'cdt'queue;                                           07295000
begin                                                                   07300000
                                                                        07305000
<< if this ldr is already on the cdt's active queue, >>                 07310000
<< just let it complete naturally.                   >>                 07315000
do                                                                      07320000
  begin  << we must get things out of the way >>                        07325000
  << get first active ldr on cdt & force completion >>                  07330000
  work'ldr := cdt'get'word(cdt'entry,cdt'md'ldr'head,0);                07335000
  if work'ldr <> 0 then                                                 07340000
    begin   << force completion >>                                      07345000
    make'segs'present(work'ldr);                                        07350000
    end                                                                 07355000
  else                                                                  07360000
    begin  << we must scan deferred disc request queue >>               07365000
    if cdt'get'bit(cdt'entry,cdt'wait'on'nopost,0) = 0 then             07370000
      scan'deferred'queue                                               07375000
    else                                                                07380000
      << wait for segment write to complete >>                          07385000
      impede'me(cdt'entry);                                             07390000
    end;                                                                07395000
  end until (ldr'cdtqued = 1) or (ldr'move'done = 1);                   07400000
end;                                                                    07405000
$page                                                                   07410000
$if x7=on                                                      <<06858>>07415000
subroutine process'flush'queue;                                         07420000
begin                                                                   07425000
                                                                        07430000
<< get head cdt in ldev's flush queue >>                                07435000
cdt'entry := cdt'get'word(ldev'entry,cdt'de'flush'hd,0);       <<06858>>07440000
if cdt'entry = 0 then                                                   07445000
  suddendeath(cdt'logic'problem)                                        07450000
else                                                                    07455000
  process'cdt'queue;                                                    07460000
                                                                        07465000
end;                                                                    07470000
$if                                                            <<06858>>07475000
$page                                                                   07480000
                                                                        07485000
inhibit'pinswitch := false;                                    <<06858>>07490000
go to start;                                                   <<06858>>07495000
                                                               <<06858>>07500000
cdt'force'cdt'completion:                                      <<06858>>07505000
inhibit'pinswitch := true;                                     <<06858>>07510000
                                                               <<06858>>07515000
start:                                                         <<06858>>07520000
                                                               <<06858>>07525000
<< we should be disable'd prior to calling this routine >>              07530000
                                                                        07535000
ldr'entry'index := ldr'index;                                           07540000
                                                                        07545000
<< if this process must stop for cache, count it >>            <<07308>>07550000
if not ldr'done then  << not marked completed >>               <<07308>>07555000
  if not inhibit'pinswitch then << not a flush call >>         <<07308>>07560000
    begin                                                      <<*7724>>07565000
    cdt'abs'on'tos;  << abs cdt memory address >>              <<d7726>>07570000
    tos := tos + (integer(ldr'cdt) * cdt'entry'size) +         <<d7726>>07575000
           cdt'md'de;                                          <<d7726>>07580000
    asmb(lsea;delb,delb);    << device entry index is on tos >><<d7726>>07585000
    ldev'entry := tos;                                         <<d7726>>07590000
$if x1=on                                                      <<*7724>>07595000
    cdt'add'double(                                            <<07308>>07600000
      cdt'find'de(ldr'ldev),   << cdt# of ldev entry >>        <<07308>>07605000
      cdt'de'stop,             << inc stop counter   >>        <<07308>>07610000
      1d);                                                     <<07308>>07615000
$if x1=off                                                     <<*7724>>07620000
    cdt'abs'on'tos;                                            <<*7724>>07625000
    << get ldev offset in cdt >>                               <<*7724>>07630000
    tos := tos + (ldev'entry * cdt'entry'size);                <<*7724>>07635000
    tos := tos + cdt'de'stop; << stop cell offset >>           <<*7724>>07640000
    << increment stop counter >>                               <<*7724>>07645000
    asmb(ldea);                                                <<*7724>>07650000
    tos := tos + 1d;                                           <<*7724>>07655000
    asmb(sdea;ddel);                                           <<*7724>>07660000
$if                                                            <<*7724>>07665000
    end;                                                       <<*7724>>07670000
if (ldr'move'done = 0) then                                             07675000
  begin  << move not done on ldr >>                                     07680000
                                                                        07685000
  << put db to sysdb for kernel calls >>                                07690000
  save'db := setsysdb;                                                  07695000
                                                                        07700000
  << if the caller's pin is different than the pin in >>                07705000
  << the logical disc request, we must fix-up locality>>                07710000
  callers'pin := curprc / pcbsize;                             <<06857>>07715000
  if callers'pin <> integer(ldr'pcb) and                       <<06858>>07720000
     not inhibit'pinswitch then                                <<06858>>07725000
    begin  << adjust localities >>                                      07730000
    << decrement initiator's prefetch count >>                          07735000
    tos := (integer(ldr'pcb)*pcbsize) ;                        <<06857>>07740000
    tos := work'cdt := buildobjid(mappeddomainobject,                   07745000
                                  ldr'cdt,0);                           07750000
    tos := 0d;                                                          07755000
    tos.decprefetchcntflag := 1;                                        07760000
    adjustlocality(*,*,*,*);                                            07765000
                                                               <<*7724>>07770000
    << if ldr thinks its not in locality, sf >>                <<*7724>>07775000
    if not ldr'inloc then                                      <<*7724>>07780000
      suddendeath(sfkerncacheintbad);                          <<*7724>>07785000
    ldr'pcb := callers'pin;                                    <<*7724>>07790000
                                                                        07795000
    << now, add domain to caller's locality >>                          07800000
    tos := lpcb( curprc + sllixwordnum );                      <<06857>>07805000
    tos := work'cdt;                                                    07810000
    tos := 0;                                                           07815000
    tos.bumpprefetchcntflag := 1;                                       07820000
    addtolocality(*,*,*);                                               07825000
                                                                        07830000
    flagprocabsent(callers'pin,work'cdt,%100000);              <<*7859>>07835000
                                                               <<*7859>>07840000
    end;                                                                07845000
                                                                        07850000
  << if ldr is not on cdt's active queue, force it there>>              07855000
  if (not ldr'cdtqued land not ldr'move'done) or               <<*8216>>07860000
     inhibit'pinswitch then  << we must assume responsibility ><<06858>>07865000
                             << for forcing completion.  wait ><<06858>>07870000
                             << forio was not called.         ><<06858>>07875000
    begin                                                               07880000
    cdt'entry := ldr'cdt;                                               07885000
    cdt'abs'on'tos;  << abs cdt memory address >>              <<d7726>>07890000
    tos := tos + (cdt'entry * cdt'entry'size) + cdt'md'de;     <<d7726>>07895000
    asmb(lsea;delb,delb);    << device entry index is on tos >><<d7726>>07900000
    ldev'entry := tos;                                         <<d7726>>07905000
                                                                        07910000
                                                               <<06858>>07915000
                                                               <<06858>>07920000
                                                               <<06858>>07925000
                                                               <<06858>>07930000
                                                               <<06858>>07935000
    process'cdt'queue;                                         <<06858>>07940000
    end;                                                                07945000
                                                                        07950000
  resetdb(save'db);                                                     07955000
                                                                        07960000
  end;                                                                  07965000
                                                                        07970000
end;  << of procedure cdt'force'ldr'completion >>                       07975000
$page "CDT'LOCK'RANGE"                                                  07980000
<< since lock code is extremely low-usage and would require >> <<06858>>07985000
<< exotic mechanisms to implement, it is currently not      >> <<06858>>07990000
<< implemented in disc caching.  routines, such as flush'   >> <<06858>>07995000
<< cache, cdt'attachio, and uncache'ldev would call this    >> <<06858>>08000000
<< mechanism.  therefore, all code will disabled via a      >> <<06858>>08005000
<< compiler switch, s7.  the locking code in cdt'initiator  >> <<06858>>08010000
<< will not be conditioned, and is an exception.            >> <<06858>>08015000
$if x7=on                                                      <<06858>>08020000
integer procedure cdt'lock'range(ldev'entry,ldr'adr,upper'ldr'adr);     08025000
value ldev'entry,ldr'adr,upper'ldr'adr;                                 08030000
integer ldev'entry;                                                     08035000
double ldr'adr,upper'ldr'adr;                                           08040000
option privileged,uncallable;                                           08045000
begin                                                                   08050000
                                                                        08055000
<<********************************************************************>>08060000
<< this procedure scans the mapped domains for a cached ldev and locks>>08065000
<< all overlapping and partially overlapping domains.  these domains  >>08070000
<< are marked to be in a "FLUSH" state, and a new mapped cdt is       >>08075000
<< obtained in the "LOCKED" state, which is linked-in the mapped      >>08080000
<< domain list to intercept any subsequent overlapping requests.      >>08085000
<< the lock count is set to 1 + the number of flushing cdts that had  >>08090000
<< to be moved onto the ldev's flush queue.  the additional lock count>>08095000
<< is to allow the caller to gain control without giving up the lock. >>08100000
<<                                                                    >>08105000
<< the passed parameters are:                                         >>08110000
<<                                                                    >>08115000
<< ldev'entry   - this is the cdt disc entry for the ldev whose         08120000
<<                mapped domains are to be locked.                    >>08125000
<< ldr'adr      - this is the low sector address to lock.             >>08130000
<< upper'ldr'adr- this is the upper sector address of the range to    >>08135000
<<                lock.  this is actually the sector number + 1 of    >>08140000
<<                the highest sector address to lock.                 >>08145000
<<                                                                    >>08150000
<< returned parameter -                                               >>08155000
<<                                                                    >>08160000
<< cdt'lock'range  - the mapped cdt entry of the domain owning the    >>08165000
<<                   lock.                                            >>08170000
<<********************************************************************>>08175000
                                                                        08180000
integer hld'beg,         << ptr to mapd cdt prior to lock range >>      08185000
        hld'end,         << ptr to mapd cdt after lock range    >>      08190000
        next'ptr,        << ptr to last mapd cdt in lock range  >>      08195000
        prior'ptr,       << ptr to 1st mapd cdt in lock range   >>      08200000
        cdt'flgs,        << flags word in cdt entry.            >>      08205000
        cdt'entry;       << new cdt entry obtained              >>      08210000
                                                                        08215000
double cdt'adr,          << cdt base sector address             >>      08220000
       upper'cdt'adr;    << cdt limit sector address            >>      08225000
                                                                        08230000
                                                               <<06858>>08235000
def'set'word;                                                           08240000
def'get'word;                                                           08245000
                                                               <<06858>>08250000
                                                               <<06858>>08255000
mmstat'(mmstat'lock'range,ldev'entry,1,0,0,0,0);               <<06859>>08260000
                                                               <<06858>>08265000
                                                                        08270000
<< get pointer to first mapped domain >>                                08275000
pdisable;                                                      <<06858>>08280000
next'ptr := cdt'get'word(ldev'entry,cdt'de'mapd'head,0);                08285000
cdt'entry := 0;   << initialize in case no "hit" >>                     08290000
if next'ptr = 0 then                                                    08295000
  begin  << there are no current mapped domains for this ldev >>        08300000
  end                                                                   08305000
else                                                                    08310000
  begin  << find the first overlapping domain >>                        08315000
  while next'ptr <> 0 do                                                08320000
    begin                                                               08325000
    if cdt'get'double(next'ptr,cdt'md'end'sector,0d) >                  08330000
       ldr'adr then  << possible overlap >>                             08335000
      begin                                                             08340000
      if cdt'get'double(next'ptr,cdt'md'sector,0d) <                    08345000
         upper'ldr'adr then << definite overlap >>                      08350000
        begin                                                           08355000
        cdt'entry := next'ptr;  << save cdt index >>                    08360000
        end                                                             08365000
      else                                                              08370000
        begin  << cdt is beyond requested lock range >>                 08375000
        end;                                                            08380000
      next'ptr := 0;                                                    08385000
      end                                                               08390000
    else                                                                08395000
      begin  << we must step to next mapped cdt >>                      08400000
      next'ptr := cdt'get'word(next'ptr,cdt'md'next,0);                 08405000
      end;                                                              08410000
    end;  << of while looking for first domain in range >>              08415000
  end;  << of looking through mapped cdts >>                            08420000
                                                                        08425000
<< delink overlapping mapped domain strings >>                          08430000
<< the current cdt entry being pointed to is where we start >>          08435000
next'ptr := prior'ptr := cdt'entry;                                     08440000
                                                                        08445000
<< now, find the last overlapping mapped domain >>                      08450000
while cdt'entry <> 0 do                                                 08455000
  begin                                                                 08460000
  << save current cdt pointer >>                                        08465000
  next'ptr := cdt'entry;                                                08470000
  << load next pointer >>                                               08475000
  cdt'entry := cdt'get'word(cdt'entry,cdt'md'next,0);                   08480000
  if cdt'entry = 0 then                                                 08485000
    begin  << this is the end of the scan >>                            08490000
    end  << the next pointer is set >>                                  08495000
  else                                                                  08500000
    begin  << see if this entry partially maps too >>                   08505000
    if cdt'get'double(cdt'entry,cdt'md'sector,0d) <                     08510000
       upper'ldr'adr  then                                              08515000
      begin  << continue looping, still overlaps >>                     08520000
      end                                                               08525000
    else                                                                08530000
      begin  << no more overlap, so terminate loop >>                   08535000
      cdt'entry := 0;                                                   08540000
      end;                                                              08545000
    end;                                                                08550000
  end;  << of while looking for partially mapped cdt's >>               08555000
                                                                        08560000
<< only perform the following if overlapping areas found >>             08565000
if prior'ptr <> 0 then                                                  08570000
  begin                                                                 08575000
                                                                        08580000
  << now, delink partially mapped domain(s) >>                          08585000
  << hold pointer to md prior to string being delinked >>               08590000
  hld'beg := cdt'get'word(prior'ptr,cdt'md'prev,0);                     08595000
  << hold pointer to md after string being delinked >>                  08600000
  hld'end := cdt'get'word(next'ptr,cdt'md'next,0);                      08605000
                                                                        08610000
  << link the md, minus the string, together >>                         08615000
  if hld'beg = 0 then                                                   08620000
    begin  << the end will be the new head pointer >>                   08625000
    cdt'set'word(ldev'entry,cdt'de'mapd'head,hld'end);                  08630000
    if hld'end <> 0 then                                                08635000
      cdt'set'word(hld'end,cdt'md'prev,0);                              08640000
    end                                                                 08645000
  else                                                                  08650000
    begin  << there is a prior mapped domain >>                         08655000
    cdt'set'word(hld'beg,cdt'md'next,hld'end);                          08660000
    if hld'end <> 0 then                                                08665000
      cdt'set'word(hld'end,cdt'md'prev,hld'beg);                        08670000
    end;                                                                08675000
                                                                        08680000
  if hld'end = 0 then                                                   08685000
    begin  << there is a new tail entry >>                              08690000
    cdt'set'word(ldev'entry,cdt'de'mapd'tail,hld'beg);                  08695000
    end                                                                 08700000
  else                                                                  08705000
    begin  << there is a "next" mapped domain >>                        08710000
    cdt'set'word(hld'end,cdt'md'prev,hld'beg);                          08715000
    end;                                                                08720000
  end;  << of processing string >>                                      08725000
                                                                        08730000
<< now, get a new cdt entry to link-in >>                               08735000
<< get lowest disc request address for cache >>                         08740000
cdt'adr := if prior'ptr = 0 then                                        08745000
             ldr'adr                                                    08750000
           else                                                         08755000
             cdt'get'double(prior'ptr,cdt'md'sector,0d);                08760000
<< get highest disc request address for cache >>                        08765000
upper'cdt'adr := if next'ptr = 0 then                                   08770000
                   upper'ldr'adr                                        08775000
                 else                                                   08780000
                   cdt'get'double(next'ptr,cdt'md'end'sector,0d);       08785000
                                                                        08790000
<< now we will get a cdt to cover the locked range >>                   08795000
cdt'entry := cdt'get'md'entry(ldev'entry,cdt'adr,-2);                   08800000
                                                                        08805000
<< initialize its fields >>                                             08810000
                                                                        08815000
                                                                        08820000
cdt'flgs := cdt'get'word(cdt'entry,cdt'md'flags,0);                     08825000
cdt'flgs.cdt'md'state := cdt'lock'state;                                08830000
cdt'set'word(cdt'entry,cdt'md'flags,cdt'flgs);                          08835000
                                                                        08840000
                                                                        08845000
cdt'set'word(cdt'entry,cdt'md'lk'cnt,1); << set lock = 1 >>             08850000
cdt'set'double(cdt'entry,cdt'md'sector,cdt'adr);                        08855000
cdt'set'double(cdt'entry,cdt'md'end'sector,upper'cdt'adr);              08860000
                                                                        08865000
<< if there is a string to "flush", we must now deal with it >>         08870000
if next'ptr <> 0 then                                                   08875000
  begin  << we have to put these mapped cdt's on the "flush" string >>  08880000
                                                                        08885000
  << force terminator in last mapped cdt >>                             08890000
  cdt'set'word(next'ptr,cdt'md'next,0);                                 08895000
                                                                        08900000
  << mark all cdts in this string "flushing" >>                         08905000
  hld'beg := prior'ptr;                                                 08910000
  while hld'beg <> 0 do                                                 08915000
    begin                                                               08920000
                                                                        08925000
                                                                        08930000
                                                                        08935000
    cdt'flgs := cdt'get'word(hld'beg,cdt'md'flags,0);                   08940000
    cdt'flgs.cdt'md'state := cdt'flush'state;                           08945000
    cdt'set'word(hld'beg,cdt'md'flags,cdt'flgs);                        08950000
                                                                        08955000
                                                                        08960000
    cdt'set'word(hld'beg,cdt'md'lkd'cdt,cdt'entry);                     08965000
    cdt'add'word(cdt'entry,cdt'md'lk'cnt,1);                            08970000
                                                                        08975000
    << get pointer to next cdt >>                                       08980000
    hld'beg := cdt'get'word(hld'beg,cdt'md'next,0);                     08985000
    end;                                                                08990000
                                                                        08995000
  << append string onto device's flush list >>                          09000000
<<hld'beg := cdt'get'word(ldev'entry,cdt'de'flush'hd,0);>>              09005000
  if hld'beg = 0 then                                                   09010000
    begin  << the flush list is currently empty >>                      09015000
  <<cdt'set'word(ldev'entry,cdt'de'flush'hd,prior'ptr);>>               09020000
                                                                        09025000
    cdt'set'word(prior'ptr,cdt'md'prev,0);                              09030000
    end                                                                 09035000
  else                                                                  09040000
    begin  << append string on tail >>                                  09045000
    << get old tail pointer >>                                          09050000
    while hld'beg <> 0 do                                               09055000
      begin                                                             09060000
      hld'end := hld'beg;                                               09065000
      hld'beg := cdt'get'word(hld'end,cdt'md'next,0);                   09070000
      end;                                                              09075000
    << link old end to new string >>                                    09080000
    cdt'set'word(hld'end,cdt'md'next,prior'ptr);                        09085000
    cdt'set'word(prior'ptr,cdt'md'prev,hld'end);                        09090000
    end;                                                                09095000
                                                                        09100000
                                                                        09105000
  end;  << of linking string to flush list >>                           09110000
                                                                        09115000
penable;                                                       <<06858>>09120000
end;  << of procedure cdt'lock'range >>                                 09125000
$if                                                            <<06858>>09130000
$page "Procedure CDT'STRATEGY"                                          09135000
procedure cdt'strategy(cdt'entry,discreq);                              09140000
value cdt'entry,discreq;                                                09145000
integer cdt'entry,discreq;                                              09150000
option privileged,uncallable,internal;                         <<06858>>09155000
begin                                                                   09160000
                                                                        09165000
<<********************************************************************>>09170000
<< this procedure examines a logical disc request and determines the  >>09175000
<< fetch strategy which is to be applied to a cdt.  the cdt is assumed>>09180000
<< to already be "linked" in the list of mapped-domain cdt's for this >>09185000
<< disc device.  the lower and upper cdt entries are consulted to     >>09190000
<< bound any round-up or round-down decision this procedure makes.    >>09195000
<< the lower and upper disc addresses calculated by this routine are  >>09200000
<< placed in the appropriate cells in the mapped cdt entry.           >>09205000
<<                                                                    >>09210000
<< the passed parameters are:                                         >>09215000
<<                                                                    >>09220000
<< cdt'entry   - the index of the mapped domain cdt entry already     >>09225000
<<               linked into the appropriate position in the list of  >>09230000
<<               mapped cdt domains for this device.                  >>09235000
<< discreq     - a disc request table relative index to the logical   >>09240000
<<               disc request.                                        >>09245000
<<                                                                    >>09250000
<< returned parameters:                                               >>09255000
<<                                                                    >>09260000
<<               only the calculated base and limit sector addresses, >>09265000
<<               which have been calculated by this routine, have been>>09270000
<<               placed in the mapped domain cdt entry.               >>09275000
<<                                                             <<*7724>>09280000
<<******** db is assumed to be at the cdt ********** >>        <<*7724>>09285000
<<********************************************************************>>09290000
                                                                        09295000
<< re-define discreq to satisfy disc request incl requirements >>       09300000
logical ldr'entry'index = discreq;                                      09305000
                                                                        09310000
integer count,       << positive byte count in cdt entry >>             09315000
        caller,      << strategy number to use           >>             09320000
        sectors,     << number of sectors in transfer    >>             09325000
        cdt'ptr,     << pointer to next/prior cdt entry  >>             09330000
        new'sectors; << cdt number of sectors to transfer>>             09335000
                                                                        09340000
double ldr'base'adr,    << base address specified in ldr entry        >>09345000
       ldr'upper'adr,   << upper address specified in ldr entry       >>09350000
       strategy'base,   << base address calculated by strategy routine>>09355000
       strategy'upper,  << upper address calculated by strategy       >>09360000
       prior'cdt'upper, << prior cdt's upper address                  >>09365000
       next'cdt'base,   << next cdt's base address                    >>09370000
       extent'base,     << file system extent base address            >>09375000
       extent'limit;    << file system extent limit address           >>09380000
                                                                        09385000
logical is'write;   << true if ldr is a write >>                        09390000
                                                                        09395000
<< variables for fast cdt access >>                            <<*7724>>09400000
integer mapd'offset,                                           <<*7724>>09405000
        temp'mapd'offset;                                      <<*7724>>09410000
                                                               <<*7724>>09415000
<< variable to access dst table via sst,lst >>                 <<*7724>>09420000
integer pointer dst   = %2;                                    <<*7724>>09425000
                                                               <<*7724>>09430000
<< re-define ldr'base'adr >>                                            09435000
integer ldr'p1  = ldr'base'adr,                                         09440000
        ldr'p2  = ldr'p1 + 1;                                           09445000
                                                               <<*7724>>09450000
                                                               <<*7724>>09455000
                                                               <<*7724>>09460000
                                                               <<*7724>>09465000
                                                               <<*7724>>09470000
                                                               <<*7724>>09475000
                                                               <<*7724>>09480000
$page                                                                   09485000
<< strategy subroutines >>                                              09490000
subroutine unknown;                                                     09495000
begin                                                                   09500000
                                                                        09505000
<< we can only use the bounds of the transfer >>                        09510000
strategy'base := ldr'base'adr;                                          09515000
strategy'upper := ldr'upper'adr;                                        09520000
                                                                        09525000
<< if this is a write, we will set the virgin bit to >>                 09530000
<< eliminate a unrequired read prior to the write.   >>                 09535000
if is'write then << this is a write >>                                  09540000
  begin                                                        <<06858>>09545000
$if x1=on                                                      <<*7724>>09550000
  cdt'set'bit(cdt'entry,cdt'virgin'bit,1);                              09555000
$if x1=off                                                     <<*7724>>09560000
  cdt'array(mapd'offset+cdt'md'flags).(cdt'virgin'bit:1):=1;   <<*7724>>09565000
$if                                                            <<*7724>>09570000
                                                               <<06858>>09575000
  << force do-post if necessary >>                             <<06858>>09580000
  if cdt'array(cdt'force'post) <> 0 then                       <<*7724>>09585000
    ldr'do'post := 1;                                          <<06858>>09590000
  end;                                                         <<06858>>09595000
                                                                        09600000
end;                                                                    09605000
$page                                                                   09610000
subroutine genmessage;                                                  09615000
begin                                                                   09620000
                                                                        09625000
<< genmessage always reads one block (record) before the >>             09630000
<< requested address.  this means that a "center" strategy>>            09635000
<< should be used.                                       >>             09640000
                                                                        09645000
if is'write then                                               <<06858>>09650000
  unknown                                                      <<06858>>09655000
else                                                           <<06858>>09660000
  begin                                                        <<06858>>09665000
  strategy'base := ldr'base'adr - double(sectors);             <<06858>>09670000
  if strategy'base < extent'base then                          <<06858>>09675000
    strategy'base := extent'base;                              <<06858>>09680000
                                                                        09685000
  new'sectors:=(cdt'array(cdt'rnd'minftch)/sectors)            <<*7724>>09690000
                * sectors;                                     <<06858>>09695000
  strategy'upper:=strategy'base + double(new'sectors);         <<06858>>09700000
                                                                        09705000
  << bounds check >>                                           <<06858>>09710000
  if strategy'upper < ldr'upper'adr then                       <<06858>>09715000
    begin  << we would have to exceed 32 sector limit >>       <<06858>>09720000
    strategy'base := ldr'base'adr;                             <<06858>>09725000
    strategy'upper := ldr'upper'adr;                           <<06858>>09730000
    end;                                                       <<06858>>09735000
                                                                        09740000
  if strategy'upper > extent'limit then                        <<06858>>09745000
    strategy'upper := extent'limit;                            <<06858>>09750000
  end;  << of read/genmsg strategy >>                          <<06858>>09755000
                                                                        09760000
end;  << of subroutine genmessage >>                                    09765000
$page                                                                   09770000
subroutine fs'sequential;                                               09775000
begin                                                                   09780000
                                                                        09785000
if is'write then                                               <<06858>>09790000
  unknown                                                      <<06858>>09795000
else                                                           <<06858>>09800000
  begin                                                        <<06858>>09805000
  << use base address of requested transfer >>                 <<06858>>09810000
  strategy'base := ldr'base'adr;                               <<06858>>09815000
                                                                        09820000
  <<use upper address of a multiple of block size, <= 8kb>>    <<06858>>09825000
  new'sectors:=(cdt'array(cdt'seq'minftch)/sectors)            <<*7724>>09830000
               *sectors;                                       <<06858>>09835000
  if new'sectors < sectors then <<less than originally requeste<<06858>>09840000
    new'sectors := sectors;   << round up to 1 block user reque<<06858>>09845000
                                                                        09850000
  << figure new upper address >>                               <<06858>>09855000
  strategy'upper := strategy'base + double(new'sectors);       <<06858>>09860000
                                                                        09865000
  << if beyond end-of-extent, truncate >>                      <<06858>>09870000
  if strategy'upper > extent'limit then                        <<06858>>09875000
    strategy'upper := extent'limit;                            <<06858>>09880000
  end;  << of read seq strategy >>                             <<06858>>09885000
                                                                        09890000
<< turn-on flags bit to indicate sequential access >>          <<06858>>09895000
$if x1=on                                                      <<*7724>>09900000
cdt'set'bit(cdt'entry,cdt'seq'bit,1);                          <<06858>>09905000
$if x1=off                                                     <<*7724>>09910000
cdt'array(mapd'offset+cdt'md'flags).(cdt'seq'bit:1):=1;        <<*7724>>09915000
$if                                                            <<*7724>>09920000
                                                               <<06858>>09925000
end;  << of fs'sequential strategy >>                                   09930000
$page                                                          <<06858>>09935000
subroutine fs'direct;                                          <<06858>>09940000
begin                                                          <<06858>>09945000
                                                               <<06858>>09950000
if is'write then                                               <<06858>>09955000
  unknown                                                      <<06858>>09960000
else                                                           <<06858>>09965000
  begin                                                        <<06858>>09970000
  << use base address of requested transfer >>                 <<06858>>09975000
  strategy'base := ldr'base'adr;                               <<06858>>09980000
                                                               <<06858>>09985000
  << use upper address of a multiple of block size, <= 8kb >>  <<06858>>09990000
  new'sectors:=(cdt'array(cdt'rnd'minftch)/sectors)            <<*7724>>09995000
                *sectors;                                      <<06858>>10000000
  if new'sectors < sectors then<<less than originally requested<<06858>>10005000
    new'sectors := sectors; << round up to 1 block user request<<06858>>10010000
                                                               <<06858>>10015000
  << figure new upper address >>                               <<06858>>10020000
  strategy'upper := strategy'base + double(new'sectors);       <<06858>>10025000
                                                               <<06858>>10030000
  << if beyond end-of-extent, truncate >>                      <<06858>>10035000
  if strategy'upper > extent'limit then                        <<06858>>10040000
    strategy'upper := extent'limit;                            <<06858>>10045000
                                                               <<06858>>10050000
  end; << of read/direct strategy >>                           <<06858>>10055000
end;  << of fs'direct strategy >>                              <<06858>>10060000
$page                                                                   10065000
subroutine strategy;                                                    10070000
begin                                                                   10075000
                                                               <<06858>>10080000
                                                               <<06858>>10085000
                                                               <<06858>>10090000
                                                               <<06858>>10095000
                                                               <<06858>>10100000
                                                               <<06858>>10105000
                                                               <<06858>>10110000
                                                               <<06858>>10115000
                                                               <<06858>>10120000
                                                               <<06858>>10125000
case caller of                                                 <<06858>>10130000
  begin                                                        <<06858>>10135000
                                                                        10140000
<<0>> unknown;            << unknown caller >>                 <<06858>>10145000
<<1>> unknown;            << unknown file system >>            <<06858>>10150000
<<2>> fs'sequential;      << spooler >>                        <<06858>>10155000
<<3>> unknown;            << directory >>                      <<06858>>10160000
<<4>> unknown;                                                 <<06858>>10165000
<<5>> unknown;                                                 <<06858>>10170000
<<6>> unknown;                                                 <<06858>>10175000
<<7>> unknown;                                                 <<06858>>10180000
<<8>> genmessage;         << genmsg >>                         <<06858>>10185000
<<9>> unknown;            << file system, quiesce i/o >>       <<06858>>10190000
<<10>> fs'sequential;     << fs, sequential, nobuf >>          <<06858>>10195000
<<11>> fs'direct;         << fs, direct, nobuf >>              <<06858>>10200000
<<12>> fs'sequential;     << fs, sequential, buf >>            <<06858>>10205000
<<13>> fs'direct;         << fs, direct, buf >>                <<06858>>10210000
<<14>> fs'direct;         << fs, ksam >>                       <<06858>>10215000
<<15>> fs'direct;         << fs, image >>                      <<06858>>10220000
                                                                        10225000
  end;  << of case on caller >>                                <<06858>>10230000
                                                                        10235000
                                                               <<06858>>10240000
                                                               <<06858>>10245000
end;  << of subroutine strategy >>                                      10250000
$page                                                                   10255000
<< procedure mainline >>                                                10260000
                                                                        10265000
$if x1=on                                                               10270000
mmstat'(mmstat'strategy,cdt'entry,ldr'entry'index,ldr'strategy,<<07311>>10275000
        0,0,0);                                                <<07311>>10280000
$if                                                                     10285000
                                                                        10290000
mapd'offset := cdt'entry * cdt'entry'size;                     <<*7724>>10295000
                                                               <<*7724>>10300000
<< put db at ldr entry for fast access >>                      <<*7724>>10305000
tos := dst((ldr'dst & asl(2)) + 2);  << dst bank on tos >>     <<*7724>>10310000
tos := dst(cdt'x:=cdt'x+1);          << dst offset on tos >>   <<*7724>>10315000
tos := tos + ldr'entry'index;        << point to entry >>      <<*7724>>10320000
exchdb;                                                        <<*7724>>10325000
                                                               <<*7724>>10330000
is'write := if ldr'db'func = writereq then true else false;    <<*7724>>10335000
                                                                        10340000
<< load ldr constants locally >>                                        10345000
tos := ldr'db'count;                                           <<*7724>>10350000
if < then                                                               10355000
  count := ((-tos)+1) & lsr(1)                                          10360000
else                                                                    10365000
  count := tos;  << make words >>                                       10370000
sectors := (count + 127) & lsr(7); << divide by 128 >>                  10375000
caller := ldr'db'strategy;  << caller's code >>                <<*7724>>10380000
<< load p1,p2 >>                                                        10385000
ldr'p1 := ldr'db'parm1;                                        <<*7724>>10390000
ldr'p2 := ldr'db'parm2;                                        <<*7724>>10395000
ldr'upper'adr := ldr'base'adr + double(sectors);                        10400000
                                                                        10405000
<< load extent base from disc request >>                                10410000
tos := ldr'db'b'hoda;                                          <<*7724>>10415000
tos := ldr'db'b'loda;                                          <<*7724>>10420000
if (extent'base := tos) > ldr'base'adr then                             10425000
  extent'base := ldr'base'adr;                                          10430000
                                                                        10435000
tos := ldr'l'hoda;                                                      10440000
tos := ldr'l'loda;                                                      10445000
if (extent'limit := tos) < ldr'upper'adr then                           10450000
  extent'limit := ldr'upper'adr;                                        10455000
                                                                        10460000
<< put db back to caller's (pointing to cdt) db >>             <<*7724>>10465000
exchdb;                                                        <<*7724>>10470000
asmb(ddel);                                                    <<*7724>>10475000
                                                               <<*7724>>10480000
<< get prior cdt's upper disc address >>                                10485000
cdt'ptr := cdt'array(mapd'offset+cdt'md'prev);                 <<*7724>>10490000
if cdt'ptr = 0 then                                                     10495000
  begin  << there is no previous, so assume 0 >>                        10500000
  prior'cdt'upper := 0d;                                                10505000
  end                                                                   10510000
else                                                                    10515000
  begin  << get prior cdt's upper address >>                            10520000
  temp'mapd'offset := cdt'ptr * cdt'entry'size;                <<*7724>>10525000
$if x1=on                                                      <<*7724>>10530000
  prior'cdt'upper := cdt'get'double(cdt'ptr,cdt'md'end'sector,0d);      10535000
$if x1=off                                                     <<*7724>>10540000
  prior'cdt'upper := cdt'darray((temp'mapd'offset +            <<*7724>>10545000
                              cdt'md'end'sector) & asr(1));    <<*7724>>10550000
$if                                                            <<*7724>>10555000
  end;                                                                  10560000
                                                                        10565000
<< get next cdt's base disc address >>                                  10570000
cdt'ptr := cdt'array(mapd'offset+cdt'md'next);                 <<*7724>>10575000
if cdt'ptr = 0 then                                                     10580000
  begin << there is no next cdt, so assume highest disc address >>      10585000
  next'cdt'base := %17777777777 d;  << highest possible address >>      10590000
  end                                                                   10595000
else                                                                    10600000
  begin  << get next cdt's base address >>                              10605000
$if x1=on                                                      <<*7724>>10610000
  next'cdt'base := cdt'get'double(cdt'ptr,cdt'md'sector,0d);            10615000
$if x1=off                                                     <<*7724>>10620000
  next'cdt'base := cdt'darray(((cdt'ptr*cdt'entry'size) +      <<*7724>>10625000
                            cdt'md'sector) & asr(1));          <<*7724>>10630000
$if                                                            <<*7724>>10635000
  end;                                                                  10640000
                                                                        10645000
strategy;                                                               10650000
                                                                        10655000
<< bounds check strategy applied >>                                     10660000
if strategy'base < prior'cdt'upper then  << must adjust >>              10665000
  strategy'base := prior'cdt'upper;                                     10670000
if strategy'upper > next'cdt'base then                                  10675000
  strategy'upper := next'cdt'base;                                      10680000
                                                                        10685000
<< place disc domain in cdt entry >>                                    10690000
$if x1=on                                                      <<*7724>>10695000
cdt'set'double(cdt'entry,cdt'md'sector,strategy'base);                  10700000
cdt'set'double(cdt'entry,cdt'md'end'sector,strategy'upper);             10705000
$if x1=off                                                     <<*7724>>10710000
cdt'darray((mapd'offset+cdt'md'sector)&asr(1)):=strategy'base; <<*7724>>10715000
                                                               <<*7724>>10720000
cdt'darray((mapd'offset+cdt'md'end'sector)&asr(1)):=           <<*7724>>10725000
   strategy'upper;                                             <<*7724>>10730000
$if                                                            <<*7724>>10735000
                                                                        10740000
end;  << of procedure cdt'strategy >>                                   10745000
$page "CDT'INITIATOR / CDT'COMPLETOR procedure"                         10750000
procedure cdt'initiator(cdt'entry,disc'req);                            10755000
value cdt'entry,disc'req;                                               10760000
integer cdt'entry,disc'req;                                             10765000
option privileged,uncallable,internal;                         <<06858>>10770000
begin                                                                   10775000
                                                                        10780000
<<********************************************************************>>10785000
<< this procedure processes requests to "queue" disc requests to an   >>10790000
<< existing cdt entry for a new request, and to "dequeue" disc re-    >>10795000
<< quests when the 'move' has been satisfied by the cache completor   >>10800000
<< code.  on initiation, it is assumed that we are running in the     >>10805000
<< caller's process environment.  a call to "PREFETCH" is made which  >>10810000
<< might add this cdt entry to the processes locality.  on completion,>>10815000
<< this routine will perform housekeeping to determine if deferred    >>10820000
<< requests can be released for processing.                           >>10825000
<<                                                                    >>10830000
<< the parameters passed to this procedure are:                       >>10835000
<<                                                                    >>10840000
<< cdt'entry    - this is the index of the cdt entry to be manipulated>>10845000
<< disc'req     - this is the index of the disc request to be attached>>10850000
<<                or released from this procedure.  when the initiator>>10855000
<<                is called, this ldr entry is attached to either the >>10860000
<<                "active" or "deferred" queue on this cdt.  when the >>10865000
<<                "completor" is called, this entry must be the head  >>10870000
<<                entry on this cdt's active list.                    >>10875000
<<                                                                    >>10880000
<< it is assumed that we are already pdisabled when entering this     >>10885000
<< routine.  also, there is no assumption made of where db is sitting.>>10890000
<<********************************************************************>>10895000
                                                                        10900000
entry cdt'completor;   << this is called to "complete" a ldr attached >>10905000
                       << to a cdt.                                   >>10910000
                                                                        10915000
<< variable to satisfy the ldr's include file >>                        10920000
integer ldr'entry'index;                                                10925000
                                                                        10930000
integer next'pointer,  << used to chase down linked ldr's >>            10935000
        save'ldr,      << cell to save passed disc'req value >>         10940000
        state,         << cdt state (saved locally)       >>            10945000
        cdt'flgs,      << flags word in cdt entry         >>            10950000
        lkd'cdt,       << cdt entry of locked cdt         >>            10955000
        dev'entry,     << device entry number             >>            10960000
        sendmsgflags,  << flags parameter to send msg     >>            10965000
        currentpin,    << pin of currently executing process>>          10970000
        impeded'pin,   << head pin waiting on write compl'n >>          10975000
        next'pin,      << next pin waiting on write compl'n >>          10980000
        function;      << i/o function from disc request  >>            10985000
                                                                        10990000
logical continue'loop, << loop control flag >>                          10995000
        first'time;    << loop control flag >>                          11000000
                                                                        11005000
double region'address,   << cdt memory address >>              <<06858>>11010000
       object'id;      << object id of cache domain         >> <<06858>>11015000
                                                               <<06858>>11020000
<< variables for fast access to cdt >>                         <<*7724>>11025000
integer ldev'offset,       << ldev entry offset in cdt   >>    <<*7724>>11030000
        mapd'offset;       << mapd entry offset in cdt   >>    <<*7724>>11035000
                                                               <<*7724>>11040000
double  save'db;           << value of caller's db       >>    <<*7724>>11045000
                                                               <<*7724>>11050000
                                                               <<*7724>>11055000
                                                               <<*7724>>11060000
                                                               <<*7724>>11065000
                                                               <<*7724>>11070000
                                                               <<*7724>>11075000
                                                               <<*7724>>11080000
                                                               <<*7724>>11085000
$page                                                                   11090000
subroutine release'cdt;                                                 11095000
begin                                                                   11100000
                                                                        11105000
<< if in-motion out bit is set, we must hold on to the cdt entry >>     11110000
$if x1=on                                                      <<*7724>>11115000
tos := cdt'get'word(cdt'entry,cdt'md'flags,0);                 <<*7724>>11120000
$if x1=off                                                     <<*7724>>11125000
tos := cdt'array(mapd'offset+cdt'md'flags);                    <<*7724>>11130000
$if                                                            <<*7724>>11135000
if tos.(cdt'imo'bit:1) = 1 then                                <<*7724>>11140000
  begin     << deferred posting is still in progress >>                 11145000
  end                                                                   11150000
                                                                        11155000
else                                                                    11160000
                                                                        11165000
  begin                                                                 11170000
                                                                        11175000
$if x7=on                                                      <<06858>>11180000
  << if there was a locked cdt, decrement its lock cnt >>               11185000
  lkd'cdt := cdt'get'word(cdt'entry,cdt'md'lkd'cdt,0);                  11190000
  if lkd'cdt <> 0 then                                                  11195000
    begin                                                               11200000
    if cdt'add'word(lkd'cdt,cdt'md'lk'cnt,-1) <= 1 then                 11205000
      cdt'completor(lkd'cdt,0); << awaken locked entry >>               11210000
    end;                                                                11215000
$if                                                            <<06858>>11220000
                                                                        11225000
  << get ldev cdt entry index >>                                        11230000
  dev'entry := cdt'array(mapd'offset+cdt'md'de);               <<d7726>>11235000
  ldev'offset := dev'entry * cdt'entry'size;                   <<*7724>>11240000
                                                                        11245000
  << if this was a sequential access and the last block >>     <<06858>>11250000
  << of the memory region was touched, delete the memory>>     <<06858>>11255000
  << region from main memory.                           >>     <<06858>>11260000
$if x1=on                                                      <<*7724>>11265000
  tos := cdt'get'word(cdt'entry,cdt'md'flags,0);               <<*7724>>11270000
$if x1=off                                                     <<*7724>>11275000
  tos := cdt'array(mapd'offset+cdt'md'flags);                  <<*7724>>11280000
$if                                                            <<*7724>>11285000
  if tos.(cdt'seq'bit:1) = 1 then                              <<*7724>>11290000
    begin                                                      <<06858>>11295000
    ldr'entry'index := disc'req;                               <<06858>>11300000
    if <> then                                                 <<06858>>11305000
      begin                                                    <<06858>>11310000
      << place ldr logical disc address on tos >>              <<06858>>11315000
      tos := ldr'parm1;                                        <<06858>>11320000
      tos := ldr(cdt'x:=cdt'x + 1);                            <<06858>>11325000
      tos := 0;   << add sector offset to it >>                <<06858>>11330000
      tos := ldr'count;                                        <<06858>>11335000
      if < then tos := ((-tos)+1) & lsr(1);  << make words>>   <<06858>>11340000
      tos := (tos+127) & lsr(7); << make sectors >>            <<06858>>11345000
      asmb(dadd);   << form end sector address >>              <<06858>>11350000
      << get domain's ending disc address >>                   <<*7724>>11355000
$if x1=on                                                      <<*7724>>11360000
      tos := cdt'get'double(cdt'entry,cdt'md'end'sector,0d);   <<*7724>>11365000
$if x1=off                                                     <<*7724>>11370000
      tos:=cdt'darray((mapd'offset+cdt'md'end'sector)&asr(1)); <<*7724>>11375000
$if                                                            <<*7724>>11380000
                                                               <<*7724>>11385000
      << now, see if they match >>                             <<*7724>>11390000
      asmb(dcmp);                                              <<*7724>>11395000
      if = then   << they do, so plan to erode the domain >>   <<*7724>>11400000
         begin                                                 <<*7724>>11405000
$if x1=on                                                      <<*7724>>11410000
         region'address:=cdt'get'double(cdt'entry,             <<06858>>11415000
                         cdt'md'mem'addr,0d);                  <<*7724>>11420000
                                                               <<*7724>>11425000
                                                               <<*7724>>11430000
$if x1=off                                                     <<*7724>>11435000
         region'address := cdt'darray((mapd'offset +           <<*7724>>11440000
                                 cdt'md'mem'addr) & asr(1));   <<*7724>>11445000
         end                                                   <<*7724>>11450000
      else                                                     <<*7724>>11455000
         region'address:=0d;                                   <<*7724>>11460000
      end                                                      <<06858>>11465000
    else                                                       <<06858>>11470000
      << if no ldr, this is no'post write >>                   <<06858>>11475000
      begin                                                    <<*7724>>11480000
$if x1=on                                                      <<*7724>>11485000
      region'address:=cdt'get'double(cdt'entry,cdt'md'mem'addr,<<06858>>11490000
                      0d);                                     <<06858>>11495000
$if x1=off                                                     <<*7724>>11500000
      region'address := cdt'darray((mapd'offset +              <<*7724>>11505000
                                  cdt'md'mem'addr) & asr(1));  <<*7724>>11510000
$if                                                            <<*7724>>11515000
      end;                                                     <<*7724>>11520000
    <<if non-zero region'address, we must purge memory region>><<06858>>11525000
    if region'address <> 0d then                               <<06858>>11530000
      begin                                                    <<06858>>11535000
      << put db at sysdb for kernel >>                         <<*7724>>11540000
      tos := %1000 d;                                          <<*7724>>11545000
      exchdb;                                                  <<*7724>>11550000
                                                               <<*7724>>11555000
      << convert to standard segment id >>                     <<*7724>>11560000
      object'id := buildobjid(mappeddomainobject,              <<*7724>>11565000
                              cdt'entry,0);                    <<*7724>>11570000
      << if not absent, make it an oc >>                       <<*7724>>11575000
      if not isobjectabsent(object'id) then                    <<*7724>>11580000
        makeoc(0,                                              <<*7724>>11585000
               object'id,                                      <<*7724>>11590000
               0,  << request size >>                          <<*7724>>11595000
               region'address);                                <<*7724>>11600000
                                                               <<*7724>>11605000
      << put db back to cdt >>                                 <<*7724>>11610000
      exchdb;                                                  <<*7724>>11615000
      asmb(ddel);                                              <<*7724>>11620000
      end;                                                     <<*7724>>11625000
                                                               <<*7724>>11630000
                                                               <<*7724>>11635000
                                                               <<*7724>>11640000
                                                               <<*7724>>11645000
                                                               <<*7724>>11650000
                                                               <<*7724>>11655000
    end;  << of processing sequential i/o special case >>      <<06858>>11660000
                                                               <<06858>>11665000
  << release cdt entry >>                                               11670000
  cdt'rel'md'entry(dev'entry,cdt'entry);                                11675000
                                                               <<06858>>11680000
  end;                                                                  11685000
                                                                        11690000
end;                                                                    11695000
$page                                                                   11700000
subroutine unimpede'waitors;                                            11705000
begin                                                                   11710000
                                                                        11715000
<< any processes waiting for writes to complete will be >>              11720000
<< awaked here.  originally, they were impeded in proc. >>              11725000
<< cdt'force'ldr'completion.                            >>              11730000
<<********** db must be at sysdb ***********************>>     <<*7724>>11735000
                                                                        11740000
<< get pin of any waitor & unimpede them                >>              11745000
impeded'pin:=cdt'set'word(cdt'entry,cdt'md'impeded,0);         <<06858>>11750000
while impeded'pin <> 0 do                                               11755000
  begin                                                                 11760000
                                                                        11765000
  << take off pcb list >>                                               11770000
  next'pin := unstringheadpin(impeded'pin);                             11775000
                                                                        11780000
  << awaken process >>                                                  11785000
  unimpede(impeded'pin * pcbsize);                                      11790000
                                                                        11795000
  impeded'pin := next'pin;                                     <<06858>>11800000
                                                                        11805000
  end;                                                                  11810000
                                                                        11815000
end;  << of subroutine unimpede'waitors >>                              11820000
$page                                                                   11825000
subroutine move'queue;                                                  11830000
begin                                                                   11835000
                                                                        11840000
<< this subroutine moves disc requests from the 'impeded' to>>          11845000
<< the 'available' queue.  the first element is always moved>>          11850000
<< and afterwards will continue until the first 'write' is  >>          11855000
<< encountered.                                             >>          11860000
                                                                        11865000
continue'loop := first'time := true;  << loop control >>                11870000
                                                                        11875000
while continue'loop do                                                  11880000
  begin                                                                 11885000
$if x1=on                                                      <<*7724>>11890000
  ldr'entry'index := cdt'get'word(cdt'entry,cdt'md'imped'hd,0);         11895000
$if x1=off                                                     <<*7724>>11900000
  ldr'entry'index := cdt'array(mapd'offset+cdt'md'imped'hd);   <<*7724>>11905000
$if                                                            <<*7724>>11910000
  if ldr'entry'index = 0 then                                           11915000
    continue'loop := false                                              11920000
  else                                                                  11925000
    begin  << try to move over to active list >>                        11930000
    << if this is a write, we must be careful >>                        11935000
    if ldr'func = writereq then                                         11940000
      begin                                                             11945000
      if first'time then                                                11950000
        begin  << we can move only this "write" >>                      11955000
        cdt'dequeue'ldr(cdt'entry,ldr'entry'index,cdt'md'imped'hd);     11960000
        cdt'queue'ldr(cdt'entry,ldr'entry'index,cdt'md'ldr'head);       11965000
        first'time := false;                                            11970000
        end                                                             11975000
      else                                                              11980000
        continue'loop := false;                                         11985000
      end                                                               11990000
    else                                                                11995000
      begin  << this is a read, so just move it >>                      12000000
      cdt'dequeue'ldr(cdt'entry,ldr'entry'index,cdt'md'imped'hd);       12005000
      cdt'queue'ldr(cdt'entry,ldr'entry'index,cdt'md'ldr'head);         12010000
      end;                                                              12015000
    end;                                                                12020000
  end;  << of looping through while stmt >>                             12025000
                                                                        12030000
<< inform cdt processor routine that new requests exist >>              12035000
                                                                        12040000
$if x1=on                                                      <<*7724>>12045000
ldr'entry'index:=cdt'get'word(cdt'entry,cdt'md'ldr'head,0);             12050000
$if x1=off                                                     <<*7724>>12055000
ldr'entry'index := cdt'array(mapd'offset+cdt'md'ldr'head);     <<*7724>>12060000
$if                                                            <<*7724>>12065000
if ldr'entry'index <> 0 then                                   <<*7724>>12070000
   begin                                                                12075000
   << put db to sysdb >>                                       <<*7724>>12080000
   tos := %1000 d;                                             <<*7724>>12085000
   exchdb;                                                     <<*7724>>12090000
                                                               <<*7724>>12095000
   tos := cdt'entry;                                                    12100000
   tos := iostatusok;                                                   12105000
   tos := cachemovereadycode;                                           12110000
   sendmsgflags:=0;                                                     12115000
   if (currentpin := (curprc/pcbsize)) <> 0                    <<06857>>12120000
   and processpri(ldr'pcb) >= processpri(currentpin)                    12125000
   then sendmsgflags.msgdon'tpreemptflag := 1;                          12130000
   sendmsg(schedpin,cachemoveport,3,sendmsgflags);                      12135000
                                                                        12140000
  << unimpede anybody waiting on write completions >>                   12145000
  unimpede'waitors;                                                     12150000
                                                                        12155000
  << put db back to cdt >>                                     <<*7724>>12160000
  exchdb;                                                      <<*7724>>12165000
  asmb(ddel);                                                  <<*7724>>12170000
  end;                                                                  12175000
<< restore current disc request pointer >>                              12180000
ldr'entry'index := disc'req;                                            12185000
                                                                        12190000
end;                                                                    12195000
$page                                                                   12200000
subroutine wake'ldr;                                                    12205000
begin                                                                   12210000
                                                                        12215000
if  disc'req <> 0 then                                                  12220000
  begin                                                                 12225000
  tos := %1000 d;                                              <<*7724>>12230000
  exchdb;                                                      <<*7724>>12235000
                                                                        12240000
  << tos := entry index >>                                     <<06856>>12245000
  ldr'entry'index := disc'req;  << peg ldr defs >>             <<*7727>>12250000
                                                               <<*7727>>12255000
                                                               <<*7727>>12260000
                                                               <<*7727>>12265000
<<       in    line    siodm'request'done      >>              <<*7727>>12270000
                                                               <<*7727>>12275000
                                                               <<*7727>>12280000
                                                               <<*7727>>12285000
  if ldr'done  then  suddendeath(261);                         <<*7727>>12290000
  ldr'done := 1;                                               <<*7727>>12295000
  tos := ldr'pcb;                                              <<*7727>>12300000
  if  ldr'iowake   then                                        <<*7727>>12305000
    begin                                                      <<*7727>>12310000
    tos := s0 * pcbsize;                                       <<*7727>>12315000
    tos:=if ldr'blocked then biowaitcode else uiowaitcode;     <<*7727>>12320000
    tos := nowait;                                             <<*7727>>12325000
    awake(*,*,*);                                              <<*7727>>12330000
    end;                                                       <<*7727>>12335000
                                                               <<*7727>>12340000
                                                               <<*7727>>12345000
  if tos = 0   then   <<  no   pcb  >>                         <<*7727>>12350000
    begin                                                      <<*7727>>12355000
    if ldr'sbuf  then                                          <<*7727>>12360000
      if ldr'bufadr   <>  0 then                               <<*7727>>12365000
        returnsysbuf(ldr'bufadr);                              <<*7727>>12370000
    returndiscreq(ldr'entry'index);                            <<*7727>>12375000
    end;                                                       <<*7727>>12380000
                                                               <<*7727>>12385000
                                                               <<*7727>>12390000
                                                               <<*7727>>12395000
                                                               <<*7727>>12400000
                                                                        12405000
  exchdb;                                                      <<*7724>>12410000
  asmb(ddel);                                                  <<*7724>>12415000
  end;                                                                  12420000
                                                                        12425000
end;                                                                    12430000
$page                                                                   12435000
subroutine setstate(state'type);                                        12440000
value state'type;                                                       12445000
integer state'type;                                                     12450000
begin                                                                   12455000
                                                                        12460000
disable;                                                       <<06858>>12465000
$if x1=on                                                      <<*7724>>12470000
cdt'flgs := cdt'get'word(cdt'entry,cdt'md'flags,0);                     12475000
cdt'flgs.cdt'md'state := state'type;                                    12480000
cdt'set'word(cdt'entry,cdt'md'flags,cdt'flgs);                          12485000
$if x1=off                                                     <<*7724>>12490000
cdt'x := mapd'offset+cdt'md'flags;                             <<*7724>>12495000
cdt'array(cdt'x).cdt'md'state := state'type;                   <<*7724>>12500000
$if                                                            <<*7724>>12505000
enable;                                                        <<06858>>12510000
                                                                        12515000
end;                                                                    12520000
$page                                                                   12525000
subroutine do'prefetch;                                                 12530000
begin                                                                   12535000
                                                                        12540000
tos := %1000 d;                                                <<*7724>>12545000
exchdb;                                                        <<*7724>>12550000
                                                               <<*7724>>12555000
<< indicate that md is now in prefetch locality of process >>  <<*7724>>12560000
tos := ldr'flags;                                              <<*7724>>12565000
tos.(ldr'inloc'bit:1) := 1;                                    <<*7724>>12570000
if <> then   << already set... problems >>                     <<*7724>>12575000
  suddendeath(sfkerncacheintbad);                              <<*7724>>12580000
ldr(cdt'x) := tos;                                             <<*7724>>12585000
prefetchobject(ldr'pcb,    << pin of requestor >>                       12590000
              buildobjid(mappeddomainobject,                            12595000
                         cdt'entry,                                     12600000
                         0 <<pin>>)); << cdt object number >>           12605000
exchdb;                                                        <<*7724>>12610000
asmb(ddel);                                                    <<*7724>>12615000
                                                                        12620000
end;                                                                    12625000
$page                                                                   12630000
subroutine init;                                                        12635000
begin                                                                   12640000
                                                                        12645000
<< this routine initializes variables for either entry point >>         12650000
                                                               <<*7724>>12655000
mapd'offset := cdt'entry * cdt'entry'size;                     <<*7724>>12660000
                                                                        12665000
<< put db at cdt >>                                            <<*7724>>12670000
cdt'abs'on'tos;                                                <<*7724>>12675000
exchdb;                                                        <<*7724>>12680000
save'db := tos;                                                <<*7724>>12685000
                                                               <<*7724>>12690000
<< if there is a disc request, place cdt# in it >>                      12695000
ldr'entry'index := disc'req;  << point to passed ldr >>        <<*7724>>12700000
if <> then                                                              12705000
  begin                                                                 12710000
  ldr'cdt := cdt'entry;                                                 12715000
  function := ldr'func;                                                 12720000
  end                                                                   12725000
else                                                                    12730000
  function := -1;                                                       12735000
                                                                        12740000
$if x1=on                                                      <<*7724>>12745000
state := cdt'get'word(cdt'entry,cdt'md'flags,0).cdt'md'state;           12750000
$if x1=off                                                     <<*7724>>12755000
state := cdt'array(mapd'offset+cdt'md'flags).cdt'md'state;     <<*7724>>12760000
$if                                                            <<*7724>>12765000
                                                                        12770000
end;                                                                    12775000
$page                                                                   12780000
<< this is the procedure initiator point >>                             12785000
$if x1=on                                                               12790000
mmstat'(mmstat'initiator,cdt'entry,disc'req,0,0,0,0);          <<06859>>12795000
$if                                                                     12800000
                                                                        12805000
init;                                                                   12810000
                                                                        12815000
case state of                                                           12820000
  begin                                                                 12825000
                                                                        12830000
  <<0>> << cdt is available, on free list >>                            12835000
  begin                                                                 12840000
  if function = readreq then                                            12845000
    begin << it's a read >>                                             12850000
    setstate(cdt'read'state);                                           12855000
    cdt'queue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);                  12860000
$if x1=on                                                      <<*7724>>12865000
    cdt'add'word(cdt'entry,cdt'md'read'cnt,1);                          12870000
$if x1=off                                                     <<*7724>>12875000
    cdt'x := mapd'offset + cdt'md'read'cnt;                    <<*7724>>12880000
    cdt'array(cdt'x) := cdt'array(cdt'x) + 1;                  <<*7724>>12885000
$if                                                            <<*7724>>12890000
    do'prefetch;                                                        12895000
    end                                                                 12900000
  else                                                                  12905000
    begin << it's a write >>                                            12910000
    setstate(cdt'write'state);                                          12915000
    cdt'queue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);                  12920000
$if x1=on                                                      <<*7724>>12925000
    cdt'add'word(cdt'entry,cdt'md'write'cnt,1);                         12930000
$if x1=off                                                     <<*7724>>12935000
    cdt'x := mapd'offset + cdt'md'write'cnt;                   <<*7724>>12940000
    cdt'array(cdt'x) := cdt'array(cdt'x) + 1;                  <<*7724>>12945000
$if                                                            <<*7724>>12950000
    do'prefetch;                                                        12955000
    end;                                                                12960000
  end;                                                                  12965000
                                                                        12970000
  <<1>> << cdt is in a read state >>                                    12975000
  begin                                                                 12980000
  if function = readreq then                                            12985000
    begin << it's a read >>                                             12990000
    cdt'queue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);                  12995000
$if x1=on                                                      <<*7724>>13000000
    cdt'add'word(cdt'entry,cdt'md'read'cnt,1);                          13005000
$if x1=off                                                     <<*7724>>13010000
    cdt'x := mapd'offset + cdt'md'read'cnt;                    <<*7724>>13015000
    cdt'array(cdt'x) := cdt'array(cdt'x) + 1;                  <<*7724>>13020000
$if                                                            <<*7724>>13025000
    do'prefetch;                                                        13030000
    end                                                                 13035000
  else                                                                  13040000
    begin << it's a write >>                                            13045000
    setstate(cdt'write'state);                                          13050000
    cdt'queue'ldr(cdt'entry,disc'req,cdt'md'imped'hd);                  13055000
$if x1=on                                                      <<*7724>>13060000
    cdt'add'word(cdt'entry,cdt'md'write'cnt,1);                         13065000
$if x1=off                                                     <<*7724>>13070000
    cdt'x := mapd'offset + cdt'md'write'cnt;                   <<*7724>>13075000
    cdt'array(cdt'x) := cdt'array(cdt'x) + 1;                  <<*7724>>13080000
$if                                                            <<*7724>>13085000
    do'prefetch;                                                        13090000
    end;                                                                13095000
  end;                                                                  13100000
                                                                        13105000
  <<2>> << cdt is in a write state >>                                   13110000
  begin                                                                 13115000
  if function = readreq then                                            13120000
    begin << it's a read >>                                             13125000
                                                                        13130000
    << if there is only one writer, we can allow other >>               13135000
    << readers to access domain.                       >>               13140000
    if cdt'array(mapd'offset+cdt'md'write'cnt) <= 1 then       <<*7724>>13145000
      cdt'queue'ldr(cdt'entry,disc'req,cdt'md'ldr'head)                 13150000
    else                                                                13155000
      cdt'queue'ldr(cdt'entry,disc'req,cdt'md'imped'hd);                13160000
$if x1=on                                                      <<*7724>>13165000
    cdt'add'word(cdt'entry,cdt'md'read'cnt,1);                          13170000
$if x1=off                                                     <<*7724>>13175000
    cdt'x := mapd'offset + cdt'md'read'cnt;                    <<*7724>>13180000
    cdt'array(cdt'x) := cdt'array(cdt'x) + 1;                  <<*7724>>13185000
$if                                                            <<*7724>>13190000
    do'prefetch;                                                        13195000
    end                                                                 13200000
  else                                                                  13205000
    begin << it's a write >>                                            13210000
    cdt'queue'ldr(cdt'entry,disc'req,cdt'md'imped'hd);                  13215000
$if x1=on                                                      <<*7724>>13220000
    cdt'add'word(cdt'entry,cdt'md'write'cnt,1);                         13225000
$if x1=off                                                     <<*7724>>13230000
    cdt'x := mapd'offset + cdt'md'write'cnt;                   <<*7724>>13235000
    cdt'array(cdt'x) := cdt'array(cdt'x) + 1;                  <<*7724>>13240000
$if                                                            <<*7724>>13245000
    do'prefetch;                                                        13250000
    end;                                                                13255000
  end;                                                                  13260000
                                                                        13265000
  <<3>> << cdt is being flushed and should not receive requests >>      13270000
  suddendeath(cdt'invalid'state);                                       13275000
                                                                        13280000
  <<4>> << cdt is locked, awaiting other cdt's to "flush" >>            13285000
  begin                                                                 13290000
  cdt'queue'ldr(cdt'entry,disc'req,cdt'md'imped'hd);                    13295000
  end;                                                                  13300000
                                                                        13305000
  end;  << of case on state >>                                          13310000
                                                                        13315000
go to leave'routine;  << perform exit housekeeping >>                   13320000
$page                                                                   13325000
<< completor entry point into procedure >>                              13330000
cdt'completor:                                                          13335000
                                                                        13340000
$if x1=on                                                               13345000
mmstat'(mmstat'initiator,cdt'entry,disc'req,1,0,0,0);          <<06859>>13350000
$if                                                                     13355000
                                                                        13360000
init;  << initialize variables >>                                       13365000
                                                                        13370000
case state of                                                           13375000
  begin                                                                 13380000
                                                                        13385000
  <<0>> << the cdt should have no requests pending (avail).  this case>>13390000
        << may be used by kernel to finish a write which has been     >>13395000
        << already reported as "completed" to the user.               >>13400000
  begin                                                                 13405000
  release'cdt;                                                          13410000
  end;                                                                  13415000
                                                                        13420000
  <<1>> << read state >>                                                13425000
  begin                                                                 13430000
  if function = readreq then                                            13435000
    begin << it's a read >>                                             13440000
    cdt'dequeue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);                13445000
$if x1=on                                                      <<*7724>>13450000
    tos := cdt'add'word(cdt'entry,cdt'md'read'cnt,-1);         <<*7724>>13455000
$if x1=off                                                     <<*7724>>13460000
    cdt'x := mapd'offset + cdt'md'read'cnt;                    <<*7724>>13465000
    tos := cdt'array(cdt'x) := cdt'array(cdt'x) - 1;           <<*7724>>13470000
$if                                                            <<*7724>>13475000
    if tos = 0 then                                            <<*7724>>13480000
      begin << read count is zero, remove this cdt entry >>             13485000
      setstate(cdt'avail'state);                                        13490000
      release'cdt;                                                      13495000
      end;                                                              13500000
    end                                                                 13505000
  else                                                                  13510000
    begin << it's a write >>                                            13515000
    suddendeath(cdt'invalid'state);                                     13520000
    end;                                                                13525000
                                                                        13530000
  << waken request >>                                                   13535000
  wake'ldr;                                                             13540000
  end;                                                                  13545000
                                                                        13550000
  <<2>> << write state >>                                               13555000
  begin                                                                 13560000
  if function = readreq then                                            13565000
    begin << it's a read >>                                             13570000
    cdt'dequeue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);                13575000
$if x1=on                                                      <<*7724>>13580000
    cdt'add'word(cdt'entry,cdt'md'read'cnt,-1);                         13585000
$if x1=off                                                     <<*7724>>13590000
    cdt'x := mapd'offset + cdt'md'read'cnt;                    <<*7724>>13595000
    cdt'array(cdt'x) := cdt'array(cdt'x) - 1;                  <<*7724>>13600000
$if                                                            <<*7724>>13605000
                                                                        13610000
    << if the cdt's active queue is empty, move requests >>             13615000
    << over from the pending queue.                      >>             13620000
    if cdt'array(mapd'offset+cdt'md'ldr'head) = 0 and          <<s7729>>13625000
       cdt'array(mapd'offset+cdt'md'flags).cdt'nopost = 0 then <<s7729>>13630000
                                                               <<s7729>>13635000
       << don't let any more writes onto the active queue    >><<s7729>>13640000
       << until any pending no-wait-on-posts have completed. >><<s7729>>13645000
                                                               <<s7729>>13650000
                                                               <<s7729>>13655000
      move'queue;                                                       13660000
    end                                                                 13665000
  else                                                                  13670000
    begin << it's a write >>                                            13675000
    if disc'req = 0 then                                                13680000
      begin  << this must be a nopost i/o completion >>                 13685000
      cdt'array(mapd'offset+cdt'md'flags).                     <<*7724>>13690000
                (cdt'wait'on'nopost:1) := 0;                   <<*7724>>13695000
      if = then                                                <<*7724>>13700000
        suddendeath(cdt'logic'problem);<< we got problems...>>          13705000
      end                                                               13710000
    else                                                                13715000
      begin << see if this is a nopost move completion >>               13720000
      if not ldr'do'post then                                  <<06858>>13725000
        begin  << yes, so don't decrement write count yet >>            13730000
        cdt'array(mapd'offset+cdt'md'flags).                   <<*7724>>13735000
                  (cdt'wait'on'nopost:1) := 1;                 <<*7724>>13740000
        if <>                                                  <<*7724>>13745000
          then suddendeath(cdt'logic'problem);                          13750000
        end;                                                            13755000
      cdt'dequeue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);              13760000
      end;                                                              13765000
                                                                        13770000
    << if we aren't waiting on a no-post completion, continue>>         13775000
    if cdt'array(mapd'offset+cdt'md'flags).                    <<*7724>>13780000
                 (cdt'wait'on'nopost:1) = 0 then               <<*7724>>13785000
      begin                                                             13790000
      cdt'x := mapd'offset + cdt'md'write'cnt;                 <<*7724>>13795000
      tos := cdt'array(cdt'x) := cdt'array(cdt'x) - 1;         <<*7724>>13800000
      if tos = 0 then                                          <<*7724>>13805000
        begin  << all writes have completed >>                          13810000
        cdt'x := mapd'offset + cdt'md'read'cnt;                <<*7724>>13815000
        if cdt'array(cdt'x) = 0 then                           <<*7724>>13820000
          begin << all activity to this cdt has completed >>            13825000
          unimpede'waitors;                                    <<*8399>>13830000
          setstate(cdt'avail'state);                                    13835000
          release'cdt;                                                  13840000
          end                                                           13845000
        else                                                            13850000
          begin  << there is other pending "read" activity >>           13855000
          move'queue; << move all deferred to active queue >>           13860000
          setstate(cdt'read'state);                                     13865000
          end;                                                          13870000
        end                                                             13875000
      else                                                              13880000
        begin  << there are still writes remaining. >>                  13885000
        cdt'x := mapd'offset + cdt'md'ldr'head;                <<*7724>>13890000
        if cdt'array(cdt'x) = 0 then                           <<*7724>>13895000
          move'queue; << move up to the next write >>                   13900000
        end;                                                            13905000
      end;                                                              13910000
    end;                                                                13915000
                                                                        13920000
  << waken caller >>                                                    13925000
  wake'ldr;                                                             13930000
  end;                                                                  13935000
                                                                        13940000
  <<3>> << flush requests >>                                            13945000
  begin                                                                 13950000
  if function = readreq then                                            13955000
    begin << it's a read >>                                             13960000
    cdt'dequeue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);                13965000
    cdt'x := mapd'offset + cdt'md'read'cnt;                    <<*7724>>13970000
    tos := cdt'array(cdt'x) := cdt'array(cdt'x) - 1;           <<*7724>>13975000
    if tos = 0 then                                            <<*7724>>13980000
      begin                                                             13985000
      if cdt'array(mapd'offset+cdt'md'write'cnt) = 0 then      <<*7724>>13990000
        begin << we're all done with this cdt >>                        13995000
        setstate(cdt'avail'state);                                      14000000
        release'cdt;                                                    14005000
        end                                                             14010000
      else                                                              14015000
        begin  << reads=0, writes>0 >>                                  14020000
        end;                                                            14025000
      end                                                               14030000
    else                                                                14035000
      begin  << reads>0, writes=? >>                                    14040000
      end;                                                              14045000
    end                                                                 14050000
  else                                                                  14055000
    begin << it's a write >>                                            14060000
    cdt'dequeue'ldr(cdt'entry,disc'req,cdt'md'ldr'head);                14065000
    cdt'x := mapd'offset + cdt'md'write'cnt;                   <<*7724>>14070000
    tos := cdt'array(cdt'x) := cdt'array(cdt'x) - 1;           <<*7724>>14075000
    if tos = 0 then                                            <<*7724>>14080000
      begin                                                             14085000
      cdt'x := mapd'offset + cdt'md'read'cnt;                  <<*7724>>14090000
      if cdt'array(cdt'x) = 0 then                             <<*7724>>14095000
        begin  << we're all done with this cdt >>                       14100000
        state := cdt'avail'state;                                       14105000
        release'cdt;                                                    14110000
        end                                                             14115000
      else                                                              14120000
        begin << writes=0, reads>0 >>                                   14125000
        move'queue;                                                     14130000
        end;                                                            14135000
      end                                                               14140000
    else                                                                14145000
      begin << writes>0, reads=? >>                                     14150000
      move'queue;                                                       14155000
      end;                                                              14160000
    end;                                                                14165000
                                                                        14170000
  << waken caller >>                                                    14175000
  wake'ldr;                                                             14180000
  end;                                                                  14185000
                                                                        14190000
  <<4>> << locked cdt entry >>                                          14195000
  begin                                                                 14200000
  << lock code should never execute completor >>                        14205000
  suddendeath(cdt'invalid'state);                                       14210000
  end;                                                                  14215000
                                                                        14220000
  end;  << of case on state >>                                          14225000
                                                                        14230000
<< we will now leave this procedure >>                                  14235000
leave'routine:                                                          14240000
                                                                        14245000
<< put db back to caller's db >>                               <<*7724>>14250000
tos := save'db;                                                <<*7724>>14255000
exchdb;                                                        <<*7724>>14260000
end;  << of procedure cdt'initiator and cdt'completor >>                14265000
$page "Procedure REQUEST'CACHE"                                         14270000
logical procedure request'cache(discreq);                               14275000
value discreq;                                                          14280000
integer discreq;                                                        14285000
option privileged,uncallable,internal;                         <<06858>>14290000
begin                                                                   14295000
                                                                        14300000
<<********************************************************************>>14305000
<< this procedure is called from attachio after determining that the  >>14310000
<< i/o to be performed is against disc, and this disc is currently    >>14315000
<< cached as specified by the flags word of the disc's dit.  if the   >>14320000
<< function requested against this disc is not of concern to caching, >>14325000
<< a return of false to attachio indicates that attachio should issue >>14330000
<< the request through p'attachio.  if this is a data-transfer func-  >>14335000
<< tion, this procedure will return true to attachio, indicating that >>14340000
<< caching will take responsibility for performing the i/o operation. >>14345000
<<                                                                    >>14350000
<< at this point, the cdt and memory regions for this disc are ex-    >>14355000
<< amined to determine if the requested data exists in main memory.   >>14360000
<< the cache service routines are then called to get everything going >>14365000
<< for this request.                                                  >>14370000
<<                                                                    >>14375000
<< the passed parameter to this procedure is:                         >>14380000
<<                                                                    >>14385000
<< discreq- an ldr relative index to the logical disc req. asso<<07311>>14390000
<<          ciated with this request.  attachio is responsible for    >>14395000
<<          filling-in the request with the proper data.              >>14400000
<<                                                                    >>14405000
<< the returned parameter is:                                         >>14410000
<<                                                                    >>14415000
<< request'cache - true indicates (to cdt'attachio) that     >><<07311>>14420000
<<                 caching has accepted the                  >><<07311>>14425000
<<                 request and takes the responsibility for  >><<07311>>14430000
<<                 processing it.                                     >>14435000
<<                 false indicates that the request has been ignored  >>14440000
<<                 by caching, and must be handled by attachio.       >>14445000
<<                                                                    >>14450000
<< db is assumed to be at sysdb in this procedure.  it is guaranteed  >>14455000
<< that the caller will not be blocked if so specified in the flags   >>14460000
<< word of the ldr.                                                   >>14465000
<<********************************************************************>>14470000
                                                                        14475000
integer ldev'link'ptr,           << pointer to next ldev cdt entry    >>14480000
        ldev,                    << the ldev number of the current cdt>>14485000
        functn,                  << ldr's function                    >>14490000
        cdt'link'ptr,            << pointer to next cache cdt entry   >>14495000
        return'code,             << return code from scan subroutine  >>14500000
        cdt'entry,               << cdt'entry found on scan           >>14505000
        miss'entry,              << cdt'entry just past where cdt shd >>14510000
                                 << have been on miss, or points to   >>14515000
                                 << first partially-mapped domain.    >>14520000
        count;                   << number of positive bytes in xfer  >>14525000
                                                                        14530000
<< it should be added to the measurement interface include  >> <<*8735>>14535000
<< file as soon as possible.  >>                               <<*8735>>14540000
equate  c'impedecache = 74 ;                                   <<*8735>>14545000
                                                               <<*8735>>14550000
logical ldr'entry'index=discreq, << satisfies ldr defines requi<<07308>>14555000
        is'read;                 << true if i/o request was a r<<07308>>14560000
                                                                        14565000
double  ldr'adr,                 << base disc address in ldr entry    >>14570000
        cdt'adr;                 << base disc address in cdt entry    >>14575000
                                                                        14580000
integer ldr'p1    = ldr'adr,                                            14585000
        ldr'p2    = ldr'p1 + 1;                                         14590000
                                                                        14595000
integer ldev'link'offset, << word offset, ldev entry in cdt >> <<*7724>>14600000
        cdt'link'offset;  << word offset, mapd entry in cdt >> <<*7724>>14605000
                                                               <<*7724>>14610000
double  upper'cdt'adr,             << high cdt disc address           >>14615000
        upper'ldr'adr;             << high ldr disc address required  >>14620000
double startcachetime;                                                  14625000
                                                               <<*7724>>14630000
                                                               <<*7724>>14635000
                                                               <<*7724>>14640000
                                                               <<*7724>>14645000
                                                               <<*7724>>14650000
                                                               <<*7724>>14655000
$page                                                                   14660000
subroutine reset'totals;                                                14665000
begin                                                                   14670000
                                                                        14675000
<< this subroutine is called when an accumulator overflows >>           14680000
cdt'set'double(ldev'link'ptr,cdt'de'rhit,0d);                  <<07308>>14685000
cdt'set'double(ldev'link'ptr,cdt'de'whit,0d);                  <<07308>>14690000
cdt'set'double(ldev'link'ptr,cdt'de'rmiss,0d);                 <<07308>>14695000
cdt'set'double(ldev'link'ptr,cdt'de'wmiss,0d);                 <<07308>>14700000
cdt'set'double(ldev'link'ptr,cdt'de'stop,0d);                  <<07308>>14705000
                                                                        14710000
end;  << of subroutine reset'totals >>                                  14715000
$page                                                          <<*7724>>14720000
subroutine inc'hit;                                            <<*7724>>14725000
begin                                                          <<*7724>>14730000
                                                               <<*7724>>14735000
$if x1=on                                                      <<*7724>>14740000
if cdt'add'double(ldev'link'ptr,if is'read then cdt'de'rhit    <<*7724>>14745000
                  else cdt'de'whit,1d) <= 0d then              <<*7724>>14750000
  reset'totals;                                                <<*7724>>14755000
$if x1=off                                                     <<*7724>>14760000
if is'read then                                                <<*7724>>14765000
  tos := cdt'darray((ldev'link'offset+cdt'de'rhit)&asr(1))     <<*7724>>14770000
else                                                           <<*7724>>14775000
  tos := cdt'darray((ldev'link'offset+cdt'de'whit)&asr(1));    <<*7724>>14780000
tos := tos + 1d;      << increment counter >>                  <<*7724>>14785000
if overflow then                                               <<*7724>>14790000
  begin                                                        <<*7724>>14795000
  asmb(ddel);                                                  <<*7724>>14800000
  reset'totals;                                                <<*7724>>14805000
  end                                                          <<*7724>>14810000
else                                                           <<*7724>>14815000
  begin                                                        <<*7724>>14820000
  cdt'darray(cdt'x) := tos; << store back parameter(s)>>       <<*7724>>14825000
  end;                                                         <<*7724>>14830000
$if                                                            <<*7724>>14835000
                                                               <<*7724>>14840000
if class0statsenabled then                                     <<*7724>>14845000
   if fupdatestatistics(measclass0,meassubclass0,measentry1,   <<*7724>>14850000
                       if is'read then c'cachereadhits         <<*7724>>14855000
                       else c'cachewritehits,                  <<*7724>>14860000
                       notnewvalue,1d,notdouble)               <<*7724>>14865000
   <> 0 then suddendeath(sfkerncacheintbad);                   <<*7724>>14870000
                                                               <<*7724>>14875000
end;                                                           <<*7724>>14880000
$page                                                          <<*7724>>14885000
subroutine inc'miss;                                           <<*7724>>14890000
begin                                                          <<*7724>>14895000
                                                               <<*7724>>14900000
$if x1=on                                                      <<*7724>>14905000
if cdt'add'double(ldev'link'ptr,if is'read then cdt'de'rmiss   <<*7724>>14910000
                  else cdt'de'wmiss,1d) <= 0d then             <<*7724>>14915000
  reset'totals;                                                <<*7724>>14920000
$if x1=off                                                     <<*7724>>14925000
if is'read then                                                <<*7724>>14930000
  tos := cdt'darray((ldev'link'offset+cdt'de'rmiss)&asr(1))    <<*7724>>14935000
else                                                           <<*7724>>14940000
  tos := cdt'darray((ldev'link'offset+cdt'de'wmiss)&asr(1));   <<*7724>>14945000
tos := tos + 1d;      << increment counter >>                  <<*7724>>14950000
if overflow then                                               <<*7724>>14955000
  begin                                                        <<*7724>>14960000
  asmb(ddel);                                                  <<*7724>>14965000
  reset'totals;                                                <<*7724>>14970000
  end                                                          <<*7724>>14975000
else                                                           <<*7724>>14980000
  begin                                                        <<*7724>>14985000
  cdt'darray(cdt'x) := tos; << store back parameter(s)>>       <<*7724>>14990000
  end;                                                         <<*7724>>14995000
$if                                                            <<*7724>>15000000
                                                               <<*7724>>15005000
end;                                                           <<*7724>>15010000
$page                                                                   15015000
logical subroutine cache'this'function;                                 15020000
begin                                                                   15025000
                                                                        15030000
<< this subroutine examines the function specified in the ldr for this>>15035000
<< request and returns true if this function is to be managed by the  >>15040000
<< cache routines.                                                    >>15045000
                                                                        15050000
if count = 0 then                                                       15055000
  cache'this'function := false                                          15060000
else                                                                    15065000
  begin                                                                 15070000
  if (ldev'link'ptr := cdt'find'de(ldr'ldev)) = 0 then         <<06858>>15075000
    cache'this'function := false << caching shut-off >>        <<06858>>15080000
  else                                                         <<06858>>15085000
    begin                                                      <<06858>>15090000
    if (functn := ldr'func) = readreq then                     <<06858>>15095000
      begin                                                    <<07308>>15100000
      is'read := cache'this'function := true;                  <<07308>>15105000
      end                                                      <<07308>>15110000
    else if functn = writereq then                             <<06858>>15115000
      begin                                                    <<06858>>15120000
      is'read := false;                                        <<07308>>15125000
                                                               <<07308>>15130000
      cache'this'function := true;                             <<06858>>15135000
      end                                                      <<06858>>15140000
    else                                                       <<06858>>15145000
      cache'this'function := false;                            <<06858>>15150000
    end;                                                       <<06858>>15155000
  ldev'link'offset := ldev'link'ptr * cdt'entry'size;          <<*7724>>15160000
  end;                                                         <<06858>>15165000
end; << of  subroutine cache'this'function >>                           15170000
$page                                                                   15175000
subroutine scan'cdts'for'hit;                                           15180000
begin                                                                   15185000
<<********************************************************************>>15190000
<< this subroutine scans the cached cdt entries for a "hit" on this   >>15195000
<< disc domain.                                                       >>15200000
<<                                                                    >>15205000
<< input parameters:  not examined.                                   >>15210000
<<                                                                    >>15215000
<< return parameters:                                                 >>15220000
<<                                                                    >>15225000
<<      cdt'entry     - cached cdt entry of 'hit' on disc address.    >>15230000
<<                      valid only if return'code is 0.               >>15235000
<<      miss'entry    - mapped cdt following desired domain, or first >>15240000
<<                      domain that is partially mapped.  valid if    >>15245000
<<                      return'code is 1 or 2.  set to 0 if beginning,>>15250000
<<                      or -1 if tail.                                >>15255000
<<      return'code   - indicates the results of the scan, which are: >>15260000
<<                      0 - cdt entry found that satisfies entire     >>15265000
<<                          requested disc domain.                    >>15270000
<<                      1 - cdt entry found that partially covers     >>15275000
<<                          requested disc domain.                    >>15280000
<<                      2 - no cdt entry found which corresponds to   >>15285000
<<                          this disc domain.                         >>15290000
<< db is assumed to be at the cdt.                             <<*7724>>15295000
<<********************************************************************>>15300000
                                                                        15305000
<< find actual cache cdt entry, if it exists >>                         15310000
<< load low ldr address >>                                              15315000
ldr'p1 := ldr'parm1;                                                    15320000
ldr'p2 := ldr(cdt'x:=cdt'x+1);   << ldr'adr is now loaded >>            15325000
                                                                        15330000
<< figure high ldr disc address >>                                      15335000
upper'ldr'adr := double((count+127)&lsr(7))+ldr'adr;                    15340000
                                                                        15345000
<< get pointer to first mapped domain >>                                15350000
$if x1=on                                                      <<*7724>>15355000
tos := cdt'link'ptr := cdt'get'word(ldev'link'ptr,             <<*7724>>15360000
                                    cdt'de'mapd'head,0);       <<*7724>>15365000
$if x1=off                                                     <<*7724>>15370000
tos := cdt'link'ptr := cdt'array(ldev'link'offset +            <<*7724>>15375000
                                 cdt'de'mapd'head);            <<*7724>>15380000
$if                                                            <<*7724>>15385000
if (tos = 0) then                                              <<*7724>>15390000
                                                               <<*7724>>15395000
  begin  << this is a miss, and cdt must be added to head >>            15400000
  return'code := 2;                                                     15405000
  miss'entry := 0;                                                      15410000
  end                                                                   15415000
else                                                                    15420000
  << we must loop >>                                                    15425000
  begin                                                                 15430000
  << wizz through mapped cdt domains >>                                 15435000
  while cdt'link'ptr <> 0 do                                            15440000
    begin                                                               15445000
    cdt'link'offset := cdt'link'ptr * cdt'entry'size;          <<*7724>>15450000
$if x1=on                                                      <<*7724>>15455000
    tos:=upper'cdt'adr:=cdt'get'double(cdt'link'ptr,           <<*7724>>15460000
                                       cdt'md'end'sector,0d);  <<*7724>>15465000
$if x1=off                                                     <<*7724>>15470000
    tos:=upper'cdt'adr:=                                       <<*7724>>15475000
        cdt'darray((cdt'link'offset+cdt'md'end'sector)&asr(1));<<*7724>>15480000
$if                                                            <<*7724>>15485000
                                                                        15490000
    << if cache addr is higher than disc address, skip checking >>      15495000
    if tos <<upper'cdt'adr>> > ldr'adr then                    <<*7724>>15500000
      begin  << we have a hit, check if it's partial, full, or miss >>  15505000
                                                                        15510000
      << get lower cdt address >>                                       15515000
$if x1=on                                                      <<*7724>>15520000
      tos := cdt'adr :=                                        <<*7724>>15525000
             cdt'get'double(cdt'link'ptr,cdt'md'sector,0d);    <<*7724>>15530000
$if x1=off                                                     <<*7724>>15535000
      tos := cdt'adr :=                                        <<*7724>>15540000
            cdt'darray((cdt'link'offset+cdt'md'sector)&asr(1));<<*7724>>15545000
$if                                                            <<*7724>>15550000
                                                                        15555000
      <<if low address is beyond high ldr address, then it's a miss>>   15560000
      if tos <<cdt'adr>> >= upper'ldr'adr then                 <<*7724>>15565000
        begin  << yep, it's a miss >>                                   15570000
        miss'entry := cdt'link'ptr;                                     15575000
        return'code := 2;                                               15580000
        return;                                                         15585000
        end;                                                            15590000
                                                                        15595000
      <<we know we have at least a partial hit.  we will now range >>   15600000
      <<check to see if we can satisfy the ldr with this cdt.  >>       15605000
      if cdt'adr <= ldr'adr and                                         15610000
         upper'cdt'adr >= upper'ldr'adr then                            15615000
        begin  << we have a total hit! >>                               15620000
        cdt'entry := cdt'link'ptr;                                      15625000
        return'code := 0;                                               15630000
        end                                                             15635000
      else                                                              15640000
        begin << we have a partial hit >>                               15645000
        miss'entry := cdt'link'ptr;                                     15650000
        return'code := 1;                                               15655000
        end;                                                            15660000
      return;   << to caller >>                                         15665000
      end;  << of processing a 'hit' >>                                 15670000
                                                                        15675000
    << increment to next cdt entry >>                                   15680000
$if x1=on                                                      <<*7724>>15685000
    cdt'link'ptr := cdt'get'word(cdt'link'ptr,cdt'md'next,0);           15690000
$if x1=off                                                     <<*7724>>15695000
    cdt'link'ptr := cdt'array(cdt'link'offset+cdt'md'next);    <<*7724>>15700000
$if                                                            <<*7724>>15705000
                                                                        15710000
    end; << of 'while' stmt wizzing through cdt entries >>              15715000
                                                                        15720000
  << at this point, we know that the disc address being      >>         15725000
  << requested is beyond any currently mapped domains.  mark it >>      15730000
  << as a 'miss' at this point.                                       >>15735000
  miss'entry := -1;  << at end-of-chain >>                              15740000
  return'code := 2;                                                     15745000
  end;                                                                  15750000
                                                                        15755000
end;  << of subroutine scan'cdts'for'hit >>                             15760000
$page                                                                   15765000
subroutine hit'on'cache;                                                15770000
begin                                                                   15775000
                                                                        15780000
inc'hit;                                                       <<*7724>>15785000
                                                               <<*7724>>15790000
                                                               <<*7724>>15795000
                                                               <<*7724>>15800000
                                                               <<*7724>>15805000
                                                               <<*7724>>15810000
                                                               <<*7724>>15815000
                                                               <<*7724>>15820000
                                                               <<*7724>>15825000
                                                                        15830000
<< go ahead and link this ldr to the cdt entry >>                       15835000
cdt'initiator(cdt'entry,discreq);                                       15840000
                                                                        15845000
end;                                                                    15850000
$page                                                                   15855000
$if x7=on                                                      <<06858>>15860000
subroutine partial'hit;                                                 15865000
begin                                                                   15870000
                                                                        15875000
<<******************************************************>>              15880000
<< patial's are not supported yet...                    >>              15885000
assemble(halt 7);                                                       15890000
<<******************************************************>>              15895000
                                                                        15900000
<< count this as a miss >>                                              15905000
inc'miss;                                                      <<*7724>>15910000
                                                               <<*7724>>15915000
                                                               <<*7724>>15920000
                                                                        15925000
<< lock range >>                                                        15930000
cdt'entry := cdt'lock'range(ldev'link'ptr,ldr'adr,upper'ldr'adr);       15935000
                                                                        15940000
<< queue this request to the locked cdt entry >>                        15945000
cdt'initiator(cdt'entry,discreq);                                       15950000
                                                                        15955000
end;                                                                    15960000
$if                                                            <<06858>>15965000
$page                                                                   15970000
subroutine miss'on'cdt;                                                 15975000
begin                                                                   15980000
                                                                        15985000
<< get cdt entry and put in list >>                                     15990000
cdt'entry:=cdt'get'md'entry(ldev'link'ptr,ldr'adr,miss'entry);          15995000
cdt'link'offset := cdt'entry * cdt'entry'size;                 <<*7724>>16000000
                                                               <<07308>>16005000
                                                               <<07308>>16010000
                                                                        16015000
<< now, we will see if unmapped region exists >>                        16020000
if cdt'map'cached'domain(ldev'link'ptr,ldr'adr,upper'ldr'adr,           16025000
                         cdt'entry,discreq) then               <<07308>>16030000
  begin  << we found a hit >>                                           16035000
  inc'hit;                                                     <<*7724>>16040000
                                                               <<*7724>>16045000
                                                               <<*7724>>16050000
                                                               <<*7724>>16055000
                                                               <<*7724>>16060000
                                                               <<*7724>>16065000
                                                               <<*7724>>16070000
                                                               <<*7724>>16075000
                                                               <<*7724>>16080000
                                                               <<*7724>>16085000
                                                               <<*7724>>16090000
                                                               <<*7724>>16095000
  end                                                                   16100000
else                                                                    16105000
  begin  << we had a total miss, so get a cdt and fill it in >>         16110000
                                                                        16115000
  inc'miss;                                                    <<*7724>>16120000
                                                               <<*7724>>16125000
                                                               <<*7724>>16130000
                                                                        16135000
  << mark cdt entry as "MISS" >>                                        16140000
  cdt'array(cdt'link'offset+cdt'md'flags).(cdt'miss'bit:1):=1; <<*7724>>16145000
                                                                        16150000
  << if monitor is enabled, report strategy applied >>                  16155000
  if measflag then                                             <<*7551>>16160000
    begin                                                               16165000
    mmstat'(-133,count,ldr'p1,ldr'p2,0,0,0);                   <<06859>>16170000
    mmstat'(-134,cdt'get'word(cdt'entry,cdt'md'sector,0),      <<06859>>16175000
           cdt'get'word(cdt'entry,cdt'md'sector+1,0),                   16180000
           ldr'flags,0,0,0);                                   <<06859>>16185000
    mmstat'(-135,cdt'get'word(cdt'entry,cdt'md'end'sector,0),  <<06859>>16190000
           cdt'get'word(cdt'entry,cdt'md'end'sector+1,0),               16195000
           ldr'func,0,0,0);                                    <<06859>>16200000
    mmstat'(-136,ldr'b'hoda,ldr'b'loda,ldr'l'loda,0,0,0);      <<06859>>16205000
    end;                                                                16210000
  end;                                                                  16215000
                                                                        16220000
<< link ldr to newly obtained cdt >>                                    16225000
cdt'initiator(cdt'entry,discreq);                                       16230000
                                                                        16235000
end;                                                                    16240000
$page                                                                   16245000
<< begin procedure mainline >>                                          16250000
                                                                        16255000
$if x1=on                                                               16260000
mmstat'(mmstat'req'cache,discreq,0,0,0,0,0);                   <<06859>>16265000
$if                                                                     16270000
                                                                        16275000
<< initialize return code >>                                            16280000
request'cache := false;                                                 16285000
                                                                        16290000
tos := ldr'count;                                                       16295000
if < then                                                               16300000
  tos := ((-tos)+1) & lsr(1); << make words >>                          16305000
count := tos;                                                           16310000
                                                                        16315000
if cache'this'function then                                             16320000
   begin <<function is cachable>>                                       16325000
                                                                        16330000
   if class0statsenabled then                                           16335000
      begin <<update meas instrumentation>>                             16340000
      startcachetime := timer;                                 <<06858>>16345000
      if fupdatestatistics(measclass0,meassubclass0,measentry1,         16350000
                          if is'read then c'cachereads         <<07308>>16355000
                          else c'cachewrites,                           16360000
                          notnewvalue,1d,notdouble)                     16365000
      <> 0 then suddendeath(sfkerncacheintbad);                         16370000
      end;                                                              16375000
                                                                        16380000
   << place db at cdt >>                                       <<*7724>>16385000
   cdt'abs'on'tos;                                             <<*7724>>16390000
   exchdb;                                                     <<*7724>>16395000
   asmb(ddel);                                                 <<*7724>>16400000
                                                               <<*7724>>16405000
   <<look thru cdt's for this dev for mapped domains>>                  16410000
loopkludge:                                                             16415000
                                                               <<*8003>>16420000
   if cache'dst = 0 then  go out;                              <<*8003>>16425000
   scan'cdts'for'hit;                                                   16430000
                                                                        16435000
   case *return'code of                                        <<*7724>>16440000
      begin                                                             16445000
                                                                        16450000
      <<0>> hit'on'cache;     << cdt fully satisfies request >>         16455000
                                                                        16460000
      <<1>> <<partial'hit;>>  << cdt partially satisfies request >>     16465000
            << this code should be eliminated if the lock code <<06858>>16470000
            << is ever implemented.  since the occurance of thi<<06858>>16475000
            << section of code is extremely low, it may never b<<06858>>16480000
            << done.  (ajk)                                    <<06858>>16485000
            begin  << kludge until code is done >>                      16490000
                                                               <<07308>>16495000
            << measure cache stop event >>                     <<07308>>16500000
            if cdt'add'double(ldev'link'ptr,cdt'de'stop,1d)    <<07308>>16505000
              <= 0d then reset'totals;                         <<07308>>16510000
                                                               <<*7724>>16515000
            << point back to sysdb before penable >>           <<*7724>>16520000
            tos := %1000 d;                                    <<*7724>>16525000
            exchdb;                                            <<*7724>>16530000
                                                               <<*8735>>16535000
         << we must save the accumulated time doing cache >>   <<*8735>>16540000
         << management on the process' stack.  this time  >>   <<*8735>>16545000
         << will start accumulating again when we return  >>   <<*8735>>16550000
         << from the delay.  >>                                <<*8735>>16555000
            startcachetime := timer - startcachetime;          <<*8735>>16560000
                                                               <<*8735>>16565000
<< count impedes due to disc caching.  this is a double count>><<*8735>>16570000
                                                               <<*8735>>16575000
if class0statsenabled then                                     <<*8735>>16580000
  if fupdatestatistics(measclass0,meassubclass0,measentry1,    <<*8735>>16585000
           c'impedecache,notnewvalue,1d,notdouble)             <<*8735>>16590000
   <> 0 then suddendeath(sfkerncacheintbad) ;                  <<*8735>>16595000
                                                               <<*8735>>16600000
<< this uses the old counter cp'segcontract to count impedes >><<*8735>>16605000
<< due to caching.  the old counters for cp'segcontract have >><<*8735>>16610000
<< been removed from kerneld.  this counter should be renamed>><<*8735>>16615000
<< cp'impedecache in the measurement include file asap!!!!!!!>><<*8735>>16620000
if gclassenabledmask.class15 then                              <<*8735>>16625000
   begin                                                       <<*8735>>16630000
   tos:=measprocxdsbank;                                       <<*8735>>16635000
   tos:=measprocxdsbase;                                       <<*8735>>16640000
   tos:=tos + curprc / pcbsize * class15'sub0size +            <<*8735>>16645000
        cp'segcontract ;                                       <<*8735>>16650000
   asmb(lsea);                                                 <<*8735>>16655000
   tos:=tos+1;                                                 <<*8735>>16660000
   asmb(ssea;ddel);                                            <<*8735>>16665000
   end;                                                        <<*8735>>16670000
            tos := 100d;  << 100 ms >>                        <<*fast*>>16675000
            penable;                                                    16680000
            delay(*);                                                   16685000
            pdisable;                                                   16690000
                                                               <<*8735>>16695000
         << restore the delta by subtracting the time >>       <<*8735>>16700000
         << accumulated before the delay. >>                   <<*8735>>16705000
            startcachetime := timer - startcachetime;          <<*8735>>16710000
                                                               <<*8735>>16715000
            << point db back to cdt >>                         <<*7724>>16720000
            exchdb;                                            <<*7724>>16725000
            asmb(ddel);                                        <<*7724>>16730000
            go to loopkludge;                                           16735000
            end;                                                        16740000
                                                                        16745000
      <<2>> miss'on'cdt;      << no overlapping cdt entry found >>      16750000
                                                                        16755000
      end;                                                              16760000
                                                                        16765000
   <<inform attachio that caching will be responsible for the i/o >>    16770000
                                                                        16775000
   request'cache := true;                                               16780000
                                                                        16785000
   if class0statsenabled then                                           16790000
      begin                                                    <<*8735>>16795000
      if fupdatestatistics(measclass0,meassubclass0,measentry1,         16800000
                          c'cacheonprocess,notnewvalue,                 16805000
                          timer-startcachetime,doublevalue)    <<06858>>16810000
      <> 0 then suddendeath(sfkerncacheintbad);                         16815000
                                                               <<*8735>>16820000
      <<we must subtract c'cacheonprocess from c'cpuprocess  >><<*8735>>16825000
      <<because cache mgt time is later added to c'cpuprocess>><<*8735>>16830000
      <<thus total time on the process' stack is c'cpuprocess>><<*8735>>16835000
      << + c'cacheonprocess.                                 >><<*8735>>16840000
                                                               <<*8735>>16845000
      if fupdatestatistics(measclass0,meassubclass0,measentry1,<<*8735>>16850000
                           c'cpuprocess,notnewvalue,           <<*8735>>16855000
                           startcachetime-timer,doublevalue)   <<*8735>>16860000
      <> 0 then suddendeath(sfkerncacheintbad);                <<*8735>>16865000
      end ;                                                    <<*8735>>16870000
                                                                        16875000
                                                               <<*8003>>16880000
out:                                                           <<*8003>>16885000
                                                               <<*8003>>16890000
   << put db back to sysdb >>                                  <<*7724>>16895000
   tos := %1000 d;                                             <<*7724>>16900000
   exchdb;                                                     <<*7724>>16905000
   asmb(ddel);                                                 <<*7724>>16910000
                                                               <<*7724>>16915000
   end;                                                                 16920000
end;  << of procedure request'cache >>                                  16925000
$page "Procedure FLUSH'CACHE"                                           16930000
<<**************************************************>>                  16935000
<< change to perform attachio or lock'range         >>                  16940000
<<**************************************************>>                  16945000
integer procedure flush'cache(ldev,start'addr,limit'addr);     <<06858>>16950000
value ldev,start'addr,limit'addr;                              <<06858>>16955000
integer ldev;                                                           16960000
double start'addr,limit'addr;                                  <<06858>>16965000
option uncallable, privileged;                                          16970000
begin                                                                   16975000
                                                                        16980000
<<********************************************************************>>16985000
<< upon return from this procedure, the caller is guaranteed of having>>16990000
<< the range of sectors specified posted to disc and removed   <<06858>>16995000
<< from main memory.                                                  >>17000000
<<                                                                    >>17005000
<< the passed arguments are:                                          >>17010000
<<                                                                    >>17015000
<< ldev         - the mpe logical device number of the disc device.   >>17020000
<< start'addr   - the logical disc address from which the data <<06858>>17025000
<<                be flushed.                                         >>17030000
<< limit'addr   - the logical disc address to which the data is<<06858>>17035000
<<                be flushed (up to, but not including sector  <<06858>>17040000
<<                limit'addr).                                 <<06858>>17045000
<<                                                             <<06858>>17050000
<< the returned value is:                                             >>17055000
<<                                                                    >>17060000
<< flush'cache  - return parameter from the procedure.  the values are>>17065000
<<                0 - disc range successfully flushed.                >>17070000
<<                1 - ldev specified is not a disc or not cached.     >>17075000
<<                                                                    >>17080000
<< db can be pointing anywhere when calling this procedure.  the      >>17085000
<< must be able to be "blocked" when calling this procedure.          >>17090000
<<********************************************************************>>17095000
                                                                        17100000
double hold'addr;      << hold logical disc address >>         <<06858>>17105000
                                                               <<06858>>17110000
logical ldr'entry'index;  << logical disc req index >>         <<06858>>17115000
                                                               <<06858>>17120000
                                                               <<06858>>17125000
integer r'flush'cache = flush'cache, << access return var >>   <<06858>>17130000
        ldev'entry,      << cdt index of ldev's entry >>       <<06858>>17135000
        cdt'entry,       << mapped-domain cdt entry   >>       <<06858>>17140000
        oldcrit,         << critical state before entering this proc >> 17145000
        old'sir,         << rerurn from getsir               >><<*7551>>17150000
        olddb;           << db location prior to calling this p<<*7551>>17155000
$page                                                          <<*7551>>17160000
subroutine check'for'disabled'ldr;                             <<*7551>>17165000
begin                                                          <<*7551>>17170000
<<***********************************************************>><<*7551>>17175000
<<* this subroutine will force any disabled logical disc    *>><<*7551>>17180000
<<* request pending for the flushing cdt to complete.       *>><<*7551>>17185000
<<***********************************************************>><<*7551>>17190000
                                                               <<*7551>>17195000
ldr'entry'index := dqh'disahead;                               <<*7551>>17200000
while ldr'entry'index <> 0 do                                  <<*7551>>17205000
   begin                                                       <<*7551>>17210000
   tos := ldr'nextq;      << save the next one >>              <<*7551>>17215000
   if ldr'ldreq and integer(ldr'ldev) = ldev and               <<*7551>>17220000
      integer(ldr'cdt) = cdt'entry  then                       <<*7551>>17225000
      cdt'force'cdt'completion(ldr'entry'index);               <<*7551>>17230000
                                                               <<*7551>>17235000
   ldr'entry'index := tos;     << next guy in queue >>         <<*7551>>17240000
   end;                                                        <<*7551>>17245000
end;       << subroutine check'for'disabled'ldr >>             <<*7551>>17250000
$page                                                          <<*7551>>17255000
subroutine check'for'lazy'ldr;                                 <<*7551>>17260000
begin                                                          <<06858>>17265000
<<****************************************************>>       <<06858>>17270000
<< this subroutine tries to force a ldr which is      >>       <<06858>>17275000
<< holding-up a flush, to complete.                   >>       <<06858>>17280000
<<****************************************************>>       <<06858>>17285000
                                                               <<06858>>17290000
cdt'entry := cdt'get'word(ldev'entry,cdt'de'mapd'head,0);      <<06858>>17295000
while cdt'entry <> 0 do                                        <<06858>>17300000
   begin                                                       <<06858>>17305000
   hold'addr := cdt'get'double(cdt'entry,cdt'md'sector,0d);    <<06858>>17310000
   if hold'addr >= start'addr and                              <<06858>>17315000
      hold'addr < limit'addr then << they overlap >>           <<06858>>17320000
      begin                                                    <<06858>>17325000
                                                               <<06858>>17330000
      << see if there is a ldr we can get out of the way >>    <<06858>>17335000
      ldr'entry'index := cdt'get'word(cdt'entry,               <<06858>>17340000
                         cdt'md'ldr'head,0);                   <<06858>>17345000
      if ldr'entry'index <> 0 then                             <<06858>>17350000
         cdt'force'cdt'completion(ldr'entry'index)             <<06858>>17355000
      else                                                     <<06858>>17360000
         begin                                                 <<06858>>17365000
         ldr'entry'index := cdt'get'word(cdt'entry,            <<06858>>17370000
                            cdt'md'imped'hd,0);                <<06858>>17375000
         if ldr'entry'index <> 0 then                          <<06858>>17380000
            cdt'force'cdt'completion(ldr'entry'index)          <<*7551>>17385000
         else                                                  <<*7551>>17390000
           if dqh'disahead <> 0 then check'for'disabled'ldr;   <<*7551>>17395000
                                                               <<*7551>>17400000
         end;                                                  <<06858>>17405000
      << terminate looping >>                                  <<06858>>17410000
      cdt'entry := 0;                                          <<06858>>17415000
      end                                                      <<06858>>17420000
   else                                                        <<06858>>17425000
      begin                                                    <<06858>>17430000
      << if address is beyond, terminate looping >>            <<06858>>17435000
      if hold'addr >= limit'addr then                          <<06858>>17440000
         cdt'entry := 0                                        <<06858>>17445000
      else                                                     <<06858>>17450000
         cdt'entry := cdt'get'word(cdt'entry,cdt'md'next,0);   <<06858>>17455000
      end;                                                     <<06858>>17460000
   end;                                                        <<06858>>17465000
end;  << of subroutine >>                                      <<06858>>17470000
$page                                                          <<06858>>17475000
<< first, set this process critical because we're getting system >>     17480000
<< resources.                                                    >>     17485000
turnofftraps;                                                  <<06858>>17490000
oldcrit := setcritical;                                                 17495000
old'sir := getsir(cache'control'sir);                          <<*7551>>17500000
                                                                        17505000
<< set db to sysdb to access i/o system tables. >>                      17510000
olddb := setsysdb;                                                      17515000
                                                                        17520000
                                                               <<06858>>17525000
pdisable;                                                      <<06858>>17530000
                                                               <<06858>>17535000
<< loop until there are no overlapping mapped domains >>       <<06858>>17540000
flush'cache := -1;   << loop control >>                        <<06858>>17545000
while r'flush'cache = -1 do                                    <<06858>>17550000
   begin                                                       <<06858>>17555000
   if cache'dst = 0 then                                       <<06858>>17560000
      flush'cache := 1                                         <<06858>>17565000
   else if (ldev'entry:=cdt'find'de(ldev)) = 0 then            <<06858>>17570000
      flush'cache := 1                                         <<06858>>17575000
   else                                                        <<06858>>17580000
      begin                                                    <<06858>>17585000
      if cdt'flush'cached'range(                               <<06858>>17590000
         ldev'entry,   << ldev entry in cdt >>                 <<06858>>17595000
         start'addr,   << start sector address >>              <<06858>>17600000
         limit'addr,   << limit sector address >>              <<06858>>17605000
         0,0) then                                             <<07308>>17610000
         flush'cache := 0                                      <<06858>>17615000
      else                                                     <<06858>>17620000
         begin  << we must wait for i/o to quiesce >>          <<06858>>17625000
         disable;                                              <<06858>>17630000
         penable;                                              <<06858>>17635000
         tos := 300d;   << 300 ms >>                           <<06858>>17640000
         delay(*);                                             <<06858>>17645000
         check'for'lazy'ldr;                                   <<06858>>17650000
         pdisable;                                             <<06858>>17655000
         enable;                                               <<06858>>17660000
         end;                                                  <<06858>>17665000
      end;                                                     <<06858>>17670000
   end;                                                        <<06858>>17675000
penable;                                                       <<06858>>17680000
resetdb(olddb);                                                <<06858>>17685000
relsir(cache'control'sir,old'sir);                             <<*7551>>17690000
resetcritical(oldcrit);                                        <<06858>>17695000
                                                                        17700000
                                                               <<06858>>17705000
                                                               <<06858>>17710000
                                                               <<06858>>17715000
end;   << of procedure flush'cache >>                                   17720000
$page "CDT'ATTACHIO"                                                    17725000
double procedure cdt'attachio(ldev,qmisc,dstx,addr,fnct,                17730000
                              cnt,p1,p2,flags,                          17735000
                              extbase,extsize);                         17740000
                                                                        17745000
value                       ldev, qmisc, dstx, addr, fnct,              17750000
                            extbase, extsize,                           17755000
                            cnt, p1, p2, flags;                         17760000
                                                                        17765000
integer                     ldev, qmisc, dstx, addr, fnct,              17770000
                            cnt, p1, p2, flags;                         17775000
                                                                        17780000
double                      extbase;                                    17785000
                                                                        17790000
logical                     extsize;                                    17795000
                                                                        17800000
option privileged,uncallable;                                           17805000
  begin                                                                 17810000
comment                                                                 17815000
<<*****************************************************>>               17820000
ldev   - logical device number                                          17825000
qmisc  - misc parameter specified for device                            17830000
dstx   - dst number of data segment.  if zero, then                     17835000
         specifies that addr is db relative to the caller's             17840000
         stack.  must be zero if system buffers is specified.           17845000
addr   - depending on flags.(14:1) and dstx, this may be:               17850000
         1)offset to data in dst.                                       17855000
         2)offset to data from db in callers stack.                     17860000
         3)index to a system buffer.                                    17865000
func   - function code.  device defined, but usually:                   17870000
         0 - read.                                                      17875000
         1 - write.                                                     17880000
         2 - open file.                                                 17885000
         3 - close file.                                                17890000
         4 - close device.                                              17895000
cnt    - data transfer count, + words or - bytes.                       17900000
p1     - parameter 1.  high-order disc sector address (hoda).           17905000
p2     - parameter 2.  low-order disc sector address (loda).            17910000
flags  - control and specification flags.                               17915000
         (0:4) - caller is unknown(0), file system(1), or               17920000
                 spooler(2).                                            17925000
         (4:1) - force posting of writes prior to              <<06858>>17930000
                 completion notification.                      <<06858>>17935000
         (5:1) - serialize write request                       <<06858>>17940000
         (6:1) - available                                     <<06858>>17945000
         (7:2) - premption flags, soft(1) or hard(2).                   17950000
         (9:1) - 0.                                                     17955000
         (10:1)- special request, device defined.  usually              17960000
                 memory management.                                     17965000
         (11:1)- if set, this is a diagnostic request.                  17970000
         (12:1)- system buffer flag.  if set, addr is an index          17975000
                 relative to the sbuf table.  for devices               17980000
                 that support chaining, the data is trans-              17985000
                 ferred to and from a set of chained buffers,           17990000
                 up to a maximum of 1024 words.                         17995000
         (13:3)- request type:                                          18000000
                 0)unblocked, no wake.  impede if no ioq.               18005000
                 1)blocked (caller is waited until done).               18010000
                 2)unblocked, wake caller, impede if no ioq.            18015000
                 3)unblocked & no pin is to be associated               18020000
                   with this i/o.  impede if no ioq.                    18025000
                 4)unblocked, no wake, no impede if no ioq.             18030000
                 5)reserved.                                            18035000
                 6)unblocked, wake, no impede if no ioq.                18040000
                 7)same as 3 but no impede & get secondary              18045000
                   ioq if necessary.                                    18050000
                                                                        18055000
return:                                                                 18060000
                                                                        18065000
blocked-                                                                18070000
                                                                        18075000
s-1    - (0:8) - pcb number.                                            18080000
         (8:5) - qualifying status.                                     18085000
         (13:3)- general status.                                        18090000
s-0    - transmission log (+words or -bytes).                           18095000
                                                                        18100000
unblocked-                                                              18105000
                                                                        18110000
s-1    - ioq index of request  (1 if no pcb i/o)                        18115000
s-0    - 0                                                              18120000
                                                                        18125000
<<************************************************************>         18130000
;                                                                       18135000
    integer pcbnum=q+1;                                                 18140000
    integer dbsave = pcbnum + 1;                                        18145000
    integer array ditp(@) = dbsave + 1;                                 18150000
    logical pointer ditpl = ditp;                                       18155000
    integer savecrit = ditp + 1;                                        18160000
<<>>                                                                    18165000
                                                               <<06858>>18170000
                                                                        18175000
equate dtype      = 5;     << device type word in dlt    >>             18180000
                                                                        18185000
define ddtype     = (8:8)#;<< device type field in dlt   >>             18190000
                                                                        18195000
    integer array dltp(@)=savecrit + 1;                                 18200000
    integer pointer ioqp  = dltp + 1;                                   18205000
    logical pointer ioqpl = ioqp;                                       18210000
    double  pointer ioqpd = ioqp;                                       18215000
    logical ldr'entry'index = ioqp,  <<satisfies equates>>              18220000
            ldstx           = dstx;  <<redefine dstx passed>>           18225000
                                                                        18230000
    integer head'pin = ioqp+1;<< head pin of impeded queue >>  <<06858>>18235000
                                                                        18240000
    integer stackdst = head'pin+1; << holds dst if a stack >>  <<06858>>18245000
                                                                        18250000
    logical lflags = flags;                                             18255000
                                                               <<07311>>18260000
    define                                                     <<07311>>18265000
       lpdt'index = ldev * size'of'lpdt'entry#;                <<07311>>18270000
                                                               <<07311>>18275000
                                                                        18280000
<<**********************************************>>                      18285000
<< defines and equates from hardres >>                                  18290000
                                                                        18295000
integer x = x;   << index register >>                                   18300000
                                                                        18305000
equate ddltp       = 4; << dlt entry offset in dit >>          <<06857>>18310000
                                                                        18315000
<< dbl offset to dst bank & offset of disc request table >>    <<*7724>>18320000
equate ldr'dstd'bank = (ldr'dst*2)+1;                          <<*7724>>18325000
                                                               <<*7724>>18330000
define notimpedable     = (13:1)#,                                      18335000
       rtype            = (14:2)#,                                      18340000
       sysbufrs         = (12:1)#, << req uses sysbuffers >>            18345000
       stackflag        = (0:1)#,  << req is stack-relative >>          18350000
       blocked          = (5:1)#,                                       18355000
       iowake           = (4:1)#;                                       18360000
                                                                        18365000
integer array dst(*)    = db + 2;                                       18370000
double pointer dstd     = dst;                                          18375000
double start'addr       = p1;   << double disc address >>      <<06858>>18380000
                                                                        18385000
                                                               <<*7724>>18390000
                                                               <<*7724>>18395000
                                                               <<*7724>>18400000
                                                                        18405000
$if x1=on                                                               18410000
mmstat'(mmstat'cdt'att,ldev,fnct,flags,p1,p2,cnt);             <<07311>>18415000
<< if we are disabled prior to calling attachio, halt >>       <<06858>>18420000
push(status);                                                  <<06858>>18425000
if tos.(1:1) = 0 then                                          <<06858>>18430000
   if absolute(%1355).(13:1) = 1 then                          <<06858>>18435000
      begin                                                    <<06858>>18440000
      asmb(halt 3);                                            <<06858>>18445000
      help;                                                    <<06858>>18450000
      end;                                                     <<06858>>18455000
$if                                                                     18460000
                                                                        18465000
<< trapsoff; >>                                                         18470000
<< force stack overflows, leave 2 words of local data >>                18475000
asmb(adds 255);                                                <<06858>>18480000
asmb(subs 253);                                                <<06858>>18485000
push(db);   if tos=%1000 d then asmb(del,zero) else                     18490000
asmb( pcal setsysdb );  << set dbsave >>                                18495000
                                                               <<07311>>18500000
tos := lpdt'dit'ptr;     << set up dit, ditpl >>               <<07311>>18505000
tos := 0;    << set savecrit >>                                         18510000
                                                                        18515000
x := dbsave;   << test if i/o system call >>                            18520000
if <> then asmb(pcal setcritical);  << set savecrit >>                  18525000
                                                                        18530000
tos := ditp(ddltp);    <<set up dlt>>                                   18535000
tos:=getdiscreq(flags.notimpedable);                                    18540000
asmb(test,dzro);   << for stackdst and pflag >>                         18545000
if = then goto out;   << no ioq's available >>                          18550000
                                                                        18555000
                                                                        18560000
if lflags.sysbufrs then             << dst # of sys bufs >>             18565000
  begin                                                                 18570000
  dstx := 8;  << system buffers >>                                      18575000
  if cnt <> 0 then  << caching does not support chained sysbufs>>       18580000
    if > then                                                           18585000
      begin                                                             18590000
      if cnt > 128 then                                                 18595000
        suddendeath(sfkerncacheintbad);                                 18600000
      end                                                               18605000
    else                                                                18610000
      if cnt < -256 then                                                18615000
        suddendeath(sfkerncacheintbad);                                 18620000
  end;                                                                  18625000
                                                                        18630000
x := dstx;                                                              18635000
if = then   << a stack relative address >>                              18640000
  begin                                                                 18645000
  stackdst := integer(lpcb(curprc+stkinfowordnum).stkdstfield);<<06857>>18650000
  tos := stackdst;  tos.stackflag := 1;  dstx := tos;                   18655000
  end;                                                                  18660000
                                                                        18665000
<< put db at ldr entry for fast access >>                      <<*7724>>18670000
tos := dstd(ldr'dstd'bank);                                    <<*7724>>18675000
tos := tos + ldr'entry'index;   << point to actual entry >>    <<*7724>>18680000
pdisable;                                                      <<*7724>>18685000
exchdb;                                                        <<*7724>>18690000
                                                               <<*7724>>18695000
<< load parameters into ldr entry >>                                    18700000
ldr'db'ldev := ldev;                                           <<*7724>>18705000
ldr'db'cdt := 0;                                               <<*7724>>18710000
ldr'db'bufdst := dstx;                                         <<*7724>>18715000
ldr'db'bufadr := addr;                                         <<*7724>>18720000
ldr'db'func := fnct;                                           <<*7724>>18725000
ldr'db'count := cnt;                                           <<*7724>>18730000
ldr'db'parm1 :=p1;                                             <<*7724>>18735000
ldr'db'parm2 := p2;                                            <<*7724>>18740000
ldr'db'stat  := 0;                                             <<*7724>>18745000
tos := extbase;                                                         18750000
ldr'db'b'loda := tos;                                          <<*7724>>18755000
ldr'db'b'hoda := tos;                                          <<*7724>>18760000
tos := extbase + double(extsize);                                       18765000
ldr'db'l'loda := tos;                                          <<*7724>>18770000
ldr'db'l'hoda := tos;                                          <<*7724>>18775000
ldr'db'strategy := lflags.(0:4);  << save strategy >>          <<*7724>>18780000
                                                                        18785000
<<tos := 0;   tos.(1:3) := flags.(10:3);>><<spec,diag,sysbuf>>          18790000
tos := (lflags land %006000)&lsr(3); << do'post, seq'post >>   <<06858>>18795000
tos := tos lor %2;  << turn on logical disc request bit >>              18800000
                                                                        18805000
x := flags.rtype;   << switch on request type >>                        18810000
asmb( br *+1,x ;                                                        18815000
      br rt0;  br rt1;  br rt2;  br rt3 );                              18820000
                                                                        18825000
<< if this is no pcb i/o, it cannot be sysbuf i/o >>                    18830000
rt3:  << no-pcb i/o >>                                                  18835000
if lflags.sysbufrs and cnt <> 0 then                                    18840000
  suddendeath(sfkerncacheintbad);                                       18845000
go to rt0;    << we must cram a pcb number in here! >>                  18850000
                                                                        18855000
rt1:  << blocked i/o - must clear wws bit in pcb >>                     18860000
<<tos.blocked := 1;>><< turn on blocked bit in flags >>                 18865000
disable;                                                                18870000
clearwws;                                                               18875000
                                                                        18880000
rt2:                                                                    18885000
<<tos.iowake := 1;>>                                                    18890000
                                                                        18895000
rt0:                                                                    18900000
ldr'db'pcb := pcbnum := curprc/pcbsize;                        <<*7724>>18905000
                                                                        18910000
ldr'db'flags := tos; << save flags word  + ldr bit >>          <<*7724>>18915000
                                                               <<*7724>>18920000
<< put db back to sysdb and allow to continue >>               <<*7724>>18925000
exchdb;                                                        <<*7724>>18930000
assemble(ddel);                                                <<*7724>>18935000
penable;                                                       <<*7724>>18940000
                                                                        18945000
<< if caching is in the process of terminating, hold-off all >><<06858>>18950000
<< user disc requests.                                       >><<06858>>18955000
disable;                                                       <<06858>>18960000
                                                               <<*7724>>18965000
<< load abs addr of stop flag on tos >>                        <<*7724>>18970000
cdt'abs'on'tos;                                                <<*7724>>18975000
tos := tos + cdt'stop'pnd;   << abs addr of stop flag >>       <<*7724>>18980000
asmb(lsea);                                                    <<*7724>>18985000
while (tos <> 0) and                                           <<*7724>>18990000
      (cache'dst <> 0) << still enabled >> do                  <<*7724>>18995000
  begin  << impede me, and wait for stopcache executor >>      <<06858>>19000000
  << get in pin list >>                                        <<06858>>19005000
  if (head'pin := cdt'get'word(0,cdt'stop'queue,0))=0 then     <<06858>>19010000
    cdt'set'word(0,cdt'stop'queue,pcbnum);                     <<06858>>19015000
  stringpinattail(head'pin,0);                                 <<06858>>19020000
                                                               <<06858>>19025000
  << impede, waiting for stop cache to work >>                 <<06858>>19030000
  impede(0);                                                   <<06858>>19035000
                                                               <<*7724>>19040000
  << re-load lock word on tos >>                               <<*7724>>19045000
  asmb(lsea);  << for while stmt >>                            <<*7724>>19050000
  end;                                                         <<06858>>19055000
                                                               <<06858>>19060000
<< remove abs pointer to lock word >>                          <<*7724>>19065000
asmb(ddel);                                                    <<*7724>>19070000
                                                               <<*7724>>19075000
<< now, perform unblocked cache processing >>                           19080000
pdisable;                                                               19085000
enable;                                                                 19090000
                                                                        19095000
tos := request'cache(@ioqp);                                            19100000
                                                                        19105000
penable;                                                                19110000
                                                                        19115000
if not tos then                                                         19120000
  begin  << cache did not accept, perform physical attachio >>          19125000
                                                                        19130000
  << return disc request element >>                                     19135000
  tos :=@ioqp;                                                 <<06856>>19140000
  returndiscreq(*);                                                     19145000
                                                                        19150000
  << if this is a stack dst, zero dstx word >>                          19155000
  if ldstx.stackflag then                                               19160000
    dstx := 0;                                                          19165000
                                                                        19170000
  << if this is a data transfer function, we must force     >> <<06858>>19175000
  << any overlapping areas in memory out.                   >> <<06858>>19180000
  if fnct > 4 and cnt <> 0 then <<not r/w/fopen/fclose/dclose>><<06858>>19185000
    if (5 <= fnct <= 6) or  <<zero/blank fill>>                <<06858>>19190000
      fnct = 11 then       << write sector zero >>             <<06858>>19195000
      flush'cache(ldev,                                        <<06858>>19200000
                                                               <<06858>>19205000
        start'addr,                                            <<06858>>19210000
                                                               <<06858>>19215000
        start'addr+(((if cnt < 0 then                          <<06858>>19220000
                                                               <<06858>>19225000
                        double((1-cnt)&asr(1))                 <<06858>>19230000
                                                               <<06858>>19235000
                      else                                     <<06858>>19240000
                                                               <<06858>>19245000
                        double(cnt)) + 127d)&dasr(7)));        <<06858>>19250000
                                                                        19255000
  cdt'attachio := p'attachio(ldev,qmisc,dstx,addr,fnct,cnt,             19260000
                             p1,p2,flags,extbase,extsize);              19265000
  end                                                                   19270000
                                                                        19275000
else                                                                    19280000
                                                                        19285000
  begin  << cache accepted responsibility, so proceed >>                19290000
  if flags.rtype=1 then   << blocked i/o >>                             19295000
    begin                                                               19300000
                                                                        19305000
    cdt'attachio := waitforio(logical(@ioqp) lor %040000);              19310000
                                                                        19315000
    end                                                                 19320000
                                                                        19325000
  else                                                                  19330000
                                                                        19335000
    begin << unblocked request, return ioq index >>                     19340000
    tos := logical(@ioqp) lor %040000;                                  19345000
                                                                        19350000
out:                                                                    19355000
                                                                        19360000
    tos := 0;  << for p'attachio return >>                              19365000
    cdt'attachio := tos;                                                19370000
    end;                                                                19375000
                                                                        19380000
  end;                                                                  19385000
                                                                        19390000
tos := dbsave;    if = then return;  << not set here >>                 19395000
resetcritical(savecrit);                                                19400000
resetdb( * );                                                           19405000
                                                                        19410000
end;      <<  cdt'attachio >>                                           19415000
                                                                        19420000
$page "Cached Disc Domain List Management : Overview"                   19425000
                                                                        19430000
comment                                                                 19435000
                                                                        19440000
all disc domains that have main memory allocated to them (ie cached     19445000
disc domains) are linked into cached disc domain lists.  a separate     19450000
cached disc domain list is maintained for the disc domains belonging    19455000
to common device.  the cached disc domains belonging to a common device 19460000
are linked together through the main memory region headers of  the      19465000
cached domains.  they are linked according to increasing sector offset  19470000
and the head and tail region addresses of the cached dommain lists      19475000
are kept in the cdt entry for the corresponding disc.  (the list is     19480000
ordered for fast searching using the llsh instruction).                 19485000
                                                                        19490000
cached regions are kept in the list even if the disc domain is not      19495000
mapped in and not present.  in particular, any cached disc domain that  19500000
is present, in motion in, or a recoverable overlay candidate is kept    19505000
in the appropraite list of cached disc domains.                         19510000
                                                                        19515000
the cached disc domain lists are managed by the procedures linkcached   19520000
domain and unlinkcacheddomain. linkcacheddomain is invoked by f<<07311>>19525000
object when the main memory region is first allocated for the c<<07311>>19530000
disc domain.  unlinkcacheddomain is invoked when the cached region is   19535000
being wiped out of main memory (from cleanregion or flushdiscrange).    19540000
                                                                        19545000
;                                                                       19550000
                                                                        19555000
$page "Cached Region Management Procedures : Link Cached Region"        19560000
                                                                        19565000
procedure linkcachedregion ( regionbase );                              19570000
value regionbase;                                                       19575000
double regionbase;                                                      19580000
option privileged,uncallable;                                           19585000
                                                                        19590000
comment                                                                 19595000
                                                                        19600000
linkcacheddomain places a main memory region into the list of           19605000
cached disc domains.                                                    19610000
                                                                        19615000
linkcacheddomain is called from fetchobject when space is first         19620000
allocated for the object. (also called from collectgarbage).   <<07311>>19625000
                                                                        19630000
;                                                                       19635000
                                                                        19640000
begin                                                                   19645000
                                                                        19650000
integer ldev,                                                           19655000
        cdtentrynum,                                                    19660000
        pages,                                                          19665000
        cdcount,                                                        19670000
        remlinkcount,                                                   19675000
        devcdtentry;                                                    19680000
                                                                        19685000
double sectoroffset,                                                    19690000
       cdhead,                                                          19695000
       prevlink,                                                        19700000
       nextlink;                                                        19705000
                                                                        19710000
integer hoda=sectoroffset,                                              19715000
        loda=hoda+1;                                                    19720000
                                                                        19725000
double oldlisthead,                                                     19730000
       nextlinktocheck,                                                 19735000
       scanpt,              << index to last scan point >>              19740000
       targetda,                                                        19745000
       thisregndptraddr,                                                19750000
       oldlisttail;                                                     19755000
                                                                        19760000
<< variables for fast cdt access >>                            <<*7724>>19765000
integer ldev'offset,                                           <<*7724>>19770000
        mapd'offset;                                           <<*7724>>19775000
                                                               <<*7724>>19780000
double  save'db;                << caller's db >>              <<*7724>>19785000
                                                               <<*7724>>19790000
logical not'smaller;                                                    19795000
$page                                                          <<*7724>>19800000
                                                               <<*7724>>19805000
                                                               <<*7724>>19810000
                                                               <<*7724>>19815000
                                                               <<*7724>>19820000
                                                               <<*7724>>19825000
subroutine fix'da(fix'region,is'tail);                                  19830000
value fix'region,is'tail;                                               19835000
double fix'region;                                                      19840000
logical is'tail;                                                        19845000
begin                                                                   19850000
                                                                        19855000
<< fix disc address in region header >>                                 19860000
if is'tail then                                                         19865000
   begin                                                                19870000
   tos := fix'region;                                                   19875000
   tos := tos + ndtocacdadisp;                                          19880000
   tos := -1;   << terminator >>                                        19885000
   asmb(ssea;ddel);                                                     19890000
   end                                                                  19895000
else                                                                    19900000
   begin                                                                19905000
   tos := fix'region;                                                   19910000
   tos := tos + ndtohodadisp;                                           19915000
   asmb(ldea);                                                          19920000
   cdt'shift'da;                                                        19925000
   asmb(del);  << remove loda >>                                        19930000
   s1 := s1 + hodatocacdadisp;                                          19935000
   asmb(ssea;ddel);                                                     19940000
   end;                                                                 19945000
                                                                        19950000
end;   << of subroutine fix'da >>                                       19955000
subroutine placeathead;                                                 19960000
                                                                        19965000
begin                                                                   19970000
oldlisthead := cdhead;                                                  19975000
tos := regionbase;                                                      19980000
tos := tos + rbtonddisp;                                                19985000
thisregndptraddr := tos;                                                19990000
                                                                        19995000
<< update scan point to this region >>                                  20000000
$if x1=on                                                      <<*7724>>20005000
cdt'set'double(devcdtentry,cdt'de'scanpt,thisregndptraddr);             20010000
$if x1=off                                                     <<*7724>>20015000
cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1)):=               <<*7724>>20020000
   thisregndptraddr;                                           <<*7724>>20025000
$if                                                            <<*7724>>20030000
                                                                        20035000
$if x1=on                                                      <<*7724>>20040000
cdt'set'double(devcdtentry,cdt'de'reg'hd,thisregndptraddr);             20045000
$if x1=off                                                     <<*7724>>20050000
cdt'darray((ldev'offset+cdt'de'reg'hd)&asr(1)):=               <<*7724>>20055000
   thisregndptraddr;                                           <<*7724>>20060000
$if                                                            <<*7724>>20065000
tos := regionbase;                                                      20070000
tos := tos+rbtopddisp;                                                  20075000
tos := 0d;                                                              20080000
asmb(sdea);      << zero out prev link >>                               20085000
tos := tos+pdtonddisp;                                                  20090000
tos := oldlisthead;                                                     20095000
asmb(sdea;ddel);                                                        20100000
if > then   << load of old head was not zero >>                         20105000
   begin       << must update prevlink of old head. >>                  20110000
   tos := oldlisthead;                                                  20115000
   tos := tos+ndtopddisp;                                               20120000
   tos := regionbase;                                                   20125000
   tos := tos + rbtopddisp;                                             20130000
   asmb(sdea;ddel);                                                     20135000
   end;                                                                 20140000
fix'da(thisregndptraddr,false);                                         20145000
end;     << subroutine placeathead >>                                   20150000
                                                                        20155000
subroutine placeattail;                                                 20160000
                                                                        20165000
begin                                                                   20170000
                                                                        20175000
tos := regionbase;                                                      20180000
tos := tos + rbtonddisp;                                                20185000
tos := 0d;                                                              20190000
asmb(sdea);    << zero next region pointer >>                           20195000
thisregndptraddr:=tos;                                                  20200000
$if x1=on                                                      <<*7724>>20205000
oldlisttail := cdt'set'double(devcdtentry,cdt'de'reg'tl,                20210000
                              thisregndptraddr);                        20215000
$if x1=off                                                     <<*7724>>20220000
oldlisttail := cdt'darray((ldev'offset+cdt'de'reg'tl)&asr(1)); <<*7724>>20225000
cdt'darray(cdt'x) := thisregndptraddr;                         <<*7724>>20230000
$if                                                            <<*7724>>20235000
                                                                        20240000
<< fill in prev and next links of this hole. >>                         20245000
                                                                        20250000
if oldlisttail <> 0d then                                               20255000
   begin                                                                20260000
   tos := thisregndptraddr;                                             20265000
   tos := tos+ndtopddisp;                                               20270000
   tos := oldlisttail;                                                  20275000
   tos := tos + ndtopddisp;                                             20280000
   asmb(sdea;ddel);    << update prev in list ptr >>                    20285000
                                                                        20290000
   << update old tail's next link >>                                    20295000
   tos := oldlisttail;                                                  20300000
   tos := thisregndptraddr;                                             20305000
   asmb(sdea;ddel);                                                     20310000
                                                                        20315000
   << update scan point >>                                              20320000
$if x1=on                                                      <<*7724>>20325000
   cdt'set'double(devcdtentry,cdt'de'scanpt,oldlisttail);               20330000
$if x1=off                                                     <<*7724>>20335000
   cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1)) :=           <<*7724>>20340000
      oldlisttail;                                             <<*7724>>20345000
$if                                                            <<*7724>>20350000
                                                                        20355000
   fix'da(oldlisttail,false);                                           20360000
   end                                                                  20365000
else                                                                    20370000
   begin                                                       <<*7724>>20375000
   << update scan point >>                                              20380000
$if x1=on                                                      <<*7724>>20385000
   cdt'set'double(devcdtentry,cdt'de'scanpt,thisregndptraddr);          20390000
$if x1=off                                                     <<*7724>>20395000
   cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1)) :=           <<*7724>>20400000
      thisregndptraddr;                                        <<*7724>>20405000
$if                                                            <<*7724>>20410000
   end;                                                        <<*7724>>20415000
                                                                        20420000
fix'da(thisregndptraddr,true);                                          20425000
end;      << subroutine placeatthead >>                                 20430000
                                                                        20435000
$page                                                          <<*7724>>20440000
                                                               <<*7724>>20445000
<< put db at the cdt >>                                        <<*7724>>20450000
cdt'abs'on'tos;                                                <<*7724>>20455000
exchdb;                                                        <<*7724>>20460000
save'db := tos;                                                <<*7724>>20465000
                                                               <<*7724>>20470000
<<look up device # and sector offset  of region , fill in               20475000
  corresponding local variables>>                                       20480000
tos := regionbase;                                             <<d7726>>20485000
tos := tos + rbtohodadisp;                                     <<d7726>>20490000
asmb(ldea);                                                    <<d7726>>20495000
asmb(ddup);                                                    <<d7726>>20500000
targetda := tos;                                               <<d7726>>20505000
loda := tos;                                                   <<d7726>>20510000
ldev:=s0.regldevfield;                                         <<d7726>>20515000
hoda:=tos.reghodafield;                                        <<d7726>>20520000
                                                               <<d7726>>20525000
                                                                        20530000
tos:=regionbase;                                                        20535000
tos := tos + rbtoobjidentdisp;                                 <<06855>>20540000
asmb(ldea;delb);        << delete object descriptor word  >>   <<07311>>20545000
cdtentrynum := tos;                                            <<06855>>20550000
                                                                        20555000
<< if the cdt is mapped-in, get length from cdt >>                      20560000
if cdtentrynum <> 0 then                                       <<07311>>20565000
   begin                                                                20570000
   mapd'offset := cdtentrynum * cdt'entry'size;                <<*7724>>20575000
$if x1=on                                                      <<*7724>>20580000
   devcdtentry := cdt'get'word(cdtentrynum,cdt'md'de,0);       <<d7726>>20585000
   pages := integer(                                                    20590000
     cdt'get'double(cdtentrynum,cdt'md'end'sector,0d) -                 20595000
     cdt'get'double(cdtentrynum,cdt'md'sector,0d)) +                    20600000
     1  << overhead >>;                                                 20605000
$if x1=off                                                     <<*7724>>20610000
   tos := cdt'darray((mapd'offset+cdt'md'end'sector)&asr(1));  <<*7724>>20615000
   tos := cdt'darray((mapd'offset+cdt'md'sector)&asr(1));      <<*7724>>20620000
   asmb(dsub,delb);                                            <<*7724>>20625000
   pages := tos+1;                                             <<*7724>>20630000
   devcdtentry := cdt'array(mapd'offset+cdt'md'de);            <<d7726>>20635000
$if                                                            <<d7726>>20640000
   end                                                                  20645000
else                                                                    20650000
   begin                                                                20655000
   tos := tos + objidenttossdisp;                                       20660000
   asmb(lsea);                                                          20665000
   pages := tos;                                                        20670000
   if (devcdtentry := cdt'find'de(ldev)) = 0 then              <<d7726>>20675000
      suddendeath(sfkerncacheintbad);                          <<d7726>>20680000
   end;                                                                 20685000
                                                               <<07311>>20690000
$if x1=on                                                      <<07311>>20695000
tos := mmstat'link'region;                                     <<07311>>20700000
tos := 0;                   << 0 = link, 1 = unlink >>         <<07311>>20705000
tos := regionbase;                                             <<07311>>20710000
mmstat'(*,*,*,*,cdtentrynum,pages,0);                          <<07311>>20715000
$if                                                            <<07311>>20720000
                                                               <<07311>>20725000
                                                                        20730000
<<find out head, tail, prev and next for the list of cached             20735000
  disc domains for this device>>                                        20740000
                                                                        20745000
ldev'offset := devcdtentry * cdt'entry'size;                   <<*7724>>20750000
                                                               <<*7724>>20755000
$if x1=on                                                      <<*7724>>20760000
                                                                        20765000
cdhead  := cdt'get'double(devcdtentry,                                  20770000
                          cdt'de'reg'hd,                                20775000
                          0d);                                          20780000
                                                                        20785000
cdcount := cdt'add'word(devcdtentry,                                    20790000
                        cdt'de'regions,                                 20795000
                        1)-1; <<bumps current by 1>>                    20800000
                                                                        20805000
                                                                        20810000
cdt'add'word(devcdtentry,cdt'de'mapd'pages,pages);                      20815000
$if x1=off                                                     <<*7724>>20820000
cdhead := cdt'darray((ldev'offset+cdt'de'reg'hd)&asr(1));      <<*7724>>20825000
                                                               <<*7724>>20830000
cdt'x := ldev'offset + cdt'de'regions;                         <<*7724>>20835000
tos := cdcount := cdt'array(cdt'x);                            <<*7724>>20840000
cdt'array(cdt'x) := tos + 1;   << bump region count >>         <<*7724>>20845000
                                                               <<*7724>>20850000
cdt'x := ldev'offset + cdt'de'mapd'pages;                      <<*7724>>20855000
cdt'array(cdt'x) := cdt'array(cdt'x) + pages;                  <<*7724>>20860000
$if                                                            <<*7724>>20865000
                                                                        20870000
if cdhead = 0d then                                                     20875000
   begin       << list of cached regions is empty >>                    20880000
   placeathead;                                                         20885000
   placeattail;                                                         20890000
   end                                                                  20895000
else                                                                    20900000
   begin     << must merge into list >>                                 20905000
                                                                        20910000
   << locate position in the hole list for this hole. >>                20915000
                                                                        20920000
   << locate proper hoda position (since llsh only masks 1 word)>>      20925000
                                                                        20930000
   tos := ndtocacdadisp;<< offset from link to target for llsh >>       20935000
   tos := targetda; <<test word>>                                       20940000
   cdt'shift'da;      << put into search form >>                        20945000
   asmb(del);         << remove loda          >>                        20950000
                                                                        20955000
   << determine whether to use scan point or cdhead >>                  20960000
$if x1=on                                                      <<*7724>>20965000
   tos := scanpt :=                                            <<*7724>>20970000
          cdt'get'double(devcdtentry,cdt'de'scanpt,0d);        <<*7724>>20975000
$if x1=off                                                     <<*7724>>20980000
   tos := scanpt :=                                            <<*7724>>20985000
      cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1));          <<*7724>>20990000
$if                                                            <<*7724>>20995000
   if (tos <<scanpt>> <> 0d) then                              <<*7724>>21000000
                                                               <<*7724>>21005000
      begin                                                             21010000
      tos := scanpt;                                                    21015000
      tos := tos + ndtohodadisp;                                        21020000
      asmb(ldea;dxch,ddel);                                             21025000
      if tos <= targetda then                                           21030000
         tos := scanpt                                                  21035000
      else                                                              21040000
         tos := cdhead;                                                 21045000
      end                                                               21050000
   else                                                                 21055000
      tos := cdhead;                                                    21060000
                                                                        21065000
   x := cdcount;                                                        21070000
   asmb(llsh);  << chase through the list to get to right place >>      21075000
   if < then placeattail  else                                          21080000
      begin    << got some regions with the same or larger hoda>>       21085000
      asmb(ddup);                                                       21090000
      nextlinktocheck:=tos;                                             21095000
      remlinkcount := x;                                                21100000
      not'smaller := false;                                             21105000
      do                                                                21110000
         begin <<locate location within hoda>>                          21115000
         asmb(ddup);                                                    21120000
         tos := tos + ndtohodadisp;                                     21125000
         asmb(ldea;dxch,ddel);                                          21130000
         tos := targetda;                                               21135000
         asmb(dcmp);                                                    21140000
         if < then                      <<go to next>>                  21145000
            begin                                                       21150000
            asmb(ldea);                                                 21155000
            if <= then  << we are at end-of-list >>                     21160000
               x := 1; << terminate scan >>                             21165000
            asmb(dxch,ddel);                                            21170000
            end                                                         21175000
         else if > then not'smaller := true                             21180000
         else suddendeath(sfkerncacheintbad);                           21185000
         end                                                            21190000
      until not'smaller or dxbz;                                        21195000
                                                                        21200000
      if x = 0 then placeattail else                                    21205000
         begin    << stopped in middle of list >>                       21210000
                                                                        21215000
         << put in front of link on tos >>                              21220000
                                                                        21225000
         tos := tos+ndtopddisp;                                         21230000
         asmb(ldea);                                                    21235000
         prevlink := tos;                                               21240000
                                                                        21245000
         << now link in behind previous region base. >>                 21250000
                                                                        21255000
         tos := prevlink;                                               21260000
         if <= then placeathead else                                    21265000
            begin                                                       21270000
            tos := tos+pdtonddisp;                                      21275000
            asmb(ldea);                                                 21280000
            nextlink := tos;                                            21285000
                                                                        21290000
            tos := regionbase;                                          21295000
            tos := tos+rbtonddisp;                                      21300000
            asmb(sdea);  << put new next link in prev in list >>        21305000
                                                                        21310000
            asmb(ddup);                                                 21315000
            scanpt := tos;                                              21320000
            << update scan point >>                                     21325000
$if x1=on                                                      <<*7724>>21330000
            cdt'set'double(devcdtentry,cdt'de'scanpt,scanpt);           21335000
$if x1=off                                                     <<*7724>>21340000
            cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1)) :=  <<*7724>>21345000
               scanpt;                                         <<*7724>>21350000
$if                                                            <<*7724>>21355000
                                                                        21360000
            tos := nextlink;                                            21365000
            if <= then suddendeath(sfkerncacheintbad);                  21370000
            tos := tos+ndtopddisp;                                      21375000
            tos := regionbase;                                          21380000
            tos := tos + rbtopddisp;                                    21385000
            asmb(sdea);  << put new prev ptr in next in list >>         21390000
                                                                        21395000
            tos := regionbase;                                          21400000
            tos := tos+rbtonddisp;                                      21405000
                                                                        21410000
            << fix llsh disc address >>                                 21415000
            asmb(ddup);                                                 21420000
            scanpt := tos;                                              21425000
            fix'da(scanpt,false);                                       21430000
                                                                        21435000
            tos := nextlink;                                            21440000
            asmb(sdea);   << put next link into this region >>          21445000
            tos := tos+ndtopddisp;                                      21450000
            tos := prevlink;                                            21455000
            asmb(sdea);   << put prev region ptr into this region >>    21460000
            end;                                                        21465000
         end;                                                           21470000
      end;                                                              21475000
   end;                                                                 21480000
                                                                        21485000
<< put db back to caller's db >>                               <<*7724>>21490000
tos := save'db;                                                <<*7724>>21495000
exchdb;                                                        <<*7724>>21500000
                                                               <<*7724>>21505000
end; <<linkcacheddomain>>                                               21510000
                                                                        21515000
$page "Cached Region Management Procedures : Unlink Cached Region"      21520000
                                                                        21525000
procedure unlinkcachedregion ( regionbase );                            21530000
value regionbase;                                                       21535000
double regionbase;                                                      21540000
option privileged,uncallable;                                           21545000
                                                                        21550000
comment                                                                 21555000
                                                                        21560000
unlinkcacheddomain takes a main memory region off the list of           21565000
cached disc domains.                                                    21570000
                                                                        21575000
this routine is called form cleanregion when a cached domain is         21580000
being wiped out of main memory and by zapcacheddomain when releasing    21585000
cached regions form memory due to partial overlaps, dismounts, or       21590000
cache bypasses.  (also called from collectgarbage).            <<07311>>21595000
                                                                        21600000
;                                                                       21605000
                                                                        21610000
begin                                                                   21615000
                                                                        21620000
integer ldev,                                                           21625000
        regsize,                                                        21630000
        devcdtentry;                                                    21635000
                                                                        21640000
double sectoroffset,                                                    21645000
       holdnextptr,                                                     21650000
       cdtail,                                                          21655000
       prevlink,                                                        21660000
       nextlink;                                                        21665000
                                                                        21670000
<< variables for fast cdt access >>                            <<*7724>>21675000
integer ldev'offset;                                           <<*7724>>21680000
                                                               <<*7724>>21685000
double  save'db;       << caller's setting of db >>            <<*7724>>21690000
                                                                        21695000
integer hoda=sectoroffset,                                              21700000
        loda=sectoroffset+1;                                            21705000
                                                                        21710000
                                                               <<*7724>>21715000
                                                               <<*7724>>21720000
                                                               <<*7724>>21725000
                                                               <<*7724>>21730000
                                                               <<*7724>>21735000
<< set db to cdt >>                                            <<*7724>>21740000
cdt'abs'on'tos;                                                <<*7724>>21745000
exchdb;                                                        <<*7724>>21750000
save'db := tos;                                                <<*7724>>21755000
                                                               <<*7724>>21760000
<<look up device # and sector address of region , fill in               21765000
  corresponding local variables>>                                       21770000
                                                                        21775000
tos:=regionbase;                                                        21780000
tos:=tos+rbtohodadisp;                                                  21785000
assemble(ldea);                                                         21790000
loda := tos;                                                            21795000
ldev:=s0.regldevfield;                                                  21800000
hoda:=tos.reghodafield;                                                 21805000
                                                                        21810000
<<find out head, tail, prev and next for the list of cached             21815000
  disc domains for this device>>                                        21820000
                                                                        21825000
if (devcdtentry := cdt'find'de(ldev)) = 0 then                 <<06858>>21830000
   suddendeath(sfkerncacheintbad);                             <<06858>>21835000
ldev'offset := devcdtentry * cdt'entry'size;                   <<*7724>>21840000
                                                                        21845000
<< decrement current region count by 1.  if < 0, sf >>                  21850000
$if x1=on                                                      <<*7724>>21855000
if cdt'add'word(devcdtentry,                                            21860000
                cdt'de'regions,                                         21865000
                -1) < 0 then                                            21870000
  suddendeath(sfkerncacheintbad);                                       21875000
$if x1=off                                                     <<*7724>>21880000
tos := cdt'array(ldev'offset+cdt'de'regions) - 1;              <<*7724>>21885000
if < then                                                      <<*7724>>21890000
   suddendeath(sfkerncacheintbad);                             <<*7724>>21895000
cdt'array(cdt'x) := tos;                                       <<*7724>>21900000
$if                                                            <<*7724>>21905000
                                                                        21910000
<< decrement number of main memory pages consumed by device >>          21915000
tos := regionbase;                                                      21920000
tos := tos + rbtossdisp;                                                21925000
asmb(lsea);                                                             21930000
regsize := -tos;                                                        21935000
$if x1=on                                                      <<*7724>>21940000
cdt'add'word(devcdtentry,cdt'de'mapd'pages,regsize);                    21945000
$if x1=off                                                     <<*7724>>21950000
cdt'x := ldev'offset + cdt'de'mapd'pages;                      <<*7724>>21955000
cdt'array(cdt'x) := cdt'array(cdt'x) + regsize;                <<*7724>>21960000
$if                                                            <<*7724>>21965000
                                                                        21970000
                                                               <<07311>>21975000
$if x1=on                                                      <<07311>>21980000
tos := mmstat'link'region;                                     <<07311>>21985000
tos := 1;                   << 0 = link, 1 = unlink >>         <<07311>>21990000
tos := regionbase;                                             <<07311>>21995000
mmstat'(*,*,*,*,devcdtentry,regsize,0);                        <<07311>>22000000
$if                                                            <<07311>>22005000
                                                               <<07311>>22010000
<< look up addresses of prev hole and next link from header >>          22015000
                                                                        22020000
tos := regionbase;                                                      22025000
tos := tos+rbtopddisp;                                                  22030000
asmb(ldea);                                                             22035000
if < then                                                               22040000
   suddendeath(sfkerncacheintbad);  << already unlinked >>              22045000
prevlink := tos;                                                        22050000
tos := -1d;                                                             22055000
asmb(sdea);                                                             22060000
tos := tos+pdtonddisp;                                                  22065000
asmb(ldea);                                                             22070000
if < then                                                               22075000
   suddendeath(sfkerncacheintbad);  << already unlinked >>              22080000
nextlink := tos;                                                        22085000
tos := -1d;                                                             22090000
asmb(sdea);                                                             22095000
asmb(ddel);                                                             22100000
                                                                        22105000
<< take the region off the list >>                                      22110000
                                                                        22115000
if prevlink <> 0d then                                                  22120000
   begin   << region is not the first in the list. >>                   22125000
                                                                        22130000
   << place next link into previous cd's next link >>                   22135000
                                                                        22140000
   tos := prevlink;                                                     22145000
   tos := tos+pdtonddisp;                                               22150000
                                                                        22155000
   << update scan point >>                                              22160000
   asmb(ddup);                                                          22165000
   holdnextptr := tos;                                                  22170000
$if x1=on                                                      <<*7724>>22175000
   cdt'set'double(devcdtentry,cdt'de'scanpt,holdnextptr);               22180000
$if x1=off                                                     <<*7724>>22185000
   asmb(ddup);                                                 <<*7724>>22190000
   cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1)) := tos;      <<*7724>>22195000
$if                                                            <<*7724>>22200000
                                                                        22205000
   tos := nextlink;                                                     22210000
   asmb(sdea;ddel);                                                     22215000
                                                                        22220000
   << place previnlist into next cd's previous pointer >>               22225000
                                                                        22230000
   if nextlink=0d then                                                  22235000
      begin   << that was the last cd in the list. >>                   22240000
                                                                        22245000
      << update hole list tail and max avail region size >>             22250000
                                                                        22255000
      tos := prevlink;                                                  22260000
      tos := tos + pdtonddisp;                                          22265000
      asmb(ddup);                                                       22270000
      cdtail := tos;                                                    22275000
                                                                        22280000
      << put terminator (llsh) in new last region >>                    22285000
      tos := tos + ndtocacdadisp;                                       22290000
      tos := -1;                                                        22295000
      asmb(ssea;ddel);                                                  22300000
                                                                        22305000
$if x1=on                                                      <<*7724>>22310000
      cdt'set'double(devcdtentry,cdt'de'reg'tl,cdtail);                 22315000
$if x1=off                                                     <<*7724>>22320000
      cdt'darray((ldev'offset+cdt'de'reg'tl)&asr(1)) :=        <<*7724>>22325000
         cdtail;                                               <<*7724>>22330000
$if                                                            <<*7724>>22335000
      end                                                               22340000
   else                                                                 22345000
      begin    << not the last cd in the list >>                        22350000
      tos := nextlink;                                                  22355000
      tos := tos+ndtopddisp;                                            22360000
      tos := prevlink;                                                  22365000
      asmb(sdea;ddel);   << new prev link for next in list >>           22370000
      end;                                                              22375000
   end                                                                  22380000
else                                                                    22385000
   begin        << removing first in list >>                            22390000
                                                                        22395000
   << update scan point.  since there isn't a prior, point >>           22400000
   << to cdhead.                                           >>           22405000
$if x1=on                                                      <<*7724>>22410000
   cdt'set'double(devcdtentry,cdt'de'scanpt,0d);                        22415000
$if x1=off                                                     <<*7724>>22420000
   cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1)) := 0d;       <<*7724>>22425000
$if                                                            <<*7724>>22430000
                                                                        22435000
   if nextlink = 0d then                                                22440000
      begin  <<last entry in list>>                                     22445000
$if x1=on                                                      <<*7724>>22450000
      cdt'set'double(devcdtentry,cdt'de'reg'hd,0d);                     22455000
      cdt'set'double(devcdtentry,cdt'de'reg'tl,0d);                     22460000
$if x1=off                                                     <<*7724>>22465000
      cdt'darray((ldev'offset+cdt'de'reg'hd)&asr(1)) := 0d;    <<*7724>>22470000
      cdt'darray((ldev'offset+cdt'de'reg'tl)&asr(1)) := 0d;    <<*7724>>22475000
$if                                                            <<*7724>>22480000
      end                                                               22485000
   else                                                                 22490000
      begin    << there's a cd after this one >>                        22495000
                                                                        22500000
      << make next cd the new head. >>                                  22505000
                                                                        22510000
$if x1=on                                                      <<*7724>>22515000
      cdt'set'double(devcdtentry,cdt'de'reg'hd,nextlink);               22520000
$if x1=off                                                     <<*7724>>22525000
      cdt'darray((ldev'offset+cdt'de'reg'hd)&asr(1)) :=        <<*7724>>22530000
         nextlink;                                             <<*7724>>22535000
$if                                                            <<*7724>>22540000
      tos := nextlink;                                                  22545000
      tos := tos+ndtopddisp;                                            22550000
      tos := 0d;                                                        22555000
      asmb(sdea;ddel);   << erase previous link >>                      22560000
      end;                                                              22565000
   end;                                                                 22570000
                                                               <<*7724>>22575000
<< put db back to caller's db >>                               <<*7724>>22580000
tos := save'db;                                                <<*7724>>22585000
exchdb;                                                        <<*7724>>22590000
                                                               <<*7724>>22595000
end;  <<unlinkcacheddomain>>                                            22600000
$page "Cache Management Utilities : Zap Cached Domain"                  22605000
                                                                        22610000
procedure zapcacheddomain(regionbase);                                  22615000
value regionbase;                                                       22620000
double regionbase;                                                      22625000
option privileged,uncallable;                                           22630000
                                                                        22635000
comment                                                                 22640000
                                                                        22645000
removes the cached disc domain pointed to by regionbase from the list   22650000
of cached domains attached to the device's cdt entry, wipes out the     22655000
indications in the region header that a cached domain was sitting       22660000
there, and releases the main memory region.                    <<06858>>22665000
                                                                        22670000
assumes caller is pdisabled, and db is placed at sysdb.        <<06858>>22675000
                                                               <<06858>>22680000
                                                                        22685000
returned condition codes are:                                  <<06858>>22690000
                                                               <<06858>>22695000
   cce - domain was successfully removed                       <<06858>>22700000
   ccg - domain was not remove because it was still mapped     <<06858>>22705000
;                                                                       22710000
                                                                        22715000
begin                                                                   22720000
                                                                        22725000
double obj;                                                    <<06855>>22730000
logical array objid(*)=obj;                                    <<06855>>22735000
logical subregflags,                                           <<06858>>22740000
        rstat = q-1;     << caller's status register >>        <<06858>>22745000
                                                               <<06858>>22750000
define rstatus = rstat.(6:2)#;                                 <<06858>>22755000
                                                                        22760000
tos:=regionbase;                                                        22765000
tos := tos+rbtoobjidentdisp;                                            22770000
asmb(ldea);                                                    <<06855>>22775000
obj := tos;                                                    <<06855>>22780000
if (objid(objidtypefield) <> objidcdtype) then                 <<06858>>22785000
   suddendeath(sfkerncacheintbad);                             <<06858>>22790000
                                                               <<06858>>22795000
<< if it is still mapped into a cdt entry, we cannot release >><<06858>>22800000
<< it from main memory.                                      >><<06858>>22805000
if (objid(objidnumfield) <> 0 ) then                           <<06858>>22810000
   rstatus := ccg                                              <<06858>>22815000
else                                                           <<06858>>22820000
   begin                                                       <<06858>>22825000
   tos:=0;                                                     <<06858>>22830000
   asmb(ssea);                                                 <<06858>>22835000
   unlinkcachedregion(regionbase);                             <<06858>>22840000
                                                                        22845000
   tos := regionbase;                                          <<06858>>22850000
   tos:=tos+rbtosasdisp;                                       <<06858>>22855000
   asmb(lsea);                                                 <<06858>>22860000
   subregflags := tos;                                         <<06858>>22865000
   if not subregflags.regcachedflag then                       <<06858>>22870000
      suddendeath(sfkerncacheintbad);                          <<06858>>22875000
   tos:=subregflags;                                           <<06858>>22880000
   tos.regcachedflag:=0;                                       <<06858>>22885000
   tos.regrocflag:=0;                                          <<06858>>22890000
   asmb(ssea);                                                 <<06858>>22895000
                                                                        22900000
   <<if reg assigned, release it>>                             <<06858>>22905000
                                                                        22910000
   tos:=tos+sastorasdisp;                                      <<06858>>22915000
   asmb(lsea);                                                 <<06858>>22920000
   if ls0.regreservedflag then suddendeath(sfkerncacheintbad); <<06858>>22925000
   if ls0.regassignedflag then                                 <<06858>>22930000
      begin                                                    <<06858>>22935000
                                                               <<06858>>22940000
                                                               <<06858>>22945000
      releaseregion(regionbase,0);                             <<06858>>22950000
                                                               <<06858>>22955000
      end;                                                     <<06858>>22960000
                                                               <<06858>>22965000
   << return good status back to caller >>                     <<06858>>22970000
   rstatus := cce;                                             <<06858>>22975000
   end;                                                        <<06858>>22980000
end;  <<zapcacheddomain>>                                               22985000
                                                                        22990000
                                                                        22995000
$page "Cache Utilities : CDT'MAP'CACHED'DOMAIN"                         23000000
                                                                        23005000
logical procedure cdt'map'cached'domain(devcdtentry,start'addr,         23010000
                                        limit'addr,new'cdt,    <<07308>>23015000
                                        ldr'entry'index);      <<07308>>23020000
value devcdtentry,start'addr,limit'addr,new'cdt,               <<07308>>23025000
      ldr'entry'index;                                                  23030000
integer devcdtentry,new'cdt;                                            23035000
logical ldr'entry'index;                                       <<07308>>23040000
double start'addr,limit'addr;                                           23045000
option privileged,uncallable,internal;                         <<06858>>23050000
                                                                        23055000
                                                                        23060000
comment                                                                 23065000
                                                                        23070000
input parameters are:                                                   23075000
                                                                        23080000
devcdtentry  - this is the cdt entry no. of the device.                 23085000
                                                                        23090000
start'addr   - this is the starting sector number of the                23095000
               requested domain(s) to flush, or the start               23100000
               address of logical disc request issued to                23105000
               satisfy a map request.                                   23110000
                                                                        23115000
limit'adr    - this is the limit sector number of the requested         23120000
               domain(s) to be flushed, or the end address of           23125000
               the logical disc request.                                23130000
                                                                        23135000
new'cdt      - only valid on a map request, this is the newly           23140000
               obtained mapped-domain cdt entry which has not h<<07308>>23145000
               strategy applied to it.  in case of a miss on the        23150000
               disc range specified by start'addr and limit'add<<07308>>23155000
               the disc address range specified in the cdt is           23160000
               flushed because it has a strategy applied to it          23165000
               which might be larger than the disc address range        23170000
               necessary to satisfy the actual logical disc req.        23175000
                                                                        23180000
ldr'entry'                                                     <<07308>>23185000
index        - only valid on a map request, this is the        <<07308>>23190000
               logical disc request which is trying to be      <<07308>>23195000
               statisfied.  its only reason for being passed   <<07308>>23200000
               is to use it as a parameter to the strategy     <<07308>>23205000
               routine on a miss.                              <<07308>>23210000
                                                               <<07308>>23215000
return parameter is:                                                    23220000
                                                                        23225000
cdt'map'cached'domain -                                        <<06858>>23230000
               on a map request, false is returned             <<06858>>23235000
               on a miss and true is returned if there is a             23240000
               hit.                                                     23245000
                                                                        23250000
cdt'flush'cached'range -                                       <<06858>>23255000
               on a flush request, true is returned if the enti<<06858>>23260000
               range was successfully flushed, and false is ret<<06858>>23265000
               if there was a mapped domain in the range specif<<06858>>23270000
               to be flushed.                                  <<06858>>23275000
                                                               <<06858>>23280000
this procedure scans the list of cached regions pointed to by the       23285000
devcdtentry passed as a parameter to locate the disc region             23290000
delimited by the start'addr and limit'addr parameters.  if a cached     23295000
region is found which completely contains the specified disc range,     23300000
a cdt entry is obtained and formatted to map the cached region and      23305000
the cdt entry number is returned.  anyt partial overlaps are zapped     23310000
out from memory.  if the specified disc range is not on the list        23315000
of cached disc domains, a zero is returned.                             23320000
                                                                        23325000
caller expected to be pdisabled, db must be at sysdb.                   23330000
                                                                        23335000
                                                                        23340000
;                                                                       23345000
                                                                        23350000
begin                                                                   23355000
                                                                        23360000
entry cdt'flush'cached'range;                                           23365000
                                                                        23370000
equate hodatopddisp    = rbtopddisp - rbtohodadisp,            <<07308>>23375000
       hodatorbdisp    = -rbtohodadisp;                        <<07308>>23380000
                                                               <<07308>>23385000
integer limithoda=limit'addr,                                           23390000
        limitloda=limithoda+1;                                          23395000
                                                                        23400000
double cdhead,                                                          23405000
       cdtail,                                                          23410000
       targetda,                                                        23415000
       nextdiscaddr,                                                    23420000
       limitda,                                                         23425000
       da'less'ldev,                                                    23430000
       nextlinktocheck,                                                 23435000
       checkregionbase,                                                 23440000
       save'overlap'regbase,   << for flush on "miss" map req >>        23445000
       targetda'hit,           << da for hit on map request   >>        23450000
       limitda'hit,            << limit da for hit on map req.>>        23455000
       scanpt,                 << scan point (to save time)   >>        23460000
       checkregionsectors,                                              23465000
       checkregionlimit,                                                23470000
       checkregionstart;                                                23475000
                                                                        23480000
integer domainsize,                                                     23485000
        cdcount,                                                        23490000
        remlinkcount,                                                   23495000
        ldev,                                                           23500000
        flags,                                                          23505000
        returned'cdt = cdt'map'cached'domain,                           23510000
        starthoda=start'addr,                                           23515000
        startloda=start'addr+1;                                         23520000
                                                                        23525000
<< variables for fast cdt accessing >>                         <<*7724>>23530000
double  save'db;             << value of db upon calling >>    <<*7724>>23535000
integer ldev'offset,         << offset of ldev entry in cdt >> <<*7724>>23540000
        mapd'offset,         << offset of mapd entry in cdt >> <<*7724>>23545000
        temp'mapd'offset;    << offset to temp mapd entry   >> <<*7724>>23550000
                                                               <<*7724>>23555000
logical flush,                                                          23560000
        cdtfield,            << cdt# portion of objident    >> <<*7724>>23565000
        smaller,                                                        23570000
        roc,                                                            23575000
        zapfailed:=false,<<t if zap of mapped domain attempted <<06858>>23580000
        gotahit := false;                                               23585000
                                                                        23590000
double obj;                                                    <<06855>>23595000
logical array objident(*)=obj;                                 <<06855>>23600000
$if x1=off                                                              23605000
def'set'double;                                                         23610000
def'set'bit;                                                            23615000
def'get'double;                                                         23620000
def'get'word;                                                           23625000
$if                                                                     23630000
$page                                                          <<07308>>23635000
subroutine checkcheckregion;                                            23640000
                                                                        23645000
comment                                                                 23650000
                                                                        23655000
checks the region pointed to by the checkregionbase variable to see     23660000
if this disc domain is contained in that region or overlaps that        23665000
region.  if contained, that region is mapped in.  if partial            23670000
overlapped, that region is zapped.                                      23675000
                                                                        23680000
the entry point cdt'flush'cachedrange causes any overlapping domains    23685000
to be zapped even if they are complete hits.                            23690000
                                                                        23695000
;                                                                       23700000
                                                                        23705000
begin                                                                   23710000
                                                                        23715000
<<check check reg for overlap>>                                         23720000
                                                                        23725000
tos := checkregionbase;                                                 23730000
tos := tos + rbtohodadisp;                                              23735000
asmb(ldea);                                                             23740000
checkregionstart:=tos;                                                  23745000
                                                                        23750000
<< if this domain is absent, but assigned a reserved region, >>         23755000
<< the ss is not correct yet.  we must figure length from    >>         23760000
<< mapped cdt entry.                                         >>         23765000
tos := tos + hodatoobjidentdisp;                                        23770000
asmb(ldea);                                                    <<06855>>23775000
obj:=tos;                                                      <<06855>>23780000
if (objident(objidtypefield) = objidcdtype) then               <<06855>>23785000
   begin  << this is a cached domain, check if assigned >>              23790000
   if ( cdtfield := objident(objidnumfield) ) <> 0 then        <<*7724>>23795000
     begin << get length from cdt entry >>                              23800000
$if x1=on                                                      <<*7724>>23805000
     checkregionsectors:=                                               23810000
      cdt'get'double(cdtfield,cdt'md'end'sector,0d)            <<*7724>>23815000
       0d)                                                     <<06855>>23820000
     -cdt'get'double(cdtfield,cdt'md'sector,0d);               <<*7724>>23825000
$if x1=off                                                     <<*7724>>23830000
     temp'mapd'offset := cdtfield * cdt'entry'size;            <<*7724>>23835000
     checkregionsectors :=                                     <<*7724>>23840000
        cdt'darray((temp'mapd'offset+cdt'md'end'sector)&asr(1))<<*7724>>23845000
      - cdt'darray((temp'mapd'offset+cdt'md'sector)&asr(1));   <<*7724>>23850000
$if                                                            <<*7724>>23855000
     end                                                                23860000
   else                                                                 23865000
     begin  << normal path >>                                           23870000
     tos := tos + objidenttossdisp;                                     23875000
     asmb(lsea;deca,zero;xch);  << put double pgs-1 on tos >>           23880000
     tos := tos * sectorspermainmempage;                                23885000
     checkregionsectors := tos;  << save # of sectors >>                23890000
     end;                                                               23895000
   end                                                                  23900000
else                                                                    23905000
   suddendeath(sfkerncacheintbad);  << not a cached domain >>           23910000
                                                                        23915000
asmb(ddel); <<get rid of region address>>                               23920000
tos:=checkregionlimit:=checkregionstart+checkregionsectors;    <<06858>>23925000
                                                                        23930000
if tos > targetda'hit then                                     <<07308>>23935000
   begin <<checkregion is beyond>>                             <<06858>>23940000
   if checkregionstart < limitda'hit then                      <<07308>>23945000
      begin  <<check region not below ==> they overlap>>                23950000
      if flush then                                            <<06858>>23955000
         begin                                                 <<06858>>23960000
         << point to sysdb >>                                  <<*7724>>23965000
         tos := %1000 d;                                       <<*7724>>23970000
         exchdb;                                               <<*7724>>23975000
                                                               <<*7724>>23980000
         zapcacheddomain(checkregionbase);                     <<06858>>23985000
         if > then                                             <<06858>>23990000
            zapfailed := true;                                 <<06858>>23995000
         << point back to cdt >>                               <<*7724>>24000000
         exchdb;                                               <<*7724>>24005000
         asmb(ddel);                                           <<*7724>>24010000
         end                                                   <<06858>>24015000
      else                                                     <<06858>>24020000
         begin  <<not flush so check for hit>>                          24025000
                                                                        24030000
         << at this point, we have determined that an overlap >>        24035000
         << exists with, at least, the strategy determined on >>        24040000
         << this request.  save the first region number over- >>        24045000
         << lapping in case we need to flush on an overlap.   >>        24050000
         if save'overlap'regbase = 0d then                              24055000
            save'overlap'regbase := checkregionbase;                    24060000
                                                                        24065000
         << now, use actual request disc address to determine >>        24070000
         << whether we have a total 'hit'.                    >>        24075000
         if (checkregionstart <= targetda'hit)                          24080000
         and (checkregionlimit >= limitda'hit) then                     24085000
            begin  <<its contained entirely in the check region>>       24090000
            gotahit := true;                                            24095000
                                                                        24100000
            <<if region not assigned, recover it>>                      24105000
                                                                        24110000
            tos:=checkregionbase;                                       24115000
            tos:=tos+rbtosasdisp;                                       24120000
            asmb(lsea);                                                 24125000
            if not ls0.regcachedflag                                    24130000
            then suddendeath(sfkerncacheintbad);                        24135000
            if ls0.regrocflag then                                      24140000
               begin <<recover it>>                                     24145000
               << point to sysdb >>                            <<*7724>>24150000
               tos := %1000 d;                                 <<*7724>>24155000
               exchdb;                                         <<*7724>>24160000
                                                               <<*7724>>24165000
               recoveroc(buildobjid(mappeddomainobject,0,0),            24170000
                         0,checkregionbase);                            24175000
               << point back to cdt >>                         <<*7724>>24180000
               exchdb;                                         <<*7724>>24185000
               asmb(ddel);                                     <<*7724>>24190000
               roc := true;                                             24195000
               end                                                      24200000
            else                                                        24205000
               roc := false;                                            24210000
                                                                        24215000
            asmb(del,ddel);                                             24220000
                                                                        24225000
            <<map in check region>>                                     24230000
                                                                        24235000
            << strip ldev >>                                            24240000
            tos := checkregionstart;                                    24245000
            s1.(0:8) := 0;                                              24250000
$if x1=on                                                      <<*7724>>24255000
            da'less'ldev := tos;                                        24260000
                                                                        24265000
            cdt'set'double(new'cdt,cdt'md'sector,                       24270000
                           da'less'ldev);                               24275000
$if x1=off                                                     <<*7724>>24280000
            cdt'darray((mapd'offset+cdt'md'sector) & asr(1))   <<*7724>>24285000
               := tos;                                         <<*7724>>24290000
$if                                                            <<*7724>>24295000
            tos := checkregionlimit;                                    24300000
            s1.(0:8) := 0;                                              24305000
$if x1=on                                                      <<*7724>>24310000
            da'less'ldev := tos;                                        24315000
            cdt'set'double(new'cdt,cdt'md'end'sector,                   24320000
                           da'less'ldev);                               24325000
$if x1=off                                                     <<*7724>>24330000
            cdt'darray((mapd'offset+cdt'md'end'sector)&asr(1)) <<*7724>>24335000
                := tos;                                        <<*7724>>24340000
$if                                                            <<*7724>>24345000
                                                               <<*7724>>24350000
$if x1=on                                                      <<*7724>>24355000
            cdt'set'double(new'cdt,cdt'md'mem'addr,checkregionbase);    24360000
                                                                        24365000
            << update scan point >>                                     24370000
            cdt'set'double(devcdtentry,cdt'de'scanpt,                   24375000
                           checkregionbase+double(rbtonddisp));         24380000
                                                                        24385000
            cdt'set'bit(new'cdt,cdt'abs'bit,0);<<mark pres>>            24390000
            cdt'set'bit(new'cdt,cdt'virgin'bit,0);<<not virgin>>        24395000
                                                               <<*7724>>24400000
$if x1=off                                                     <<*7724>>24405000
            cdt'darray((mapd'offset+cdt'md'mem'addr) & asr(1)) <<*7724>>24410000
                := checkregionbase;                            <<*7724>>24415000
                                                               <<*7724>>24420000
            << update scan point >>                            <<*7724>>24425000
            tos := checkregionbase;                            <<*7724>>24430000
            tos := tos + rbtonddisp;                           <<*7724>>24435000
            cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1))     <<*7724>>24440000
               := tos;                                         <<*7724>>24445000
                                                               <<*7724>>24450000
            tos := cdt'array(mapd'offset+cdt'md'flags);        <<*7724>>24455000
            tos.(cdt'abs'bit:1) := 0;                          <<*7724>>24460000
            tos.(cdt'virgin'bit:1) := 0;                       <<*7724>>24465000
            cdt'array(cdt'x) := tos;                           <<*7724>>24470000
$if                                                            <<*7724>>24475000
                                                               <<*7724>>24480000
            <<fix up objident in region header>>                        24485000
            tos:=checkregionbase;                                       24490000
            tos:=tos+rbtoobjidentdisp;                                  24495000
            tos := obj;                                        <<07307>>24500000
                                                               <<*7724>>24505000
            << if already mapped, there is a logic problem >>  <<*7724>>24510000
            if cdtfield <> 0 then                              <<*7724>>24515000
               suddendeath(sfkerncacheintbad);                          24520000
            s0:=new'cdt;                                       <<06855>>24525000
            asmb(sdea;ddel);                                   <<06855>>24530000
            end;                                                        24535000
         end;                                                           24540000
      end;                                                              24545000
   end;                                                                 24550000
end;  <<subroutine checkcheckregion>>                                   24555000
$page                                                          <<07308>>24560000
subroutine loop'thru'list;                                              24565000
begin                                                                   24570000
                                                                        24575000
<< called when pointing to overlapping part of list >>                  24580000
tos := nextlinktocheck;                                                 24585000
tos := tos + ndtohodadisp;                                              24590000
asmb(ldea;dxch,ddel);                                                   24595000
nextdiscaddr := tos;                                                    24600000
while (nextlinktocheck > 0d)                                            24605000
and (limitda'hit > nextdiscaddr)                               <<07308>>24610000
and not gotahit                                                         24615000
do                                                                      24620000
   begin <<check next link for overlap>>                                24625000
   tos := nextlinktocheck;                                              24630000
   asmb(ldea);                                                          24635000
   nextlinktocheck := tos;                                              24640000
   tos := tos + ndtorbdisp;                                             24645000
   checkregionbase := tos;                                              24650000
   checkcheckregion;                                                    24655000
   tos := nextlinktocheck;                                              24660000
   tos := tos + ndtohodadisp;                                           24665000
   asmb(ldea);                                                          24670000
   nextdiscaddr := tos;                                                 24675000
   asmb(ddel);    << clean up stack >>                                  24680000
   end;                                                                 24685000
end;                                                                    24690000
$page                                                          <<07308>>24695000
subroutine process'miss;                                       <<07308>>24700000
begin                                                          <<07308>>24705000
<< process a miss on a map request >>                          <<07308>>24710000
<< first, apply a strategy to the request >>                   <<07308>>24715000
cdt'strategy(new'cdt,ldr'entry'index);                         <<07308>>24720000
                                                               <<07308>>24725000
<< obtain disc limits from strategy >>                         <<07308>>24730000
$if x1=on                                                      <<*7724>>24735000
tos := cdt'get'double(new'cdt,cdt'md'sector,0d);               <<07308>>24740000
$if x1=off                                                     <<*7724>>24745000
tos := cdt'darray((mapd'offset+cdt'md'sector)&asr(1));         <<*7724>>24750000
$if                                                            <<*7724>>24755000
s1.regldevfield := ldev;                                       <<07308>>24760000
targetda := tos;                                               <<07308>>24765000
$if x1=on                                                      <<*7724>>24770000
tos := cdt'get'double(new'cdt,cdt'md'end'sector,0d);           <<07308>>24775000
$if x1=off                                                     <<*7724>>24780000
tos := cdt'darray((mapd'offset+cdt'md'end'sector)&asr(1));     <<*7724>>24785000
$if                                                            <<*7724>>24790000
s1.regldevfield := ldev;                                       <<07308>>24795000
limitda := tos;                                                <<07308>>24800000
                                                               <<07308>>24805000
<< determine region address to back-up to to start flush >>    <<07308>>24810000
if save'overlap'regbase = 0d then                              <<07308>>24815000
   if (save'overlap'regbase:=checkregionbase) = 0d then        <<07308>>24820000
      if cdtail <> 0d then                                     <<07308>>24825000
         save'overlap'regbase:=cdtail+double(ndtorbdisp);      <<07308>>24830000
                                                               <<07308>>24835000
tos := save'overlap'regbase;                                   <<07308>>24840000
if <> then                                                     <<07308>>24845000
   begin  << start backing-up regions until no overlap >>      <<07308>>24850000
   smaller := false;                                           <<07308>>24855000
   do                                                          <<07308>>24860000
      begin                                                    <<07308>>24865000
      tos := tos + rbtohodadisp;                               <<07308>>24870000
      asmb(ldea);                                              <<07308>>24875000
      if tos > targetda then  << we must go-back a region >>   <<07308>>24880000
         begin                                                 <<07308>>24885000
         tos := tos + hodatopddisp;                            <<07308>>24890000
         asmb(ldea);                                           <<07308>>24895000
         if = then << we're at beginning-of-list >>            <<07308>>24900000
            begin << terminate scan >>                         <<07308>>24905000
            asmb(ddel);  << remove zeros >>                    <<07308>>24910000
            tos := tos + pdtorbdisp;  << point back to rb >>   <<07308>>24915000
            smaller := true;                                   <<07308>>24920000
            end                                                <<07308>>24925000
         else                                                  <<07308>>24930000
            << make tos a rb to previous region >>             <<07308>>24935000
            begin                                              <<07308>>24940000
            tos := tos + pdtorbdisp;                           <<07308>>24945000
            asmb(dxch,ddel);                                   <<07308>>24950000
            end;                                               <<07308>>24955000
         end                                                   <<07308>>24960000
      else                                                     <<07308>>24965000
         << we have backed-up far-enough >>                    <<07308>>24970000
         begin                                                 <<07308>>24975000
         tos := tos + hodatorbdisp;                            <<07308>>24980000
         smaller := true;                                      <<07308>>24985000
         end;                                                  <<07308>>24990000
      end until smaller;  << of do backing-up regions >>       <<07308>>24995000
                                                               <<07308>>25000000
   << region base should be on tos here >>                     <<07308>>25005000
   tos := tos + rbtonddisp;                                    <<07308>>25010000
   nextlinktocheck := tos;                                     <<07308>>25015000
   flush := true;                                              <<07308>>25020000
   limitda'hit := limitda;                                     <<07308>>25025000
   targetda'hit := targetda;                                   <<07308>>25030000
   loop'thru'list;                                             <<07308>>25035000
   end                                                         <<07308>>25040000
else                                                           <<07308>>25045000
   asmb(ddel);  << remove stacked regionbase of zeros >>       <<07308>>25050000
end;  << of subroutine process'miss >>                         <<07308>>25055000
$page                                                          <<07308>>25060000
flush := false;                                                         25065000
go start;                                                               25070000
                                                                        25075000
cdt'flush'cached'region : flush := true;                                25080000
                                                                        25085000
start:                                                                  25090000
                                                                        25095000
<< place db at cdt >>                                          <<*7724>>25100000
cdt'abs'on'tos;                                                <<*7724>>25105000
exchdb;                                                        <<*7724>>25110000
save'db := tos;                                                <<*7724>>25115000
ldev'offset := devcdtentry * cdt'entry'size;                   <<*7724>>25120000
mapd'offset := new'cdt * cdt'entry'size;                       <<*7724>>25125000
                                                               <<*7724>>25130000
$if x1=on                                                      <<*7724>>25135000
cdhead  := cdt'get'double(devcdtentry,                                  25140000
                          cdt'de'reg'hd,                                25145000
                          0d);                                          25150000
                                                                        25155000
cdtail := cdt'get'double(devcdtentry,                                   25160000
                         cdt'de'reg'tl,                                 25165000
                         0d);                                           25170000
                                                                        25175000
ldev := cdt'get'word(devcdtentry,cdt'de'ldev,0);                        25180000
                                                                        25185000
$if x1=off                                                     <<*7724>>25190000
cdhead:=cdt'darray((ldev'offset+cdt'de'reg'hd)&asr(1));        <<*7724>>25195000
cdtail:=cdt'darray((ldev'offset+cdt'de'reg'tl)&asr(1));        <<*7724>>25200000
ldev := cdt'array(ldev'offset+cdt'de'ldev);                    <<*7724>>25205000
$if                                                            <<*7724>>25210000
                                                               <<*7724>>25215000
checkregionbase :=                                             <<07308>>25220000
save'overlap'regbase := 0d;  << init to no overlap >>                   25225000
                                                               <<*7551>>25230000
if (cdcount := cdt'array(ldev'offset+cdt'de'regions)) = 0      <<*7724>>25235000
   and cdt'array(ldev'offset+cdt'de'mapd'cnt) <> 0             <<*7724>>25240000
  then zapfailed := true;                                      <<*7551>>25245000
                                                               <<*7551>>25250000
                                                                        25255000
$if x1=on                                                      <<*7724>>25260000
tos := cdcount := cdt'get'word(devcdtentry,cdt'de'regions,0);  <<*7724>>25265000
$if x1=off                                                     <<*7724>>25270000
tos := cdcount := cdt'array(ldev'offset+cdt'de'regions);       <<*7724>>25275000
$if                                                            <<*7724>>25280000
                                                               <<*7724>>25285000
if (tos <<cdcount>> <> 0) then                                 <<*7724>>25290000
                                                               <<*7724>>25295000
   begin     << device has some cached domains >>                       25300000
                                                                        25305000
   << use disc address from cdt if this is a map request >>             25310000
                                                               <<07308>>25315000
                                                               <<07308>>25320000
   tos := limit'addr;                                          <<07308>>25325000
   s1.regldevfield := ldev;  << overlay ldev >>                <<07308>>25330000
   limitda'hit := tos;                                         <<07308>>25335000
   tos := start'addr;                                          <<07308>>25340000
   s1.regldevfield := ldev;  << overlay ldev >>                <<07308>>25345000
   targetda'hit := tos;                                        <<07308>>25350000
                                                               <<07308>>25355000
   tos := ndtocacdadisp;<< offset from link to target for llsh >>       25360000
   tos := targetda'hit;  << search double word >>              <<07308>>25365000
   cdt'shift'da;  << shift disc address for search >>                   25370000
   asmb(del);     << remove loda portion of da     >>                   25375000
                                                                        25380000
   << determine whether to use scan point or cdhead >>                  25385000
$if x1=on                                                      <<*7724>>25390000
   tos := scanpt :=                                            <<*7724>>25395000
          cdt'get'double(devcdtentry,cdt'de'scanpt,0d);        <<*7724>>25400000
$if x1=off                                                     <<*7724>>25405000
   tos := scanpt :=                                            <<*7724>>25410000
      cdt'darray((ldev'offset+cdt'de'scanpt)&asr(1));          <<*7724>>25415000
$if                                                            <<*7724>>25420000
                                                               <<*7724>>25425000
   if (tos <> 0d) then                                         <<*7724>>25430000
                                                               <<*7724>>25435000
      begin                                                             25440000
      tos := scanpt;                                                    25445000
      tos := tos + ndtohodadisp;                                        25450000
      asmb(ldea;dxch,ddel);                                             25455000
      if tos <= targetda'hit then                              <<07308>>25460000
         tos := scanpt                                                  25465000
      else                                                              25470000
         tos := cdhead;                                                 25475000
      end                                                               25480000
   else                                                                 25485000
      tos := cdhead;                                                    25490000
                                                                        25495000
   x := cdcount;         << link count >>                               25500000
   asmb(llsh);  << chase through the list to get to right place >>      25505000
   if < then                                                            25510000
      begin <<hit end-check the tail of the list>>                      25515000
      checkregionbase := cdtail + double(ndtorbdisp);                   25520000
      checkcheckregion;                                                 25525000
      end                                                               25530000
   else                                                                 25535000
      begin    << got some regions with the same or larger hoda>>       25540000
      << check prior region (if any) for overlap >>            <<07308>>25545000
      tos := tos + ndtopddisp;                                 <<07308>>25550000
      asmb(ldea);  << load prior link pointer >>               <<07308>>25555000
      if = then    << there was no prior link >>               <<07308>>25560000
         asmb(ddel)                                            <<07308>>25565000
      else                                                     <<07308>>25570000
         begin  << there was, so adjust count, etc >>          <<07308>>25575000
         x := x + 1;  << new count of remaining regions >>     <<07308>>25580000
         asmb(dxch,ddel); << remove old link pointer >>        <<07308>>25585000
         end;                                                  <<07308>>25590000
      tos := tos + pdtonddisp;  << change ptr to next ptr >>   <<07308>>25595000
      << save parameters for posterity >>                      <<07308>>25600000
      tos := nextlinktocheck := tos;                           <<07308>>25605000
      remlinkcount := x;                                       <<07308>>25610000
      << start looking for overlapping domains >>              <<07308>>25615000
      smaller := true;                                         <<07308>>25620000
                                                               <<07308>>25625000
      do                                                       <<07308>>25630000
         begin <<chase thru list for a ms or so>>              <<07308>>25635000
         asmb(ddup);                                           <<07308>>25640000
         tos := tos + ndtohodadisp;                            <<07308>>25645000
         asmb(ldea;dxch,ddel);                                 <<07308>>25650000
         tos := targetda'hit;                                  <<07308>>25655000
         asmb(dcmp);                                           <<07308>>25660000
         if <= then                                            <<07308>>25665000
            begin <<targetda > regionda so continue>>          <<07308>>25670000
            asmb(ldea);  <<addr of next region's link>>        <<07308>>25675000
            if <= then                                         <<07308>>25680000
               x := 1;  << terminate scan >>                   <<07308>>25685000
            asmb(dxch,ddel);  << remove address >>             <<07308>>25690000
            end                                                <<07308>>25695000
         else                                                  <<07308>>25700000
            begin                                              <<07308>>25705000
            smaller := false;                                  <<07308>>25710000
            end                                                <<07308>>25715000
         end                                                   <<07308>>25720000
      until (not smaller) or dxbz;                             <<07308>>25725000
                                                                        25730000
      if smaller then                                          <<07308>>25735000
         begin <<got to end of list>>                          <<07308>>25740000
         checkregionbase := cdtail + double(ndtorbdisp);       <<07308>>25745000
         checkcheckregion;                                     <<07308>>25750000
         end                                                   <<07308>>25755000
      else                                                     <<07308>>25760000
         begin    << stopped in middle of list >>              <<07308>>25765000
                                                               <<07308>>25770000
         <<prev region may have overlapped so check it>>       <<07308>>25775000
         tos := nextlinktocheck := tos;                        <<07308>>25780000
         tos := tos +ndtopddisp;                               <<07308>>25785000
         asmb(ldea);                                           <<07308>>25790000
         if > then                                             <<07308>>25795000
            begin <<check prev region>>                        <<07308>>25800000
            tos := tos+pdtorbdisp;                             <<07308>>25805000
            checkregionbase := tos;                            <<07308>>25810000
            checkcheckregion;                                  <<07308>>25815000
            end;                                               <<07308>>25820000
         if not gotahit then                                   <<07308>>25825000
            loop'thru'list;                                    <<07308>>25830000
                                                                        25835000
         end;                                                  <<07308>>25840000
      end;                                                     <<07308>>25845000
   end;                                                        <<07308>>25850000
                                                               <<07308>>25855000
                                                                        25860000
if flush then                                                           25865000
   begin                                                       <<06858>>25870000
   if zapfailed then                                           <<06858>>25875000
      << there were mapped domains in the way >>               <<06858>>25880000
      cdt'map'cached'domain := false                           <<06858>>25885000
   else                                                        <<06858>>25890000
      cdt'map'cached'domain := true; << full range zapped >>   <<06858>>25895000
   end                                                         <<06858>>25900000
else                                                                    25905000
  if gotahit then                                                       25910000
     cdt'map'cached'domain := true                                      25915000
  else                                                                  25920000
     begin  << we must flush any overlapping domains >>                 25925000
     << process miss on cache >>                               <<07308>>25930000
     process'miss;                                             <<07308>>25935000
     cdt'map'cached'domain := false;  << miss >>                        25940000
     end;                                                               25945000
                                                                        25950000
$if x1=on                                                               25955000
mmstat'(mmstat'map'domain,new'cdt,returned'cdt,0,0,0,0);       <<06859>>25960000
$if                                                                     25965000
                                                                        25970000
<< put db back to caller's db >>                               <<*7724>>25975000
tos := save'db;                                                <<*7724>>25980000
exchdb;                                                        <<*7724>>25985000
                                                               <<*7724>>25990000
end;  <<map'cached'domain>>                                             25995000
$page "Cache Management Utilities : CDT'Unmap'Region"                   26000000
                                                                        26005000
                                                                        26010000
procedure cdt'unmap'region(devcdtentry,regcdtentry);                    26015000
value devcdtentry,regcdtentry;                                          26020000
integer devcdtentry,regcdtentry;                                        26025000
option privileged,uncallable,internal;                         <<06858>>26030000
                                                                        26035000
comment                                                                 26040000
                                                                        26045000
invoked when the cdt entry for a mapped disc domain is released.  the   26050000
region is still to be cached, but not mapped, so any semblence to a     26055000
mapped disc domain must be eliminated.                                  26060000
                                                                        26065000
caller is assumed to be pdisabled.                                      26070000
                                                                        26075000
                                                                        26080000
;                                                                       26085000
                                                                        26090000
begin                                                                   26095000
                                                                        26100000
double reg'addr,    << hold memory region address >>           <<d7726>>26105000
       mapd'abs'ofst; << mapped domain entry abs address >>    <<d7726>>26110000
                                                               <<d7726>>26115000
logical flags;                                                 <<06855>>26120000
double obj;                                                    <<06855>>26125000
logical array objident(*)=obj;                                 <<06855>>26130000
                                                                        26135000
                                                               <<d7726>>26140000
                                                               <<d7726>>26145000
                                                               <<d7726>>26150000
                                                               <<d7726>>26155000
                                                                        26160000
subroutine fixobjident;                                                 26165000
                                                                        26170000
begin <<  mapped domain is present >>                                   26175000
$if x1=on                                                      <<d7726>>26180000
tos := cdt'set'double(regcdtentry,cdt'md'mem'addr,0d);                  26185000
$if x1=off                                                     <<d7726>>26190000
tos := mapd'abs'ofst;                                          <<d7726>>26195000
tos := tos + cdt'md'mem'addr;                                  <<d7726>>26200000
asmb(ldea);                                                    <<d7726>>26205000
reg'addr := tos;                                               <<d7726>>26210000
tos := 0d;                                                     <<d7726>>26215000
asmb(sdea;ddel);  << store 0d back to mapped domain mem addr >><<d7726>>26220000
tos := reg'addr;                                               <<d7726>>26225000
$if                                                            <<d7726>>26230000
tos := tos+rbtoobjidentdisp;                                            26235000
asmb(ldea);                                                    <<06855>>26240000
obj := tos;                                                    <<06855>>26245000
if (objident(objidtypefield) <> objidcdtype)                   <<06855>>26250000
or (objident(objidnumfield) <> logical(regcdtentry))           <<06855>>26255000
then suddendeath(sfkerncacheintbad);                                    26260000
tos := obj;                                                    <<06855>>26265000
s0:= 0;                                                        <<07307>>26270000
asmb(sdea;ddel);                                               <<07307>>26275000
end;                                                                    26280000
                                                                        26285000
                                                                        26290000
disable;                                                                26295000
                                                                        26300000
$if x1=on                                                      <<d7726>>26305000
flags :=  cdt'get'word(regcdtentry,cdt'md'flags,0);                     26310000
$if x1=off                                                     <<d7726>>26315000
cdt'abs'on'tos;                                                <<d7726>>26320000
tos := tos + (regcdtentry * cdt'entry'size);                   <<d7726>>26325000
tos := mapd'abs'ofst := tos;  << save entry's address >>       <<d7726>>26330000
tos := tos + cdt'md'flags;                                     <<d7726>>26335000
asmb(lsea;delb,delb);  << mapped flags is on tos >>            <<d7726>>26340000
flags := tos;                                                  <<d7726>>26345000
$if                                                            <<d7726>>26350000
                                                                        26355000
<< create mask word for compare >>                             <<d7726>>26360000
tos := 0;                                                      <<d7726>>26365000
tos.cdt'imi := 1;                                              <<d7726>>26370000
tos.cdt'fwip := 1;                                             <<d7726>>26375000
tos.cdt'imo := 1;                                              <<d7726>>26380000
if ((tos land flags) <> 0)                                     <<d7726>>26385000
then suddendeath(sfkerncachesyncbad);                                   26390000
                                                                        26395000
if (not flags.cdt'absent) or (flags.cdt'roc) then                       26400000
   begin <<mapped domain has a memory region corresponding>>            26405000
   fixobjident;                                                         26410000
$if x1=on                                                      <<d7726>>26415000
   flags.cdt'absent:=1;                                                 26420000
   flags.cdt'roc := 0;                                                  26425000
   cdt'set'word(regcdtentry,cdt'md'flags,flags);                        26430000
$if x1=off                                                     <<d7726>>26435000
   tos := mapd'abs'ofst;                                       <<d7726>>26440000
   tos := tos + cdt'md'flags;                                  <<d7726>>26445000
   tos := flags;                                               <<d7726>>26450000
   tos.cdt'absent := 1;                                        <<d7726>>26455000
   tos.cdt'roc := 0;                                           <<d7726>>26460000
   asmb(ssea;ddel);                                            <<d7726>>26465000
$if                                                            <<d7726>>26470000
   end;                                                                 26475000
                                                               <<07311>>26480000
$if x1=on                                                      <<07311>>26485000
mmstat'(mmstat'unmap'region,devcdtentry,regcdtentry,0,0,0,0);  <<07311>>26490000
$if                                                            <<07311>>26495000
end;  <<procedure cdt'unmap'region>>                                    26500000
                                                                        26505000
$page "Cache/Mem Mgr Interfaces : Cache Transfer Completor"             26510000
                                                                        26515000
procedure cachexfercomp(ldr'entry'index,iostatus);                      26520000
value ldr'entry'index,iostatus;                                         26525000
integer ldr'entry'index,iostatus;                                       26530000
option privileged, uncallable, internal;                       <<06858>>26535000
                                                                        26540000
comment                                                                 26545000
                                                                        26550000
cachexfercomp is called when a requested transfer against a mapped      26555000
domain is completed.  for a read, this occurs right after the move      26560000
from the mapped domain to the target segment completes.  for a write,   26565000
the completion occurs either after the move to cache has completed      26570000
(in case nowait for post was specified) or (if wait till post was spec  26575000
ified) the xfer completor is not invoked until the physical i/o backin  26580000
up the disc copy of the mapped domain completes. for reads and nowait-  26585000
for-post writes, the cachexfercomp routine is called by processcdtqueu  26590000
when the cache move is performed.  for writes in which wait till post   26595000
was set, the logical transfer completor is called by the segment write  26600000
completor for the physical write updating the disc.  cachexfercomp      26605000
invokes the cache management completor to allow it to clean up the cdt  26610000
requesting the transfer if the wakeup bit has been set (ie if process   26615000
entry, get the next things going, awaken the process if wakeup set,     26620000
etc..                                                                   26625000
                                                                        26630000
;                                                                       26635000
                                                                        26640000
begin                                                                   26645000
                                                                        26650000
<<record transfer status into logical request element>>                 26655000
                                                                        26660000
<< mpe v/e no longer needs to zero out the strategy field >>   <<*7727>>26665000
<< of the ldr'func word.                                  >>   <<*7727>>26670000
                                                               <<*7727>>26675000
ldr'stat := iostatus;                                                   26680000
                                                                        26685000
<<if bad status, zap the xfer count>>                                   26690000
                                                                        26695000
if iostatus <> iostatusok                                               26700000
then ldr'count := 0;                                                    26705000
                                                                        26710000
<<adjust locality if not db or stk, adj loc on cdt entry in sll         26715000
to offset add in attchio for blocked, waitforio for unbl>>              26720000
                                                                        26725000
if (not ldr'dbrel) land ((ldr'blocked=1) lor (ldr'iowake=1)) then       26730000
   begin  <<must offset addtolocality of seg if not dbseg>>    <<07311>>26735000
<< if lpcb(ldr'pcb*pcbsize + dbxdstinfowordnum).xdsdstfield  >><<07311>>26740000
<<    <> ldr'buf'dstn  then                                  >><<07311>>26745000
      begin  <<not his db seg so do it>>                                26750000
      tos := ldr'pcb*pcbsize;                                  <<07311>>26755000
      tos := double(ldr'buf'dstn);                             <<07311>>26760000
      tos:=0;<<reqsize>>                                                26765000
      tos:=0;                                                           26770000
      tos.cleardiscsegflag:=1;                                          26775000
      adjustlocality(*,*,*,*);                                          26780000
      end;                                                              26785000
   end;                                                                 26790000
                                                                        26795000
<<invoke the cache management xfer completor>>                          26800000
                                                                        26805000
cdt'completor(ldr'cdt,ldr'entry'index);                                 26810000
                                                                        26815000
end;  <<procedure cachexfercomp>>                                       26820000
                                                                        26825000
$page "Cache Write Completor"                                           26830000
                                                                        26835000
procedure cachewritecomp(cdtentrynumber,xferstatus);                    26840000
value cdtentrynumber,xferstatus;                                        26845000
integer cdtentrynumber,xferstatus;                                      26850000
option privileged,uncallable;                                           26855000
                                                                        26860000
comment                                                                 26865000
                                                                        26870000
the cache write completor is invoked by the object write completor      26875000
from the ics in response to the interrupt signalling the completion     26880000
of a physical write to the disc of a mapped disc domain.                26885000
                                                                        26890000
the cdt entry number of the mapped domain and the status of the disc    26895000
request transfer are sent as incoming parameters.                       26900000
                                                                        26905000
the cache write completor stuffs the status of the write update into    26910000
the cdt entry of the mapped domain and invokes the transfer completor   26915000
for the logical disc req which is related to this write update.         26920000
                                                                        26925000
;                                                                       26930000
                                                                        26935000
begin                                                                   26940000
                                                                        26945000
integer ldr'entry'index;                                                26950000
                                                                        26955000
$if x1=off                                                              26960000
def'get'word;                                                           26965000
$if                                                                     26970000
ldr'entry'index:=cdt'get'word(cdtentrynumber,cdt'md'ldr'head,0);        26975000
if ldr'entry'index <> 0 then                                            26980000
   begin  <<somebody waiting>>                                          26985000
   if ldr'func = writereq then  << this is a non-nopost >>              26990000
     cachexfercomp(ldr'entry'index,xferstatus)                          26995000
   else                                                                 27000000
     cdt'completor(cdtentrynumber,0);                                   27005000
   end                                                                  27010000
else cdt'completor(cdtentrynumber,0);                                   27015000
                                                                        27020000
end;  <<cachewritecomp>>                                                27025000
$page "Process CDT Disc Request Queue"                                  27030000
procedure processcdtlogreqqueue (cdtentrynum, iostatus, xfercnt);       27035000
value cdtentrynum,iostatus,xfercnt;                                     27040000
integer cdtentrynum, iostatus,xfercnt;                                  27045000
option privileged,uncallable;                                           27050000
                                                                        27055000
comment                                                                 27060000
                                                                        27065000
processcdtdiscqueue is invoked by the dispatcher when processing        27070000
a message related to the arrival of a mapped disc domain into           27075000
main memory, and by prefecthobject,recoveroc, and fetchobject when      27080000
a cached mapped disc domain is requested and found to be in memory.     27085000
                                                                        27090000
processcdtdiscqueue chases through the queue of pending logical         27095000
disc requests attached to the cdt entry passed as parameter.  for       27100000
each logical disc request in the cdt entry's pending queue :            27105000
                                                                        27110000
   if the segment involved in the transfer request is absent,           27115000
   the process requesting the logical transfer is flagged absent        27120000
   and the disc request element is moved to the hung logical request    27125000
   queue.                                                               27130000
                                                                        27135000
   if the mapped domain is absent, the process requesting the transfer  27140000
   is flagged absent.                                                   27145000
                                                                        27150000
   if both the segment and the mapped domain are present, a             27155000
   move effecting the desired transfer is performed.  the prefetch      27160000
   count of the sll entry of the mapped domain is decremented, and      27165000
   the ongoingio flag of the sllentry of the segment is                 27170000
   cleared.  if the transfer involved a write, the virginflag of the    27175000
   cdt entry is cleared and a physical write update of the cached       27180000
   domain is initiated through attachio.  if the transfer is for a      27185000
   read, the transfer completor is invoked.                             27190000
                                                                        27195000
after a transfer is performed, the reference bit of the cached disc     27200000
domain is set, the prefetch count of the mapped domain is cleared       27205000
in the process' sll, and the ongoing disc io count of the related       27210000
buffer is decrementd in the process' sll if not a stack, db not         27215000
pointing at it, and blocked or the iowake bit set.                      27220000
                                                                        27225000
it is assumed that the caller is pdisabled, and that db is set at       27230000
sysdb.                                                                  27235000
                                                                        27240000
;                                                                       27245000
                                                                        27250000
begin                                                                   27255000
                                                                        27260000
logical domainabsent,                                                   27265000
        segabsent,                                                      27270000
        odd'byte,    << true if transfer is odd-byte >>                 27275000
        is'write,    << true if this is a write function >>             27280000
        dbrel;                                                          27285000
                                                                        27290000
integer processid,                                                      27295000
        flagprocflags,                                                  27300000
        urgency,                                                        27305000
        ldr'entry'index,                                                27310000
        nextxferreqindex,                                               27315000
        xfercount,                                                      27320000
        residual,     << residual count >>                     <<06858>>27325000
        segoffset,                                                      27330000
        segsize,                                               <<h8580>>27335000
        mdoffset,                                                       27340000
        mdhoda,                                                         27345000
        mdloda,                                                         27350000
        xferhoda,                                                       27355000
        xferloda,                                                       27360000
        discreqoffset;                                         <<06855>>27365000
                                                                        27370000
double mdregionbase,                                                    27375000
       mdobjident,                                             <<06855>>27380000
       segregionbase,                                                   27385000
       seg,                                                    <<06855>>27390000
       mddiscaddr=mdhoda,                                               27395000
       xferdiscaddr=xferhoda,                                           27400000
       segxferstartaddr,                                                27405000
       mdxferstartaddr,                                                 27410000
       startcachetime,                                                  27415000
       segaddress;                                                      27420000
                                                               <<*7724>>27425000
<< the following cell is used for abs addressing of cdt >>     <<*7724>>27430000
double mapd'cdt'ofst;                                          <<*7724>>27435000
                                                                        27440000
logical array segid(*)=seg;                                    <<06855>>27445000
integer discreqbase; <<ditto>>                                 <<07311>>27450000
                                                                        27455000
                                                               <<*7724>>27460000
                                                               <<*7724>>27465000
                                                               <<*7724>>27470000
                                                               <<*7724>>27475000
                                                               <<*7724>>27480000
                                                               <<*7724>>27485000
                                                               <<*7724>>27490000
                                                               <<*7724>>27495000
                                                                        27500000
<< only process if this entry is currently assigned >>                  27505000
cdt'abs'on'tos;        << abs addr of cdt is on tos >>         <<*7724>>27510000
tos := tos + (cdtentrynum * cdt'entry'size);                   <<*7724>>27515000
                                                               <<*7724>>27520000
<< store absolute entry address >>                             <<*7724>>27525000
tos :=  mapd'cdt'ofst := tos;                                  <<*7724>>27530000
                                                               <<*7724>>27535000
<< load word 0 of entry - will be negative if unassigned >>    <<*7724>>27540000
asmb(lsea;ddel,del);  << cc is set - remove stacked words >>   <<*7724>>27545000
                                                               <<*7724>>27550000
if >= then    << it is an allocated entry >>                   <<*7724>>27555000
begin                                                                   27560000
                                                                        27565000
if class0statsenabled and curprc = 0                           <<07311>>27570000
then startcachetime:=timer; <<for meas support>>                        27575000
                                                                        27580000
mdobjident := buildobjid(mappeddomainobject,cdtentrynum,0);             27585000
                                                                        27590000
<< load first active ldr index to process >>                   <<*7724>>27595000
tos := mapd'cdt'ofst;   << entry abs address >>                <<*7724>>27600000
tos := tos + cdt'md'ldr'head;                                  <<*7724>>27605000
asmb(lsea;delb,delb);   << load ldr inx, remove abs addr >>    <<*7724>>27610000
nextxferreqindex := tos;                                       <<*7724>>27615000
                                                                        27620000
while nextxferreqindex <> 0 do                                          27625000
   begin  <<try to perform this move>>                                  27630000
   disable;                                                             27635000
   ldr'entry'index := nextxferreqindex;                                 27640000
   nextxferreqindex := ldr'nextq;                                       27645000
                                                               <<07311>>27650000
   if not ldr'move'done then                                            27655000
   begin  << cache move has not been performed yet >>                   27660000
                                                                        27665000
   if ldr'dbrel then dbrel := true  else dbrel := false;       <<07311>>27670000
   seg := double(ldr'buf'dstn);                                <<07311>>27675000
                                                                        27680000
   if integer(ldr'cdt) <> cdtentrynum                          <<07311>>27685000
   then suddendeath(sfkerncacheintbad);                                 27690000
                                                                        27695000
   processid:=ldr'pcb;                                                  27700000
                                                                        27705000
   <<handle case of absent mapped domain>>                              27710000
                                                                        27715000
   if isobjectabsent(mdobjident) then                                   27720000
      begin  <<mapped domain is out, so flag process absent>>           27725000
      domainabsent:=true;                                               27730000
      flagprocflags:=0;                                                 27735000
      flagprocflags.causefullswap:=1;                                   27740000
      flagprocabsent (processid,mdobjident,flagprocflags);     <<*8735>>27745000
$if x1=on                                                               27750000
      tos := 139;                                              <<07311>>27755000
      tos := 0;                                                <<07311>>27760000
      tos := processid;                                        <<07311>>27765000
      tos := mdobjident;                                       <<07311>>27770000
      mmstat'(*,*,*,*,*,0,0);                                  <<07311>>27775000
$if                                                                     27780000
      end                                                               27785000
   else domainabsent := false;                                          27790000
                                                                        27795000
   << handle case of absent data segment>>                              27800000
                                                                        27805000
   if isobjectabsent(seg) then                                 <<06855>>27810000
      begin                                                             27815000
      segabsent := true;                                                27820000
      << make sure desired xds is already in locality >>       <<*7551>>27825000
      tos := 0;                                                <<*7551>>27830000
      tos.setmemreqptrflag := 1;  << fetch, but still launch>> <<*7551>>27835000
      flagprocflags := tos;                                    <<*7551>>27840000
      addtolocality(pcb((processid*pcbsize)+sllixwordnum),     <<*7551>>27845000
                    seg,flagprocflags);                        <<*7551>>27850000
                                                               <<*7551>>27855000
      flagprocflags:=0;                                                 27860000
      flagprocflags.causefullswap:=1;                                   27865000
      flagprocabsent (processid,0d,flagprocflags);             <<06855>>27870000
$if x1=on                                                               27875000
      mmstat'(139,ldr'entry'index,processid,segid(0),segid(1), <<06859>>27880000
                                                       0,0);   <<06859>>27885000
$if                                                                     27890000
      discreqbase := ldr'entry'index;                          <<07311>>27895000
      dequeuediscreq(discreqbase,cdtreqq,cdtentrynum);         <<07311>>27900000
      queuediscreq(discreqbase,deferredreqq,0);                <<07311>>27905000
      end                                                               27910000
   else segabsent := false;                                             27915000
                                                                        27920000
   <<handle case of seg and mapped domain present>>                     27925000
                                                                        27930000
   if (not segabsent) and (not domainabsent) then                       27935000
      begin                                                             27940000
                                                                        27945000
      enable;                                                           27950000
                                                                        27955000
      << lookup mdregionbase, seg region base>>                         27960000
                                                                        27965000
      tos := mapd'cdt'ofst;  << mapped domain abs address >>   <<*7724>>27970000
      tos := tos + cdt'md'mem'addr; << cell offset added  >>   <<*7724>>27975000
      asmb(ldea;dxch,ddel);  << only retrieved value on tos >> <<*7724>>27980000
      mdregionbase := tos;                                     <<*7724>>27985000
                                                               <<*7724>>27990000
      tos:=0;                                                           27995000
      tos := abs(dstp)+segid(objidnumfield)&lsl(2)+2;          <<06855>>28000000
      asmb(ldea); <<base and bank from dst entry>>                      28005000
      segregionbase := tos;                                             28010000
                                                                        28015000
      <<figure out transfer count>>                                     28020000
                                                                        28025000
      xfercount := ldr'count;                                           28030000
      if < then                                                         28035000
         begin  << make count positive words >>                         28040000
         if logical(xfercount) then  << round count down 1 byte >>      28045000
            odd'byte := true                                            28050000
         else                                                           28055000
            odd'byte := false;                                          28060000
         xfercount := (-xfercount) & asr(1); << make words >>           28065000
         end                                                            28070000
      else                                                              28075000
         odd'byte := false;                                             28080000
                                                                        28085000
      <<figure out offsets for transfer from base of seg, md>>          28090000
                                                                        28095000
      segoffset := ldr'bufadr;                                          28100000
      if dbrel then                                                     28105000
         begin <<must add db offset of stack to offset>>                28110000
         tos := segregionbase;                                          28115000
         tos := tos+sbtostkreldbdisp;                                   28120000
         asmb(lsea);                                                    28125000
         segoffset := segoffset+tos;                                    28130000
         ddel;                                                 <<h8580>>28135000
         end;                                                           28140000
      tos:=0;                                                           28145000
      tos:=segoffset;                                                   28150000
      segxferstartaddr := tos + segregionbase;                          28155000
                                                                        28160000
      << make sure everything o.k. for the target segment.    ><<h8580>>28165000
      << don't want to go beyond the region limit for the seg.><<h8580>>28170000
                                                               <<h8580>>28175000
      segsize := dst(ldr'buf'dstn&lsl(2)).datasizefield * 4;   <<h8580>>28180000
                                                               <<h8580>>28185000
      if (segxferstartaddr-segregionbase) + double(xfercount)  <<h8580>>28190000
         > double(segsize) then                                <<h8580>>28195000
         suddendeath(sfkerncacheintbad);                       <<h8580>>28200000
                                                               <<h8580>>28205000
                                                                        28210000
      tos:=mdregionbase;                                                28215000
      tos:=tos+rbtohodadisp;                                            28220000
      asmb(ldea);                                                       28225000
      mdloda:=tos;                                                      28230000
      mdhoda:=tos.reghodafield;                                         28235000
      xferhoda := ldr'parm1;                                            28240000
      xferloda := ldr(cdt'x:=cdt'x+1);                                  28245000
      tos:=xferdiscaddr-mddiscaddr;                                     28250000
      mdoffset := tos*sectorsizeinwords;                                28255000
      if < then suddendeath(sfkerncacheintbad);                         28260000
                                                                        28265000
      << check transfer count >>                                        28270000
      tos := mdregionbase;                                              28275000
      tos := tos + rbtorsdisp;                                          28280000
      asmb(lsea;delb,delb);  << region size on tos >>                   28285000
      if (logical(tos * mmpagesize) <=                         <<*7551>>28290000
         logical(mdoffset + xfercount)) then                   <<*7551>>28295000
        suddendeath(sfkerncacheintbad);                                 28300000
                                                                        28305000
      tos:=0;                                                           28310000
      tos:=mdoffset;                                                    28315000
      mdxferstartaddr:=tos + mdregionbase;                              28320000
                                                                        28325000
      if ldr'func = readreq then                                        28330000
         begin                                                          28335000
         is'write := false;                                             28340000
         tos := segxferstartaddr;                                       28345000
         tos := mdxferstartaddr;                                        28350000
         end                                                            28355000
      else                                                              28360000
         begin                                                          28365000
         is'write := true;                                              28370000
         tos := mdxferstartaddr;                                        28375000
         tos := segxferstartaddr;                                       28380000
         end;                                                           28385000
                                                                        28390000
      << at this point, absolute target and source addresses >><<06858>>28395000
      << for mabs instruction are stacked.                   >><<06858>>28400000
      <<perform the move effecting the transfer>>                       28405000
                                                                        28410000
      if iostatus = iostatusok then                                     28415000
         begin  << perform move of data >>                              28420000
         tos:=xfercount;                                                28425000
         asmb(mabs 1);                                                  28430000
         if odd'byte then                                               28435000
            begin  << take care of residual data byte >>                28440000
            asmb(lsea;delb,delb); << load next word of source >>        28445000
            cdt'x    := tos;      << save it >>                <<06858>>28450000
            asmb(lsea);           << load next target word    >>        28455000
            tos.(0:8) := cdt'x.(0:8); << overlay byte      >>  <<06858>>28460000
            asmb(ssea);      << store modified byte      >>    <<06858>>28465000
            end                                                         28470000
         else                                                           28475000
            asmb(ddel);   << remove stacked source addr  >>    <<06858>>28480000
         << at this point, move target abs addr is on tos >>   <<06858>>28485000
         if is'write then                                      <<06858>>28490000
         if (residual:=integer((128-(logical(xfercount)        <<06858>>28495000
            land %177) ) land %177)) <> 0 or odd'byte then     <<06858>>28500000
            begin if odd'byte then                             <<06858>>28505000
               begin                                           <<06858>>28510000
               asmb(lsea); << load word w/hobyte modified >>   <<06858>>28515000
               tos := tos & lsr(8); << shift off unneeded byte><<06858>>28520000
               asmb(dup);  << duplicate word >>                <<06858>>28525000
               tos := tos & lsl(8); << put byte in upper half ><<06858>>28530000
               tos := tos lor tos;  << make new word >>        <<06858>>28535000
               asmb(ssea);  << store back in main memory >>    <<06858>>28540000
               << if residual is zero, 1 byte was moved >>     <<06858>>28545000
               if residual = 0 then                            <<06858>>28550000
                  residual := 128;   << actually, 1 sector >>  <<06858>>28555000
               end                                             <<06858>>28560000
            else                                               <<06858>>28565000
               begin  << copy last byte, like the cs80 controll<<06858>>28570000
               asmb(deca;lsea);  << load last valid word >>    <<06858>>28575000
               tos := tos & lsl(8); << shift-off crap >>       <<06858>>28580000
               asmb(dup); << dup word >>                       <<06858>>28585000
               tos := tos & lsr(8); << put byte in low order >><<06858>>28590000
               tos := tos lor tos;  << byte appears in both >> <<06858>>28595000
               asmb(incb);  << increment destination address >><<06858>>28600000
               asmb(ssea);  << store next word back >>         <<06858>>28605000
               end;                                            <<06858>>28610000
            << perform overlapping move >>                     <<06858>>28615000
            asmb(inca,ddup;deca);<< copy target to source, sub <<06858>>28620000
            tos := residual-1;                                 <<06858>>28625000
            asmb(mabs 5);                                      <<06858>>28630000
            end                                                <<06858>>28635000
         else                                                  <<06858>>28640000
            asmb(ddel);  << remove stacked target address >>   <<06858>>28645000
         end                                                   <<06858>>28650000
      else                                                              28655000
         asmb(ddel,ddel);  << remove stacked parameters >>              28660000
                                                                        28665000
      <<set ref bit in region header of cached domain>>                 28670000
                                                                        28675000
      tos := mdregionbase;                                              28680000
      tos := tos+rbtosasdisp;                                           28685000
      asmb(lsea);                                                       28690000
      if not ls0.regcachedflag then suddendeath(sfkerncacheintbad);     28695000
      tos.regrefflag := 1;                                              28700000
      asmb(ssea;ddel);                                                  28705000
                                                                        28710000
      <<update measurement instrumentation if statistics enabled>>      28715000
                                                                        28720000
      if class0statsenabled then                                        28725000
         if fupdatestatistics(measclass0,meassubclass0,measentry1,      28730000
                             c'cachedatamoves,notnewvalue,1d,notdouble) 28735000
         <> 0 then suddendeath(sfkerncacheintbad);                      28740000
                                                                        28745000
      <<adjust locality to offset prefetch on mapped domain>>           28750000
                                                                        28755000
      tos := processid*pcbsize;                                <<06858>>28760000
      tos:=mdobjident;                                                  28765000
      tos:=0;<<reqsize>>                                                28770000
      tos:=0;                                                           28775000
      tos.decprefetchcntflag := 1;                                      28780000
      adjustlocality(*,*,*,*);                                          28785000
                                                                        28790000
      << record fact that move has taken place >>                       28795000
      tos := ldr'flags;                                        <<*7724>>28800000
      tos.(ldr'move'done'bit:1) := 1;                          <<*7724>>28805000
      tos.(ldr'inloc'bit:1):=0;<<md no longer in locality list><<*7724>>28810000
      if = then            << someone already removed it      ><<*7724>>28815000
        suddendeath(sfkerncacheintbad);                        <<*7724>>28820000
      ldr(cdt'x) := tos;   << save back flags >>               <<*7724>>28825000
                                                                        28830000
      mmstat'(mmstatcachemove,segid(0),segid(1),cdtentrynum,   <<06859>>28835000
                                   xfercount,0,0);             <<06859>>28840000
                                                                        28845000
      disable;                                                          28850000
                                                                        28855000
      <<nextxferreqindex := ldr'nextq;>><<may have changed>>   <<06858>>28860000
                                                                        28865000
      <<start disc update for write requests>>                          28870000
                                                                        28875000
      if is'write then                                                  28880000
         begin                                                          28885000
                                                                        28890000
         << clear mapped cdt virgin bit, if set >>                      28895000
         tos := mapd'cdt'ofst;  << abs mapped entry address >> <<*7724>>28900000
         tos := tos + cdt'md'flags; << add flags word offset>> <<*7724>>28905000
         asmb(lsea);            << load flags word          >> <<*7724>>28910000
         tos.(cdt'virgin'bit:1) := 0;                          <<*7724>>28915000
         asmb(ssea;ddel);<<store back flags, remove abs addr>> <<*7724>>28920000
                                                                        28925000
         << load physical disc request for kernel to use >>    <<*7724>>28930000
         tos := mapd'cdt'ofst;  << abs addr of mapped entry >> <<*7724>>28935000
         tos := tos + cdt'md'discreq; << phys drq offset    >> <<*7724>>28940000
         asmb(lsea;delb,delb);  << load drq, remove abs addr>> <<*7724>>28945000
         discreqoffset := tos;                                 <<*7724>>28950000
         urgency := if ldr'do'post or ldr'serial'post then     <<07310>>28955000
                       processpri(processid)                   <<07310>>28960000
                    else                                       <<07310>>28965000
                       bkgrndpri;                              <<07310>>28970000
         startobjwrite(mdobjident,urgency,mdregionbase,                 28975000
                       ldr'entry'index,discreqoffset);                  28980000
         end;                                                           28985000
                                                                        28990000
      <<finish off request for read, no-wait-for-post write requests>>  28995000
                                                                        29000000
      if (not is'write) or (not ldr'do'post) then              <<06858>>29005000
         begin <<complete it now>>                                      29010000
         cachexfercomp(ldr'entry'index,iostatus);                       29015000
         end;                                                           29020000
                                                                        29025000
      end;                                                              29030000
                                                                        29035000
   end;  << of if testing if move has been performed >>                 29040000
                                                                        29045000
   end;  <<while loop>>                                                 29050000
                                                                        29055000
if class0statsenabled and curprc = 0 then                      <<07311>>29060000
   if fupdatestatistics(measclass0,meassubclass0,measentry1,            29065000
                       c'cacheonics,notnewvalue,                        29070000
                       timer-startcachetime,doublevalue)                29075000
   <> 0 then suddendeath(sfkerncacheintbad);                            29080000
                                                                        29085000
                                                                        29090000
end;  << of processing valid cdt entry >>                               29095000
                                                                        29100000
end;  <<procedure  processcdtreqq>>                                     29105000
                                                               <<06858>>29110000
                                                               <<06858>>29115000
                                                               <<06858>>29120000
                                                               <<06858>>29125000
                                                               <<06858>>29130000
$page "DISC CACHE ENABLE / DISABLE CONTROL : CACHE'LDEV  "     <<06858>>29135000
procedure cache'ldev(ldev,stat);                               <<06858>>29140000
value ldev;                                                    <<06858>>29145000
integer ldev,stat  ;                                           <<06858>>29150000
option privileged,uncallable;                                  <<06858>>29155000
begin                                                          <<06858>>29160000
                                                               <<06858>>29165000
<< cache'ldev is the executor for the startcache command.      <<06858>>29170000
                                                               <<06858>>29175000
<< this procedure accepts ldev as input, and manipulates variou<<06858>>29180000
<< i/o and cache tables to enable global caching on that disc. <<06858>>29185000
<< if this is the first time a disc has been enabled, it will  <<06858>>29190000
<< obtain a cache dst, initialize it, and set up the environmen<<06858>>29195000
<< to allow any disc to have caching enabled.                  <<06858>>29200000
                                                               <<06858>>29205000
<<*************************************************************<<06858>>29210000
<< input - ldev.  this logical device number is assumed to be a<<06858>>29215000
<<         valid disc logical device configured into the system<<06858>>29220000
<<                                                             <<06858>>29225000
<< output- stat  . this integer is returned to the caller to   <<06858>>29230000
<<         indicate the status of the call.  the values returne<<06858>>29235000
<<         are:                                                <<06858>>29240000
<<         0 - call completed successfully.                    <<06858>>29245000
<<         1 - the cache dst could not be obtained.            <<06858>>29250000
<<         2 - an internal cache software error occurred.      <<06858>>29255000
<<         3 - the ldev specified is already cached.           <<06858>>29260000
<<         4 - the cdt would be too large due to too many disc <<06858>>29265000
<<         5 - the device specified is not cachable            <<06858>>29270000
<<         6 - this system is not permitted to use disc caching<<06858>>29275000
<<*************************************************************<<06858>>29280000
                                                               <<06858>>29285000
<<******************* caller environment **********************<<06858>>29290000
<< the caller of this procedure should have db pointing to the <<06858>>29295000
<< stack and be able to be "BLOCKED", as an absence trap might <<06858>>29300000
<< occur during the cache dst initialization.                  <<06858>>29305000
<<                                                             <<06858>>29310000
<< this routine may pdisable/penable at various times to handle<<06858>>29315000
<< syncronization problems.  it also needs to be privileged to <<06858>>29320000
<< access various system tables.                               <<06858>>29325000
<<*************************************************************<<06858>>29330000
                                                               <<06858>>29335000
<<**************** mpe tables accessed ************************<<06858>>29340000
<< cache'dst    - this sysglob cell is read and modified.      <<06858>>29345000
<< lpdt         - this table is read only to obtain disc dit in<<06858>>29350000
<<                and determine the highest ldev configured.   <<06858>>29355000
<< dit          - dit word 0 (flags) is accessed to set/reset b<<06858>>29360000
<<                which is the dit'cache'enabled bit for this d<<06858>>29365000
<<*************************************************************<<06858>>29370000
$page                                                          <<06858>>29375000
integer highest'ldev,          << highest ldev config'd in mpe><<06858>>29380000
        num'of'discs,          << number of discs config'd    ><<06858>>29385000
        ctr,                   << indexing variable           ><<06858>>29390000
        num'of'discreq,        << number of discreq entries   ><<06858>>29395000
        num'of'entries,        << number of entries in cdt    ><<06858>>29400000
        xds'size,              << caching dst size            ><<06858>>29405000
        old'critical,          << return from setcritical     ><<06858>>29410000
        old'sir,               << return from getsir          ><<06858>>29415000
        x = x,                 << index register              ><<06858>>29420000
        lpdt'index,            << peg variable for incllpdt   ><<06858>>29425000
        dst'number;            << dst number obtained for cach><<06858>>29430000
double  object'ident;          << mpe standard object ident   ><<06858>>29435000
$page                                                          <<06858>>29440000
subroutine format'cdt;                                         <<06858>>29445000
begin                                                          <<06858>>29450000
                                                               <<06858>>29455000
<< this procedure formats the cache dst.  at this point, the ds<<06858>>29460000
<< is already locked and frozen in memory.  we will move db to <<06858>>29465000
<< the dst to facilitate ease of formatting.                   <<06858>>29470000
                                                               <<06858>>29475000
exchangedb(dst'number);                                        <<06858>>29480000
                                                               <<06858>>29485000
<< zero out dst.  >>                                           <<06858>>29490000
cdt'array := 0;                                                <<06858>>29495000
move cdt'array(1) := cdt'array,(xds'size-1);                   <<06858>>29500000
                                                               <<06858>>29505000
<< perform specific initialization >>                          <<06858>>29510000
                                                               <<06858>>29515000
<< initialize table header >>                                  <<06858>>29520000
cdt'array(cdt'entries) := num'of'entries;                      <<06858>>29525000
cdt'array(cdt'size) := cdt'entry'size;                         <<06858>>29530000
cdt'array(cdt'free'count) := num'of'entries - 1;               <<06858>>29535000
<< cdt'free'head already 0 >>                                  <<06858>>29540000
<< cdt'free'tail already 0 >>                                  <<06858>>29545000
cdt'array(cdt'max'used) := 1;                                  <<06858>>29550000
<< cdt'num'ldevs already 0 >>                                  <<06858>>29555000
<< cdt'disc'head already 0 >>                                  <<06858>>29560000
cdt'array(cdt'dst'words) := xds'size;  << words cdt is in lengt<<06858>>29565000
<< cdt'stop'pnd already false >>                               <<06858>>29570000
cdt'array(cdt'seq'minftch) := cache'sequential;                <<06858>>29575000
cdt'array(cdt'rnd'minftch) := cache'random;                    <<06858>>29580000
<< cdt'force'post already false >>                             <<06858>>29585000
                                                               <<06858>>29590000
<< initialize free entry list >>                               <<06858>>29595000
cdt'array(cdt'free'head) := cdt'entry'size;                    <<06858>>29600000
ctr := cdt'entry'size;                                         <<06858>>29605000
while ctr < xds'size do                                        <<06858>>29610000
  begin                                                        <<06858>>29615000
  cdt'array(ctr) := -1;  << mark as unassigned >>              <<06858>>29620000
  cdt'array(ctr+cdt'free'head) := ctr + cdt'entry'size;        <<06858>>29625000
  ctr := ctr + cdt'entry'size;                                 <<06858>>29630000
  end;                                                         <<06858>>29635000
<< back-up to last entry >>                                    <<06858>>29640000
ctr := ctr - cdt'entry'size;                                   <<06858>>29645000
cdt'array(ctr + cdt'free'head) := 0;                           <<06858>>29650000
cdt'array(cdt'free'tail) := ctr;  << fix tail pointer in header<<06858>>29655000
                                                               <<06858>>29660000
<< put db back to the caller's stack >>                        <<06858>>29665000
exchangedb(0);                                                 <<06858>>29670000
                                                               <<06858>>29675000
end; <<of subroutine format'cdt>>                              <<06858>>29680000
$page                                                          <<06858>>29685000
subroutine init'dits;                                          <<06858>>29690000
begin                                                          <<06858>>29695000
                                                               <<06858>>29700000
<< this subroutine turns off the dit'cache'enabled bit in all  <<06858>>29705000
<< disc dits "FLAGS" word.                                   >><<06858>>29710000
                                                               <<06858>>29715000
ctr := 0;     << sweep through all the ldev's >>               <<06858>>29720000
while (ctr:=ctr+1) <= highest'ldev do                          <<06858>>29725000
  begin                                                        <<06858>>29730000
  if isdevcachable(ctr) then                                   <<06858>>29735000
    begin <<this dev is cachable>>                             <<06858>>29740000
    disable;                                                   <<06858>>29745000
    lpdt'index := ctr * size'of'lpdt'entry;                    <<*7551>>29750000
    s'ditp(lpdt'dit'ptr).dit'cache'enabled := 0;  << bit off >><<06858>>29755000
    enable;                                                    <<06858>>29760000
    end;                                                       <<06858>>29765000
  end;                                                         <<06858>>29770000
                                                               <<06858>>29775000
end;  << of subroutine init'dits >>                            <<06858>>29780000
$page                                                          <<06858>>29785000
subroutine build'cdt;                                          <<06858>>29790000
begin                                                          <<06858>>29795000
                                                               <<06858>>29800000
<< this subroutine is called the first time a disc is requested<<06858>>29805000
<< to have caching enabled.  the sysglob cell containing the ds<<06858>>29810000
<< number will be zero until the first disc is requested to hav<<06858>>29815000
<< caching enabled against it.                                 <<06858>>29820000
                                                               <<06858>>29825000
<< determine the number of discs configured on this system.    <<06858>>29830000
highest'ldev := lpdt'max'entries;<< max ldev configured on syst<<06858>>29835000
num'of'discs := 0;                                             <<06858>>29840000
ctr := 0;   << ldev index >>                                   <<06858>>29845000
                                                               <<06858>>29850000
<< step through the ldev's >>                                  <<06858>>29855000
while (ctr:=ctr+1) <= highest'ldev do                          <<06858>>29860000
  begin                                                        <<06858>>29865000
  if isdevcachable(ctr) then num'of'discs:=num'of'discs+1;     <<06858>>29870000
  end;                                                         <<06858>>29875000
                                                               <<06858>>29880000
<< determine the number of disc request elements configured >> <<06858>>29885000
num'of'discreq := integer(dqh'tot'ent);                        <<*7551>>29890000
                                                               <<06858>>29895000
<< calculate the dst size and obtain caching dst >>            <<06858>>29900000
num'of'entries := num'of'discs +   << one entry for every disc <<06858>>29905000
                  num'of'discreq + << one for each disc request<<06858>>29910000
                  1;               << one entry for table head <<06858>>29915000
                                                               <<06858>>29920000
<< over-configure table to handle table roundoff & init routine<<06858>>29925000
xds'size := cdt'entry'size * num'of'entries;                   <<06858>>29930000
                                                               <<06858>>29935000
<< if overflow, its too big >>                                 <<06858>>29940000
if carry or overflow then                                      <<06858>>29945000
  begin  << system manager must make ldr table smaller >>      <<06858>>29950000
  stat := stat'cdt'overflow;                                   <<06858>>29955000
  end                                                          <<06858>>29960000
else                                                           <<06858>>29965000
  begin <<can procede - get the xds for the cdt>>              <<06858>>29970000
  dst'number := getdataseg(xds'size,xds'size);                 <<06858>>29975000
  if dst'number <= 0 then                                      <<06858>>29980000
     begin  << could not obtain dst >>                         <<06858>>29985000
     stat   := stat'no'dst;                                    <<06858>>29990000
     end                                                       <<06858>>29995000
  else                                                         <<06858>>30000000
     begin <<got the xds for the cdt, now lock,freeze, format>><<06858>>30005000
     << lock and freeze the dst in main memory >>              <<06858>>30010000
     object'ident := buildobjid(dataobject,dst'number,0);      <<06858>>30015000
     lockseg'(object'ident,true);  << place it in a good locati<<06858>>30020000
     freezeseg'(object'ident,0);   << don't allow it to move.  <<06858>>30025000
                                                               <<06858>>30030000
     << format the data segment into the cdt >>                <<06858>>30035000
     format'cdt;                                               <<06858>>30040000
                                                               <<06858>>30045000
     << build object identifier for the cacheseg>>             <<06858>>30050000
     object'ident := buildobjid(slobject,                      <<06858>>30055000
                      logical(@cdt'get'entry) land %377,0);    <<06858>>30060000
                                                               <<06858>>30065000
     << lock and freeze the cacheseg into main memory >>       <<06858>>30070000
     lockseg'(object'ident,true);                              <<06858>>30075000
     freezeseg'(object'ident,0);                               <<06858>>30080000
                                                               <<06858>>30085000
     disable;                                                  <<06858>>30090000
                                                               <<06858>>30095000
     << turn off the cached bit in all disc dits >>            <<06858>>30100000
     init'dits;                                                <<06858>>30105000
                                                               <<06858>>30110000
     <<stuff away cdt dst num & address into sysglob>>         <<06858>>30115000
     cache'dst := dst'number;                                  <<06858>>30120000
     cache'dst'bank := s'dst((dst'number*4)+2); << bank >>     <<06858>>30125000
     cache'dst'ofst := s'dst((dst'number*4)+3); << offset >>   <<06858>>30130000
                                                               <<06858>>30135000
     enable;                                                   <<06858>>30140000
                                                               <<06858>>30145000
     end;                                                      <<06858>>30150000
  end;                                                         <<06858>>30155000
end;  << of subroutine build'cdt>>                             <<06858>>30160000
$page                                                          <<06858>>30165000
subroutine enable'cache;                                       <<06858>>30170000
begin                                                          <<06858>>30175000
                                                               <<06858>>30180000
<< this routine checks whether caching is already enabled again<<06858>>30185000
<< the specified ldev, and if not, proceeds to enable caching o<<06858>>30190000
<< it.  the cache transition flag is set to block any further r<<06858>>30195000
<< uests until all the physical i/o's have completed on this ld<<06858>>30200000
                                                               <<06858>>30205000
disable;     << protect possible concurrent access >>          <<06858>>30210000
                                                               <<06858>>30215000
<< see if ldev is already cached >>                            <<06858>>30220000
lpdt'index := ldev * size'of'lpdt'entry;                       <<07311>>30225000
x := lpdt'dit'ptr;       << dit pointer is placed in index regi<<06858>>30230000
if s'ditp(x).dit'cache'enabled = 1 then                        <<06858>>30235000
  begin  << cache is already enabled on this ldev >>           <<06858>>30240000
  stat := stat'ldev'cached;  << return error code >>           <<06858>>30245000
  end                                                          <<06858>>30250000
else                                                           <<06858>>30255000
   begin <<caching not yet enabled - go ahead>>                <<06858>>30260000
   << get a table entry for this new ldev >>                   <<06858>>30265000
   ctr := cdt'get'entry;                                       <<06858>>30270000
   if ctr = 0 then                                             <<06858>>30275000
     begin  << we could not get an entry >>                    <<06858>>30280000
     stat := stat'int'error;  << indicate software error >>    <<06858>>30285000
     end                                                       <<06858>>30290000
   else                                                        <<06858>>30295000
     begin  <<got a cdt entry for this device>>                <<06858>>30300000
     << increment number of ldevs cached >>                    <<06858>>30305000
     cdt'add'word(0 << header >>,cdt'num'ldevs,1);             <<06858>>30310000
                                                               <<06858>>30315000
     << format this new entry >>                               <<06858>>30320000
     cdt'set'word(ctr,cdt'de'ldev,ldev);                       <<06858>>30325000
                                                               <<06858>>30330000
     << fix pointers >>                                        <<06858>>30335000
     if cdt'get'word(0,cdt'disc'head,0) = 0 then               <<06858>>30340000
        begin   << this is the first disc on the list >>       <<06858>>30345000
        cdt'set'word(0,cdt'disc'head,ctr);                     <<06858>>30350000
        end                                                    <<06858>>30355000
                                                               <<06858>>30360000
     else                                                      <<06858>>30365000
                                                               <<06858>>30370000
        begin  << someone else is on the list >>               <<06858>>30375000
        << use dst'number as index >>                          <<06858>>30380000
        dst'number := cdt'get'word(0,cdt'disc'head,0);         <<06858>>30385000
        while cdt'get'word(dst'number,cdt'de'next'ldev,0)      <<06858>>30390000
                                               <> 0            <<06858>>30395000
        do dst'number :=                                       <<06858>>30400000
           cdt'get'word(dst'number,cdt'de'next'ldev,0);        <<06858>>30405000
        << at this point, we should be at last entry in chain ><<06858>>30410000
        << put new ldev in this ldev's next pointer >>         <<06858>>30415000
        cdt'set'word(dst'number,cdt'de'next'ldev,ctr);         <<06858>>30420000
        << point new ldev entry back to prior ldev entry >>    <<06858>>30425000
        cdt'set'word(ctr,cdt'de'prev'ldev,dst'number);         <<06858>>30430000
        end;                                                   <<06858>>30435000
                                                               <<06858>>30440000
      << finally, turn on the dit'cache'enabled bit in the dit <<06858>>30445000
      lpdt'index := ldev * size'of'lpdt'entry;                 <<*7551>>30450000
      x := lpdt'dit'ptr;      << sysdb ditp in index register ><<06858>>30455000
      s'ditp(x).dit'cache'enabled := 1; << turn on bit >>      <<06858>>30460000
                                                               <<06858>>30465000
      enable;   << let the system rip >>                       <<06858>>30470000
                                                               <<06858>>30475000
      end;                                                     <<06858>>30480000
   end;                                                        <<06858>>30485000
end;  << of subroutine enable'cache >>                         <<06858>>30490000
$page                                                          <<06858>>30495000
<<turn off arithmetic traps, set critical to prevent midway abo<<06858>>30500000
                                                               <<06858>>30505000
turnofftraps;                                                  <<06858>>30510000
old'critical := setcritical;                                   <<06858>>30515000
                                                               <<06858>>30520000
<<serialize cache control thru sir acquisition>>               <<06858>>30525000
                                                               <<06858>>30530000
old'sir := getsir(cache'control'sir);                          <<06858>>30535000
                                                               <<06858>>30540000
<<if caching is permitted on this system and on the >>         <<06858>>30545000
<<specified device, enable caching for the device>>            <<06858>>30550000
                                                               <<06858>>30555000
if not issyscachable then stat := stat'sys'not'cachable else   <<06858>>30560000
   begin  <<system is allowed to have disc caching enabled>>   <<06858>>30565000
   if not isdevcachable(ldev)  then                            <<06858>>30570000
         stat := stat'dev'not'cachable else                    <<06858>>30575000
      begin  <<device is a cachable device>>                   <<06858>>30580000
      stat := stat'ok;  <<initialize to successful completion>><<06858>>30585000
      if cache'dst = 0 then build'cdt; << first enable-build cd<<06858>>30590000
      if stat = stat'ok then enable'cache;                     <<06858>>30595000
      end;                                                     <<06858>>30600000
   end;                                                        <<06858>>30605000
                                                               <<06858>>30610000
<< release sir and reset critical state >>                     <<06858>>30615000
                                                               <<06858>>30620000
relsir(cache'control'sir,old'sir);                             <<06858>>30625000
resetcritical(old'critical);                                   <<06858>>30630000
                                                               <<06858>>30635000
end;  << of procedure cache'ldev >>                            <<06858>>30640000
$page "DISC CACHE ENABLE / DISABLE CONTROL : UNCACHE'LDEV  "   <<06858>>30645000
procedure uncache'ldev(ldev,statr);                            <<06858>>30650000
value ldev;                                                    <<06858>>30655000
integer ldev,statr ;                                           <<06858>>30660000
option privileged,uncallable;                                  <<06858>>30665000
begin                                                          <<06858>>30670000
                                                               <<06858>>30675000
<< uncache'ldev is the executor for the stopcache command.     <<06858>>30680000
                                                               <<06858>>30685000
<< this procedure accepts ldev as input, and manipulates variou<<06858>>30690000
<< i/o and cache tables to disable global caching from that dis<<06858>>30695000
<< if this is the last disc to have caching disabled against it<<06858>>30700000
<< the cache data segment will be unfrozen, unlocked and releas<<06858>>30705000
<< and the cache segment cacheseg will be unfrozen nad unlocked<<06858>>30710000
                                                               <<06858>>30715000
<<*************************************************************<<06858>>30720000
<< input - ldev.  this logical device number is assumed to be a<<06858>>30725000
<<         valid disc logical device configured into the system<<06858>>30730000
<<                                                             <<06858>>30735000
<< output- statr . this integer is returned to the caller to   <<06858>>30740000
<<         indicate the status of the call.  the values returne<<06858>>30745000
<<         are:                                                <<06858>>30750000
<<         0 - call completed successfully.                    <<06858>>30755000
<<         1 - caching was not enabled for any devices         <<06858>>30760000
<<         2 - an internal cache software error occurred.      <<06858>>30765000
<<         3 - the ldev specified did not have caching enabled <<06858>>30770000
<<         5 - the device cannot support caching               <<06858>>30775000
<<         6 - this system is not permitted to use disc caching<<06858>>30780000
<<*************************************************************<<06858>>30785000
                                                               <<06858>>30790000
<<******************* caller environment **********************<<06858>>30795000
<< the caller of this procedure should have db pointing to the <<06858>>30800000
<< stack and be able to be "BLOCKED", as an absence trap might <<06858>>30805000
<< occur during the cache dst initialization.                  <<06858>>30810000
<<                                                             <<06858>>30815000
<< this routine may pdisable/penable at various times to handle<<06858>>30820000
<< syncronization problems.  it also needs to be privileged to <<06858>>30825000
<< access various system tables.                               <<06858>>30830000
<<*************************************************************<<06858>>30835000
                                                               <<06858>>30840000
<<**************** mpe tables accessed ************************<<06858>>30845000
<< cache'dst    - this sysglob cell is read and modified.      <<06858>>30850000
<< lpdt         - this table is read only to obtain disc dit in<<06858>>30855000
<<                and determine the highest ldev configured.   <<06858>>30860000
<< dit          - dit word 0 (flags) is accessed to set/reset b<<06858>>30865000
<<                which is the dit'cache'enabled bit for this d<<06858>>30870000
<<*************************************************************<<06858>>30875000
                                                               <<06858>>30880000
integer old'sir,       << return from getsir              >>   <<06858>>30885000
        old'critical,  << return from setcritical         >>   <<06858>>30890000
        dbsave,        << return from setsysdb            >>   <<06858>>30895000
        stat,          << return status from procedure    >>   <<06858>>30900000
        ldev'index,    << cdt entry of ldev to be uncached>>   <<06858>>30905000
        cdt'entry,     << cdt entry of mapped domain      >>   <<06858>>30910000
        lpdt'index,    << peg for incllpdt                >>   <<06858>>30915000
        prior'ptr,     << prior mapped cdt entry          >>   <<06858>>30920000
        next'ptr,      << next mapped cdt entry           >>   <<06858>>30925000
        save'dst,      << temporarily save dst number     >>   <<*8003>>30930000
        impeded'pin,   << head impeded pin                >>   <<06858>>30935000
        next'pin;      << next pin to be unimpeded        >>   <<06858>>30940000
                                                               <<06858>>30945000
double  object'ident;  << object identifier               >>   <<06858>>30950000
$page                                                          <<06858>>30955000
subroutine deallocate'resources;                               <<06858>>30960000
begin                                                          <<06858>>30965000
                                                               <<06858>>30970000
<< this subroutine cleans-up all code and data structures >>   <<06858>>30975000
<< associated with disc caching.                          >>   <<06858>>30980000
                                                               <<06858>>30985000
<< unlock/unfreeze cache dst >>                                <<06858>>30990000
object'ident := buildobjid(slobject,logical(@cdt'get'entry)    <<06858>>30995000
                land %377,0);                                  <<06858>>31000000
unfreezeseg'(object'ident);                                    <<06858>>31005000
unlockseg'(object'ident);                                      <<06858>>31010000
                                                               <<06858>>31015000
object'ident := buildobjid(dataobject,cache'dst,0);            <<06858>>31020000
unfreezeseg'(object'ident);                                    <<06858>>31025000
unlockseg'(object'ident);                                      <<06858>>31030000
                                                               <<06858>>31035000
<< clean-up sysglob cells >>                                   <<*8003>>31040000
                                                               <<*8003>>31045000
save'dst := cache'dst;                                         <<*8003>>31050000
cache'dst := cache'dst'bank := cache'dst'ofst := 0;            <<*8003>>31055000
                                                               <<*8003>>31060000
penable;                                                       <<*8003>>31065000
                                                               <<*8003>>31070000
<< release the cache xds >>                                    <<06858>>31075000
reldataseg(save'dst);                                          <<*8003>>31080000
                                                               <<06858>>31085000
                                                               <<06858>>31090000
end;                                                           <<06858>>31095000
$page                                                          <<06858>>31100000
turnofftraps;                                                  <<06858>>31105000
dbsave := setsysdb;                                            <<06858>>31110000
old'critical := setcritical;                                   <<06858>>31115000
old'sir := getsir(cache'control'sir);                          <<06858>>31120000
                                                               <<06858>>31125000
<< perform error checking >>                                   <<06858>>31130000
if not issyscachable then                                      <<06858>>31135000
   stat := stat'sys'not'cachable  << caching not permitted >>  <<*7553>>31140000
else if cache'dst = 0 then                                     <<06858>>31145000
   stat := stat'no'dst    << caching not enabled >>            <<*7553>>31150000
else if not isdevcachable(ldev) then                           <<06858>>31155000
   stat := stat'dev'not'cachable   << not a cachable device >> <<*7553>>31160000
else if (ldev'index:=cdt'find'de(ldev)) = 0 then               <<06858>>31165000
   stat := stat'ldev'cached      << device is not cached >>    <<*7553>>31170000
else                                                           <<06858>>31175000
   begin  << turn it off... >>                                 <<06858>>31180000
   stat := stat'ok;                                            <<06858>>31185000
                                                               <<06858>>31190000
   << lock the entire cdt >>                                   <<06858>>31195000
   cdt'set'word(0,cdt'stop'pnd,-1);                            <<06858>>31200000
                                                               <<06858>>31205000
   << flush all domains for this device >>                     <<06858>>31210000
   while (cdt'entry:=cdt'get'word(ldev'index,cdt'de'mapd'head, <<06858>>31215000
          0)) <> 0 or                                          <<06858>>31220000
         (cdt'get'word(ldev'index,cdt'de'regions,0) <> 0) do   <<06858>>31225000
      flush'cache(ldev,0d,%17777777777 d);                     <<06858>>31230000
                                                               <<06858>>31235000
   << turn off cached flag in the dit >>                       <<06858>>31240000
   pdisable;                                                   <<06858>>31245000
   disable;                                                    <<06858>>31250000
   lpdt'index := ldev * size'of'lpdt'entry;                    <<07311>>31255000
   s'ditp(lpdt'dit'ptr).dit'cache'enabled := 0;                <<06858>>31260000
   enable;                                                     <<06858>>31265000
                                                               <<06858>>31270000
   << delink the entry >>                                      <<06858>>31275000
   prior'ptr := cdt'set'word(ldev'index,cdt'de'prev'ldev,0);   <<06858>>31280000
   next'ptr  := cdt'set'word(ldev'index,cdt'de'next'ldev,0);   <<06858>>31285000
   if prior'ptr <> 0 then                                      <<06858>>31290000
      cdt'set'word(prior'ptr,cdt'de'next'ldev,next'ptr)        <<06858>>31295000
   else                                                        <<06858>>31300000
      cdt'set'word(0,cdt'disc'head,next'ptr);                  <<06858>>31305000
                                                               <<06858>>31310000
   if next'ptr <> 0 then                                       <<06858>>31315000
      cdt'set'word(next'ptr,cdt'de'prev'ldev,prior'ptr);       <<06858>>31320000
                                                               <<06858>>31325000
   << release the entry >>                                     <<06858>>31330000
   cdt'free'entry(ldev'index);                                 <<06858>>31335000
                                                               <<06858>>31340000
   << decrement count of cached devices >>                     <<06858>>31345000
   cdt'add'word(0,cdt'num'ldevs,-1);                           <<06858>>31350000
                                                               <<06858>>31355000
   << unlock/unimpede waiting processes >>                     <<06858>>31360000
   cdt'set'word(0,cdt'stop'pnd,0);                             <<06858>>31365000
   impeded'pin := cdt'set'word(0,cdt'stop'queue,0);            <<06858>>31370000
   while impeded'pin <> 0 do                                   <<06858>>31375000
      begin                                                    <<06858>>31380000
      next'pin := unstringheadpin(impeded'pin);                <<06858>>31385000
      unimpede(impeded'pin * pcbsize);                         <<06858>>31390000
      impeded'pin := next'pin;                                 <<06858>>31395000
      end;                                                     <<06858>>31400000
                                                               <<06858>>31405000
   << if there are no more devices, deallocate resources >>    <<06858>>31410000
   if cdt'get'word(0 <<header>>, cdt'disc'head,0) = 0 then     <<*8003>>31415000
      begin                                                    <<*8003>>31420000
      deallocate'resources;  << returns penabled >>            <<*8003>>31425000
      end                                                      <<*8003>>31430000
   else                                                        <<*8003>>31435000
      penable;                                                 <<*8003>>31440000
                                                               <<*8003>>31445000
   end;                                                        <<06858>>31450000
                                                               <<06858>>31455000
<< clean-up >>                                                 <<06858>>31460000
relsir(cache'control'sir,old'sir);                             <<06858>>31465000
resetcritical(old'critical);                                   <<06858>>31470000
resetdb(dbsave);                                               <<06858>>31475000
statr := stat;                                                 <<06858>>31480000
end;   << of procedure uncache'ldev >>                         <<06858>>31485000
$page "CDT'DISPLAY'LDEVS"                                      <<06858>>31490000
$page "CDT'DISPLAY'LDEVS"                                      <<07308>>31495000
procedure cdt'display'ldevs(reset'ttls,rstat);                 <<07308>>31500000
value reset'ttls;                                              <<07308>>31505000
logical reset'ttls;                                            <<07308>>31510000
integer rstat;                                                 <<07308>>31515000
option privileged,uncallable;                                  <<07308>>31520000
begin                                                          <<07308>>31525000
                                                               <<07308>>31530000
<<cdt'display'ldevs is the executor for the showcache cmd.  >> <<07308>>31535000
<< this procedure displays basic caching statistics for all >> <<07308>>31540000
<< cached discs on the system.  the returned value(s) are:  >> <<07308>>31545000
<<                                                          >> <<07308>>31550000
<< rstat    - returned status, where:                       >> <<07308>>31555000
<<            0 - successful                                >> <<07308>>31560000
<<            1 - caching is not enabled on this system.    >> <<07308>>31565000
<<            2 - could not obtain xds to capture data.     >> <<*7553>>31570000
<<            6 - caching not permitted.                    >> <<*7553>>31575000
<<                                                          >> <<07308>>31580000
<< passed parameter is:                                     >> <<07308>>31585000
<< reset'ttls - set to true if caller wishes to reset       >> <<07308>>31590000
<<              cache hit and request counters.             >> <<07308>>31595000
<< **** reset is not currently supported ****               >> <<*7553>>31600000
<< db is assumed to be at the caller's stack.               >> <<07308>>31605000
<<**********************************************************>> <<07308>>31610000
                                                               <<07308>>31615000
array buf(0:39);                                               <<07308>>31620000
byte array b'buf(*) = buf;                                     <<07308>>31625000
                                                               <<07308>>31630000
<< cdt entry save arrays >>                                    <<*7553>>31635000
integer array ld(0:cdt'entry'size-1),                          <<*7553>>31640000
              hd(0:cdt'entry'size-1);  << table header >>      <<*7553>>31645000
                                                               <<*7553>>31650000
double array ldd(*) = ld;                                      <<*7553>>31655000
                                                               <<*7553>>31660000
integer xds,           << entry # of obtained xds  >>          <<*7553>>31665000
        max'index;     << highest entry used in xds>>          <<*7553>>31670000
                                                               <<*7553>>31675000
integer length,    << for printing >>                          <<07308>>31680000
        ldev,      << number of ldev being displayed >>        <<07308>>31685000
        old'sir,   << return value from getsir >>              <<07308>>31690000
        old'crit,  << old value from setcritical>>             <<07308>>31695000
        ldev'link, << pointer to device entry  >>              <<07308>>31700000
        work,      << temp variable            >>              <<07308>>31705000
        ohead,     << number of words in cdt   >>              <<07308>>31710000
        pcnt'mem,  << percent of main memory   >>              <<07308>>31715000
        pcnt'read, << % of reads to all reqs.  >>              <<07308>>31720000
        rpercent,  << read hit ratio on disc   >>              <<07308>>31725000
        wpercent;  << write hit ratio on disc  >>              <<07308>>31730000
                                                               <<07308>>31735000
double rhit,      << number of read cache hits >>              <<07308>>31740000
       whit,      << number of write cache hits>>              <<07308>>31745000
       rmiss,    << number of cache read misses on this ldev >><<07308>>31750000
       wmiss,    << number of cache write misses on this ldev>><<07308>>31755000
       writes,     << number of cache write requests      >>   <<07308>>31760000
       twrites,    << total # of cache write requests     >>   <<07308>>31765000
       trhit,     << total # read hits for all ldev's         ><<07308>>31770000
       twhit,     << total # write hits for all ldev's        ><<07308>>31775000
       trmiss,   << total # of read misses for all ldev's    >><<07308>>31780000
       twmiss,   << total # of write misses for all ldev's   >><<07308>>31785000
       stops,      << number of process stops on this ldev     <<07308>>31790000
       tstops,     << total # of process stops on this ldev    <<07308>>31795000
       pages,      << number of pages consumed by this dev>>   <<07308>>31800000
       tpages,     << total # of pages by all devices     >>   <<07308>>31805000
       regions,    << number of cached domains for disc   >>   <<07308>>31810000
       tregions,   << total # of cached domains for all   >>   <<07308>>31815000
       tmemory,    << total bytes of main memory          >>   <<07308>>31820000
       requests;   << total number of cache requests on this ld<<07308>>31825000
                                                               <<07308>>31830000
logical ovrflow;           << an arithmetic overflow occurred ><<07308>>31835000
                                                               <<07308>>31840000
equate nbanksinx = %1047;  << sysglob cell indicating # banks>><<07308>>31845000
                                                               <<07308>>31850000
if not issyscachable then                                      <<*7553>>31855000
   begin                                                       <<*7553>>31860000
   rstat := stat'sys'not'cachable;                             <<*7553>>31865000
   return;                                                     <<*7553>>31870000
   end;                                                        <<*7553>>31875000
                                                               <<*7553>>31880000
<< we can't abort here... >>                                   <<07308>>31885000
old'crit := setcritical;                                       <<07308>>31890000
                                                               <<07308>>31895000
<< obtain sir to protect integrity >>                          <<07308>>31900000
old'sir := getsir(cache'control'sir);                          <<07308>>31905000
                                                               <<07308>>31910000
<< check if caching is enabled >>                              <<07308>>31915000
if cache'dst = 0 then                                          <<07308>>31920000
  begin  << caching is not enabled >>                          <<07308>>31925000
  rstat := stat'no'dst;                                        <<*7553>>31930000
  relsir(cache'control'sir,old'sir);                           <<*7553>>31935000
  end                                                          <<07308>>31940000
else                                                           <<07308>>31945000
  begin                                                        <<07308>>31950000
                                                               <<07308>>31955000
  turnofftraps;                                                <<07308>>31960000
                                                               <<07308>>31965000
  << get xds to copy data to >>                                <<*7553>>31970000
  length := cdt'entry'size *                                   <<*7553>>31975000
            integer(cdt'get'word(0,cdt'num'ldevs,0));          <<*7553>>31980000
  getdseg(xds,length,0);                                       <<*7553>>31985000
  if xds <= 0 then                                             <<*7553>>31990000
    begin                                                      <<*7553>>31995000
    rstat := stat'int'error;                                   <<*7553>>32000000
    relsir(cache'control'sir,old'sir);                         <<*7553>>32005000
    end                                                        <<*7553>>32010000
  else                                                         <<*7553>>32015000
                                                               <<*7553>>32020000
  begin                                                        <<*7553>>32025000
  << couldn't indent here... >>                                <<*7553>>32030000
  << copy cdt entries to xds >>                                <<*7553>>32035000
  ldev'link := cdt'get'word(0<<hdr>>,cdt'disc'head,0);         <<*7553>>32040000
  max'index := -1;                                             <<*7553>>32045000
  while (ldev'link <> 0) do                                    <<*7553>>32050000
    begin                                                      <<*7553>>32055000
    max'index := max'index + 1;                                <<*7553>>32060000
    length := -1;                                              <<*7553>>32065000
    pdisable;                                                  <<*7553>>32070000
    while (length:=length+1) < cdt'entry'size do               <<*7553>>32075000
      ld(length) := cdt'get'word(ldev'link,length,0);          <<*7553>>32080000
    penable;                                                   <<*7553>>32085000
    << copy data to xds >>                                     <<*7553>>32090000
    dmovout(xds,max'index*cdt'entry'size,cdt'entry'size,ld);   <<*7553>>32095000
    ldev'link  := ld(cdt'de'next'ldev);                        <<*7553>>32100000
    end;   << while loop >>                                    <<*7553>>32105000
                                                               <<*7553>>32110000
  << save cdt header >>                                        <<*7553>>32115000
  length := -1;                                                <<*7553>>32120000
  while (length:=length+1) < cdt'entry'size do                 <<*7553>>32125000
    hd(length) := cdt'get'word(0,length,0);                    <<*7553>>32130000
                                                               <<*7553>>32135000
  << release cdt sir >>                                        <<*7553>>32140000
  relsir(cache'control'sir,old'sir);                           <<*7553>>32145000
                                                               <<*7553>>32150000
  << loop through all cached discs >>                          <<07308>>32155000
  print(buf,0,0);   << one line space >>                       <<07308>>32160000
  trhit := twhit := trmiss := twmiss :=                        <<07308>>32165000
  twrites := tregions := tpages := tstops := 0d;               <<07308>>32170000
  ovrflow := false;                                            <<07308>>32175000
                                                               <<07308>>32180000
  move buf :=                                                  <<07308>>32185000
"DISC   CACHE    READ WRITE        PROCESS               % OF    CACHE" 32190000
,2;                                                            <<07308>>32195000
  length := tos - @buf;                                        <<07308>>32200000
  print(buf,length,0);                                         <<07308>>32205000
                                                               <<07308>>32210000
  move buf :=                                                  <<07308>>32215000
"LDEV  REQUESTS  HIT%  HIT%  READ%  STOPS      K-BYTES  MEMORY  DOMAINS"32220000
,2;                                                            <<07308>>32225000
  length := tos - @buf;                                        <<07308>>32230000
  print(buf,length,0);                                         <<07308>>32235000
                                                               <<07308>>32240000
  buf := "--";                                                 <<07308>>32245000
  move buf(1) := buf,(length-1);                               <<07308>>32250000
  print(buf,length,0);                                         <<07308>>32255000
  print(buf,0,0);  << space >>                                 <<07308>>32260000
                                                               <<07308>>32265000
  << get main memory size in bytes >>                          <<07308>>32270000
  tmemory := double(absolute(nbanksinx)) * 131072d;            <<07308>>32275000
                                                               <<07308>>32280000
  << get cache data segment words >>                           <<07308>>32285000
  ohead := hd(cdt'dst'words);                                  <<*7553>>32290000
                                                               <<07308>>32295000
  ldev'link := 0;                                              <<*7553>>32300000
  while ldev'link <= max'index do                              <<*7553>>32305000
    begin                                                      <<07308>>32310000
    << get statistics >>                                       <<07308>>32315000
    << load entry from xds >>                                  <<*7553>>32320000
    dmovin(xds,ldev'link * cdt'entry'size,cdt'entry'size,ld);  <<*7553>>32325000
                                                               <<*7553>>32330000
    rhit := ldd(cdt'de'rhit/2);                                <<*7553>>32335000
    whit := ldd(cdt'de'whit/2);                                <<*7553>>32340000
    rmiss := ldd(cdt'de'rmiss/2);                              <<*7553>>32345000
    wmiss := ldd(cdt'de'wmiss/2);                              <<*7553>>32350000
    stops := ldd(cdt'de'stop/2);                               <<*7553>>32355000
                                                               <<07308>>32360000
    work := ld(cdt'de'mapd'pages);                             <<*7553>>32365000
    pages := double(work);                                     <<07308>>32370000
    work := ld(cdt'de'regions);                                <<*7553>>32375000
    regions := double(work);                                   <<07308>>32380000
                                                               <<07308>>32385000
    << since there is 1 page overhead per mapped domain, >>    <<07308>>32390000
    << mask it off.                                      >>    <<07308>>32395000
    pages := pages - regions;                                  <<07308>>32400000
                                                               <<07308>>32405000
    ldev := ld(cdt'de'ldev);                                   <<*7553>>32410000
    requests := rhit + rmiss + whit + wmiss;                   <<07308>>32415000
    if overflow then requests := 0d;                           <<07308>>32420000
    if requests = 0d then   << no hits/misses >>               <<07308>>32425000
      begin                                                    <<07308>>32430000
      pcnt'read := 0;                                          <<07308>>32435000
      rpercent  := wpercent := 0;                              <<07308>>32440000
      end                                                      <<07308>>32445000
    else                                                       <<07308>>32450000
      begin                                                    <<07308>>32455000
      pcnt'read:=integer(                                      <<07308>>32460000
                 (requests-whit-wmiss)*100d / requests         <<07308>>32465000
                 );                                            <<07308>>32470000
      rpercent := integer((rhit*100d)/(rhit+rmiss));           <<07308>>32475000
      wpercent := integer((whit*100d)/(whit+wmiss));           <<07308>>32480000
      end;                                                     <<07308>>32485000
                                                               <<07308>>32490000
    trhit := trhit + rhit;                                     <<07308>>32495000
    if overflow then ovrflow := true;                          <<07308>>32500000
    twhit := twhit + whit;                                     <<07308>>32505000
    if overflow then ovrflow := true;                          <<07308>>32510000
    trmiss := trmiss + rmiss;                                  <<07308>>32515000
    if overflow then ovrflow := true;                          <<07308>>32520000
    twmiss := twmiss + wmiss;                                  <<07308>>32525000
    if overflow then ovrflow := true;                          <<07308>>32530000
    tpages := tpages + pages;                                  <<07308>>32535000
    if overflow then ovrflow := true;                          <<07308>>32540000
    tregions := tregions + regions;                            <<07308>>32545000
    if overflow then ovrflow := true;                          <<07308>>32550000
    tstops := tstops + stops;                                  <<07308>>32555000
    if overflow then ovrflow := true;                          <<07308>>32560000
                                                               <<07308>>32565000
    << perform interum calculations >>                         <<07308>>32570000
    pages := pages * 256d;   << number of bytes >>             <<07308>>32575000
    pcnt'mem := integer((pages*100d)/tmemory);                 <<07308>>32580000
    pages := (pages+512d)/1024d;  << number of k-bytes >>      <<07308>>32585000
                                                               <<07308>>32590000
    buf := "  ";                                               <<07308>>32595000
    move buf(1) := buf,(39);                                   <<07308>>32600000
    ascii(ldev,10,b'buf);                                      <<07308>>32605000
    dascii(requests,10,b'buf(6));                              <<07308>>32610000
    ascii(rpercent,10,b'buf(17));                              <<07308>>32615000
    ascii(wpercent,10,b'buf(23));                              <<07308>>32620000
    ascii(pcnt'read,10,b'buf(29));                             <<07308>>32625000
    dascii(stops,10,b'buf(34));                                <<07308>>32630000
    dascii(pages,10,b'buf(46));                                <<07308>>32635000
    ascii(pcnt'mem,10,b'buf(58));                              <<07308>>32640000
    length := dascii(regions,10,b'buf(64));                    <<07308>>32645000
    length := length + 64;                                     <<07308>>32650000
    print(buf,-length,0);                                      <<07308>>32655000
                                                               <<07308>>32660000
    ldev'link := ldev'link + 1;                                <<*7553>>32665000
    end;  << of while >>                                       <<07308>>32670000
                                                               <<07308>>32675000
  << print final results >>                                    <<07308>>32680000
  print(buf,0,0);                                              <<07308>>32685000
  buf := "  ";                                                 <<07308>>32690000
  move buf(1) := buf,(39);                                     <<07308>>32695000
                                                               <<07308>>32700000
  move buf := "Total";                                         <<07308>>32705000
  if ovrflow then                                              <<07308>>32710000
    begin                                                      <<07308>>32715000
    move b'buf(6) := "* * Arithmetic overflow * *",2;          <<07308>>32720000
    length := tos - @b'buf;                                    <<07308>>32725000
    print(buf,-length,0);                                      <<07308>>32730000
    end                                                        <<07308>>32735000
  else                                                         <<07308>>32740000
    begin                                                      <<07308>>32745000
    requests := trhit + trmiss + twhit + twmiss;               <<07308>>32750000
    if overflow then requests := 0d;                           <<07308>>32755000
    if requests = 0d then                                      <<07308>>32760000
      begin                                                    <<07308>>32765000
      pcnt'read := 0;                                          <<07308>>32770000
      rpercent := 0;                                           <<07308>>32775000
      wpercent := 0;                                           <<07308>>32780000
      end                                                      <<07308>>32785000
    else                                                       <<07308>>32790000
      begin                                                    <<07308>>32795000
      if ((trhit+trmiss)=0d) then                              <<07308>>32800000
        begin                                                  <<07308>>32805000
        rpercent := 0;                                         <<07308>>32810000
        end                                                    <<07308>>32815000
      else                                                     <<07308>>32820000
        begin                                                  <<07308>>32825000
        rpercent := integer((trhit*100d)/(trhit + trmiss));    <<07308>>32830000
        end;                                                   <<07308>>32835000
                                                               <<07308>>32840000
      pcnt'read := integer((requests-twhit-twmiss)             <<07308>>32845000
                   *100d/requests);                                     32850000
                                                               <<07308>>32855000
      if ((twhit+twmiss)=0d) then                              <<07308>>32860000
        begin                                                  <<07308>>32865000
        wpercent := 0;                                         <<07308>>32870000
        end                                                    <<07308>>32875000
      else                                                     <<07308>>32880000
        begin                                                  <<07308>>32885000
        wpercent := integer((twhit*100d)/(twhit + twmiss));    <<07308>>32890000
        end;                                                   <<07308>>32895000
      end;                                                     <<07308>>32900000
                                                               <<07308>>32905000
    dascii(requests,10,b'buf(6));                              <<07308>>32910000
    ascii(rpercent,10,b'buf(17));                              <<07308>>32915000
    ascii(wpercent,10,b'buf(23));                              <<07308>>32920000
    ascii(pcnt'read,10,b'buf(29));                             <<07308>>32925000
    dascii(tstops,10,b'buf(34));                               <<07308>>32930000
    tpages := tpages * 256d;                                   <<07308>>32935000
    if overflow then tpages := 0d;                             <<07308>>32940000
    pcnt'mem := integer((tpages*100d)/tmemory);                <<07308>>32945000
    tpages := (tpages + 512d) / 1024d;                         <<07308>>32950000
    dascii(tpages,10,b'buf(46));                               <<07308>>32955000
    ascii(pcnt'mem,10,b'buf(58));                              <<07308>>32960000
    length := dascii(tregions,10,b'buf(64));                   <<07308>>32965000
    length := length + 64;                                     <<07308>>32970000
    print(buf,-length,0);                                      <<07308>>32975000
                                                               <<07308>>32980000
    print(buf,0,0);                                            <<*7553>>32985000
                                                               <<*7553>>32990000
    << print percent of user i/o eliminated >>                 <<*7553>>32995000
                                                               <<*7553>>33000000
    length := dascii(if requests=0d then 0d                    <<*7553>>33005000
              else ((trhit*100d)/requests),10,b'buf(0));       <<*7553>>33010000
    move b'buf(length) := "% of user I/Os eliminated.",2;      <<*7553>>33015000
    length := tos - @b'buf;                                    <<*7553>>33020000
    print(buf,-length,0);                                      <<*7553>>33025000
                                                               <<*7553>>33030000
    << print cache overhead number >>                          <<*7553>>33035000
                                                               <<*7553>>33040000
    move b'buf := "Data overhead is ",2;                       <<07308>>33045000
    length := tos - @b'buf;                                    <<07308>>33050000
    length := length + dascii(((tregions*256d)+                <<07308>>33055000
       double(ohead))/1024d,10,b'buf(length));                 <<07308>>33060000
    move b'buf(length) := "K bytes. ",2;                       <<*7553>>33065000
    length := tos - @b'buf;                                    <<07308>>33070000
    print(buf,-length,0);                                      <<07308>>33075000
                                                               <<07308>>33080000
    move b'buf:="Sequential fetch quantum is ",2;              <<07308>>33085000
    length := tos - @b'buf;                                    <<07308>>33090000
    length := length + ascii(hd(cdt'seq'minftch),              <<*7553>>33095000
                             10,                               <<*7553>>33100000
                             b'buf(length));                   <<*7553>>33105000
    move b'buf(length):=" sectors.",2;                         <<07308>>33110000
    length := tos - @b'buf;                                    <<07308>>33115000
    print(buf,-length,0);                                      <<07308>>33120000
                                                               <<07308>>33125000
    move b'buf:="Random fetch quantum is ",2;                  <<07308>>33130000
    length := tos - @b'buf;                                    <<07308>>33135000
    length := length + ascii(hd(cdt'rnd'minftch),              <<*7553>>33140000
                             10,                               <<*7553>>33145000
                             b'buf(length));                   <<*7553>>33150000
    move b'buf(length):=" sectors.",2;                         <<07308>>33155000
    length := tos - @b'buf;                                    <<07308>>33160000
    print(buf,-length,0);                                      <<07308>>33165000
    move b'buf := "Block on Write = ", 2;                      <<*7551>>33170000
    length := tos - @b'buf;                                    <<*7551>>33175000
    if hd(cdt'force'post) = 0                                  <<*7553>>33180000
      then move b'buf(length) := "NO.", 2                      <<*7551>>33185000
    else move b'buf(length) := "YES. ", 2;                     <<*7551>>33190000
    length := tos - @b'buf;                                    <<*7551>>33195000
    print(buf,-length,0);                                      <<*7551>>33200000
    end;                                                       <<07308>>33205000
                                                               <<07308>>33210000
  print(buf,0,0);                                              <<07308>>33215000
  rstat := 0;                                                  <<07308>>33220000
  << release xds >>                                            <<*7553>>33225000
  freedseg(xds,0);                                             <<*7553>>33230000
  end;                                                         <<07308>>33235000
                                                               <<07308>>33240000
  end;                                                         <<*7553>>33245000
resetcritical(old'crit);                                       <<07308>>33250000
                                                               <<07308>>33255000
end;  << of procedure cdt'display'discs >>                     <<07308>>33260000
$page "CDT'SET'SEQ / CDT'SET'RND / CDT'SET'POST procedure"     <<07308>>33265000
procedure cdt'set'seq(parm,rstat);                             <<07308>>33270000
value parm;                                                    <<07308>>33275000
integer parm,rstat;                                            <<07308>>33280000
option privileged,uncallable;                                  <<07308>>33285000
begin                                                          <<07308>>33290000
                                                               <<07308>>33295000
<<cdt'set'seq is one of the executors for the cachecontrol cmd <<07308>>33300000
                                                               <<07308>>33305000
<< this procedure sets basic caching strategy and policy    >> <<07308>>33310000
<< parameters for all discs.    the returned value(s) are:  >> <<07308>>33315000
<<                                                          >> <<07308>>33320000
<< rstat    - returned status, where:                       >> <<07308>>33325000
<<            0 - successful                                >> <<07308>>33330000
<<            1 - caching is not enabled on this system.    >> <<07308>>33335000
<<            6 - caching not permitted.                    >> <<*7553>>33340000
<<                                                          >> <<07308>>33345000
<< passed parameter is:                                     >> <<07308>>33350000
<< parm       - set to 1 to 96 to indicate the fetch        >> <<07308>>33355000
<<              quantum on cdt'set'seq and cdt'set'rnd (in  >> <<07308>>33360000
<<              sectors).  in cdt'set'post, a non-zero value>> <<07308>>33365000
<<              indicates that caching should only notify   >> <<07308>>33370000
<<              the user of a write completion when the     >> <<07308>>33375000
<<              actual physical write has completed.        >> <<07308>>33380000
<<                                                          >> <<07308>>33385000
<< db is assumed to be at the caller's stack.               >> <<07308>>33390000
<<**********************************************************>> <<07308>>33395000
                                                               <<07308>>33400000
integer old'sir,   << return value from getsir >>              <<07308>>33405000
        old'crit,  << old value from setcritical>>             <<07308>>33410000
        entry'index; << index to which entry point was called ><<07308>>33415000
                                                               <<07308>>33420000
entry cdt'set'rnd, cdt'set'post;                               <<07308>>33425000
                                                               <<07308>>33430000
entry'index := 0;    << set'seq >>                             <<07308>>33435000
go to start;                                                   <<07308>>33440000
                                                               <<07308>>33445000
cdt'set'rnd:                                                   <<07308>>33450000
entry'index := 1;    << set'rnd >>                             <<07308>>33455000
go to start;                                                   <<07308>>33460000
                                                               <<07308>>33465000
cdt'set'post:                                                  <<07308>>33470000
entry'index := 2;                                              <<07308>>33475000
go to start;                                                   <<07308>>33480000
                                                               <<07308>>33485000
start:                                                         <<07308>>33490000
                                                               <<07308>>33495000
if not issyscachable then                                      <<*7553>>33500000
   begin                                                       <<*7553>>33505000
   rstat := stat'sys'not'cachable;                             <<*7553>>33510000
   return;                                                     <<*7553>>33515000
   end;                                                        <<*7553>>33520000
                                                               <<*7553>>33525000
<< we can't abort here... >>                                   <<07308>>33530000
old'crit := setcritical;                                       <<07308>>33535000
                                                               <<07308>>33540000
<< obtain sir to protect integrity >>                          <<07308>>33545000
old'sir := getsir(cache'control'sir);                          <<07308>>33550000
                                                               <<07308>>33555000
<< see if caching is enabled >>                                <<07308>>33560000
if cache'dst = 0 then                                          <<07308>>33565000
  rstat := stat'no'dst                                         <<*7553>>33570000
else                                                           <<07308>>33575000
  begin                                                        <<07308>>33580000
                                                               <<07308>>33585000
  << set the appropriate parameter >>                          <<07308>>33590000
  case entry'index of                                          <<07308>>33595000
    begin                                                      <<07308>>33600000
                                                               <<07308>>33605000
<<0 - seq >>                                                   <<07308>>33610000
    begin                                                      <<07308>>33615000
    if not (1 <= parm <= 96) then                              <<07308>>33620000
      parm := cache'sequential;                                <<07308>>33625000
    cdt'set'word(0,cdt'seq'minftch,parm);                      <<07308>>33630000
    end;                                                       <<07308>>33635000
                                                               <<07308>>33640000
<<1 - rnd >>                                                   <<07308>>33645000
    begin                                                      <<07308>>33650000
    if not (1 <= parm <= 96) then                              <<07308>>33655000
      parm := cache'random;                                    <<07308>>33660000
    cdt'set'word(0,cdt'rnd'minftch,parm);                      <<07308>>33665000
    end;                                                       <<07308>>33670000
                                                               <<07308>>33675000
<<2- post notification >>                                      <<07308>>33680000
    begin                                                      <<07308>>33685000
    cdt'set'word(0,cdt'force'post,if(parm=0)then 0 else -1);            33690000
    end;                                                       <<07308>>33695000
                                                               <<07308>>33700000
    end;  << of case on entry'index >>                         <<07308>>33705000
                                                               <<07308>>33710000
  rstat := 0;   << return a good status >>                     <<07308>>33715000
  end;                                                         <<07308>>33720000
                                                               <<07308>>33725000
relsir(cache'control'sir,old'sir);                             <<07308>>33730000
resetcritical(old'crit);                                       <<07308>>33735000
end;                                                           <<07308>>33740000
                                                               <<06858>>33745000
$page "ShutDownCaching"                                        <<*8596>>33750000
procedure shutdowncaching;                                     <<*8596>>33755000
   option privileged, uncallable;                              <<*8596>>33760000
begin                                                          <<*8596>>33765000
                                                               <<*8596>>33770000
<< this procedure will stop caching on all discs currently >>  <<*8596>>33775000
<< cached. this is called by progen on =shutdown.          >>  <<*8596>>33780000
                                                               <<*8596>>33785000
integer                                                        <<*8596>>33790000
   dev'entry,                                                  <<*8596>>33795000
   dummy,                                                      <<*8596>>33800000
   ldev;                                                       <<*8596>>33805000
                                                               <<*8596>>33810000
disable;                                                       <<*8596>>33815000
if cache'dst <> 0 then                                         <<*8596>>33820000
   begin                                                       <<*8596>>33825000
   dev'entry := cdt'get'word(0 <<header>>,cdt'disc'head,0);    <<*8596>>33830000
   while dev'entry <> 0 do                                     <<*8596>>33835000
      begin                                                    <<*8596>>33840000
      ldev := cdt'get'word(dev'entry,cdt'de'ldev,0);           <<*8596>>33845000
      dev'entry := cdt'get'word(dev'entry,cdt'de'next'ldev,0); <<*8596>>33850000
      uncache'ldev(ldev,dummy);                                <<*8596>>33855000
      end;                                                     <<*8596>>33860000
   end;                                                        <<*8596>>33865000
end;     << procedure shutdowncaching >>                       <<*8596>>33870000
$title " "                                                     <<*8596>>33875000
$control segment = main                                        <<06858>>33880000
end.  <<cacheseg>>                                             <<06858>>33885000
